2000-09-07 00:10 UTC+0800 Ron Pinkas <ron@profit-master.com>

* include/hbcomp.h
   * source/compiler/harbour.c
     + Added: char hb_comp_cCastType

   * source/compiler/harbour.y
     ! Optimized AsType
     + Added: support for type casting like: Var := FunCal() AS ... and, return Var AS ...
     /* Todo: add support for Array[n] := ... AS ..., and oVar:Data := ... AS ... */

   * source/compiler/hbpcode.c
     + Added type casting support to:
       HB_P_POPLOCAL
       HB_P_POPLOCALNEAR
       HB_P_POPMEMVAR
       HB_P_POPSTATIC
       HB_P_RETVALUE

   * include/hbclass.ch
     + Added type casting to resolve Strong Type warnings:
       return s_oClass:Instance() AS CLASS _CLASS_NAME_
       local Self AS CLASS <ClassName> := QSelf() AS CLASS <ClassName>

   /* Note: Strong Type code, and Class code, should compile with upto -w4, without [invalid] Strong Type warnings. */
This commit is contained in:
Ron Pinkas
2000-09-07 07:31:31 +00:00
parent c201844c39
commit b1658bda6d
6 changed files with 209 additions and 43 deletions

View File

@@ -1,7 +1,32 @@
2000-09-07 00:10 UTC+0800 Ron Pinkas <ron@profit-master.com>
* include/hbcomp.h
* source/compiler/harbour.c
+ Added: char hb_comp_cCastType
* source/compiler/harbour.y
! Optimized AsType
+ Added: support for type casting like: Var := FunCal() AS ... and, return Var AS ...
/* Todo: add support for Array[n] := ... AS ..., and oVar:Data := ... AS ... */
* source/compiler/hbpcode.c
+ Added type casting support to:
HB_P_POPLOCAL
HB_P_POPLOCALNEAR
HB_P_POPMEMVAR
HB_P_POPSTATIC
HB_P_RETVALUE
* include/hbclass.ch
+ Added type casting to resolve Strong Type warnings:
return s_oClass:Instance() AS CLASS _CLASS_NAME_
local Self AS CLASS <ClassName> := QSelf() AS CLASS <ClassName>
/* Note: Strong Type code, and Class code, should compile with upto -w4, without [invalid] Strong Type warnings. */
2000-09-06 12:40 UTC+0800 Ron Pinkas <ron@profit-master.com>
* source/compiler/harbour.l
+ Added AS CHAR[ACTER] for compatibility with FW (FW can't use #translate AS CHAR => AS STRING, because FW also uses AS CHAR
in DLL calls where AS CHAR referes to *native* char type).
in DLL calls where AS CHAR refers to *native* char type).
! Correted AS ... to allow multiple space/tab, and support abbreviations.
* source/compiler/simplex.c
@@ -12,7 +37,7 @@
* source/compiler/harbour.slx
+ Added AS CHAR[ACTER] for compatibility with FW (FW can't use #translate AS CHAR => AS STRING, because FW also uses AS CHAR
in DLL calls where AS CHAR referes to *native* char type.
in DLL calls where AS CHAR refers to *native* char type.
! Optimized numerous HB_*_ID to a single HB_IDENTIFIER.
* include/hbclass.ch

View File

@@ -47,7 +47,7 @@
* See doc/license.txt for licensing terms.
*
*/
/*
DECLARE TClass ;
New( cName AS STRING, OPTIONAL SuperParams ) AS CLASS TClass ;
Create() AS OBJECT;
@@ -57,7 +57,7 @@ DECLARE TClass ;
AddMultiData( cType AS STRING, uVal, nScope AS NUMERIC, aDatas AS ARRAY OF STRING );
AddMethod( cName AS STRING, @MethodName(), nScope AS NUMERIC );
AddInLine( cName AS STRING, bBlock AS CODEBLOCK, nScope AS NUMERIC );
AddVirtual( cName AS STRING ) */
AddVirtual( cName AS STRING )
#ifndef HB_CLASS_CH_
#define HB_CLASS_CH_
@@ -422,7 +422,7 @@ DECLARE TClass ;
#xcommand ENDCLASS => ;;
s_oClass:Create() ;;
endif ;;
return s_oClass:Instance()
return s_oClass:Instance() AS CLASS _CLASS_NAME_
#xtranslate :Super( <SuperClass> ) : => :<SuperClass>:
#xtranslate :Super() : => :Super:
@@ -432,28 +432,28 @@ DECLARE TClass ;
#xcommand METHOD <MethodName>( [<params,...>] ) CLASS <ClassName> => ;
static function <ClassName>_<MethodName>( [<params>] ) ;;
local Self AS CLASS <ClassName> := QSelf()
local Self AS CLASS <ClassName> := QSelf() AS CLASS <ClassName>
#xcommand ACCESS <AccessName>() CLASS <ClassName> => ;
static function <ClassName>_<AccessName>() ;;
local Self AS CLASS <ClassName> := QSelf()
local Self AS CLASS <ClassName> := QSelf() AS CLASS <ClassName>
#xcommand ASSIGN <AssignName>( [<params,...>] ) CLASS <ClassName> => ;
static function <ClassName>__<AssignName>( [<params>] ) ;;
local Self AS CLASS <ClassName> := QSelf()
local Self AS CLASS <ClassName> := QSelf() AS CLASS <ClassName>
#else
#xcommand METHOD <MethodName>( [<params,...>] ) CLASS <ClassName> => ;
static function <MethodName>( [<params>] ) ;;
local Self AS CLASS <ClassName> := QSelf()
local Self AS CLASS <ClassName> := QSelf() AS CLASS <ClassName>
#xcommand ACCESS <AccessName>() CLASS <ClassName> => ;
static function <AccessName>() ;;
local Self AS CLASS <ClassName> := QSelf()
local Self AS CLASS <ClassName> := QSelf() AS CLASS <ClassName>
#xcommand ASSIGN <AssignName>( [<params,...>] ) CLASS <ClassName> => ;
static function _<AssignName>( [<params>] ) ;;
local Self AS CLASS <ClassName> := QSelf()
local Self AS CLASS <ClassName> := QSelf() AS CLASS <ClassName>
#endif /* HB_SHORTNAMES */

View File

@@ -411,6 +411,7 @@ extern int hb_comp_iExitLevel;
extern int hb_comp_iFunctionCnt;
extern char hb_comp_cVarType;
extern char hb_comp_cDataListType;
extern char hb_comp_cCastType;
extern int hb_comp_iVarScope;
extern BOOL hb_comp_bDontGenLineNum;
extern FILES hb_comp_files;

View File

@@ -114,6 +114,7 @@ int hb_comp_iFunctionCnt;
int hb_comp_iErrorCount;
char hb_comp_cVarType; /* current declared variable type */
char hb_comp_cDataListType; /* current declared variable list type */
char hb_comp_cCastType; /* current casting type */
BOOL hb_comp_bDontGenLineNum = FALSE; /* suppress line number generation */
ULONG hb_comp_ulLastLinePos; /* position of last opcode with line number */
int hb_comp_iStaticCnt; /* number of defined statics variables on the PRG */

View File

@@ -292,23 +292,18 @@ Params : { $$ = 0; }
;
AsType : /* not specified */ { hb_comp_cVarType = ' '; }
| AS_NUMERIC { hb_comp_cVarType = 'N'; }
| StrongType
;
StrongType : AS_NUMERIC { hb_comp_cVarType = 'N'; }
| AS_CHARACTER { hb_comp_cVarType = 'C'; }
| AS_DATE { hb_comp_cVarType = 'D'; }
| AS_LOGICAL { hb_comp_cVarType = 'L'; }
| AS_ARRAY { hb_comp_cVarType = 'A'; }
| AS_BLOCK { hb_comp_cVarType = 'B'; }
| AS_OBJECT { hb_comp_cVarType = 'O'; }
| AS_CLASS IdentName { hb_comp_cVarType = 'S'; hb_comp_szFromClass = $2 }
| AS_VARIANT { hb_comp_cVarType = ' '; }
| AS_NUMERIC_ARRAY { hb_comp_cVarType = 'n'; }
| AS_CHARACTER_ARRAY { hb_comp_cVarType = 'c'; }
| AS_DATE_ARRAY { hb_comp_cVarType = 'd'; }
| AS_LOGICAL_ARRAY { hb_comp_cVarType = 'l'; }
| AS_ARRAY_ARRAY { hb_comp_cVarType = 'a'; }
| AS_BLOCK_ARRAY { hb_comp_cVarType = 'b'; }
| AS_OBJECT_ARRAY { hb_comp_cVarType = 'o'; }
| AS_CLASS_ARRAY IdentName { hb_comp_cVarType = 's'; hb_comp_szFromClass = $2 }
| AsArray
;
AsArray : AS_ARRAY { hb_comp_cVarType = 'A'; }
@@ -363,7 +358,11 @@ Statement : ExecFlow CrlfStmnt { }
hb_comp_bDontGenLineNum = TRUE;
hb_comp_functions.pLast->bFlags |= FUN_BREAK_CODE;
}
| RETURN { hb_compLinePushIfInside(); } Expression Crlf {
| RETURN { hb_compLinePushIfInside(); hb_comp_cVarType = ' '; } Expression Crlf {
hb_comp_cCastType = hb_comp_cVarType;
hb_comp_cVarType = ' ';
if( hb_comp_wSeqCounter )
{
hb_compGenError( hb_comp_szErrors, 'E', HB_COMP_ERR_EXIT_IN_SEQUENCE, "RETURN", NULL );
@@ -619,15 +618,15 @@ VariableAtAlias : VariableAt ALIASOP { $$ = $1; }
/* Function call
*/
FunCall : IdentName '(' ArgList ')' { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( $1 ), $3 ); }
| MacroVar '(' ArgList ')' { $$ = hb_compExprNewFunCall( $1, $3 ); }
;
FunCall : IdentName '(' ArgList ')' { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( $1 ), $3 ); }
| MacroVar '(' ArgList ')' { $$ = hb_compExprNewFunCall( $1, $3 ); }
;
ArgList : Argument { $$ = hb_compExprNewArgList( $1 ); }
| ArgList ',' Argument { $$ = hb_compExprAddListExpr( $1, $3 ); }
;
Argument : EmptyExpression { $$ = $1; }
Argument : EmptyExpression { $$ = $1; }
| '@' IdentName { $$ = hb_compExprNewVarRef( $2 ); }
| '@' IdentName '(' ')' { $$ = hb_compExprNewFunRef( $2 ); }
;
@@ -684,6 +683,7 @@ SimpleExpression :
| CodeBlock { $$ = $1; }
| Logical { $$ = $1; }
| SelfValue { $$ = $1; }
| SelfValue {hb_comp_cVarType = ' '} StrongType { $$ = $1; }
| Array { $$ = $1; }
| ArrayAt { $$ = $1; }
| AliasVar { $$ = $1; }
@@ -691,9 +691,12 @@ SimpleExpression :
| MacroExpr { $$ = $1; }
| VariableAt { $$ = $1; }
| FunCall { $$ = $1; }
| FunCall {hb_comp_cVarType = ' '} StrongType { $$ = $1; }
| IfInline { $$ = $1; }
| ObjectData { $$ = $1; }
| ObjectData {hb_comp_cVarType = ' '} StrongType { $$ = $1; }
| ObjectMethod { $$ = $1; }
| ObjectMethod {hb_comp_cVarType = ' '} StrongType { $$ = $1; }
| AliasExpr { $$ = $1; }
| ExprAssign { $$ = $1; }
| ExprOperEq { $$ = $1; }
@@ -703,16 +706,18 @@ SimpleExpression :
| ExprMath { $$ = $1; }
| ExprBool { $$ = $1; }
| ExprRelation { $$ = $1; }
;
;
Expression : Variable { $$ = $1; }
| SimpleExpression { $$ = $1; }
| PareExpList { $$ = $1; }
;
Expression : Variable { $$ = $1; }
| SimpleExpression { $$ = $1; }
| PareExpList { $$ = $1; }
| Variable { hb_comp_cVarType = ' ';} StrongType { $$ = $1; }
| PareExpList { hb_comp_cVarType = ' ';} StrongType { $$ = $1; }
;
EmptyExpression: /* nothing => nil */ { $$ = hb_compExprNewEmpty(); }
| Expression
;
;
LValue : IdentName { $$ = hb_compExprNewVar( $1 ); }
| AliasVar
@@ -776,16 +781,16 @@ ExprAssign : NumValue INASSIGN Expression { $$ = hb_compExprAssign( $1, $
| SelfValue INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); }
| Array INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); }
| ArrayAt INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); }
| Variable INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); }
| Variable INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); hb_comp_cCastType = hb_comp_cVarType; hb_comp_cVarType = ' ';}
| MacroVar INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); }
| MacroExpr INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); }
| AliasVar INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); }
| AliasExpr INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); }
| VariableAt INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); }
| VariableAt INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); hb_comp_cCastType = hb_comp_cVarType; hb_comp_cVarType = ' ';}
| PareExpList INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); }
| IfInline INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); }
| FunCall INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); }
| ObjectData INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); }
| ObjectData INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); hb_comp_cCastType = hb_comp_cVarType; hb_comp_cVarType = ' ';}
| ObjectMethod INASSIGN Expression { $$ = hb_compExprAssign( $1, $3 ); }
;
@@ -1116,23 +1121,26 @@ VarDef : IdentName AsType { hb_compVariableAdd( $1, hb_comp_cVarType ); }
| IdentName AsType { $<iNumber>$ = hb_comp_iVarScope;
hb_compVariableAdd( $1, hb_comp_cVarType );
}
INASSIGN Expression
INASSIGN {hb_comp_cVarType = ' ';} Expression
{
hb_comp_cCastType = hb_comp_cVarType;
hb_comp_cVarType = ' ';
hb_comp_iVarScope = $<iNumber>3;
if( hb_comp_iVarScope == VS_STATIC )
{
hb_compStaticDefStart(); /* switch to statics pcode buffer */
hb_compExprDelete( hb_compExprGenStatement( hb_compExprAssignStatic( hb_compExprNewVar( $1 ), $5 ) ) );
hb_compExprDelete( hb_compExprGenStatement( hb_compExprAssignStatic( hb_compExprNewVar( $1 ), $6 ) ) );
hb_compStaticDefEnd();
}
else if( hb_comp_iVarScope == VS_PUBLIC || hb_comp_iVarScope == VS_PRIVATE )
{
hb_compExprDelete( hb_compExprGenPush( $5 ) );
hb_compExprDelete( hb_compExprGenPush( $6 ) );
hb_compRTVariableAdd( hb_compExprNewRTVar( $1, NULL ), TRUE );
}
else
{
hb_compExprDelete( hb_compExprGenStatement( hb_compExprAssign( hb_compExprNewVar( $1 ), $5 ) ) );
hb_compExprDelete( hb_compExprGenStatement( hb_compExprAssign( hb_compExprNewVar( $1 ), $6 ) ) );
}
hb_comp_iVarScope = $<iNumber>3;
}

View File

@@ -257,6 +257,9 @@ void hb_compStrongType( int iSize )
break;
case HB_P_RETVALUE :
if( pFunc->iStackIndex < 1 )
break;
pFunc->iStackIndex--;
pSym = hb_compSymbolFind( pFunc->szName, NULL );
@@ -269,6 +272,38 @@ void hb_compStrongType( int iSize )
if( pDeclared )
{
if( hb_comp_cCastType == ' ' )
; /* No casting - do nothing. */
else if( toupper( hb_comp_cCastType ) == 'S' )
{
PCOMCLASS pClass = hb_compClassFind( hb_comp_szFromClass );
if( pClass )
{
if( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses )
{
pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] = pClass;
}
else
{
pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pClass;
}
pFunc->pStack[ pFunc->iStackIndex ] = hb_comp_cCastType;
}
else
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_CLASS_NOT_FOUND, hb_comp_szFromClass, pDeclared->szName );
pFunc->pStack[ pFunc->iStackIndex ] = ( isupper( ( int ) hb_comp_cCastType ) ? 'O' : 'o' );
}
hb_comp_cCastType = ' ';
}
else
{
pFunc->pStack[ pFunc->iStackIndex ] = hb_comp_cCastType;
hb_comp_cCastType = ' ';
}
/* Variant as SubType. */
if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
cSubType1 = ( pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT );
@@ -278,9 +313,9 @@ void hb_compStrongType( int iSize )
if( cSubType1 )
{
if( cSubType1 == 'S' && pFunc->iStackClasses )
sprintf( ( char * ) szType1, "AnyType.SubType[%s]", pFunc->pStackClasses[ pFunc->iStackClasses-- ]->szName );
sprintf( ( char * ) szType1, "AnyType.SubType[%s]", pFunc->pStackClasses[ --pFunc->iStackClasses ]->szName );
else if( cSubType1 == 's' && pFunc->iStackClasses )
sprintf( ( char * ) szType1, "AnyType.SubType[ARRAY OF %s]", pFunc->pStackClasses[ pFunc->iStackClasses-- ]->szName );
sprintf( ( char * ) szType1, "AnyType.SubType[ARRAY OF %s]", pFunc->pStackClasses[ --pFunc->iStackClasses ]->szName );
else if( cSubType1 == '-' )
strcpy( ( char * ) szType1, "AnyType.SubType[NIL]" );
else
@@ -289,9 +324,9 @@ void hb_compStrongType( int iSize )
else
{
if( cType1 == 'S' && pFunc->iStackClasses )
sprintf( ( char * ) szType1, "%s", pFunc->pStackClasses[ pFunc->iStackClasses-- ]->szName );
sprintf( ( char * ) szType1, "%s", pFunc->pStackClasses[ --pFunc->iStackClasses ]->szName );
else if( cType1 == 's' && pFunc->iStackClasses )
sprintf( ( char * ) szType1, "ARRAY OF %s", pFunc->pStackClasses[ pFunc->iStackClasses-- ]->szName );
sprintf( ( char * ) szType1, "ARRAY OF %s", pFunc->pStackClasses[ --pFunc->iStackClasses ]->szName );
else if( cType1 == '-' )
strcpy( ( char * ) szType1, "NIL" );
else
@@ -1794,6 +1829,38 @@ void hb_compStrongType( int iSize )
/*printf( "Variable: %s Type: \'%c\' SubType: %c Comparing: %c Recorded: %s\n", pSym->szName, pVar->cType, pVar->cType - 100, pFunc->pStack[ pFunc->iStackIndex ], ( char * ) szType );*/
if( hb_comp_cCastType == ' ' )
; /* No casting - do nothing. */
else if( toupper( hb_comp_cCastType ) == 'S' )
{
PCOMCLASS pClass = hb_compClassFind( hb_comp_szFromClass );
if( pClass )
{
if( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses )
{
pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] = pClass;
}
else
{
pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pClass;
}
pFunc->pStack[ pFunc->iStackIndex ] = hb_comp_cCastType;
}
else
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_CLASS_NOT_FOUND, hb_comp_szFromClass, pVar->szName );
pFunc->pStack[ pFunc->iStackIndex ] = ( isupper( ( int ) hb_comp_cCastType ) ? 'O' : 'o' );
}
hb_comp_cCastType = ' ';
}
else
{
pFunc->pStack[ pFunc->iStackIndex ] = hb_comp_cCastType;
hb_comp_cCastType = ' ';
}
if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT;
@@ -1968,6 +2035,38 @@ void hb_compStrongType( int iSize )
else
sprintf( ( char * ) szType, "%c", pVar->cType );
if( hb_comp_cCastType == ' ' )
; /* No casting - do nothing. */
else if( toupper( hb_comp_cCastType ) == 'S' )
{
PCOMCLASS pClass = hb_compClassFind( hb_comp_szFromClass );
if( pClass )
{
if( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses )
{
pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] = pClass;
}
else
{
pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pClass;
}
pFunc->pStack[ pFunc->iStackIndex ] = hb_comp_cCastType;
}
else
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_CLASS_NOT_FOUND, hb_comp_szFromClass, pVar->szName );
pFunc->pStack[ pFunc->iStackIndex ] = ( isupper( ( int ) hb_comp_cCastType ) ? 'O' : 'o' );
}
hb_comp_cCastType = ' ';
}
else
{
pFunc->pStack[ pFunc->iStackIndex ] = hb_comp_cCastType;
hb_comp_cCastType = ' ';
}
if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT;
@@ -2064,6 +2163,38 @@ void hb_compStrongType( int iSize )
else
sprintf( ( char * ) szType, "%c", pVar->cType );
if( hb_comp_cCastType == ' ' )
; /* No casting - do nothing. */
else if( toupper( hb_comp_cCastType ) == 'S' )
{
PCOMCLASS pClass = hb_compClassFind( hb_comp_szFromClass );
if( pClass )
{
if( toupper( pFunc->pStack[ pFunc->iStackIndex ] ) == 'S' && pFunc->iStackClasses )
{
pFunc->pStackClasses[ pFunc->iStackClasses - 1 ] = pClass;
}
else
{
pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pClass;
}
pFunc->pStack[ pFunc->iStackIndex ] = hb_comp_cCastType;
}
else
{
hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_CLASS_NOT_FOUND, hb_comp_szFromClass, pVar->szName );
pFunc->pStack[ pFunc->iStackIndex ] = ( isupper( ( int ) hb_comp_cCastType ) ? 'O' : 'o' );
}
hb_comp_cCastType = ' ';
}
else
{
pFunc->pStack[ pFunc->iStackIndex ] = hb_comp_cCastType;
hb_comp_cCastType = ' ';
}
if( pFunc->pStack[ pFunc->iStackIndex ] >= ( 'A' + VT_OFFSET_VARIANT ) )
pFunc->pStack[ pFunc->iStackIndex ] -= VT_OFFSET_VARIANT;