From 078ca0fa5876275272e46a24e96770879388cb07 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 28 Feb 2010 16:15:58 -0800
Subject: [PATCH] alien.parser: refactor FUNCTION: parsing to read from the
 source incrementally. parse errors in FUNCTION: should now correspond to
 their location within the definition

---
 basis/alien/parser/parser.factor      | 63 ++++++++++++++-------------
 basis/alien/syntax/syntax-docs.factor |  5 ---
 2 files changed, 32 insertions(+), 36 deletions(-)

diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor
index cf8c878589..f4331b3624 100644
--- a/basis/alien/parser/parser.factor
+++ b/basis/alien/parser/parser.factor
@@ -59,64 +59,65 @@ ERROR: *-in-c-type-name name ;
         [ ]
     } cleave ;
 
-: normalize-c-arg ( type name -- type' name' )
-    [ length ]
-    [
-        [ CHAR: * = ] trim-head
-        [ length - CHAR: * <array> append ] keep
-    ] bi
-    [ parse-c-type ] dip ;
-
 <PRIVATE
 GENERIC: return-type-name ( type -- name )
 
 M: object return-type-name drop "void" ;
 M: word return-type-name name>> ;
 M: pointer return-type-name to>> return-type-name CHAR: * suffix ;
+
+: parse-pointers ( type name -- type' name' )
+    "*" ?head
+    [ [ <pointer> ] dip parse-pointers ] when ;
+
 PRIVATE>
 
-: parse-arglist ( parameters return -- types effect )
-    [
-        2 group [ first2 normalize-c-arg 2array ] map
-        unzip [ "," ?tail drop ] map
-    ]
-    [ [ { } ] [ return-type-name 1array ] if-void ]
-    bi* <effect> ;
+: scan-function-name ( -- return function )
+    scan-c-type scan parse-pointers ;
+
+:: (scan-c-args) ( end-marker types names -- )
+    scan :> type-str
+    type-str end-marker = [
+        type-str { "(" ")" } member? [
+            type-str parse-c-type :> type
+            scan :> name
+            type name parse-pointers :> ( type' name' )
+            type' types push name' names push
+        ] unless
+        end-marker types names (scan-c-args)
+    ] unless ;
+
+: scan-c-args ( end-marker -- types names )
+    V{ } clone V{ } clone [ (scan-c-args) ] 2keep [ >array ] bi@ ;
 
 : function-quot ( return library function types -- quot )
     '[ _ _ _ _ alien-invoke ] ;
 
-:: make-function ( return library function parameters -- word quot effect )
-    return function normalize-c-arg :> ( return function )
-    function create-in dup reset-generic
-    return library function
-    parameters return parse-arglist [ function-quot ] dip ;
+: function-effect ( names return -- effect )
+    [ { } ] [ return-type-name 1array ] if-void <effect> ;
 
-: parse-arg-tokens ( -- tokens )
-    ";" parse-tokens [ "()" subseq? not ] filter ;
+:: make-function ( return function library types names -- word quot effect )
+    function create-in dup reset-generic
+    return library function types function-quot
+    names return function-effect ;
 
 : (FUNCTION:) ( -- word quot effect )
-    scan "c-library" get scan parse-arg-tokens make-function ;
-
-: define-function ( return library function parameters -- )
-    make-function define-declared ;
+    scan-function-name "c-library" get ";" scan-c-args make-function ;
 
 : callback-quot ( return types abi -- quot )
     '[ [ _ _ _ ] dip alien-callback ] ;
 
-:: make-callback-type ( lib return type-name parameters -- word quot effect )
-    return type-name normalize-c-arg :> ( return type-name )
+:: make-callback-type ( lib return type-name types names -- word quot effect )
     type-name current-vocab create :> type-word 
     type-word [ reset-generic ] [ reset-c-type ] bi
     void* type-word typedef
-    parameters return parse-arglist :> ( types callback-effect )
-    type-word callback-effect "callback-effect" set-word-prop
+    type-word names return function-effect "callback-effect" set-word-prop
     type-word lib "callback-library" set-word-prop
     type-word return types lib library-abi callback-quot (( quot -- alien )) ;
 
 : (CALLBACK:) ( -- word quot effect )
     "c-library" get
-    scan scan parse-arg-tokens make-callback-type ;
+    scan-function-name ";" scan-c-args make-callback-type ;
 
 PREDICATE: alien-function-word < word
     def>> {
diff --git a/basis/alien/syntax/syntax-docs.factor b/basis/alien/syntax/syntax-docs.factor
index 3d1c757035..58b43cec31 100644
--- a/basis/alien/syntax/syntax-docs.factor
+++ b/basis/alien/syntax/syntax-docs.factor
@@ -112,11 +112,6 @@ HELP: c-struct?
 { $values { "c-type" "a C type" } { "?" "a boolean" } }
 { $description "Tests if a C type is a structure defined by " { $link POSTPONE: STRUCT: } "." } ;
 
-HELP: define-function
-{ $values { "return" "a C return type" } { "library" "a logical library name" } { "function" "a C function name" } { "parameters" "a sequence of C parameter types" } }
-{ $description "Defines a word named " { $snippet "function" } " in the current vocabulary (see " { $link "vocabularies" } "). The word calls " { $link alien-invoke } " with the specified parameters." }
-{ $notes "This word is used to implement the " { $link POSTPONE: FUNCTION: } " parsing word." } ;
-
 HELP: C-GLOBAL:
 { $syntax "C-GLOBAL: type name" }
 { $values { "type" "a C type" } { "name" "a C global variable name" } }