diff --git a/harbour/ChangeLog b/harbour/ChangeLog index b599bb74a2..f3c1d46678 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,7 +1,32 @@ +2000-09-07 00:10 UTC+0800 Ron Pinkas + * 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 := QSelf() AS CLASS + + /* 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 * 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 diff --git a/harbour/include/hbclass.ch b/harbour/include/hbclass.ch index e6c6d87b1a..31c6c6d908 100644 --- a/harbour/include/hbclass.ch +++ b/harbour/include/hbclass.ch @@ -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( ) : => :: #xtranslate :Super() : => :Super: @@ -432,28 +432,28 @@ DECLARE TClass ; #xcommand METHOD ( [] ) CLASS => ; static function _( [] ) ;; - local Self AS CLASS := QSelf() + local Self AS CLASS := QSelf() AS CLASS #xcommand ACCESS () CLASS => ; static function _() ;; - local Self AS CLASS := QSelf() + local Self AS CLASS := QSelf() AS CLASS #xcommand ASSIGN ( [] ) CLASS => ; static function __( [] ) ;; - local Self AS CLASS := QSelf() + local Self AS CLASS := QSelf() AS CLASS #else #xcommand METHOD ( [] ) CLASS => ; static function ( [] ) ;; - local Self AS CLASS := QSelf() + local Self AS CLASS := QSelf() AS CLASS #xcommand ACCESS () CLASS => ; static function () ;; - local Self AS CLASS := QSelf() + local Self AS CLASS := QSelf() AS CLASS #xcommand ASSIGN ( [] ) CLASS => ; static function _( [] ) ;; - local Self AS CLASS := QSelf() + local Self AS CLASS := QSelf() AS CLASS #endif /* HB_SHORTNAMES */ diff --git a/harbour/include/hbcomp.h b/harbour/include/hbcomp.h index 428c760a1f..e76b54ad63 100644 --- a/harbour/include/hbcomp.h +++ b/harbour/include/hbcomp.h @@ -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; diff --git a/harbour/source/compiler/harbour.c b/harbour/source/compiler/harbour.c index a12f7843a6..b20b3427a1 100644 --- a/harbour/source/compiler/harbour.c +++ b/harbour/source/compiler/harbour.c @@ -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 */ diff --git a/harbour/source/compiler/harbour.y b/harbour/source/compiler/harbour.y index eafbc4e7a8..bae8ff3029 100644 --- a/harbour/source/compiler/harbour.y +++ b/harbour/source/compiler/harbour.y @@ -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 { $$ = 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 = $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 = $3; } diff --git a/harbour/source/compiler/hbpcode.c b/harbour/source/compiler/hbpcode.c index 8a19d10057..76aa1509ab 100644 --- a/harbour/source/compiler/hbpcode.c +++ b/harbour/source/compiler/hbpcode.c @@ -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;