From c3cde2a777c0c1780f93f534c7fdb80b6d1bc8fa Mon Sep 17 00:00:00 2001 From: Ron Pinkas Date: Thu, 2 Nov 2000 23:18:49 +0000 Subject: [PATCH] 2000-11-02 15:20 UTC+0800 Ron Pinkas * source/compiler/harbour.sly + Added support for extended parameters to __GET() and __GETA() ! Corrected 2nd parameter of __GETA() to reflect only the Base Array Name. * source/rtl/tget.prg ! Added support for :SubScript in __GETA() * include/hbextern.ch - Removed _GET_ + Added __GETA --- harbour/ChangeLog | 16 +++++- harbour/include/hbextern.ch | 2 +- harbour/source/compiler/harbour.sly | 86 +++++++++++++++++++++-------- harbour/source/rtl/tget.prg | 31 ++--------- 4 files changed, 83 insertions(+), 52 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index a736bfa228..44cc9f82af 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,15 @@ +2000-11-02 15:20 UTC+0800 Ron Pinkas + * source/compiler/harbour.sly + + Added support for extended parameters to __GET() and __GETA() + ! Corrected 2nd parameter of __GETA() to reflect only the Base Array Name. + + * source/rtl/tget.prg + ! Added support for :SubScript in __GETA() + + * include/hbextern.ch + - Removed _GET_ + + Added __GETA + 2000-11-02 19:20 GMT -3 Luiz Rafael Culik *doc/en/tbrowse.txt *added missing CVS ID @@ -11,7 +23,7 @@ *utils/hbdoc/rtf.prg utils/hbdoc/genrtf.prg utils/hbdoc/hbdoc.prg - *Small Changes + *Small Changes *utils/hbdoc/genrtf.prg utils/hbdoc/genrtf.prg *Small Fix to work with $CLASSDOC$ style headers @@ -32,7 +44,7 @@ *utils/hbdoc/rtf.prg utils/hbdoc/genrtf.prg utils/hbdoc/hbdoc.prg - *Small Changes + *Small Changes 2000-11-01 17:25 UTC+0800 Ron Pinkas diff --git a/harbour/include/hbextern.ch b/harbour/include/hbextern.ch index c3e3300908..d7ca321605 100644 --- a/harbour/include/hbextern.ch +++ b/harbour/include/hbextern.ch @@ -695,7 +695,7 @@ EXTERNAL __TEXTRESTORE // EXTERNAL GETNEW EXTERNAL __GET -EXTERNAL _GET_ +EXTERNAL __GETA // //symbols from file: rtl\tgetlist.prg // diff --git a/harbour/source/compiler/harbour.sly b/harbour/source/compiler/harbour.sly index fa0aa19a2b..7702f9b74f 100644 --- a/harbour/source/compiler/harbour.sly +++ b/harbour/source/compiler/harbour.sly @@ -117,7 +117,8 @@ char * hb_comp_buffer; /* yacc input buffer */ static PTR_LOOPEXIT hb_comp_pLoops = NULL; static HB_RTVAR_PTR hb_comp_rtvars = NULL; -static HB_EXPR_PTR pArrayIndexAsList = NULL, pArrayIndexAsArray = NULL; +static HB_EXPR_PTR pArrayIndexAsList = NULL, pGetArgList = NULL, pBaseArrayName = NULL; +static BOOL bTrancuateBaseArray = FALSE; char * hb_comp_szAnnounce = NULL; /* ANNOUNCEd procedure */ @@ -231,7 +232,7 @@ static void hb_compDebugStart( void ) { }; %type DimIndex DimList %type FieldAlias FieldVarAlias %type PostOp -%type Get GetA GetBlock +%type Get GetA GetArgList %% @@ -441,8 +442,17 @@ NilAlias : NilValue ALIASOP { $$ = $1; } /* Literal string value */ -LiteralValue : LITERAL { $$ = hb_compExprNewString( $1 ); } -; +LiteralValue : LITERAL { $$ = hb_compExprNewString( $1 ); + if( bTrancuateBaseArray ) + { char *pCopy = hb_strdup( $1 ), *pTmp = strchr( pCopy, '[' ); + if( pTmp ) + { + pCopy[ pTmp - pCopy ] = '\0'; + pBaseArrayName = hb_compExprNewString( pCopy ); + } + bTrancuateBaseArray = FALSE; +; } + } LiteralAlias : LiteralValue ALIASOP { $$ = $1; } ; @@ -976,30 +986,58 @@ 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 AliasVar ',' 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 ObjectData ',' 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 ObjectData ArrayIndex ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' - { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $3 ), $5 ), $7 ), $9 ), $11 ), $13 ) ); } - | 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 ) ); } +Get : GET Variable { pGetArgList = hb_compExprNewArgList( $2 ); } ',' GetArgList ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET"), pGetArgList ); pGetArgList = NULL; } + | GET AliasVar { pGetArgList = hb_compExprNewArgList( $2 ); } ',' GetArgList ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET"), pGetArgList ); pGetArgList = NULL; } + | GET ObjectData { pGetArgList = hb_compExprNewArgList( $2 ); } ',' GetArgList ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET"), pGetArgList ); pGetArgList = NULL; } + | GET ObjectData ArrayIndex { pGetArgList = hb_compExprNewArgList( $3 ); } ',' GetArgList ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET"), pGetArgList ); pGetArgList = NULL; } + | GET MacroVar { pGetArgList = hb_compExprNewArgList( $2 ); } ',' GetArgList ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET"), pGetArgList ); pGetArgList = NULL; } + | GET MacroExpr { pGetArgList = hb_compExprNewArgList( $2 ); } ',' GetArgList ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET"), pGetArgList ); pGetArgList = NULL; } ; -GetA : GET Variable ArrayIndex { pArrayIndexAsArray = hb_compExprNewArray( pArrayIndexAsList ); pArrayIndexAsList = NULL; } ',' 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 ), $6 ), $8 ), $10 ), $12 ), $14 ), pArrayIndexAsArray ) ) } - | GET AliasVar ArrayIndex { pArrayIndexAsArray = hb_compExprNewArray( pArrayIndexAsList ); pArrayIndexAsList = NULL; } ',' 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 ), $6 ), $8 ), $10 ), $12 ), $14 ), pArrayIndexAsArray ) ) } - | GET MacroVar ArrayIndex { pArrayIndexAsArray = hb_compExprNewArray( pArrayIndexAsList ); pArrayIndexAsList = NULL; } ',' 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 ), $6 ), $8 ), $10 ), $12 ), $14 ), pArrayIndexAsArray ) ) } - ; - -GetBlock : /* nothing => nil */ { $$ = hb_compExprNewEmpty(); } - | CodeBlock +GetArgList : Argument { $$ = hb_compExprAddListExpr( pGetArgList, $1 ); } + | GetArgList ',' Argument { $$ = hb_compExprAddListExpr( pGetArgList, $3 ); } ; +GetA : GET Variable ArrayIndex { pGetArgList = hb_compExprNewArgList( $2 ); bTrancuateBaseArray = TRUE; } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, ( pBaseArrayName ? pBaseArrayName : $6 ) ); pBaseArrayName = NULL; /* Var Name */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, $9 ) ; /* Picture */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, $12 ); /* ValidBlock */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, $15 ); /* WhenBlock */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, hb_compExprNewArray( pArrayIndexAsList ) ); /* Array with Index Expressions as 6th parameter */ } + GetAExt ')' { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA"), pGetArgList ); pGetArgList = NULL; } + | GET AliasVar ArrayIndex { pGetArgList = hb_compExprNewArgList( $2 ); bTrancuateBaseArray = TRUE; } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, ( pBaseArrayName ? pBaseArrayName : $6 ) ); pBaseArrayName = NULL; /* Var Name */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, $9 ) ; /* Picture */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, $12 ); /* ValidBlock */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, $15 ); /* WhenBlock */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, hb_compExprNewArray( pArrayIndexAsList ) ); /* Array with Index Expressions as 6th parameter */ } + GetAExt ')' { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA"), pGetArgList ); pGetArgList = NULL; } + | GET MacroVar ArrayIndex { pGetArgList = hb_compExprNewArgList( $2 ); bTrancuateBaseArray = TRUE; } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, ( pBaseArrayName ? pBaseArrayName : $6 ) ); pBaseArrayName = NULL; /* Var Name */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, $9 ) ; /* Picture */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, $12 ); /* ValidBlock */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, $15 ); /* WhenBlock */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, hb_compExprNewArray( pArrayIndexAsList ) ); /* Array with Index Expressions as 6th parameter */ } + GetAExt ')' { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA"), pGetArgList ); pGetArgList = NULL; } + | GET MacroExpr ArrayIndex { pGetArgList = hb_compExprNewArgList( $2 ); bTrancuateBaseArray = TRUE; } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, ( pBaseArrayName ? pBaseArrayName : $6 ) ); pBaseArrayName = NULL; /* Var Name */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, $9 ) ; /* Picture */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, $12 ); /* ValidBlock */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, $15 ); /* WhenBlock */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, hb_compExprNewArray( pArrayIndexAsList ) ); /* Array with Index Expressions as 6th parameter */ } + GetAExt ')' { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA"), pGetArgList ); pGetArgList = NULL; } + ; + +GetAExt : { /* Nothing*/ } + | ',' GetArgList + ; + /* 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 7c906bec34..530aa204e9 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -1111,12 +1111,6 @@ return Get():New( nRow, nCol, bVarBlock, cVarName, cPicture, cColor ) //---------------------------------------------------------------------------// -/* Huummm, why not using something like */ -/* Function __GET(...) */ -/* Return _GET_(...) */ - -/* NOTE: Same as _GET_() */ - FUNCTION __GET( uVar, cVarName, cPicture, bValid, bWhen, bSetGet ) LOCAL oGet := Get():New(,, bSetGet, cVarName, cPicture ) @@ -1128,37 +1122,24 @@ FUNCTION __GET( uVar, cVarName, cPicture, bValid, bWhen, bSetGet ) RETURN oGet -FUNCTION __GETA( aBaseVar, cVarName, cPicture, bValid, bWhen, bSetGet, anIndex ) +FUNCTION __GETA( aBaseVar, cVarName, cPicture, bValid, bWhen, anIndex ) - LOCAL oGet, cIndex := '', nLen := Len( anIndex ), Counter + LOCAL bSetGet, oGet, cIndex := '', nLen := Len( anIndex ), Counter FOR Counter := 1 TO nLen - cIndex += '[' + LTrim( Str( anIndex[ Counter ] ) ) + ']' + 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 := Get():New( , , bSetGet, cVarName, cPicture ) - oGet:PreBlock := bWhen + oGet:PreBlock := bWhen oGet:PostBlock := bValid + oGet:SubScript := anIndex 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 - - oGet:PreBlock := bWhen - oGet:PostBlock := bValid - -RETURN oGet - - /* Here for compatibility reason with previous version */ /* Not sure it should be keeped here ... (JFL) */ /* But does'nt annoy me */