unmaintained: New home for misfit Factor vocabularies.

[factor-unmaintained.git] / alien / marshall / syntax / syntax.factor

diff --git a/alien/marshall/syntax/syntax.factor b/alien/marshall/syntax/syntax.factor
new file mode 100644 (file)
index 0000000..3343436
--- /dev/null
+++ b/alien/marshall/syntax/syntax.factor
@@ -0,0 +1,50 @@
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.inline alien.inline.types alien.marshall
+combinators effects generalizations kernel locals make namespaces
+quotations sequences words alien.marshall.structs lexer parser
+vocabs.parser multiline ;
+IN: alien.marshall.syntax
+
+:: marshalled-function ( name types effect -- word quot effect )
+    name types effect factor-function
+    [ in>> ]
+    [ out>> types [ pointer-to-non-const-primitive? ] filter append ]
+    bi <effect>
+    [
+        [
+            types [ marshaller ] map , \ spread , ,
+            types length , \ nkeep ,
+            types [ out-arg-unmarshaller ] map
+            effect out>> dup empty?
+            [ drop ] [ first unmarshaller prefix ] if
+            , \ spread ,
+        ] [ ] make
+    ] dip ;
+
+: define-c-marshalled ( name types effect body -- )
+    [
+        [ marshalled-function define-declared ]
+        [ prototype-string ] 3bi
+    ] dip append-function-body c-strings get push ;
+
+: define-c-marshalled' ( name effect body -- )
+    [
+        [ in>> ] keep
+        [ marshalled-function define-declared ]
+        [ out>> prototype-string' ] 3bi
+    ] dip append-function-body c-strings get push ;
+
+SYNTAX: CM-FUNCTION:
+    function-types-effect parse-here define-c-marshalled ;
+
+SYNTAX: M-FUNCTION:
+    function-types-effect marshalled-function define-declared ;
+
+SYNTAX: M-STRUCTURE:
+    scan current-vocab parse-definition
+    define-marshalled-struct ;
+
+SYNTAX: CM-STRUCTURE:
+    scan current-vocab parse-definition
+    [ define-marshalled-struct ] [ nip define-c-struct ] 3bi ;