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