diff options
| -rw-r--r-- | src/ChangeLog | 30 | ||||
| -rw-r--r-- | src/interp/bootlex.lisp | 23 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 14 | ||||
| -rw-r--r-- | src/interp/debug.lisp | 62 | ||||
| -rw-r--r-- | src/interp/lisp-backend.boot | 4 | ||||
| -rw-r--r-- | src/interp/macros.lisp | 15 | ||||
| -rw-r--r-- | src/interp/parsing.lisp | 256 | ||||
| -rw-r--r-- | src/interp/slam.boot | 11 | ||||
| -rw-r--r-- | src/interp/spad-parser.boot | 7 | ||||
| -rw-r--r-- | src/interp/spad.lisp | 57 |
10 files changed, 108 insertions, 371 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 503dc47d..e51099df 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,35 @@ 2012-05-20 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/parsing.lisp (CONVERSATION): Remove. + (CONVERSATION1): Likewise. + (MAKE-PARSE-FUNCTION): Likewise. + (MAKE-PARSE-FUNCTION1): Likewise. + (MAKE-PARSE-FUNC-FLATTEN): Likewise. + (MAKE-PARSE-FUNC-FLATTEN-1): Likewise. + (TRANSPGVAR): Likewise. + (GETRULEFUNLISTS): Likewise. + (REDUCTION-PRINT): Likewise. + (TRACEMETA): Likewise. + (TRMETA): Likewise. + (TRMETA1): Likewise. + (/MDEF): Likewise. + * interp/macros.lisp (EXPAND-TABS): Likewise. + * interp/spad.lisp (READ-SPAD): Likewise. + (READ-INPUT): Likewise. + (READ-SPAD0): Likewise. + (READ-SPAD1): Likewise. + (READ-SPAD-1): Likewise. + (New,ENTRY,1): Likewise. + (New,ENTRY,2): Likewise. + * interp/bootlex.lisp (SPAD_SYNTAX_ERROR): Move to debug.lisp. + (SPAD_LONG_ERROR): Likewise. + (SPAD_SHORT_ERROR): Likewise. + (SPAD_ERROR_LOC): Likewise. + * interp/c-util.boot (COMP370): Move to lisp-backend.boot. + (compQuietly): Move to slam.boot. + +2012-05-20 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/utility.boot (strinSuffix?): New. * boot/translator.boot (shoeRemovebootIfNec): Use it. diff --git a/src/interp/bootlex.lisp b/src/interp/bootlex.lisp index ec75471d..acb8d0e8 100644 --- a/src/interp/bootlex.lisp +++ b/src/interp/bootlex.lisp @@ -131,26 +131,3 @@ (if Y (setf (FIRST X) Y) (TRANSLABEL1 (CDR X) AL)))) ((TRANSLABEL1 (FIRST X) AL) (TRANSLABEL1 (CDR X) AL)))) -; **** 5. BOOT Error Handling - -(defun SPAD_SYNTAX_ERROR (&rest byebye) - "Print syntax error indication, underline character, scrub line." - (BUMPERRORCOUNT '|syntax|) - (COND ((AND (EQ DEBUGMODE 'YES) (NOT(CONSOLEINPUTP IN-STREAM))) - (SPAD_LONG_ERROR)) - ((SPAD_SHORT_ERROR))) - (IOClear) - (throw 'spad_reader nil)) - -(defun SPAD_LONG_ERROR () - (SPAD_ERROR_LOC SPADERRORSTREAM) - (iostat) - (unless (EQUAL OUT-STREAM SPADERRORSTREAM) - (SPAD_ERROR_LOC OUT-STREAM) - (TERPRI OUT-STREAM))) - -(defun SPAD_SHORT_ERROR () (current-line-show)) - -(defun SPAD_ERROR_LOC (STR) - (format str "******** Spad Syntax Error detected ********")) - diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index b0ecbb73..a24b4539 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1759,20 +1759,6 @@ compAndDefine l == $compileDontDefineFunctions := true -++ Subroutine of compileInteractive. -compQuietly fn == - _*COMP370_-APPLY_* := - $InteractiveMode => - $compileDontDefineFunctions => "COMPILE-DEFUN" - "EVAL-DEFUN" - "PRINT-DEFUN" - quietlyIfInteractive backendCompile fn - -COMP370 x == - first x is [.,:.] => [COMPILE1 y for y in x] - [COMPILE1 x] - - --% --% Compile Time operation lookup for the benefit of domain inlining. --% diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp index 6ece9a85..746f10c4 100644 --- a/src/interp/debug.lisp +++ b/src/interp/debug.lisp @@ -99,6 +99,41 @@ (defvar /fn nil) +(DEFPARAMETER /DEPTH 0) + +(defparameter debugmode 'yes "Can be either YES or NO") + +(defun reduction-print (y rule) + (format t "~&") + (cond ((eq y t) (|sayBrightly| `(|%b| ,rule |%d| " reduced"))) + (y (|sayBrightlyNT| `(|%b| ,rule |%d|)) + (format t " reduced ~A~%" y))) + y) + +(defun /embed-1 (x y) + (princ (strconc (pname x) " embedded")) + (terpri) + (/embed-q x y)) + +(defvar /embednames) + +(defun /embed-q (x y) + (setq /embednames (cons x /embednames)) + (embed x + (cond ((eqcar y 'lambda) y) + ((eqcar y 'before) + `(lambda ,(cadr y) + (prog2 ,(caddr y) ,(cons 'funcall (cons x (cadr y)))))) + ((eqcar y 'after) + `(lambda ,(cadr y) + (prog1 ,(cons 'funcall (cons x (cadr y))) ,(caddr y)))))) + (/embedreply)) + +(defun /embedreply () + (if (atom (embedded)) '(|none| |embedded|) + (append (embedded) (list '|embedded|)))) + + (DEFUN /D-1 (L OP EFLG TFLG) (CATCH 'FILENAM (PROG (TO OPTIONL OPTIONS FNL INFILE OUTSTREAM FN ) @@ -130,13 +165,13 @@ ISID NBLNK COMMENTCHR $TOKSTACK (/SOURCEFILES |$sourceFiles|) METAKEYLST DEFINITION_NAME (|$sourceFileTypes| '(|spad| |boot| |lisp| |lsp| |meta|)) ($FUNCTION FN) $NEWSPAD $LINESTACK $LINENUMBER STACK STACKX BACK OK - TRAPFLAG |$InteractiveMode| TOK ERRCOL COLUMN *QUERY CHR LINE + TRAPFLAG |$InteractiveMode| TOK COLUMN *QUERY CHR LINE (*COMP370-APPLY* (if (eq op 'define) #'eval-defun #'compile-defun))) (declare (special |$Echo| SINGLINEMODE INPUTSTREAM SPADERRORSTREAM ISID NBLNK COMMENTCHR $TOKSTACK /SOURCEFILES METAKEYLST DEFINITION_NAME |$sourceFileTypes| $FUNCTION $NEWSPAD $LINESTACK $LINENUMBER STACK STACKX BACK OK - TRAPFLAG |$InteractiveMode| TOK ERRCOL COLUMN *QUERY CHR LINE)) + TRAPFLAG |$InteractiveMode| TOK COLUMN *QUERY CHR LINE)) (if (CONSP FN) (SETQ FN (QCAR FN))) (SETQ INFILE (OR INFILE (|getFunctionSourceFile| FN))) ;; $FUNCTION is freely set in getFunctionSourceFile @@ -1096,3 +1131,26 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|)) (defun interrupt (&rest ignore)) +; **** 5. BOOT Error Handling + +(defun SPAD_SYNTAX_ERROR (&rest byebye) + "Print syntax error indication, underline character, scrub line." + (BUMPERRORCOUNT '|syntax|) + (COND ((AND (EQ DEBUGMODE 'YES) (NOT(CONSOLEINPUTP IN-STREAM))) + (SPAD_LONG_ERROR)) + ((SPAD_SHORT_ERROR))) + (IOClear) + (throw 'spad_reader nil)) + +(defun SPAD_LONG_ERROR () + (SPAD_ERROR_LOC SPADERRORSTREAM) + (iostat) + (unless (EQUAL OUT-STREAM SPADERRORSTREAM) + (SPAD_ERROR_LOC OUT-STREAM) + (TERPRI OUT-STREAM))) + +(defun SPAD_SHORT_ERROR () (current-line-show)) + +(defun SPAD_ERROR_LOC (STR) + (format str "******** Spad Syntax Error detected ********")) + diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot index bb61333e..35230f86 100644 --- a/src/interp/lisp-backend.boot +++ b/src/interp/lisp-backend.boot @@ -806,6 +806,10 @@ COMPILE1 fun == compileLispDefinition(name,body) body +COMP370 x == + first x is [.,:.] => [COMPILE1 y for y in x] + [COMPILE1 x] + assembleCode x == if $PrettyPrint then PRETTYPRINT x if not $COMPILE then SAY '"No Compilation" diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp index 69959807..7044e6e1 100644 --- a/src/interp/macros.lisp +++ b/src/interp/macros.lisp @@ -473,21 +473,6 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (terpri stream) (finish-output stream))) -(defun expand-tabs (str) - (if (and (stringp str) (> (length str) 0)) - (let ((bpos (|firstNonblankCharPosition| str)) - (tpos (|indentationLocation| str))) - (setq str - (if (eql bpos tpos) - str - (concatenate 'string - (make-string tpos :initial-element #\space) - (subseq str bpos)))) - ;; remove dos CR - (let ((lpos (|maxIndex| str))) - (if (eq (char str lpos) #\Return) (subseq str 0 lpos) str))) - str)) - ;; stream handling for paste-in generation (defun |applyWithOutputToString| (func args) diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp index 658286e7..828de1db 100644 --- a/src/interp/parsing.lisp +++ b/src/interp/parsing.lisp @@ -270,267 +270,11 @@ the stack, then stack a NIL. Return the value of prod." ; 3B. Error handling -(defparameter errcol nil) (defparameter line nil) -(defun conversation (x y) - (prog (u) - a (|reduceStackClear|) - (setq u (namederrset 'spad_reader (conversation1 x y) )) - (cond (*eof* (return nil)) - ((atom u) (go a)) - ((return (car u)))))) - -(defparameter ulcasefg nil "") - -(defun conversation1 (firstfun procfun) - (prog nil - top(cond ((not (|currentChar|)) (return nil)) - ((and (|currentToken|) (|nextToken|)) (go top)) - ((compfin) (return 't)) - ((and (funcall firstfun) - (or (funcall procfun (|popStack1|)))) - (go top)) - ((compfin) (return 't)) ) - (spad_syntax_error) - (go top))) - (defun termchr () "Is CHR a terminating character?" (|findChar| (|currentChar|) " *,;<>()[]/\\")) -(defun compfin () (or (|matchString| ")fin") (|matchString| ".FIN"))) - -; 3 C. Constructing parsing procedures - -; FUNCTIONS DEFINED IN THIS SECTION: -; -; Make-Parse-Function, GetGenSym - -(MAKEPROP 'PROGN 'NARY T) ; Setting for Make-Parse-Function - -(defun make-parse-function (l op) - (if (flagp op 'nary) (setq l (make-parse-func-flatten-1 l op nil))) - (make-parse-function1 l op)) - -(defun make-parse-func-flatten (x op) - (cond ((atom x) x) - ((eq (car x) op) (cons op (make-parse-func-flatten-1 (cdr x) op nil))) - (t (cons (make-parse-func-flatten (car x) op) (make-parse-func-flatten (cdr x) op))))) - -(defun make-parse-func-flatten-1 (l op r) - (let (x) - (if (null l) - r - (make-parse-func-flatten-1 - (cdr l) op - (append r (if (eqcar (setq x (make-parse-func-flatten (car l) op)) op) - (cdr x) - (list x))))))) - -(defun make-parse-function1 (l op) - (let (x) - (case op - (plus (cond ((eq 0 (setq x (length (setq l (s- l '(0 (zero))))))) 0) - ((eq 1 x) (car l)) - (t `(+ . ,l)))) - (times (cond ((s* l '(0 (zero))) 0) - ((eq 0 (setq x (length (setq l (s- l '(1 (one))))))) 1) - ((eq 1 x) (car l)) - (t `(times . ,l)) )) - (quotient (cond ((> (length l) 2) (fail)) - ((eq 0 (car l)) 0) - ((eq (cadr l) 1) (car l)) - (t `(quotient . ,l)) )) - (minus (cond ((cdr l) (fail)) - ((numberp (setq x (car l))) (minus x)) - ((eqcar x 'minus) (cadr x)) - (t `(minus . ,l)) )) - (- (cond ((> (length l) 2) (fail)) - ((equal (car l) (cadr l)) '(zero)) - ((member (car l) '(0 (zero))) (make-parse-function (cdr l) 'minus)) - ((member (cadr l) '(0 (zero))) (car l)) - ((eqcar (cadr l) 'minus) - (make-parse-function (list (car l) (cadadr l)) 'plus)) - (t `(- . ,l)) )) - (expt (cond ((> (length l) 2) (fail)) - ((eq 0 (cadr l)) 1) - ((eq 1 (cadr l)) (car l)) - ((member (car l) '(0 1 (zero) (one))) (car l)) - (t `(expt . ,l)) )) - (or (cond ((member 't l) ''t) - ((eq 0 (setq x (length (setq l (delete nil l))))) nil) - ((eq 1 x) (car l)) - (t `(or . ,l)) )) - (|or| (cond ((member 't l) 't) - ((eq 0 (setq x (length (setq l (delete nil l))))) nil) - ((eq 1 x) (car l)) - (t `(|or| . ,l)) )) - (null (cond ((cdr l) (fail)) - ((eqcar (car l) 'null) (cadar l)) - ((eq (car l) 't) nil) - ((null (car l)) ''t) - (t `(null . ,l)))) - (|and| (cond ((eq 0 (setq x (length (setq l (delete 't (delete 'true l)))))) 't) - ((eq 1 x) (car l)) - (t `(|and| . ,l)) )) - (and (cond ((eq 0 (setq x (length (setq l (delete 't (delete 'true l)))))) ''t) - ((eq 1 x) (car l)) - (t `(and . ,l)) )) - (progn (cond ((and (not (atom l)) (null (last l))) - (cond ((cdr l) `(progn . ,l)) - (t (car l)))) - ((null (setq l (delete nil l))) nil) - ((cdr l) `(progn . ,l)) - (t (car l)) )) - (seq (cond ((eqcar (car l) 'exit) (cadar l)) - ((cdr l) `(seq . ,l)) - (t (car l)) )) - (list (cond ((null l) nil) (t `(list . ,l)))) - (cons (cond ((cdr l) `(cons . ,l)) (t (car l)) )) - (t (cons op l) )))) - -(defparameter /genvarlst nil "??") - -(defun transpgvar (metapgvar) (remove-duplicates metapgvar)) - -(defparameter /gensymlist nil "List of rule local variables generated by getgensym.") - -(defun getgensym (n) - "Used to create unique numerically indexed local variables for the use of rules." - (loop - (let ((m (length /gensymlist))) - (if (< m n) - (setq /gensymlist (|append!| /gensymlist `(,(intern (format nil "G~D" (1+ m)))))) - (return (nth (1- n) /gensymlist)))))) - -; 3 D. Managing rule sets - -(defparameter bac nil "") -(defparameter keyfn nil "") -(defparameter /metaoption "") -(defparameter tline nil "") -(defparameter rs nil "") - -(defun getrulefunlists (rootfun rs) - (let* ((metapfx (or (get rootfun 'metapfx) "")) - (mainfun (internl metapfx (pname rootfun))) - (mainfunstr (pname mainfun)) - (flnam (internl mainfunstr "FUN")) - (pfx-funlist (union (cons mainfun - (if (atom (eval flnam)) nil (eval flnam))) - (mapcar #'(lambda (x) (internl metapfx (pname x))) - (assocleft rs)))) - n unpfx-funlist) - (setf (symbol-value flnam) pfx-funlist) - (if (not (lessp (setq n (length metapfx)) 0)) - (setq unpfx-funlist - (mapcar #'(lambda (x) - (intern (subseq - (symbol-name (copy-symbol (pname x))) n))) - pfx-funlist))) - (if unpfx-funlist (list pfx-funlist unpfx-funlist)))) - -; 4. Tracing routines - -(defparameter debugmode 'yes "Can be either YES or NO") - -(defun reduction-print (y rule) - (format t "~&") - (cond ((eq y t) (|sayBrightly| `(|%b| ,rule |%d| " reduced"))) - (y (|sayBrightlyNT| `(|%b| ,rule |%d|)) - (format t " reduced ~A~%" y))) - y) - -(defmacro tracemeta (&rest l) `(trmeta ',l)) - -(defparameter /depth 0 "Used in Debug.lisp.") - -(defun trmeta (l) (setq /depth 0) (mapc #'trmeta1 l)) - -(defun trmeta1 (x) - (let (y) - (if (not (fboundp x)) - (if (fboundp (setq y (internl $lastprefix (pname x)))) - (moan (format nil "********* ~S RENAMED AS ~S" x (setq x y))) - (croak (format nil "********* ~S MUST BE GIVEN PREFIX" x)))) - (/embed-1 x - (sublislis - (list (pname x) x (gensym)) - '(nam* fun* argl*) - '(lambda (&rest argl*) - (prog (v tok) - (terpri) - (trblanks (* 2 /depth)) (setq /depth (+ 1 /depth)) - (princ (stringimage /depth)) (princ "<") - (princ nam*) (trargprint argl*) (princ "/") - (princ "chr= ") (prin1 (|currentChar|)) - (princ "/tok= ") (prin1 (setq tok (current-symbol))) - (princ "/col= ") (prin1 (|lineCurrentIndex| |$spadLine|)) - ;; (princ "/icol= ") (prin1 initcolumn) - (cond ( (not nonblank) (go a1))) (princ "/nblnk= T") - a1 ;;(cond (ok (go b1))) (princ "/ok= NIL") - b1 ;;(cond ( (not stackx) (go c1))) (princ "/stackx= ") - ;;(prin1 stackx) - c1 (cond ( (not (|ident?| tok)) (go d1))) - (princ "/isid= ") - ;; (princ (cond (isid "T") (t "NIL"))) - d1 (princ "/stack= ") (prin1 (|stackStore| |$reduceStack|)) - (setq v (apply fun* argl*)) (setq /depth (- /depth 1)) - (terpri) - (trblanks (* 2 /depth)) (princ (stringimage (\1+ /depth))) - (princ ">") (princ nam*) - (princ "/chr= ") (prin1 (|currentChar|)) - (princ "/tok= ") (prin1 (setq tok (current-symbol))) - (princ "/col= ") (prin1 (|lineCurrentIndex| |$spadLine|)) - (if (not nonblank) (go a2)) (princ "/nblnk= ") - (princ (if nonblank "T" "NIL")) - a2 ;;(if ok (go b2)) (princ "/ok= ") (prin1 ok) - b2 ;;(if (not stackx) (go c2)) (princ "/stackx1= ") (prin1 stackx) - c2 (if (not (|ident?| tok)) (go d2)) - (princ "/isid= ") - ;; (princ (if isid "T" "NIL")) - d2 (princ "/stack= ") (prin1 (|stackStore| |$reduceStack|)) - (princ "/value= ") (prin1 v) - (return v))))))) - -(defun /embed-1 (x y) - (princ (strconc (pname x) " embedded")) - (terpri) - (/embed-q x y)) - -(defvar /embednames) - -(defun /embed-q (x y) - (setq /embednames (cons x /embednames)) - (embed x - (cond ((eqcar y 'lambda) y) - ((eqcar y 'before) - `(lambda ,(cadr y) - (prog2 ,(caddr y) ,(cons 'funcall (cons x (cadr y)))))) - ((eqcar y 'after) - `(lambda ,(cadr y) - (prog1 ,(cons 'funcall (cons x (cadr y))) ,(caddr y)))))) - (/embedreply)) - -(defun /embedreply () - (if (atom (embedded)) '(|none| |embedded|) - (append (embedded) (list '|embedded|)))) - -(defparameter mdeftrace nil "") - -(defun /mdef (x) - (let (u) - (cond ((atom x) x) - ((or (null (atom (car x))) (not (mbpip (car x)))) - (mapcar #'/mdef x)) - ((equal x (setq u (mdef (car x) x))) x) - (mdeftrace (print x) (princ " --> ") (print u) (/mdef u)) - ((/mdef u))))) - -(defun trargprint (l) (mapc #'(lambda (x) (princ " / ") (prin1 x)) l)) - -(defun trblanks (n) (do ((i 1 (1+ i))) ((> i n)) (princ " "))) - ; 5. Routines for inspecting and resetting total I/O system state ; ; The package largely assumes that: diff --git a/src/interp/slam.boot b/src/interp/slam.boot index c48b0cbf..5a74a0cb 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -406,7 +406,16 @@ compileInteractive fn == result := compQuietly optfn if $InteractiveMode then stopTimingProcess 'compilation result - + +++ Subroutine of compileInteractive. +compQuietly fn == + _*COMP370_-APPLY_* := + $InteractiveMode => + $compileDontDefineFunctions => "COMPILE-DEFUN" + "EVAL-DEFUN" + "PRINT-DEFUN" + quietlyIfInteractive backendCompile fn + clearAllSlams x == fn(x,nil) where fn(thoseToClear,thoseCleared) == diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot index 54c6fa82..6bcfca02 100644 --- a/src/interp/spad-parser.boot +++ b/src/interp/spad-parser.boot @@ -161,8 +161,8 @@ preparseEcho lines == formatToStream(OUT_-STREAM,'"~&;~A~%",x) $EchoLineStack := nil -++ The line to be worked on is (CAR SLINES). -++ It's indentation is (CAR SLOCS). +++ The line to be worked on is the first in `lines. +++ It's indentation is the first in `locs'. ++ There is a notion of current indentation. Then: ++ ++ A. Add open paren to beginning of following line if following @@ -171,7 +171,8 @@ preparseEcho lines == ++ B. Add semicolon to end of line if following line's indentation is ++ the same. ++ C. If the entire line consists of the single keyword then or else, -++ leave it alone. +++ leave it alone. +addParensAndSemisToLine: (%List %String,%List %Maybe %Short) -> %Void addParensAndSemisToLine(lines,locs) == sc := first locs -- first line column number sc = nil or sc <= 0 => nil diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp index aa1971a1..78d6cc66 100644 --- a/src/interp/spad.lisp +++ b/src/interp/spad.lisp @@ -140,23 +140,6 @@ (if *spad-output-file* (shut out-stream))) T)) -(defun READ-SPAD1 (FN FT FM TO) - (LET ((STRM IN-STREAM)) - (SETQ $MAXLINENUMBER 0) - (SETQ $SPAD_ERRORS (VECTOR 0 0 0)) - (SETQ IN-STREAM (open (strconc fm ">" fn "." ft) :direction :input)) - ($ERASE (LIST FN 'ERROR 'A)) - (SETQ OUT-STREAM (if TO (open to :direction :output) OUT-STREAM)) - (SETQ SPADERRORSTREAM (open (strconc "a>" fn ".error") :direction :output)) - (READ-SPAD-1) - (close SPADERRORSTREAM) - (SETQ IN-STREAM STRM) - (OR (EQUAL #(0 0 0) $SPAD_ERRORS) - (|sayBrightly| (LIST '|%b| (ELT $SPAD_ERRORS 0) '|%d| '|syntax errors| - '|%l| '|%b| (ELT $SPAD_ERRORS 1) '|%d| '|precompilation errors| - '|%l| '|%b| (ELT $SPAD_ERRORS 2) '|%d| '|semantic errors| '|%l|))) - (+ (ELT $SPAD_ERRORS 0) (ELT $SPAD_ERRORS 1) (ELT $SPAD_ERRORS 2)))) - (DEFUN INTEGER-BIT (N I) (LOGBITP I N)) (DEFUN /TRANSPAD (X) @@ -188,23 +171,6 @@ (|comp| |$x| |$m| |$f|) (UNEMBED '|comp|)) -(defun READ-SPAD (FN FM TO) - (LET ((proplist - (LIST '(FLUID . |true|) - (CONS '|special| (COPY-TREE |$InitialDomainsInScope|))))) - (SETQ |$InteractiveFrame| - (|addBinding| '|$DomainsInScope| proplist - (|addBinding| '|$Information| NIL - (|makeInitialModemapFrame|)))) - (READ-SPAD0 FN 'SPAD FM TO))) - -(defun READ-INPUT (FN FM TO) (READ-SPAD0 FN 'INPUT FM TO)) - -(defun READ-SPAD0 (FN FT FM TO) - (let (($newspad t)) (READ-SPAD1 FN FT FM TO))) - -(defun READ-SPAD-1 () (|New,ENTRY,1|)) - (defun UNCONS (X) (COND ((ATOM X) X) ((EQCAR X 'CONS) (CONS (SECOND X) (UNCONS (THIRD X)))) @@ -338,29 +304,6 @@ (if |$InteractiveMode| (|spadThrow|)) (S-PROCESS x)))) -(defun |New,ENTRY,1| () - (let (ZZ str N RLGENSYMFG RLGENSYMLST - SINGLELINEMODE OK ISID NBLNK COUNT CHR ULCASEFG ($LINESTACK 'BEGIN_UNIT) - $TOKSTACK COMMENTCHR TOK LINE BACK INPUTSTREAM - STACK STACKX TRAPFLAG) - (PROMPT) - (SETQ COMMENTCHR 'IGNORE) - (SETQ INITCOLUMN 0) - (SETQ SINGLELINEMODE T) ; SEE NewSYSTOK - (SETQ ULCASEFG T) - (setq STR (|New,ENTRY,2| '|PARSE-NewEXPR| '|process| |$InputStream|)) - (if (/= 0 (setq N (NOTE STR))) - (progn (SETQ |$InputStream| (POINTW N |$InputStream|))) - ) - '|END_OF_New|)) - -(defun |New,ENTRY,2| (RULE FN INPUTSTREAM) (declare (special INPUTSTREAM)) - (let (zz) - (INITIALIZE) - (SETQ |$previousTime| (TEMPUS-FUGIT)) - (setq ZZ (CONVERSATION '|parseNewExpr| '|process|)) - INPUTSTREAM)) - (defun INITIALIZE () (init-boot/spad-reader) (initialize-preparse |$InputStream|)) |