diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 20 | ||||
| -rw-r--r-- | src/boot/initial-env.lisp | 8 | ||||
| -rw-r--r-- | src/boot/translator.boot | 58 | ||||
| -rw-r--r-- | src/interp/boot-pkg.lisp | 4 | ||||
| -rw-r--r-- | src/interp/bootlex.lisp | 67 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 2 | ||||
| -rw-r--r-- | src/interp/sys-globals.boot | 3 | ||||
| -rw-r--r-- | src/interp/util.lisp | 31 |
8 files changed, 66 insertions, 127 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 04485014..07a1bd75 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,25 @@ 2008-07-06 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/initial-env.lisp: Export $InteractiveMode and + string2BootTree. + * boot/translator.boot (BOOTTOCL): Tidy. + (BOOTTOCLC): Likewise. + (BOOTTOCLLINES): Likewise. + (BOOTTOCLCLINES): Likewise. + (string2BootTree): Define. + (translateToplevelExpression): Tidy. + (translateToplevel): Handle atoms. Tidy. + (shoePCompileTrees): Don't use bStreamPackageNull. + * interp/boot-pkg.lisp: Import $interactiveMode and string2BootTree. + * interp/util.lisp (string2BootTree): Remove. + (OLD-BOOT::BOOT): Likewise. + * interp/bootlex.lisp (boot): Likewise. + (boot-parse-1): Likewise. + * interp/compiler.boot (compileNot): Fix thinko. + * interp/sys-globals.boot ($InteractiveMode): Don't define here. + +2008-07-06 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/parse.boot ($normalizeTree): New. (parseNotEqual): Likewise. * interp/compiler.boot (compCompilerPredicate): New. diff --git a/src/boot/initial-env.lisp b/src/boot/initial-env.lisp index 2e126843..96785ab6 100644 --- a/src/boot/initial-env.lisp +++ b/src/boot/initial-env.lisp @@ -49,7 +49,9 @@ (:export "systemRootDirectory" "systemLibraryDirectory" "loadNativeModule" - "loadSystemRuntimeCore")) + "loadSystemRuntimeCore" + "$InteractiveMode" + "string2BootTree")) (in-package "BOOTTRAN") @@ -57,6 +59,10 @@ #+:ieee-floating-point (defparameter $ieee t) #-:ieee-floating-point (defparameter $ieee nil) +;; when true indicate that that the Boot translator +;; is called interactively. +(defparameter |$InteractiveMode| nil) + (defmacro memq (a b) `(member ,a ,b :test #'eq)) diff --git a/src/boot/translator.boot b/src/boot/translator.boot index f49cf0c4..b2b4ed15 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -79,7 +79,11 @@ shoeCOMPILE_-FILE lspFileName == BOOTTOCL(fn, out) == - BOOTTOCLLINES(nil,fn, out) + callingPackage := _*PACKAGE_* + IN_-PACKAGE '"BOOTTRAN" + result := BOOTTOCLLINES(nil,fn, out) + setCurrentPackage callingPackage + result ++ (bootclam "filename") translates the file "filename.boot" to ++ the common lisp file "filename.clisp" , producing, for each function @@ -95,13 +99,8 @@ BOOTCLAMLINES(lines, fn, out) == BOOTTOCLLINES(lines, fn, outfn)== -- The default floating point number is double-float. SETQ(_*READ_-DEFAULT_-FLOAT_-FORMAT_*, 'DOUBLE_-FLOAT) - callingPackage := _*PACKAGE_* - IN_-PACKAGE '"BOOTTRAN" infn:=shoeAddbootIfNec fn - result := shoeOpenInputFile(a,infn, - shoeClLines(a,fn,lines,outfn)) - setCurrentPackage callingPackage - result + shoeOpenInputFile(a,infn, shoeClLines(a,fn,lines,outfn)) shoeClLines(a,fn,lines,outfn)== a=nil => shoeNotFound fn @@ -116,16 +115,15 @@ shoeClLines(a,fn,lines,outfn)== ++ the common lisp file "filename.clisp" with the original boot ++ code as comments BOOTTOCLC(fn, out)== - BOOTTOCLCLINES(nil, fn, out) - -BOOTTOCLCLINES(lines, fn, outfn)== callingPackage := _*PACKAGE_* IN_-PACKAGE '"BOOTTRAN" - infn:=shoeAddbootIfNec fn - result := shoeOpenInputFile(a,infn, - shoeClCLines(a,fn,lines,outfn)) + result := BOOTTOCLCLINES(nil, fn, out) setCurrentPackage callingPackage result + +BOOTTOCLCLINES(lines, fn, outfn)== + infn:=shoeAddbootIfNec fn + shoeOpenInputFile(a,infn, shoeClCLines(a,fn,lines,outfn)) shoeClCLines(a,fn,lines,outfn)== @@ -189,14 +187,24 @@ shoeToConsole(a,fn)== a=nil => shoeNotFound fn shoeConsoleTrees shoeTransformToConsole shoeInclude bAddLineNumber(bRgen a,bIgen 0) - + -- (stout "string") translates the string "string" -- and prints the result at the console + +STOUT string == + PSTOUT [string] -STOUT string== PSTOUT [string] --- $GenVarCounter := 0 --- $bfClamming :=false --- shoeConsoleTrees shoeTransformString [string] +string2BootTree string == + callingPackage := _*PACKAGE_* + IN_-PACKAGE '"BOOTTRAN" + $GenVarCounter := 0 + a := shoeTransformString [string] + result := + bStreamNull a => nil + stripm(first a,callingPackage,FIND_-PACKAGE '"BOOTTRAN") + setCurrentPackage callingPackage + result + STEVAL string== callingPackage := _*PACKAGE_* @@ -204,7 +212,7 @@ STEVAL string== $GenVarCounter := 0 a:= shoeTransformString [string] result := - bStreamPackageNull a => nil + bStreamNull a => nil fn:=stripm(first a,_*PACKAGE_*,FIND_-PACKAGE '"BOOTTRAN") EVAL fn setCurrentPackage callingPackage @@ -219,7 +227,7 @@ STTOMC string== $GenVarCounter := 0 a:= shoeTransformString [string] result := - bStreamPackageNull a => nil + bStreamNull a => nil shoePCompile first a setCurrentPackage callingPackage result @@ -230,7 +238,7 @@ shoeCompileTrees s== shoeCompile first s s := rest s -shoerCompile: %Ast -> %Thing +shoeCompile: %Ast -> %Thing shoeCompile fn== fn is ['DEFUN,name,bv,:body] => COMPILE (name,['LAMBDA,bv,:body]) @@ -473,15 +481,18 @@ translateToplevelExpression expr == for t in expr' repeat t is ["DECLARE",:.] => RPLACA(t,"DECLAIM") - shoeEVALANDFILEACTQ + expr' := #expr' > 1 => ["PROGN",:expr'] first expr' + $InteractiveMode => expr' + shoeEVALANDFILEACTQ expr' maybeExportDecl(d,export?) == export? => d d translateToplevel(b,export?) == + atom b => [b] -- generally happens in interactive mode. b is ["TUPLE",:xs] => [maybeExportDecl(x,export?) for x in xs] case b of Signature(op,t) => @@ -514,6 +525,7 @@ translateToplevel(b,export?) == if lhs is ["%Signature",n,t] then sig := maybeExportDecl(genDeclaration(n,t),export?) lhs := n + $InteractiveMode => [["SETF",lhs,rhs]] [maybeExportDecl(["DEFPARAMETER",lhs,rhs],export?)] namespace(n) => @@ -759,7 +771,7 @@ shoeFindName(fn,name,a)== shoePCompileTrees shoeTransformString lines shoePCompileTrees s== - while not bStreamPackageNull s repeat + while not bStreamNull s repeat REALLYPRETTYPRINT shoePCompile first s s := rest s diff --git a/src/interp/boot-pkg.lisp b/src/interp/boot-pkg.lisp index 95c14b2f..134f0f73 100644 --- a/src/interp/boot-pkg.lisp +++ b/src/interp/boot-pkg.lisp @@ -41,7 +41,9 @@ "systemRootDirectory" "systemLibraryDirectory" "loadNativeModule" - "loadSystemRuntimeCore")) + "loadSystemRuntimeCore" + "$InteractiveMode" + "string2BootTree")) (in-package "BOOT") diff --git a/src/interp/bootlex.lisp b/src/interp/bootlex.lisp index b944c653..718c3058 100644 --- a/src/interp/bootlex.lisp +++ b/src/interp/bootlex.lisp @@ -80,73 +80,6 @@ (when (or |$PrettyPrint| (not (is-console st))) (print-full body st) (force-output st)))) -(defun boot-parse-1 (in-stream - &aux - (Echo-Meta nil) - (current-fragment nil) - ($INDEX 0) - ($LineList nil) - ($EchoLineStack nil) - ($preparse-last-line nil) - ($BOOT T) - (*EOF* NIL) - (OPTIONLIST NIL)) - (declare (special echo-meta *comp370-apply* *EOF* File-Closed - $index $linelist $echolinestack $preparse-last-line)) - (init-boot/spad-reader) - (let* ((Boot-Line-Stack (PREPARSE in-stream)) - (parseout (prog2 (|PARSE-Expression|) (pop-stack-1)) ) ) - ;(setq parseout (|new2OldLisp| parseout)) - ; (setq parseout (DEF-RENAME parseout)) - ; (DEF-PROCESS parseout) - parseout)) - -(defun boot (&optional - (*boot-input-file* nil) - (*boot-output-file* nil) - &aux - (Echo-Meta t) - ($BOOT T) - (XCape #\_) - (File-Closed NIL) - (*EOF* NIL) - (OPTIONLIST NIL) - (*fileactq-apply* (function print-defun)) - (*comp370-apply* (function print-defun))) - (declare (special echo-meta *comp370-apply* *EOF* File-Closed XCape)) - (setq |$normalizeTree| t) - (setq |$InteractiveMode| NIL) - (init-boot/spad-reader) - (with-open-stream - (in-stream (if *boot-input-file* - (open *boot-input-file* :direction :input) - |$InputStream|)) - (initialize-preparse in-stream) - (with-open-stream - (out-stream (if *boot-output-file* - (open *boot-output-file* :direction :output) - (make-broadcast-stream |$OutputStream|))) - (when *boot-output-file* - (format out-stream "~&;;; -*- Mode:Lisp; Package:Boot -*-~%~%") - (print-package "BOOT")) - (loop (if (and (not File-Closed) - (setq Boot-Line-Stack (PREPARSE in-stream))) - (progn - (|PARSE-Expression|) - (let ((parseout (pop-stack-1)) ) - (setq parseout (|new2OldLisp| parseout)) - (setq parseout (DEF-RENAME parseout)) - (let ((|$OutputStream| out-stream)) - (DEF-PROCESS parseout)) - (format out-stream "~&") - (if (null parseout) (ioclear)) )) - (return nil))) - (if *boot-input-file* - (format out-stream ";;;Boot translation finished for ~a~%" - (namestring *boot-input-file*))) - (IOClear in-stream out-stream))) - T) - (defun spad (&optional (*spad-input-file* nil) (*spad-output-file* nil) diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 7c91d4e0..10657288 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -1148,7 +1148,7 @@ compileNot(x,m,e) == -- ??? selected through general modemaps, and their semantics -- ??? are quite hardwired with their syntax. -- ??? Eventually, we should not need to do this. - $compilerValue => compIf(["IF",y,"false","true"],m,e) + $normalizeTree => compIf(["IF",y,"false","true"],m,e) compForm(x,m,e) --% Case diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot index 458ea603..67499dec 100644 --- a/src/interp/sys-globals.boot +++ b/src/interp/sys-globals.boot @@ -160,9 +160,6 @@ $e := $EmptyEnvironment $env := [[nil]] ++ -$InteractiveMode := false - -++ $InteractiveTimingStatsIfTrue := false ++ diff --git a/src/interp/util.lisp b/src/interp/util.lisp index 3609b591..995050f8 100644 --- a/src/interp/util.lisp +++ b/src/interp/util.lisp @@ -390,26 +390,6 @@ ;; directory from the current {\bf AXIOM} shell variable. (defvar $relative-library-directory-list '("/algebra/")) -(eval-when (:compile-toplevel :load-toplevel :execute) - #-:GCL (defpackage "OLD-BOOT") - #+:GCL (in-package "OLD-BOOT")) - -(defun -#-:GCL old-boot::boot ;; translates a single boot file -#+:GCL boot - (file) -#+:AKCL - (in-package "BOOT") - (let (*print-level* - *print-length* - (fn (pathname-name file)) - (*print-pretty* t)) - (boot::boot - file - (merge-pathnames (make-pathname :type "clisp") file)))) - -#+:GCL (in-package "BOOT") - ;; This is a little used subsystem to generate {\bf ALDOR} code ;; from {\bf Spad} code. Frankly, I'd be amazed if it worked. (defparameter translate-functions '( @@ -544,17 +524,6 @@ ) -(DEFUN |string2BootTree| (S) - (init-boot/spad-reader) - (LET* ((BOOT-LINE-STACK (LIST (CONS 1 S))) - ($BOOT T) - ($SPAD NIL) - (XTOKENREADER 'GET-BOOT-TOKEN) - (LINE-HANDLER 'NEXT-BOOT-LINE) - (PARSEOUT (PROGN (|PARSE-Expression|) (POP-STACK-1)))) - (DECLARE (SPECIAL BOOT-LINE-STACK $BOOT $SPAD XTOKENREADER LINE-HANDLER)) - (DEF-RENAME (|new2OldLisp| PARSEOUT)))) - (DEFUN |string2SpadTree| (LINE) (DECLARE (SPECIAL LINE)) (if (and (> (LENGTH LINE) 0) (EQ (CHAR LINE 0) #\) )) |