aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-10-01 22:21:23 +0000
committerdos-reis <gdr@axiomatics.org>2011-10-01 22:21:23 +0000
commit496ca25659180bb29cc5fea2f3c0337695d742d3 (patch)
treefe020f749b8247903bc66b576c273b61c5aa46ae /src/boot
parent73374b314b15f2a313718d0e347a1050d1d1a405 (diff)
downloadopen-axiom-496ca25659180bb29cc5fea2f3c0337695d742d3.tar.gz
* boot/parser.boot (bpImport): Accept long names for used namespaces.
* boot/translator.boot (packageBody): Tidy. (translateToplevel): Likewise. (getIntermediateLispFile): Likewise. * interp/sys-os.boot: Import System.Foreign.
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/parser.boot8
-rw-r--r--src/boot/strap/parser.clisp22
-rw-r--r--src/boot/strap/translator.clisp37
-rw-r--r--src/boot/strap/utility.clisp3
-rw-r--r--src/boot/translator.boot22
5 files changed, 59 insertions, 33 deletions
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 8c67c7c6..f2c0a721 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -362,7 +362,6 @@ bpName() ==
bpAnyNo function bpQualifiedName
false
-
++ Constant:
++ INTEGER
++ FLOAT
@@ -445,10 +444,13 @@ bpModule() ==
++ Import:
++ IMPORT Signature FOR Name
++ IMPORT Name
-++ IMPORT Namespace
+++ IMPORT NAMESPACE LongName
bpImport() ==
bpEqKey "IMPORT" =>
- bpNamespace() => bpPush %Import bpPop1()
+ bpEqKey "NAMESPACE" =>
+ bpLeftAssoc('(DOT),function bpName) and
+ bpPush %Import bfNamespace bpPop1()
+ or bpTrap()
a := bpState()
bpName() or bpTrap()
bpEqPeek "COLON" =>
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 7b470d05..3d8d15f8 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -440,15 +440,19 @@
(RETURN
(COND
((|bpEqKey| 'IMPORT)
- (COND ((|bpNamespace|) (|bpPush| (|%Import| (|bpPop1|))))
- (T (SETQ |a| (|bpState|)) (OR (|bpName|) (|bpTrap|))
- (COND
- ((|bpEqPeek| 'COLON) (|bpRestore| |a|)
- (AND (OR (|bpSignature|) (|bpTrap|))
- (OR (|bpEqKey| 'FOR) (|bpTrap|))
- (OR (|bpName|) (|bpTrap|))
- (|bpPush| (|%ImportSignature| (|bpPop1|) (|bpPop1|)))))
- (T (|bpPush| (|%Import| (|bpPop1|))))))))
+ (COND
+ ((|bpEqKey| 'NAMESPACE)
+ (OR
+ (AND (|bpLeftAssoc| '(DOT) #'|bpName|)
+ (|bpPush| (|%Import| (|bfNamespace| (|bpPop1|)))))
+ (|bpTrap|)))
+ (T (SETQ |a| (|bpState|)) (OR (|bpName|) (|bpTrap|))
+ (COND
+ ((|bpEqPeek| 'COLON) (|bpRestore| |a|)
+ (AND (OR (|bpSignature|) (|bpTrap|))
+ (OR (|bpEqKey| 'FOR) (|bpTrap|)) (OR (|bpName|) (|bpTrap|))
+ (|bpPush| (|%ImportSignature| (|bpPop1|) (|bpPop1|)))))
+ (T (|bpPush| (|%Import| (|bpPop1|))))))))
(T NIL)))))
(DEFUN |bpNamespace| ()
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 95ad05d9..7ce79ebe 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -566,7 +566,7 @@
(T (LIST (|inAllContexts| (LIST 'EXPORT (|quote| |ns|)))))))
(DEFUN |packageBody| (|x| |p|)
- (PROG (|user| |ns| |ISTMP#3| |ISTMP#2| |ISTMP#1|)
+ (PROG (|z| |user| |ns| |ISTMP#3| |ISTMP#2| |ISTMP#1|)
(RETURN
(COND
((AND (CONSP |x|) (EQ (CAR |x|) '|%Import|)
@@ -587,7 +587,25 @@
(LIST (LIST '|%hasFeature| :COMMON-LISP)
(CONS 'USE-PACKAGE (CONS "COMMON-LISP" |user|)))
(LIST 'T (CONS 'USE-PACKAGE (CONS "LISP" |user|)))))
- (T (CONS 'USE-PACKAGE (CONS (SYMBOL-NAME |ns|) |user|)))))
+ (T
+ (SETQ |z|
+ (COND
+ ((AND (CONSP |ns|) (EQ (CAR |ns|) 'DOT)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |ns|))
+ (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) '|System|)
+ (PROGN
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
+ (EQ (CAR |ISTMP#2|) '|Foreign|))))))
+ (COND ((|%hasFeature| :SBCL) 'SB-ALIEN)
+ ((|%hasFeature| :CLISP) 'FFI)
+ ((|%hasFeature| :CLOZURE) 'CCL)
+ ((|%hasFeature| :ECL) 'EXT) ((|%hasFeature| :GCL) 'SI)
+ (T NIL)))
+ ((|ident?| |ns|) |ns|) (T NIL)))
+ (COND ((NULL |z|) (|bpTrap|))
+ (T (CONS 'USE-PACKAGE (CONS (SYMBOL-NAME |z|) |user|)))))))
((AND (CONSP |x|) (EQ (CAR |x|) 'PROGN))
(CONS (CAR |x|)
(LET ((|bfVar#2| NIL)
@@ -607,7 +625,7 @@
(T |x|)))))
(DEFUN |translateToplevel| (|b| |export?|)
- (PROG (|lhs| |t| |ISTMP#2| |sig| |def| |ns| |n| |ISTMP#1| |xs|)
+ (PROG (|lhs| |t| |ISTMP#2| |sig| |ns| |n| |ISTMP#1| |xs|)
(DECLARE
(SPECIAL |$currentModuleName| |$foreignsDefsForCLisp|
|$constantIdentifiers| |$InteractiveMode| |$activeNamespace|))
@@ -662,7 +680,7 @@
(SETQ |ISTMP#1| (CDR |m|))
(AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
(PROGN (SETQ |n| (CAR |ISTMP#1|)) T))))
- (LIST (|inAllContexts| (|packageBody| |m| NIL))))
+ (LIST (|inAllContexts| (|packageBody| |b| NIL))))
(T
(COND
((NOT (STRING= (|getOptionValue| '|import|) "skip"))
@@ -682,11 +700,7 @@
(SETQ |ISTMP#1| (CDR |lhs|))
(AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
(PROGN (SETQ |ns| (CAR |ISTMP#1|)) T))))
- (SETQ |def|
- (LIST 'UNLESS
- (LIST 'FIND-PACKAGE (SYMBOL-NAME |ns|))
- (LIST 'MAKE-PACKAGE (SYMBOL-NAME |ns|))))
- (LIST (|inAllContexts| |def|)
+ (LIST (LIST 'DEFPACKAGE (SYMBOL-NAME |ns|))
(|inAllContexts| (|packageBody| |rhs| |ns|))))
(T (SETQ |sig| NIL)
(COND
@@ -1234,9 +1248,8 @@
(SETQ |out| (NAMESTRING (|getOutputPathname| |options|)))
(COND
(|out|
- (CONCAT
- (|shoeRemoveStringIfNec| (CONCAT "." |$effectiveFaslType|) |out|)
- ".clisp"))
+ (CONCAT (|shoeRemoveStringIfNec| (CONCAT "." |$faslType|) |out|)
+ ".clisp"))
(T (|defaultBootToLispFile| |file|)))))))
(DEFUN |translateBootFile| (|progname| |options| |file|)
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index 7137a1c6..8a06ff0c 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -1,6 +1,5 @@
(PROCLAIM '(OPTIMIZE SPEED))
-(EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
- (UNLESS (FIND-PACKAGE #1="BOOTTRAN") (MAKE-PACKAGE #1#)))
+(DEFPACKAGE "BOOTTRAN")
(EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
(PROGN
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 2ff8870c..f7a6fc36 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -428,7 +428,18 @@ packageBody(x,p) ==
['COND,
[['%hasFeature,KEYWORD::COMMON_-LISP],['USE_-PACKAGE,'"COMMON-LISP",:user]],
['T,['USE_-PACKAGE,'"LISP",:user]]]
- ['USE_-PACKAGE,symbolName ns,:user]
+ z :=
+ ns is ['DOT,'System,'Foreign] =>
+ %hasFeature KEYWORD::SBCL => 'SB_-ALIEN
+ %hasFeature KEYWORD::CLISP => 'FFI
+ %hasFeature KEYWORD::CLOZURE => 'CCL
+ %hasFeature KEYWORD::ECL => 'FFI
+ %hasFeature KEYWORD::GCL => 'SI
+ nil
+ ident? ns => ns
+ nil
+ z = nil => bpTrap()
+ ['USE_-PACKAGE,symbolName z,:user]
x is ['PROGN,:.] => [x.op,:[packageBody(y,p) for y in x.args]]
x
@@ -446,7 +457,7 @@ translateToplevel(b,export?) ==
:[first translateToplevel(d,true) for d in ds]]
%Import(m) =>
- m is ['%Namespace,n] => [inAllContexts packageBody(m,nil)]
+ m is ['%Namespace,n] => [inAllContexts packageBody(b,nil)]
if getOptionValue "import" ~= '"skip" then
bootImport symbolName m
[["IMPORT-MODULE", symbolName m]]
@@ -458,9 +469,7 @@ translateToplevel(b,export?) ==
%ConstantDefinition(lhs,rhs) =>
lhs is ['%Namespace,ns] =>
- def := ['UNLESS,['FIND_-PACKAGE,symbolName ns],
- ['MAKE_-PACKAGE,symbolName ns]]
- [inAllContexts def,inAllContexts packageBody(rhs,ns)]
+ [['DEFPACKAGE,symbolName ns],inAllContexts packageBody(rhs,ns)]
sig := nil
if lhs is ["%Signature",n,t] then
sig := genDeclaration(n,t)
@@ -725,8 +734,7 @@ defaultBootToLispFile file ==
getIntermediateLispFile(file,options) ==
out := NAMESTRING getOutputPathname(options)
out ~= nil =>
- strconc(shoeRemoveStringIfNec
- (strconc('".",$effectiveFaslType),out),'".clisp")
+ strconc(shoeRemoveStringIfNec(strconc('".",$faslType),out),'".clisp")
defaultBootToLispFile file
translateBootFile(progname, options, file) ==