fbc: internal refactor of PROCPTR handling

- add cProcPtrBody() to move the handling for PROCPTR() arguments
  outside of cAddrOfExpression()
- in cIdentifierOrUDTMember() allow parsing / lookup starting at a specified base parent

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

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 )
 

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 _

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

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