aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog20
-rw-r--r--src/boot/initial-env.lisp8
-rw-r--r--src/boot/translator.boot58
-rw-r--r--src/interp/boot-pkg.lisp4
-rw-r--r--src/interp/bootlex.lisp67
-rw-r--r--src/interp/compiler.boot2
-rw-r--r--src/interp/sys-globals.boot3
-rw-r--r--src/interp/util.lisp31
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) #\) ))