Automate FFI at Boot level

5 files changed, 62 insertions, 9 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 80dea1e1..5de92eec 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,15 @@
+2008-01-07  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* boot/ast.boot.pamphlet (Ast): Add ImportSignature, Signature,
+	and Mapping.
+	* boot/parser.boot.pamphlet (bpImport): Parse import declaration.
+	(bpSignature): New.
+	(bpMapping): Likewise.
+	* boot/tokens.boot.pamphlet (shoeKeyWords): Add new keyword.
+	* boot/translator.boot.pamphlet (genImportDeclaration): Translate 
+	import declaration.
+	(shoeOutItem):  Handle import declarations.
+
 2008-01-06  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* sman/sman.c: Remove debug and dead codes.
diff --git a/src/boot/ast.boot.pamphlet b/src/boot/ast.boot.pamphlet
index b4f6e76d..b0c2f483 100644
--- a/src/boot/ast.boot.pamphlet
+++ b/src/boot/ast.boot.pamphlet
@@ -76,8 +76,11 @@ structure Name == Name(Symbol)
 structure Ast ==
   Command(String)			-- includer command
   Module(String)			-- module declaration
-  Import(String)			-- import declaration
+  Import(String)			-- import module
+  ImportSignature(Name, Signature)      -- import function declaration
   TypeAlias(Name, List, List)		-- type alias definition
+  Signature(Name, Mapping)		-- op: S -> T
+  Mapping(Ast, List)			-- (S1, S2) -> T
   SuffixDot(Ast)			-- x . 
   Quote(Ast)				-- 'x
   EqualName(Name)			-- =x        -- patterns
diff --git a/src/boot/parser.boot.pamphlet b/src/boot/parser.boot.pamphlet
index 863ef202..2ff33d38 100644
--- a/src/boot/parser.boot.pamphlet
+++ b/src/boot/parser.boot.pamphlet
@@ -512,6 +512,9 @@ bpMoveTo n==
 
 <<Constant>>
 
+++ Parse a module definitoin
+++   Module:
+++     MODULE QUOTE String
 bpModule() ==
   bpEqKey "MODULE" =>
     -- we really want to check that the next token is indeed
@@ -521,16 +524,22 @@ bpModule() ==
     bpConstTok() and bpPush Module bpPop1()
   false
 
+++ Parse a module import, or a import declaration for a foreign entity.
+++ Import:
+++    IMPORT Name for Signature
+++    IMPORT QUOTE String
 bpImport() ==
   bpEqKey "IMPORT" =>
-    -- we really want to check that the next token is indeed
-    -- a string.  For the moment, we delay the type checking
-    -- to the Lisp compiler/interpreter.  That is likely to 
-    -- cause cryptic diagnostics.  To be fixed.
-    bpConstTok() and bpPush Import bpPop1()
+    (bpName() and (bpEqKey "FOR" or bpTrap()) and bpSignature()
+       and bpPush ImportSignature(bpPop2(), bpPop1()))
+         or 
+	  -- we really want to check that the next token is indeed
+	  -- a string.  For the moment, we delay the type checking
+	  -- to the Lisp compiler/interpreter.  That is likely to 
+	  -- cause cryptic diagnostics.  To be fixed.
+	   (bpConstTok() and bpPush Import bpPop1())
   false
 
-
 -- Parse a type alias defnition:
 --    type-alias-definition: 
 --          identifier <=> logical-expression
@@ -538,7 +547,21 @@ bpTypeAliasDefition() ==
   (bpName() or bpTrap()) and 
     bpEqKey "TDEF" and bpLogical() and
       bpPush TypeAlias(bpPop2(), nil, bpPop1())
- 
+
+++ Parse a signature declaration
+++  Signature:
+++    Name COLON Mapping
+bpSignature() ==
+  bpName() and bpEqKey "COLON" and bpMapping()
+    and bpPush Signature(bpPop2(), bpPop1())
+
+++ Parse a mapping expression
+++   Mapping:
+++      (Name | IdList) -> Name
+bpMapping() ==
+  (bpName() or bpIdList()) and bpEqKey "ARROW" and bpName()
+    and bpPush Mapping(bpPop1(), bpPop1())
+
 bpCancel()==
     a:=bpState()
     if bpEqKeyNextTok  "SETTAB"
diff --git a/src/boot/tokens.boot.pamphlet b/src/boot/tokens.boot.pamphlet
index 106e96e8..bb4d7ec2 100644
--- a/src/boot/tokens.boot.pamphlet
+++ b/src/boot/tokens.boot.pamphlet
@@ -209,6 +209,7 @@ shoeKeyWords := [  _
             ['"..","SEG" ], _
             ['"#", "LENGTH"], _
             ['"=>","EXIT" ], _
+            ['"->", "ARROW"],_
             ['":=", "BEC"], _
             ['"==", "DEF"], _
             ['"==>","MDEF" ], _
diff --git a/src/boot/translator.boot.pamphlet b/src/boot/translator.boot.pamphlet
index 50e146aa..c66ba1f2 100644
--- a/src/boot/translator.boot.pamphlet
+++ b/src/boot/translator.boot.pamphlet
@@ -375,7 +375,18 @@ shoeConsoleTrees s ==
           s:=CDR s
  
 shoeAddComment l==  CONCAT('"; ",CAR l)
- 
+
+++ Generate an import declaration for `op' as equivalent of the
+++ foreign signature `sig'.  Here, `foreign' operationally means that
+++ the entity is from the C language world. 
+genImportDeclaration(op, sig) ==
+  sig isnt ["Signature", op', m] => coreError '"invalid signature"
+  m isnt ["Mapping", t, s] => coreError '"invalid function type"
+  %hasFeature KEYWORD::GCL => 
+    if SYMBOLP s then s := [s]
+    ["DEFENTRY", op, s, [t, SYMBOL_-NAME op']]
+  fatalError '"import declaration not implemented for this Lisp"
+
 shoeOutParse stream ==
     $inputStream :local:= stream
     $stack:local       :=nil
@@ -415,6 +426,9 @@ bpOutItem()==
       Import(m) => 
         bpPush [["IMPORT-MODULE", m]]
 
+      ImportSignature(x, sig) =>
+        bpPush [genImportDeclaration(x, sig)]
+
       TypeAlias(t, args, rhs) => 
         bpPush [["DEFTYPE", t, args, ["QUOTE", rhs]]]