From cd820d07248dcce1106cbcd5e18bd4831b570f76 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sun, 16 Mar 2008 16:22:14 +0000
Subject: 	* lisp/Makefile.in (void_type): New. 	(char_type): Likewise.
 	(int_type): Likewise. 	(float_type): Likewise. 	(double_type):
 Likewise. 	(string_type): Likewise. 	(pointer_type): Likewise. 
 (edit): Use them. 	* interp/wi1.boot (ppFull): Tidy.  Don't set
 *PRINT-DEPTH*. 	* interp/vmlisp.lisp (gcmsg): Define when SBCL. 
 * interp/template.boot (measureCommon): Fix thinko. 	*
 interp/sys-utility.boot: Move basic type definition from 	g-util.boot to
 here. 	* interp/g-util.boot (augProplistOf): Fix signature declaration. 
 * interp/daase.lisp: Tidy. 	* interp/c-util.boot (displayComp): Remove
 assignment to 	$X,$M,$F. 	* interp/boot-pkg.lisp: Tidy. 	*
 interp/axext_l.lisp: Likewise. 	* interp/Makefile.pamphlet
 (makeint.lisp): Call GBC only when GCL. 
 ($(axiom_targetdir)/algebra/exposed.$(FASLEXT)): Tidy. 
 (patches.$(FASLEXT)): Require debug.$(FASLEXT), g-timer.$(FASLEXT). 
 (wi2.$(FASLEXT)): Require define.$(FASLEXT). 	(spad.$(FASLEXT)): Require
 postpar.$(FASLEXT), debug.$(FASLEXT). 	* boot/translator.boot
 (genImportDeclaration): Include translation 	for SBCL. 	*
 boot/parser.boot (bpMapping): Tidy. 	* boot/ast.boot (coreSymbol): New. 
 (bootSymbol): Likewise. 	(bootSymbol): Likewise. 	*
 lisp/core.lisp.in (|$NativeTypeTable|): New. Export. 	*
 algebra/Makefile.pamphlet (COMPILE_LISP): Use $(INTERPSYS). 	*
 algebra/exposed.lsp.pamphlet: Tidy.

---
 src/boot/ast.boot        | 14 ++++++++++++++
 src/boot/parser.boot     |  5 +++--
 src/boot/translator.boot |  8 +++++++-
 3 files changed, 24 insertions(+), 3 deletions(-)

(limited to 'src/boot')

diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 210d5b2e..112236b6 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -1157,3 +1157,17 @@ bfThrow e ==
   atom e => ["THROW",["QUOTE",e],nil]
   not atom first e => bpTrap()
   ["THROW",["QUOTE",first e],:rest e]
+
+--% Native datatype translation
+coreSymbol: %Symbol -> %Symbol
+coreSymbol s ==
+  INTERN(SYMBOL_-NAME s, "AxiomCore")
+
+bootSymbol: %Symbol -> %Symbol
+bootSymbol s ==
+  INTERN SYMBOL_-NAME s
+
+nativeType t ==
+  null t => t
+  t' := ASSOC(coreSymbol t,$NativeTypeTable) => bootSymbol rest t'
+  fatalError CONCAT('"unsupported native type: ", SYMBOL_-NAME t)
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 5cc2d856..10970e82 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -458,8 +458,9 @@ bpSignature() ==
 ++   Mapping:
 ++      (Name | IdList) -> Name
 bpMapping() ==
-  (bpName() or bpIdList()) and bpEqKey "ARROW" and bpName()
-    and bpPush Mapping(bpPop1(), bpPop1())
+  (bpName() or bpParenthesized function bpIdList) and 
+     bpEqKey "ARROW" and bpName() and 
+       bpPush Mapping(bpPop1(), bfUntuple bpPop1())
 
 bpCancel()==
     a:=bpState()
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 801848b8..5388c6c5 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -321,9 +321,15 @@ shoeAddComment l==  CONCAT('"; ",CAR l)
 genImportDeclaration(op, sig) ==
   sig isnt ["Signature", op', m] => coreError '"invalid signature"
   m isnt ["Mapping", t, s] => coreError '"invalid function type"
+  if not null s and SYMBOLP s then s := [s]
   %hasFeature KEYWORD::GCL => 
-    if SYMBOLP s then s := [s]
     ["DEFENTRY", op, s, [t, SYMBOL_-NAME op']]
+  %hasFeature KEYWORD::SBCL =>
+    args := [GENSYM() for x in s]
+    ["DEFUN",op,args,
+      [INTERN('"ALIEN-FUNCALL",'"SB-ALIEN"),
+        [INTERN('"EXTERN-ALIEN",'"SB-ALIEN"),SYMBOL_-NAME op',
+          ["FUNCTION",nativeType t,:[nativeType x for x in s]]], :args]]
   fatalError '"import declaration not implemented for this Lisp"
 
 shoeOutParse stream ==
-- 
cgit v1.2.3