diff --git a/harbour/ChangeLog b/harbour/ChangeLog index e537bee586..8008ebbd30 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,14 @@ +2000-11-01 04:25 UTC+0800 Ron Pinkas + + * source/compiler/harbour.slx + + Added support for pseudo function _GET_(...) + * source/compiler/harbour.sly + + Added support for pseudo function _GET_(...) to be converted into appropriate __GET(...) or __GETA(...) + * source/rtl/tget.prg + + Added __GETA() to correctly support early binding of Array Element Index of GET + * tests/testread.prg + + Added code to test correct (early) binding of Array Element Index of GET + 2000-10-31 20:56 GMT+1 JFL (Mafact) * source/vm/classes.c * Bug correction where __OBJHASMSG() returned True when no msg exist diff --git a/harbour/source/compiler/harbour.slx b/harbour/source/compiler/harbour.slx index d1f2691db5..3b2e4be589 100644 --- a/harbour/source/compiler/harbour.slx +++ b/harbour/source/compiler/harbour.slx @@ -265,7 +265,8 @@ LANGUAGE_WORDS_ARE { LEX_WORD( "STEP" ) AS_TOKEN( HB_STEP ), LEX_WORD( "TO" ) AS_TOKEN( HB_TO ), LEX_WORD( "WITH" ) AS_TOKEN( HB_WITH ), - LEX_WORD( "_FIELD" ) AS_TOKEN( FIELD ) + LEX_WORD( "_FIELD" ) AS_TOKEN( FIELD ), + LEX_WORD( "_GET_" ) AS_TOKEN( GET ) }; /* Intermediate Reductions when still ambigious or need further reductions. */ @@ -380,9 +381,12 @@ LANGUAGE_RULES_ARE { IF_SEQUENCE_IS( OPTIONAL , '@' , 0 , 0 ) PASS_THROUGH(), IF_SEQUENCE_IS( OPTIONAL , 0 , 0 , 0 ) REDUCE_TO( HB_IDENTIFIER , 0 ), - IF_SEQUENCE_IS( PROCREQ , '(' , 0 , 0 ) PASS_THROUGH(), + IF_SEQUENCE_IS( PROCREQ , '(' , 0 , 0 ) REDUCE_TO( PROCREQ + DONT_REDUCE, 0 ), IF_SEQUENCE_IS( PROCREQ , 0 , 0 , 0 ) REDUCE_TO( HB_IDENTIFIER , 0 ), + IF_SEQUENCE_IS( GET , '(' , 0 , 0 ) REDUCE_TO( GET + DONT_REDUCE , 0 ), + IF_SEQUENCE_IS( GET , 0 , 0 , 0 ) REDUCE_TO( HB_IDENTIFIER , 0 ), + IF_SEQUENCE_IS( NE1 , _LINE_ , 0 , 0 ) REDUCE_TO( LINE + DONT_REDUCE, 0 ), IF_SEQUENCE_IS( _LINE_ , 0 , 0 , 0 ) REDUCE_TO( HB_IDENTIFIER , 0 ), diff --git a/harbour/source/compiler/harbour.sly b/harbour/source/compiler/harbour.sly index 1aa99df173..3535c16c5f 100644 --- a/harbour/source/compiler/harbour.sly +++ b/harbour/source/compiler/harbour.sly @@ -160,7 +160,7 @@ static void hb_compDebugStart( void ) { }; %token MACROVAR MACROTEXT %token AS_ARRAY AS_BLOCK AS_CHARACTER AS_CLASS AS_DATE AS_LOGICAL AS_NUMERIC AS_OBJECT AS_VARIANT DECLARE OPTIONAL DECLARE_CLASS DECLARE_MEMBER %token AS_ARRAY_ARRAY AS_BLOCK_ARRAY AS_CHARACTER_ARRAY AS_CLASS_ARRAY AS_DATE_ARRAY AS_LOGICAL_ARRAY AS_NUMERIC_ARRAY AS_OBJECT_ARRAY -%token PROCREQ +%token PROCREQ GET /*the lowest precedence*/ /*postincrement and postdecrement*/ @@ -229,6 +229,7 @@ static void hb_compDebugStart( void ) { }; %type DimIndex DimList %type FieldAlias FieldVarAlias %type PostOp +%type Get GetA GetBlock GetArrayIndex GetIndexList GetAliasVar %% @@ -632,6 +633,8 @@ ObjectData : NumValue ':' SendId { $$ = hb_compExprNewSend( $1, $3 ); } | MacroVar ':' SendId { $$ = hb_compExprNewSend( $1, $3 ); } | MacroExpr ':' SendId { $$ = hb_compExprNewSend( $1, $3 ); } | FunCall ':' SendId { $$ = hb_compExprNewSend( $1, $3 ); } + | Get ':' SendId { $$ = hb_compExprNewSend( $1, $3 ); } + | GetA ':' SendId { $$ = hb_compExprNewSend( $1, $3 ); } | IfInline ':' SendId { $$ = hb_compExprNewSend( $1, $3 ); } | PareExpList ':' SendId { $$ = hb_compExprNewSend( $1, $3 ); } | VariableAt ':' SendId { $$ = hb_compExprNewSend( $1, $3 ); } @@ -971,6 +974,43 @@ CodeBlock : '{' '|' { $$ = hb_compExprNewCodeBlock(); } BlockNoVar '|' BlockExpList '}' { $$ = $3; } ; +Get : GET Variable ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $2 ), $4 ), $6 ), $8 ), $10 ), $12 ) ); } + | GET GetAliasVar ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $2 ), $4 ), $6 ), $8 ), $10 ), $12 ) ); } + | GET MacroVar ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $2 ), $4 ), $6 ), $8 ), $10 ), $12 ) ); } + ; + +GetA : GET Variable GetArrayIndex ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $2 ), $5 ), $7 ), $9 ), $11 ), $13 ), $3 ) ); } + | GET GetAliasVar GetArrayIndex ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $2 ), $5 ), $7 ), $9 ), $11 ), $13 ), $3 ) ); } + | GET MacroVar GetArrayIndex ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $2 ), $5 ), $7 ), $9 ), $11 ), $13 ), $3 ) ); } + ; + +GetAliasVar: NumAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); } + | MacroVarAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); } + | MacroExprAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); } + | PareExpListAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); } + | VarAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); } + | FieldAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); } + | FieldVarAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); } + ; + +GetBlock : /* nothing => nil */ { $$ = hb_compExprNewEmpty(); } + | CodeBlock + ; + +GetArrayIndex : GetIndexList ']' { $$ = hb_compExprNewArray( $1 ); } + ; + +GetIndexList : '[' Expression { $$ = hb_compExprNewList( $2 ); } + | GetIndexList ',' Expression { $$ = hb_compExprAddListExpr( $1, $3 ); } + | GetIndexList ']' '[' Expression { $$ = hb_compExprAddListExpr( $1, $4 ); } + ; + /* NOTE: This uses $-2 then don't use BlockExpList in other context */ BlockExpList : Expression { $$ = hb_compExprAddListExpr( $-2, $1 ); } diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index 18e1fa429f..b90d1e5e2f 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -1108,6 +1108,7 @@ return Get():New( nRow, nCol, bVarBlock, cVarName, cPicture, cColor ) /* NOTE: Same as _GET_() */ FUNCTION __GET( uVar, cVarName, cPicture, bValid, bWhen, bSetGet ) + LOCAL oGet := Get():New(,, bSetGet, cVarName, cPicture ) uVar := uVar // Suppress unused variable warning @@ -1115,11 +1116,29 @@ FUNCTION __GET( uVar, cVarName, cPicture, bValid, bWhen, bSetGet ) oGet:PreBlock := bWhen oGet:PostBlock := bValid - RETURN oGet +RETURN oGet + +FUNCTION __GETA( aBaseVar, cVarName, cPicture, bValid, bWhen, bSetGet, anIndex ) + + LOCAL oGet, cIndex := '', nLen := Len( anIndex ), Counter + + FOR Counter := 1 TO nLen + cIndex += '[' + LTrim( Str( anIndex[ Counter ] ) ) + ']' + NEXT + + bSetGet := {|x| M->__aArray := aBaseVar, IIF( x == NIL, M->&( "__aArray" + cIndex ), M->&( "__aArray" + cIndex ) := x ) } + + oGet := Get():New(,, bSetGet, cVarName, cPicture ) + + oGet:PreBlock := bWhen + oGet:PostBlock := bValid + +RETURN oGet /* NOTE: Same as __GET() */ FUNCTION _GET_( uVar, cVarName, cPicture, bValid, bWhen, bSetGet ) + LOCAL oGet := Get():New(,, bSetGet, cVarName, cPicture ) uVar := uVar // Suppress unused variable warning diff --git a/harbour/tests/testread.prg b/harbour/tests/testread.prg index 52b9d1f0ec..a616dd5dd1 100644 --- a/harbour/tests/testread.prg +++ b/harbour/tests/testread.prg @@ -9,6 +9,8 @@ function Main() local cName := "Harbour " local cWish := "Power " local cEffort := "Join us! " + local acVars := { "Hello", "World" }, Counter + local GetList := {} SET COLOR TO GR+/B, W+/BG @@ -19,12 +21,19 @@ function Main() @ 2, 2 SAY " Enter your name:" GET cName @ 4, 2 SAY " Enter your wish:" GET cWish @ 6, 2 SAY "Enter your effort:" GET cEffort + + FOR Counter := 1 TO Len( acVars ) + @ Row() + 2, 2 SAY "Array Element [" + Str( Counter, 1 ) + "]: " GET acVars[ Counter ] + NEXT + READ - @ 8, 2 + @ Row() + 2, 2 ? cName ? cWish ? cEffort + ? acVars[1] + ? acVars[2] return nil