windows.com: update COM-INTERFACE: to parse incrementally

basis/windows/com/syntax/syntax.factor

@@ -2,8 +2,8 @@ USING: alien alien.c-types alien.accessors alien.parser
 effects kernel windows.ole32 parser lexer splitting grouping
 sequences namespaces assocs quotations generalizations
 accessors words macros alien.syntax fry arrays layouts math
-classes.struct windows.kernel32 ;
+classes.struct windows.kernel32 locals ;
-FROM: alien.parser.private => return-type-name ;
+FROM: alien.parser.private => parse-pointers return-type-name ;
 IN: windows.com.syntax
 
 <PRIVATE
@@ -18,7 +18,7 @@ MACRO: com-invoke ( n return parameters -- )
 TUPLE: com-interface-definition word parent iid functions ;
 C: <com-interface-definition> com-interface-definition
 
-TUPLE: com-function-definition name return parameters ;
+TUPLE: com-function-definition return name parameter-types parameter-names ;
 C: <com-function-definition> com-function-definition
 
 SYMBOL: +com-interface-definitions+
@@ -37,19 +37,20 @@ ERROR: no-com-interface interface ;
 : save-com-interface-definition ( definition -- )
     dup word>> +com-interface-definitions+ get-global set-at ;
 
-: (parse-com-function) ( tokens -- definition )
+: (parse-com-function) ( return name -- definition )
-    [ second ]
+    ")" scan-c-args
-    [ first parse-c-type ]
+    [ pointer: void prefix ] [ "this" prefix ] bi*
-    [
-        3 tail [ CHAR: , swap remove ] map
-        2 group [ first2 normalize-c-arg 2array ] map
-        { void* "this" } prefix
-    ] tri
     <com-function-definition> ;
 
+:: (parse-com-functions) ( functions -- )
+    scan dup ";" = [ drop ] [
+        parse-c-type scan parse-pointers
+        (parse-com-function) functions push
+        functions (parse-com-functions)
+    ] if ;
+
 : parse-com-functions ( -- functions )
-    ";" parse-tokens { ")" } split harvest
+    V{ } clone [ (parse-com-functions) ] keep >array ;
-    [ (parse-com-function) ] map ;
 
 : (iid-word) ( definition -- word )
     word>> name>> "-iid" append create-in ;
@@ -66,20 +67,10 @@ ERROR: no-com-interface interface ;
     dup parent>> [ family-tree-functions ] [ { } ] if*
     swap functions>> append ;
 
-: (invocation-quot) ( function return parameters -- quot )
+:: (define-word-for-function) ( function interface n -- )
-    [ first ] map [ com-invoke ] 3curry ;
+    function interface (function-word)
-
+    n function [ return>> ] [ parameter-types>> ] bi '[ _ _ _ com-invoke ]
-: (stack-effect-from-return-and-parameters) ( return parameters -- stack-effect )
+    function [ parameter-names>> ] [ return>> ] bi function-effect
-    swap
-    [ [ second ] map ]
-    [ dup void? [ drop { } ] [ return-type-name 1array ] if ] bi*
-    <effect> ;
-
-: (define-word-for-function) ( function interface n -- )
-    -rot [ (function-word) swap ] 2keep drop
-    [ return>> ] [ parameters>> ] bi
-    [ (invocation-quot) ] 2keep
-    (stack-effect-from-return-and-parameters)
     define-declared ;
 
 : define-words-for-com-interface ( definition -- )

basis/windows/com/wrapper/wrapper.factor

@@ -110,11 +110,7 @@ unless
     keep (next-vtbl-counter) '[
         swap [
             [ name>> _ _ (callback-word) ]
-            [ return>> ] [
+            [ return>> ] [ parameter-types>> dup length ] tri
-                parameters>>
-                [ [ first ] map ]
-                [ length ] bi
-            ] tri
         ] [
             first2 (finish-thunk)
         ] bi*