diff --git a/src/compiler/parser-expr-unary.bas b/src/compiler/parser-expr-unary.bas index daf3fd7b1..7eacf7ee3 100644 --- a/src/compiler/parser-expr-unary.bas +++ b/src/compiler/parser-expr-unary.bas @@ -490,7 +490,7 @@ end sub private function hProcPtrBody _ ( _ byval base_parent as FBSYMBOL ptr, _ - byref proc as FBSYMBOL ptr, _ + byval proc as FBSYMBOL ptr, _ byval check_exact as boolean _ ) as ASTNODE ptr @@ -527,6 +527,91 @@ private function hProcPtrBody _ function = astBuildProcAddrof( proc ) end function +function cProcPtrBody _ + ( _ + byval dtype as integer, _ + byval subtype as FBSYMBOL ptr _ + ) as ASTNODE ptr + + dim as FBSYMCHAIN ptr chain_ = any + dim as FBSYMBOL ptr sym = any, base_parent = any + dim as ASTNODE ptr expr = any + + if( dtype = FB_DATATYPE_STRUCT ) then + base_parent = subtype + chain_ = NULL + + else + chain_ = cIdentifier( base_parent, _ + FB_IDOPT_CHECKSTATIC or _ + FB_IDOPT_ALLOWSTRUCT or _ + FB_IDOPT_ALLOWOPERATOR ) + + end if + + sym = cIdentifierOrUDTMember( base_parent, chain_ ) + + if( sym = NULL ) then + errReport( FB_ERRMSG_UNDEFINEDSYMBOL ) + '' error recovery: skip until ')' and fake a node + hSkipUntil( CHAR_RPRNT, TRUE ) + return astNewCONSTi( 0 ) + end if + + if( symbGetClass( sym ) <> FB_SYMBCLASS_PROC ) then + errReport( FB_ERRMSG_INVALIDDATATYPES, TRUE ) + '' error recovery: skip until ')' and fake a node + hSkipUntil( CHAR_RPRNT, TRUE ) + return astNewCONSTi( 0 ) + end if + + hCheckEmptyProcParens() + + '' ','? + if( hMatch( CHAR_COMMA ) ) then + dim as integer dtype = any + dim as FBSYMBOL ptr subtype = any + dim as integer is_exact = FALSE + + '' only if anything but ')' follows... + if( lexGetToken( ) <> CHAR_RPRNT ) then + if( cSymbolType( dtype, subtype ) = FALSE ) then + errReport( FB_ERRMSG_INVALIDDATATYPES, TRUE ) + '' error recovery: skip until ')' and fake a node + hSkipUntil( CHAR_RPRNT, TRUE ) + return astNewCONSTi( 0 ) + end if + + select case typeGetDtAndPtrOnly( dtype ) + case FB_DATATYPE_VOID + '' 'ANY' matches first declaration + case typeAddrOf( FB_DATATYPE_FUNCTION ) + is_exact = TRUE + case else + errReport( FB_ERRMSG_INVALIDDATATYPES, TRUE ) + '' error recovery: skip until ')' and fake a node + hSkipUntil( CHAR_RPRNT, TRUE ) + return astNewCONSTi( 0 ) + end select + end if + + dim as FBSYMBOL ptr oldsym = parser.ctxsym + dim as integer old_dtype = parser.ctx_dtype + parser.ctxsym = subtype + parser.ctx_dtype = dtype + + expr = hProcPtrBody( base_parent, sym, is_exact ) + + parser.ctxsym = oldsym + parser.ctx_dtype = old_dtype + + else + expr = hProcPtrBody( base_parent, sym, FALSE ) + end if + + return expr +end function + private function hVarPtrBody _ ( _ byval base_parent as FBSYMBOL ptr, _ @@ -547,6 +632,7 @@ private function hVarPtrBody _ '' hand, we need to make sure we don't prematurely optimize '' the CONST specifier away in the event that it is needed '' to be known with AST type checking later. + dim as ASTNODE ptr t = astSkipConstCASTs( expr ) select case as const astGetClass( t ) @@ -628,10 +714,10 @@ function cAddrOfExpression( ) as ASTNODE ptr lexSkipToken( LEXCHECK_POST_LANG_SUFFIX ) hCheckEmptyProcParens() return hProcPtrBody( base_parent, sym, FALSE ) - '' anything else.. - else - return hVarPtrBody( base_parent, chain_ ) end if + + '' anything else + return hVarPtrBody( base_parent, chain_ ) end if select case as const lexGetToken( ) @@ -656,7 +742,7 @@ function cAddrOfExpression( ) as ASTNODE ptr hSkipUntil( CHAR_RPRNT, TRUE ) end if - '' PROCPTR '(' Proc ('('')')? ')' + '' PROCPTR '(' Proc ('('')')? ( ',' signature )? ')' case FB_TK_PROCPTR lexSkipToken( LEXCHECK_POST_SUFFIX ) @@ -668,64 +754,7 @@ function cAddrOfExpression( ) as ASTNODE ptr return astNewCONSTi( 0 ) end if - '' proc? - dim as FBSYMCHAIN ptr chain_ = any - dim as FBSYMBOL ptr sym = any, base_parent = any - - chain_ = cIdentifier( base_parent, _ - FB_IDOPT_CHECKSTATIC or _ - FB_IDOPT_ALLOWSTRUCT or _ - FB_IDOPT_ALLOWOPERATOR ) - - sym = cIdentifierOrUDTMember( base_parent, chain_ ) - - if( sym = NULL ) then - errReport( FB_ERRMSG_UNDEFINEDSYMBOL ) - '' error recovery: skip until ')' and fake a node - hSkipUntil( CHAR_RPRNT, TRUE ) - return astNewCONSTi( 0 ) - end if - - select case symbGetClass( sym ) - case FB_SYMBCLASS_PROC - case else - errReport( FB_ERRMSG_INVALIDDATATYPES, TRUE ) - '' error recovery: skip until ')' and fake a node - hSkipUntil( CHAR_RPRNT, TRUE ) - return astNewCONSTi( 0 ) - end select - - hCheckEmptyProcParens() - - '' ',' ? - if( hMatch( CHAR_COMMA ) ) then - dim dtype as integer - dim subtype as FBSYMBOL ptr - if( cSymbolType( dtype, subtype ) = FALSE ) then - errReport( FB_ERRMSG_INVALIDDATATYPES, TRUE ) - '' error recovery: skip until ')' and fake a node - hSkipUntil( CHAR_RPRNT, TRUE ) - return astNewCONSTi( 0 ) - else - if( typeGetDtAndPtrOnly( dtype ) = typeAddrOf( FB_DATATYPE_FUNCTION ) ) then - dim oldsym as FBSYMBOL ptr = parser.ctxsym - dim old_dtype as integer = parser.ctx_dtype - parser.ctxsym = subtype - parser.ctx_dtype = dtype - expr = hProcPtrBody( base_parent, sym, TRUE ) - parser.ctxsym = oldsym - parser.ctx_dtype = old_dtype - else - errReport( FB_ERRMSG_SYNTAXERROR, TRUE ) - '' error recovery: skip until ')' and fake a node - hSkipUntil( CHAR_RPRNT, TRUE ) - return astNewCONSTi( 0 ) - end if - end if - - else - expr = hProcPtrBody( base_parent, sym, FALSE ) - end if + expr = cProcPtrBody( 0, NULL ) '' ')' if( hMatch( CHAR_RPRNT ) = FALSE ) then diff --git a/src/compiler/parser-identifier.bas b/src/compiler/parser-identifier.bas index c9b3ff0ee..8ae92d3f5 100644 --- a/src/compiler/parser-identifier.bas +++ b/src/compiler/parser-identifier.bas @@ -635,7 +635,17 @@ function cIdentifierOrUDTMember _ FB_IDOPT_ALLOWOPERATOR if( chain_ = NULL ) then - chain_ = cIdentifier( base_parent, idopts ) + if( base_parent = NULL ) then + chain_ = cIdentifier( base_parent, idopts ) + + else + chain_ = symbLookupAt( base_parent, lexGetText( ), FALSE ) + '' No symbol found in the base_parent namespace? then it must + '' be operator or constructor or destructor + if( chain_ = NULL ) then + chain_ = cIdentifier( NULL, idopts ) + end if + end if end if '' not defined if symbol was not found @@ -683,6 +693,7 @@ function cIdentifierOrUDTMember _ select case as const lexGetToken( ) case FB_TK_CONSTRUCTOR sym = symbGetCompCtorHead( base_parent ) + case FB_TK_DESTRUCTOR sym = symbGetCompDtor1( base_parent ) diff --git a/src/compiler/parser.bi b/src/compiler/parser.bi index 5a8e5a92e..7bf2cdb8e 100644 --- a/src/compiler/parser.bi +++ b/src/compiler/parser.bi @@ -531,6 +531,13 @@ declare function cHighestPrecExpr _ ) as ASTNODE ptr declare function cDerefExpression( ) as ASTNODE ptr + +declare function cProcPtrBody _ + ( _ + byval dtype as integer, _ + byval subtype as FBSYMBOL ptr _ + ) as ASTNODE ptr + declare function cAddrOfExpression( ) as ASTNODE ptr declare function cTypeConvExpr _ diff --git a/src/compiler/symb.bi b/src/compiler/symb.bi index 4863e91e4..167798f5a 100644 --- a/src/compiler/symb.bi +++ b/src/compiler/symb.bi @@ -628,7 +628,7 @@ type FB_PROCEXT stmtnum as integer priority as integer gosub as FB_PROCGSB - base_initree as ASTNODE_ ptr '' base() ctorcall/initializer given in constructor bodies + base_initree as ASTNODE_ ptr '' base() ctorcall/initializer given in constructor bodies '' virtual methods: '' vtable array index, location of the procptr in the vtbl diff --git a/todo.txt b/todo.txt index e5d14ef6e..97b0ee219 100644 --- a/todo.txt +++ b/todo.txt @@ -311,14 +311,22 @@ o -exx should catch... - := must be a new token because the "foo bar : baz" ambiguity [ ] method pointers / delegates - - extend PROCPTR( id, type ) to allow pointers to methods - - fbc handles method pointers fairly well but the syntax is not symmetrical with - invoking a method on a TYPE (class) - - var x = procptr( T.method ) could return a method pointer but must currently be - invoked with x( instance, [params]... ). This is a different syntax from other - languages that support method pointers. - - delegates would need to aggregate the instance and method pointer which will - likely requre a new built-in type to handle by the compiler + [x] extend PROCPTR( id [, signature] ) to allow pointers to methods + [x] fbc handles method pointers fairly well even though the syntax is not symmetrical + with invoking a method on a TYPE (class). We should probably be ok with this since + at a low level methods are just procedures and allowing this syntax at the very + least avoids extra procedure calls (i.e. non-static member calls static member + to call non-static member hack) and we would prefer to just call the non-static + member directly. + [x] var x = procptr( T.method ) returns a method pointer can can be invoked with + x( instance, [params]... ) - see above + [ ] safe-ish delegates would need to aggregate the instance and method pointer which will + likely requre a new built-in type to handle by the compiler. It's possible that we + could build a delegate in user code, but would have to sacrifice some type safety + since type information about the virtual table is not exposed to the user in any way. + The net result is that lookups in virtual tables must be cast to the proper type and + we don't have a way to check in user code the function signature of the virtual table + in user code. *** *** *** *** *** [ ] All functions returning STRING should actually return the FBSTRING object