From edb06cb10a9e1109bc44b3717d7f903586ea9606 Mon Sep 17 00:00:00 2001 From: Ron Pinkas Date: Sun, 3 Dec 2000 23:21:19 +0000 Subject: [PATCH] 2000-12-03 15:05 UTC+0800 Ron Pinkas * source/compiler/harbour.sly ! Optimized __GETA() support, and changed it to be implementated identical to Clipper. /* Clipper passed a bGet Block which refrences the Base Array Variable and not the Variable itself. Clipper passes NIL instead of bGet block if the Base Array is MACROVAR or MACROTEXT. Clipper does not optimize "&Macro" to Macro, but Harbour does! */ * source/rtl/tgetint.prg * __GETA() Changed 1st parameter aVar to bGetArray and logic to get the Base Array if bGetArray is NIL /* Optimized to not use macro if possible (most cases) even if the GetArray is a macro. */ * tests/testget.prg + Added additional test. --- harbour/ChangeLog | 14 +++++++ harbour/source/compiler/harbour.sly | 59 ++++++++++++++--------------- harbour/source/rtl/tgetint.prg | 24 +++++++++--- harbour/tests/testget.prg | 13 +++++-- 4 files changed, 70 insertions(+), 40 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index e7f502a6df..5cf8f53cf0 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,17 @@ +2000-12-03 15:05 UTC+0800 Ron Pinkas + * source/compiler/harbour.sly + ! Optimized __GETA() support, and changed it to be implementated identical to Clipper. + /* Clipper passed a bGet Block which refrences the Base Array Variable and not the Variable itself. + Clipper passes NIL instead of bGet block if the Base Array is MACROVAR or MACROTEXT. + Clipper does not optimize "&Macro" to Macro, but Harbour does! */ + + * source/rtl/tgetint.prg + * __GETA() Changed 1st parameter aVar to bGetArray and logic to get the Base Array if bGetArray is NIL + /* Optimized to not use macro if possible (most cases) even if the GetArray is a macro. */ + + * tests/testget.prg + + Added additional test. + 2000-12-03 10:45 UTC+0800 Ron Pinkas * source/pp/ppcore.c + Added support for whaite space between = and > in #[x]command/[x]translate rules. diff --git a/harbour/source/compiler/harbour.sly b/harbour/source/compiler/harbour.sly index e54ec30ca7..2358b1de3f 100644 --- a/harbour/source/compiler/harbour.sly +++ b/harbour/source/compiler/harbour.sly @@ -241,7 +241,7 @@ static void hb_compDebugStart( void ) { }; %type DimIndex DimList %type FieldAlias FieldVarAlias %type PostOp -%type Get GetVar GetA GetArgList +%type Get GetVar GetA GetVarArray GetArgList %% @@ -452,7 +452,7 @@ NilAlias : NilValue ALIASOP { $$ = $1; } /* Literal string value */ LiteralValue : LITERAL { $$ = hb_compExprNewString( $1 ); - if( bTrancuateBaseArray ) + if( bTrancuateBaseArray && pBaseArrayName == NULL ) { char *pCopy = hb_strdup( $1 ), *pTmp = strchr( pCopy, '[' ); if( pTmp ) { @@ -1058,7 +1058,6 @@ Get : GET GetVar ',' EmptyExpression { hb_compExprAddListExpr( pGetArgList, $14 ); /* WhenBlock */ } GetAExt ')' { - /* TODO: Clipper allways error, but we can handle simple macros or macros with no declared symbols!!! */ hb_compGenError( hb_comp_szErrors, 'E', HB_COMP_ERR_GET_COMPLEX_MACRO, NULL, NULL ); $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET"), pGetArgList ); pGetArgList = NULL; @@ -1082,36 +1081,34 @@ GetArgList : Argument { $$ = hb_compExprAddListExpr( pGetArg | 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; } +GetA : GET GetVarArray { pGetArgList = hb_compExprNewArgList( $2 ); bTrancuateBaseArray = TRUE; } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, ( pBaseArrayName ? pBaseArrayName : $5 ) ); pBaseArrayName = NULL; /* Var Name */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, $8 ) ; /* Picture */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, $11 ); /* ValidBlock */ } ',' + EmptyExpression { hb_compExprAddListExpr( pGetArgList, $14 ); /* WhenBlock */ + hb_compExprAddListExpr( pGetArgList, hb_compExprNewArray( pArrayIndexAsList ) ); /* Array with Index Expressions as 6th parameter */ + } + GetAExt ')' { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA"), pGetArgList ); pGetArgList = NULL; } ; +GetVarArray : Variable ArrayIndex { $$ = hb_compExprAddListExpr( hb_compExprNewCodeBlock(), $1 ); } + | AliasVar ArrayIndex { $$ = hb_compExprAddListExpr( hb_compExprNewCodeBlock(), $1 ); } + | MacroVar ArrayIndex { $$ = hb_compExprNewNil(); + if( $1->value.asMacro.cMacroOp ) + { + pBaseArrayName = hb_compExprNewVar( $1->value.asMacro.szMacro ); + } + else + { + pBaseArrayName = hb_compExprNewString( $1->value.asMacro.szMacro ); + } + } + | MacroExpr ArrayIndex { $$ = hb_compExprNewNil(); + /* TODO: Clipper allways error, but we can handle simple macros or macros with no declared symbols!!! */ + hb_compGenError( hb_comp_szErrors, 'E', HB_COMP_ERR_GET_COMPLEX_MACRO, NULL, NULL ); + } + ; + GetAExt : { /* Nothing*/ } | ',' GetArgList ; diff --git a/harbour/source/rtl/tgetint.prg b/harbour/source/rtl/tgetint.prg index fe6178e1da..7de7e11bda 100644 --- a/harbour/source/rtl/tgetint.prg +++ b/harbour/source/rtl/tgetint.prg @@ -31,6 +31,13 @@ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit * their web site at http://www.gnu.org/). * + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2000 RonPinkas + * __GET() + * __GETA() + * */ #include "hbclass.ch" @@ -50,11 +57,9 @@ FUNCTION __GET( bSetGet, cVarName, cPicture, bValid, bWhen ) LOCAL oGet IF( bSetGet == NIL ) - //Alert( "No Block: " + cVarName ) IF __ISMV( cVarName ) bSetGet := {|_1| IIF( _1 == NIL, __MVGET( cVarName ), __MVPUT( cVarName, _1 ) ) } ELSE - //Alert( "Not Mem Var: " + cVarName ) // "{|_1| IIF( _1 == NIL, &cVarName, &cVarName := _1 )" bSetGet := &( "{|_1| IIF( _1 == NIL, " + cVarName + ", " + cVarName + " := _1 ) }" ) ENDIF @@ -68,15 +73,24 @@ FUNCTION __GET( bSetGet, cVarName, cPicture, bValid, bWhen ) RETURN oGet -FUNCTION __GETA( aVar, cVarName, cPicture, bValid, bWhen, aIndex ) +FUNCTION __GETA( bGetArray, cVarName, cPicture, bValid, bWhen, aIndex ) LOCAL oGet, nDim := Len( aIndex ), bSetGet, aGetVar, Counter - aGetVar := aVar + IF( bGetArray == NIL ) + IF __ISMV( cVarName ) + aGetVar := __MVGET( cVarName ) + ELSE + aGetVar := &cVarName + ENDIF + ELSE + aGetVar := Eval( bGetArray ) + ENDIF + FOR Counter := 1 TO nDim - 1 aGetVar := aGetVar[aIndex[Counter]] NEXT - bSetGet := {|xValue| IIF( PCOUNT() == 0, aGetVar[aIndex[Counter]], aGetVar[aIndex[Counter]] := xValue )} + bSetGet := {|_1| IIF( _1 == NIL, aGetVar[aIndex[Counter]], aGetVar[aIndex[Counter]] := _1 ) } oGet := Get():New( , ,bSetGet, cVarName, cPicture ) oGet:SubScript := aIndex diff --git a/harbour/tests/testget.prg b/harbour/tests/testget.prg index 6d61aac6ba..8c07cfcf40 100644 --- a/harbour/tests/testget.prg +++ b/harbour/tests/testget.prg @@ -2,28 +2,33 @@ Procedure Main() LOCAL GetList := {}, cVar := "Hello" MEMVAR aVar, nIndex, cMacro - PRIVATE aVar := { "World", "Again" }, nIndex := 1, cMacro := "cEarly", cEarly := "Early", cLate := "Late!" + PRIVATE aVar := { "World", "Again" }, nIndex := 1, cMacro := "cEarly", cEarly := {"Early"}, cLate := "Late!", cEarly2 := {"Early2"} CLS ? "2nd GET should say 'Early'." @ 10,10 SAY "cVar :" GET cVar PICTURE "@K!" - @ 12,10 SAY "cMacro :" GET &cMacro + @ 12,10 SAY "cMacro[1] :" GET &cMacro[1] + @ 14,10 SAY "cMacro.2[1] :" GET &cMacro.2[1] + @ 16,10 SAY "cEarly[1] :" GET cEarly[1] + //@ 14,10 SAY "cMacro :" GET &(cMacro)[1] nIndex := 2 - @ 14,10 SAY "aVar :" GET aVar[nIndex] - @ 16,10 SAY "Picture of GET-1:" GET GetList[1]:Picture + @ 18,10 SAY "aVar :" GET aVar[nIndex] + @ 20,10 SAY "Picture of GET-1:" GET GetList[1]:Picture nIndex := 3 cMacro := "cLate" READ CLS + /* Clipper Error "Get contains complex macro" ? "This GET should say 'Late!'." cMacro := "cEarly" @ 10,10 SAY "cMacro :" GET &(cMacro) cMacro := "cLate" READ + */ RETURN