From c17f22c0fea71fba2e99aad1e7292be1963ae96d Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sun, 10 May 2009 22:50:44 +0000 Subject: Cope with SBCL-1.0.28 improvements. * boot/translator.boot (translateToplevel): Load imported modules. * boot/ast.boot ($constantIdentifiers): New. ($activeNamespace): Likewise. (bfSimpleDefinition): Likewise. (isDynamicVariable): Likewise. (shoeCompTran1): Tidy. Use it. * boot/parser.boot (bpSimpleDefinitionTail): Use bfSimpleDefinition. * boot/Makefile.in (stage1/%.clisp): Specify load directory. (stage2/%.clisp): Likewise. * lisp/core.lisp.in (startCompileDuration): Export. (endCompileDuration): Likewise. --- src/boot/strap/ast.clisp | 53 ++++++++++++++++++++++++++++++++++------- src/boot/strap/parser.clisp | 2 +- src/boot/strap/translator.clisp | 45 +++++++++++++++++++--------------- 3 files changed, 72 insertions(+), 28 deletions(-) (limited to 'src/boot/strap') diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 62028541..bd54f16f 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -7,6 +7,10 @@ (DEFPARAMETER |$bfClamming| NIL) +(DEFPARAMETER |$constantIdentifiers| NIL) + +(DEFPARAMETER |$activeNamespace| NIL) + (DEFTYPE |%Thing| () 'T) (DEFTYPE |%Boolean| () 'BOOLEAN) @@ -214,6 +218,31 @@ (DEFUN |bfDefinition| (|bflhsitems| |bfrhs| |body|) (LIST 'DEF |bflhsitems| |bfrhs| |body|)) +(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing|) |%Thing|) + |bfSimpleDefinition|)) + +(DEFUN |bfSimpleDefinition| (|lhs| |rhs|) + (PROG (|ISTMP#2| |id| |ISTMP#1|) + (DECLARE (SPECIAL |$constantIdentifiers|)) + (RETURN + (PROGN + (COND + ((ATOM |lhs|) + (SETQ |$constantIdentifiers| + (CONS |lhs| |$constantIdentifiers|))) + ((AND (CONSP |lhs|) (EQ (CAR |lhs|) '|%Signature|) + (PROGN + (SETQ |ISTMP#1| (CDR |lhs|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SETQ |id| (CAR |ISTMP#1|)) + (SETQ |ISTMP#2| (CDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) + (EQ (CDR |ISTMP#2|) NIL)))))) + (SETQ |$constantIdentifiers| + (CONS |id| |$constantIdentifiers|)))) + (|ConstantDefinition| |lhs| |rhs|))))) + (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%List|) |bfMDefinition|)) @@ -1622,6 +1651,21 @@ ((ATOM |x|) (LIST |x|)) ('T (APPEND (|shoeATOMs| (CAR |x|)) (|shoeATOMs| (CDR |x|)))))) +(DEFUN |isDynamicVariable| (|x|) + (PROG (|y|) + (DECLARE (SPECIAL |$activeNamespace| |$constantIdentifiers|)) + (RETURN + (COND + ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) + (COND + ((MEMQ |x| |$constantIdentifiers|) NIL) + ((CONSTANTP |x|) NIL) + ((OR (BOUNDP |x|) (NULL |$activeNamespace|)) T) + ((SETQ |y| (FIND-SYMBOL (STRING |x|) |$activeNamespace|)) + (NOT (CONSTANTP |y|))) + (#0='T T))) + (#0# NIL))))) + (DEFUN |shoeCompTran1| (|x|) (PROG (|res| |newbindings| |r| |ISTMP#2| |l| |ISTMP#1| U) (DECLARE (SPECIAL |$fluidVars| |$locVars| |$dollarVars|)) @@ -1629,7 +1673,7 @@ (COND ((ATOM |x|) (COND - ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) + ((|isDynamicVariable| |x|) (SETQ |$dollarVars| (COND ((MEMQ |x| |$dollarVars|) |$dollarVars|) @@ -2203,7 +2247,6 @@ (APPEND |$NativeSimpleDataTypes| '(|void| |string|))) (DEFUN |isSimpleNativeType| (|t|) - (DECLARE (SPECIAL |$NativeSimpleReturnTypes|)) (MEMBER |t| |$NativeSimpleReturnTypes|)) (DECLAIM (FTYPE (FUNCTION (|%Symbol|) |%Symbol|) |coreSymbol|)) @@ -2219,7 +2262,6 @@ (DEFUN |nativeType| (|t|) (PROG (|t'|) - (DECLARE (SPECIAL |$NativeTypeTable|)) (RETURN (COND ((NULL |t|) |t|) @@ -2315,7 +2357,6 @@ (#0# (|unknownNativeTypeError| |t|)))))) (DEFUN |nativeReturnType| (|t|) - (DECLARE (SPECIAL |$NativeSimpleReturnTypes|)) (COND ((MEMBER |t| |$NativeSimpleReturnTypes|) (|nativeType| |t|)) ('T @@ -2325,7 +2366,6 @@ (DEFUN |nativeArgumentType| (|t|) (PROG (|t'| |c| |m|) - (DECLARE (SPECIAL |$NativeSimpleDataTypes|)) (RETURN (COND ((MEMBER |t| |$NativeSimpleDataTypes|) (|nativeType| |t|)) @@ -2508,7 +2548,6 @@ (DEFUN |genGCLnativeTranslation,gclTypeInC| (|x|) (PROG (|ISTMP#3| |ISTMP#2| |ISTMP#1|) - (DECLARE (SPECIAL |$NativeSimpleDataTypes|)) (RETURN (COND ((MEMBER |x| |$NativeSimpleDataTypes|) (SYMBOL-NAME |x|)) @@ -2531,7 +2570,6 @@ (DEFUN |genGCLnativeTranslation,gclArgInC| (|x| |a|) (PROG (|y| |c|) - (DECLARE (SPECIAL |$NativeSimpleDataTypes|)) (RETURN (COND ((MEMBER |x| |$NativeSimpleDataTypes|) |a|) @@ -2625,7 +2663,6 @@ (DEFUN |genECLnativeTranslation,selectDatum| (|x|) (PROG (|y| |c|) - (DECLARE (SPECIAL |$ECLVersionNumber|)) (RETURN (COND ((|isSimpleNativeType| |x|) "") diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index fc373262..56275620 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -920,7 +920,7 @@ (DEFUN |bpSimpleDefinitionTail| () (AND (|bpEqKey| 'DEF) (OR (|bpWhere|) (|bpTrap|)) - (|bpPush| (|ConstantDefinition| (|bpPop2|) (|bpPop1|))))) + (|bpPush| (|bfSimpleDefinition| (|bpPop2|) (|bpPop1|))))) (DEFUN |bpCompoundDefinitionTail| () (AND (|bpVariable|) (|bpReturnType|) (|bpEqKey| 'DEF) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index 32cad87a..b809ddd6 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -84,7 +84,6 @@ (#0# NIL))))) (DEFUN |genOptimizeOptions| (|stream|) - (DECLARE (SPECIAL |$LispOptimizeOptions|)) (REALLYPRETTYPRINT (LIST 'PROCLAIM (LIST 'QUOTE (CONS 'OPTIMIZE |$LispOptimizeOptions|))) @@ -124,12 +123,15 @@ (DEFUN BOOTTOCL (|fn| |out|) (PROG (|result| |callingPackage|) (RETURN - (PROGN - (SETQ |callingPackage| *PACKAGE*) - (IN-PACKAGE "BOOTTRAN") - (SETQ |result| (BOOTTOCLLINES NIL |fn| |out|)) - (|setCurrentPackage| |callingPackage|) - |result|)))) + (UNWIND-PROTECT + (PROGN + (|startCompileDuration|) + (SETQ |callingPackage| *PACKAGE*) + (IN-PACKAGE "BOOTTRAN") + (SETQ |result| (BOOTTOCLLINES NIL |fn| |out|)) + (|setCurrentPackage| |callingPackage|) + |result|) + (|endCompileDuration|))))) (DEFUN BOOTCLAM (|fn| |out|) (DECLARE (SPECIAL |$bfClamming|)) @@ -171,12 +173,15 @@ (DEFUN BOOTTOCLC (|fn| |out|) (PROG (|result| |callingPackage|) (RETURN - (PROGN - (SETQ |callingPackage| *PACKAGE*) - (IN-PACKAGE "BOOTTRAN") - (SETQ |result| (BOOTTOCLCLINES NIL |fn| |out|)) - (|setCurrentPackage| |callingPackage|) - |result|)))) + (UNWIND-PROTECT + (PROGN + (|startCompileDuration|) + (SETQ |callingPackage| *PACKAGE*) + (IN-PACKAGE "BOOTTRAN") + (SETQ |result| (BOOTTOCLCLINES NIL |fn| |out|)) + (|setCurrentPackage| |callingPackage|) + |result|) + (|endCompileDuration|))))) (DEFUN BOOTTOCLCLINES (|lines| |fn| |outfn|) (PROG (|infn|) @@ -602,8 +607,8 @@ (DEFUN |translateToplevel| (|b| |export?|) (PROG (|lhs| |t| |ISTMP#2| |n| |ISTMP#1| |sig| |bfVar#17| |bfVar#16| |xs|) - (DECLARE (SPECIAL |$InteractiveMode| |$foreignsDefsForCLisp| - |$currentModuleName|)) + (DECLARE (SPECIAL |$activeNamespace| |$InteractiveMode| + |$foreignsDefsForCLisp| |$currentModuleName|)) (RETURN (COND ((ATOM |b|) (LIST |b|)) @@ -653,7 +658,9 @@ (SETQ |bfVar#14| (CDR |bfVar#14|)))))))) (|Import| (LET ((|m| (CAR |bfVar#17|))) - (LIST (LIST 'IMPORT-MODULE (STRING |m|))))) + (PROGN + (|bootImport| (STRING |m|)) + (LIST (LIST 'IMPORT-MODULE (STRING |m|)))))) (|ImportSignature| (LET ((|x| (CAR |bfVar#17|)) (|sig| (CADR |bfVar#17|))) @@ -721,7 +728,9 @@ |export?|))))))) (|namespace| (LET ((|n| (CAR |bfVar#17|))) - (LIST (LIST 'IN-PACKAGE (STRING |n|))))) + (PROGN + (SETQ |$activeNamespace| (STRING |n|)) + (LIST (LIST 'IN-PACKAGE (STRING |n|)))))) (T (LIST (|translateToplevelExpression| |b|)))))))))) (DEFUN |bpOutItem| () @@ -1343,7 +1352,6 @@ (DEFUN |getIntermediateLispFile| (|file| |options|) (PROG (|out|) - (DECLARE (SPECIAL |$effectiveFaslType|)) (RETURN (PROGN (SETQ |out| (NAMESTRING (|getOutputPathname| |options|))) @@ -1401,7 +1409,6 @@ (|coreError| "don't know how to load a dynamically linked module")))) (DEFUN |loadSystemRuntimeCore| () - (DECLARE (SPECIAL |$NativeModuleExt|)) (COND ((OR (|%hasFeature| :ECL) (|%hasFeature| :GCL)) NIL) ('T -- cgit v1.2.3