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

2000-11-02 15:20 UTC+0800 Ron Pinkas <ron@profit-master.com>

Browse Source 
* 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
This commit is contained in:
Ron Pinkas
2000-11-02 23:18:49 +00:00
parent f2080fb802
commit c3cde2a777
4 changed files with 83 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
harbour/ChangeLog
View File

@@ -1,3 +1,15 @@
2000-11-02 15:20 UTC+0800 Ron Pinkas <ron@profit-master.com>
* 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 <culik@sl.conex.net>
*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 <ron@profit-master.com>

2
harbour/include/hbextern.ch
View File

@@ -695,7 +695,7 @@ EXTERNAL __TEXTRESTORE
//
EXTERNAL GETNEW
EXTERNAL __GET
EXTERNAL _GET_
EXTERNAL __GETA
//
//symbols from file: rtl\tgetlist.prg
//

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

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

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

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