2000-12-03 15:05 UTC+0800 Ron Pinkas <ron@profit-master.com>

* 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 23:21:19 +00:00
parent 18f85944f6
commit edb06cb10a
4 changed files with 70 additions and 40 deletions
--- a/harbour/ChangeLog
+++ b/harbour/ChangeLog
@@ -1,3 +1,17 @@
+2000-12-03 15:05 UTC+0800 Ron Pinkas <ron@profit-master.com>
+   * 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 <ron@profit-master.com>
   * source/pp/ppcore.c
     + Added support for whaite space between = and > in #[x]command/[x]translate rules.
--- a/harbour/source/compiler/harbour.sly
+++ b/harbour/source/compiler/harbour.sly
@@ -241,7 +241,7 @@ static void hb_compDebugStart( void ) { };
 %type <asExpr>  DimIndex DimList
 %type <asExpr>  FieldAlias FieldVarAlias
 %type <asExpr>  PostOp
-%type <asExpr>  Get GetVar GetA GetArgList
+%type <asExpr>  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
 	  ;
--- 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 <Ron@Profit-Master.com>
+ *    __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
--- 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