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

2000-11-01 17:25 UTC+0800 Ron Pinkas <ron@profit-master.com>

Browse Source 
* source/compiler/harbour.sly
     ! Optimized _GET_ support.
     + Added support for GET of ObjectData and ObjectData ArrayIndex.

   * source/rtl/tget.prg
     + Added method ParsePict() and logic to support dynamic modification of the picture by altering :Picture as in Clipper.

   * tests/testread.prg
     + Added line to demonstrate GET of ObjectData and dynamic modification of a PICTURE clause.
This commit is contained in:
Ron Pinkas
2000-11-02 01:28:51 +00:00
parent 066236c511
commit ee24175dc0
4 changed files with 56 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
harbour/ChangeLog
View File

@@ -1,3 +1,14 @@
2000-11-01 17:25 UTC+0800 Ron Pinkas <ron@profit-master.com>
* source/compiler/harbour.sly
! Optimized _GET_ support.
+ Added support for GET of ObjectData and ObjectData ArrayIndex.
* source/rtl/tget.prg
+ Added method ParsePict() and logic to support dynamic modification of the picture by altering :Picture as in Clipper.
* tests/testread.prg
+ Added line to demonstrate GET of ObjectData and dynamic modification of a PICTURE clause.
2000-11-01 15:00 UTC+0800 Brian Hays <bhays@abacuslaw.com>
* contrib/rdd_ads/ads1.c

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

@@ -117,6 +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;
char * hb_comp_szAnnounce = NULL; /* ANNOUNCEd procedure */
static void hb_compDebugStart( void ) { };
@@ -229,7 +231,7 @@ static void hb_compDebugStart( void ) { };
%type <asExpr> DimIndex DimList
%type <asExpr> FieldAlias FieldVarAlias
%type <asExpr> PostOp
%type <asExpr> Get GetA GetBlock GetArrayIndex GetIndexList GetAliasVar
%type <asExpr> Get GetA GetBlock
%%
@@ -959,9 +961,9 @@ ArrayIndex : IndexList ']' { $$ = $1; }
/* NOTE: $0 represents the expression before ArrayIndex
* Don't use ArrayIndex in other context than as an array index!
*/
IndexList : '[' Expression { $$ = hb_compExprNewArrayAt( $<asExpr>0, $2 ); }
| IndexList ',' Expression { $$ = hb_compExprNewArrayAt( $1, $3 ); }
| IndexList ']' '[' Expression { $$ = hb_compExprNewArrayAt( $1, $4 ); }
IndexList : '[' Expression { $$ = hb_compExprNewArrayAt( $<asExpr>0, $2 ); pArrayIndexAsList = hb_compExprNewList( $2 ); }
| IndexList ',' Expression { $$ = hb_compExprNewArrayAt( $1, $3 ) ; pArrayIndexAsList = hb_compExprAddListExpr( pArrayIndexAsList, $3 ); }
| IndexList ']' '[' Expression { $$ = hb_compExprNewArrayAt( $1, $4 ) ; pArrayIndexAsList = hb_compExprAddListExpr( pArrayIndexAsList, $4 ); }
;
ElemList : Argument { $$ = hb_compExprNewList( $1 ); }
@@ -976,41 +978,28 @@ CodeBlock : '{' '|' { $<asExpr>$ = hb_compExprNewCodeBlock(); } BlockNoVar
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 GetAliasVar ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')'
| 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 ) ); }
;
GetA : GET Variable GetArrayIndex ',' 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 ), $5 ), $7 ), $9 ), $11 ), $13 ), $3 ) ); }
| GET GetAliasVar GetArrayIndex ',' 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 ), $5 ), $7 ), $9 ), $11 ), $13 ), $3 ) ); }
| GET MacroVar GetArrayIndex ',' 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 ), $5 ), $7 ), $9 ), $11 ), $13 ), $3 ) ); }
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 ) ) }
;
GetAliasVar: NumAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); }
| MacroVarAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); }
| MacroExprAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); }
| PareExpListAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); }
| VarAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); }
| FieldAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); }
| FieldVarAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); }
;
GetBlock : /* nothing => nil */ { $$ = hb_compExprNewEmpty(); }
| CodeBlock
;
GetArrayIndex : GetIndexList ']' { $$ = hb_compExprNewArray( $1 ); }
;
GetIndexList : '[' Expression { $$ = hb_compExprNewList( $2 ); }
| GetIndexList ',' Expression { $$ = hb_compExprAddListExpr( $1, $3 ); }
| GetIndexList ']' '[' Expression { $$ = hb_compExprAddListExpr( $1, $4 ); }
;
/* NOTE: This uses $-2 then don't use BlockExpList in other context
*/
BlockExpList : Expression { $$ = hb_compExprAddListExpr( $<asExpr>-2, $1 ); }

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

@@ -91,6 +91,7 @@ CLASS Get
METHOD Display()
METHOD ColorDisp( cColorSpec ) INLINE ::ColorSpec := cColorSpec, ::Display(), Self
METHOD KillFocus()
METHOD ParsePict( cPicture )
METHOD Reset()
METHOD SetFocus()
METHOD Undo()
@@ -139,13 +140,6 @@ ENDCLASS
METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS Get
local cChar
local nAt
local nFor
local cNum
cNum := ""
DEFAULT nRow TO Row()
DEFAULT nCol TO Col()
DEFAULT cVarName TO ""
@@ -180,6 +174,28 @@ METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS Get
// Existe function en picture
::ParsePict( cPicture )
::buffer := ::PutMask( ::Original, .f. )
::nMaxLen := Len( ::buffer )
if ::nDispLen == NIL
::nDispLen := ::nMaxLen
endif
return Self
//---------------------------------------------------------------------------//
METHOD ParsePict( cPicture ) CLASS Get
local cChar
local nAt
local nFor
local cNum
cNum := ""
if Left( cPicture, 1 ) == "@"
nAt := At( " ", cPicture )
if nAt == 0
@@ -255,14 +271,7 @@ METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS Get
Next
endif
::buffer := ::PutMask( ::Original, .f. )
::nMaxLen := Len( ::buffer )
if ::nDispLen == NIL
::nDispLen := ::nMaxLen
endif
return Self
return ::cPicFunc + ' ' + ::cPicMask
//---------------------------------------------------------------------------//
@@ -361,6 +370,7 @@ METHOD SetFocus() CLASS Get
::hasfocus := .t.
::rejected := .f.
::typeout := .f.
::ParsePict( :: Picture )
::buffer := ::PutMask( ::VarGet(), .f. )
::changed := .f.
::clear := ( "K" $ ::cPicFunc .or. ::type == "N")

5
harbour/tests/testread.prg
View File

@@ -18,9 +18,10 @@ function Main()
SET KEY -1 TO ShowVar()
@ 2, 2 SAY " Enter your name:" GET cName
@ 4, 2 SAY " Enter your wish:" GET cWish
@ 2, 2 SAY "Enter your name :" GET cName PICTURE "@K!"
@ 4, 2 SAY "Enter your wish :" GET cWish
@ 6, 2 SAY "Enter your effort:" GET cEffort
@ 8, 2 SAY "Object Data :" GET GetList[1]:Picture
FOR Counter := 1 TO Len( acVars )
@ Row() + 2, 2 SAY "Array Element [" + Str( Counter, 1 ) + "]: " GET acVars[ Counter ]