From bde65fe2d076ac57535b3f1961bf8e7dfd27c72e Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 28 Feb 2010 19:30:15 -0800
Subject: [PATCH] windows.com: update COM-INTERFACE: to parse incrementally

---
 basis/windows/com/syntax/syntax.factor   | 45 ++++++++++--------------
 basis/windows/com/wrapper/wrapper.factor |  6 +---
 2 files changed, 19 insertions(+), 32 deletions(-)

diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor
index 5230d9497e..49c9272d9b 100644
--- a/basis/windows/com/syntax/syntax.factor
+++ b/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 ;
-FROM: alien.parser.private => return-type-name ;
+classes.struct windows.kernel32 locals ;
+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 )
-    [ second ]
-    [ first parse-c-type ]
-    [
-        3 tail [ CHAR: , swap remove ] map
-        2 group [ first2 normalize-c-arg 2array ] map
-        { void* "this" } prefix
-    ] tri
+: (parse-com-function) ( return name -- definition )
+    ")" scan-c-args
+    [ pointer: void prefix ] [ "this" prefix ] bi*
     <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
-    [ (parse-com-function) ] map ;
+    V{ } clone [ (parse-com-functions) ] keep >array ;
 
 : (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 )
-    [ first ] map [ com-invoke ] 3curry ;
-
-: (stack-effect-from-return-and-parameters) ( return parameters -- stack-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-word-for-function) ( function interface n -- )
+    function interface (function-word)
+    n function [ return>> ] [ parameter-types>> ] bi '[ _ _ _ com-invoke ]
+    function [ parameter-names>> ] [ return>> ] bi function-effect
     define-declared ;
 
 : define-words-for-com-interface ( definition -- )
diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor
index 623a9c8db3..25861659dc 100644
--- a/basis/windows/com/wrapper/wrapper.factor
+++ b/basis/windows/com/wrapper/wrapper.factor
@@ -110,11 +110,7 @@ unless
     keep (next-vtbl-counter) '[
         swap [
             [ name>> _ _ (callback-word) ]
-            [ return>> ] [
-                parameters>>
-                [ [ first ] map ]
-                [ length ] bi
-            ] tri
+            [ return>> ] [ parameter-types>> dup length ] tri
         ] [
             first2 (finish-thunk)
         ] bi*