fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2000-11-01 04:25 UTC+0800 Ron Pinkas <ron@profit-master.com>

Browse Source 
* 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
This commit is contained in:
Ron Pinkas
2000-11-01 12:23:24 +00:00
parent f4f1bdab20
commit 97f36b7075
5 changed files with 88 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
harbour/ChangeLog
View File

@@ -1,3 +1,14 @@
2000-11-01 04:25 UTC+0800 Ron Pinkas <ron@profit-master.com>
* 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) <jfl@mafact.com>
* source/vm/classes.c
* Bug correction where __OBJHASMSG() returned True when no msg exist

8
harbour/source/compiler/harbour.slx
View File

@@ -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 ),

42
harbour/source/compiler/harbour.sly
View File

@@ -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 <asExpr> DimIndex DimList
%type <asExpr> FieldAlias FieldVarAlias
%type <asExpr> PostOp
%type <asExpr> 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 : '{' '|' { $<asExpr>$ = hb_compExprNewCodeBlock(); } BlockNoVar
'|' BlockExpList '}' { $$ = $<asExpr>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( $<asExpr>-2, $1 ); }

21
harbour/source/rtl/tget.prg
View File

@@ -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

11
harbour/tests/testread.prg
View File

@@ -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