diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 8 | ||||
| -rw-r--r-- | src/boot/parser.boot | 8 | ||||
| -rw-r--r-- | src/boot/strap/parser.clisp | 22 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 37 | ||||
| -rw-r--r-- | src/boot/strap/utility.clisp | 3 | ||||
| -rw-r--r-- | src/boot/translator.boot | 22 | ||||
| -rw-r--r-- | src/interp/sys-os.boot | 3 |
7 files changed, 69 insertions, 34 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 038f5147..8bc23caa 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,13 @@ 2011-10-01 Gabriel Dos Reis <gdr@cs.tamu.edu> + * 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. + +2011-10-01 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/utility.boot: Define BOOTTRAN namespace. (setUnion): New. (setDifference): New. 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) == diff --git a/src/interp/sys-os.boot b/src/interp/sys-os.boot index 52a2b1e3..f4d4658f 100644 --- a/src/interp/sys-os.boot +++ b/src/interp/sys-os.boot @@ -1,4 +1,4 @@ --- Copyright (C) 2007-2010 Gabriel Dos Reis. +-- Copyright (C) 2007-2011 Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -41,6 +41,7 @@ import sys_-constants namespace BOOT +import namespace System.Foreign module sys_-os |