aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/bootlex.lisp10
-rw-r--r--src/interp/debug.lisp11
-rw-r--r--src/interp/metalex.lisp60
-rw-r--r--src/interp/preparse.lisp4
-rw-r--r--src/interp/spad.lisp10
-rw-r--r--src/interp/util.lisp4
6 files changed, 15 insertions, 84 deletions
diff --git a/src/interp/bootlex.lisp b/src/interp/bootlex.lisp
index 487de0e3..2032c0c8 100644
--- a/src/interp/bootlex.lisp
+++ b/src/interp/bootlex.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
;; All rights reserved.
-;; 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
@@ -56,9 +56,6 @@
(defun init-boot/spad-reader ()
(setq $SPAD_ERRORS (VECTOR 0 0 0))
(setq SPADERRORSTREAM |$OutputStream|)
- (setq XTokenReader 'get-BOOT-token)
- (setq Line-Handler 'next-BOOT-line)
- (setq Meta_Error_Handler 'spad_syntax_error)
(setq File-Closed nil)
(Next-Lines-Clear)
(setq Boot-Line-Stack nil)
@@ -88,7 +85,6 @@
(*comp370-apply* (function print-defun))
(*fileactq-apply* (function print-defun))
($SPAD T)
- (XCape #\_)
(OPTIONLIST nil)
(*EOF* NIL)
(File-Closed NIL)
@@ -238,7 +234,7 @@ or the chracters ?, !, ' or %"
(suffix (current-char) buf)
(advance-char)
id (let ((cur-char (current-char)))
- (cond ((char= cur-char XCape)
+ (cond ((char= cur-char #\_)
(if (not (advance-char)) (go bye))
(suffix (current-char) buf)
(setq escaped? t)
@@ -290,7 +286,7 @@ or the chracters ?, !, ' or %"
(if (char/= (current-char) #\") (RETURN NIL) (advance-char))
(loop
(if (char= (current-char) #\") (return nil))
- (SUFFIX (if (char= (current-char) XCape)
+ (SUFFIX (if (char= (current-char) #\_)
(advance-char)
(current-char))
BUF)
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index 49927594..25902a68 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
;; All rights reserved.
-;; 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
@@ -62,9 +62,6 @@
(MAKEPROP 'INPUT '/TERMCHR '(#\: #\< #\ #\())
(MAKEPROP 'SPAD '/TERMCHR '(#\: #\< #\ #\())
(MAKEPROP 'BOOT '/TERMCHR '(#\: #\< #\ #\())
-(MAKEPROP 'INPUT '/XCAPE #\_)
-(MAKEPROP 'BOOT '/XCAPE '#\_)
-(MAKEPROP 'SPAD '/XCAPE '#\_)
(MAKEPROP 'META '/READFUN 'META\,RULE)
(MAKEPROP 'INPUT '/READFUN '|New,LEXPR,Interactive|)
(MAKEPROP 'INPUT '/TRAN '/TRANSPAD)
@@ -129,13 +126,13 @@
(DEFUN /D-2 (FN INFILE OUTPUTSTREAM OP EDITFLAG TRACEFLAG)
(declare (special OUTPUTSTREAM))
(PROG (FT oft SFN X EDINFILE FILE DEF KEY RECNO U W SOURCEFILES
- |$Echo| SINGLINEMODE XCAPE XTOKENREADER INPUTSTREAM SPADERRORSTREAM
+ |$Echo| SINGLINEMODE INPUTSTREAM SPADERRORSTREAM
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
(*COMP370-APPLY* (if (eq op 'define) #'eval-defun #'compile-defun)))
- (declare (special |$Echo| SINGLINEMODE XCAPE XTOKENREADER INPUTSTREAM
+ (declare (special |$Echo| SINGLINEMODE INPUTSTREAM
SPADERRORSTREAM ISID NBLNK COMMENTCHR $TOKSTACK /SOURCEFILES
METAKEYLST DEFINITION_NAME |$sourceFileTypes|
$FUNCTION $NEWSPAD $LINESTACK $LINENUMBER STACK STACKX BACK OK
@@ -160,9 +157,7 @@
;;?(REMFLAG S-SPADKEY 'KEY) ; hack !!
(SETQ FT (|pathnameType| FILE))
(SETQ oft (|object2Identifier| (UPCASE FT)))
- (SETQ XCAPE (OR (GET oft '/XCAPE) #\|))
(SETQ COMMENTCHR (GET oft '/COMMENTCHR))
- (SETQ XTOKENREADER (OR (GET oft '/NXTTOK) 'METATOK))
(SETQ DEFINITION_NAME FN)
(SETQ KEY
(STRCONC
diff --git a/src/interp/metalex.lisp b/src/interp/metalex.lisp
index 8ae5de18..a5ab0393 100644
--- a/src/interp/metalex.lisp
+++ b/src/interp/metalex.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
;; All rights reserved.
-;; Copyright (C) 2007-2009, Gabriel Dos Reis.
+;; Copyright (C) 2007-2011, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -168,10 +168,6 @@
; *** Next Line
-(defparameter Line-Handler 'next-META-line "Who grabs lines for us.")
-
-(defun next-line (&optional (in-stream t)) (funcall Line-Handler in-stream))
-
(defun make-string-adjustable (s)
(cond ((adjustable-array-p s) s)
(t (make-array (array-dimensions s) :element-type 'character
@@ -262,8 +258,6 @@ Symbolics read-line returns embedded newlines in a c-m-Y.")
; *** Current Char, Next Char, Advance Char
-(defparameter xcape #\_ "Escape character for Boot code.")
-
(defun Current-Char ()
"Returns the current character of the line, initially blank for an unread line."
(if (Line-Past-End-P Current-Line) #\Return (Line-Current-Char Current-Line)))
@@ -279,7 +273,7 @@ is a token separator, which blank is equivalent to."
"Advances IN-STREAM, invoking Next Line if necessary."
(loop (cond ((not (Line-At-End-P Current-Line))
(return (Line-Advance-Char Current-Line)))
- ((next-line in-stream)
+ ((next-boot-line in-stream)
(return (current-char)))
((return nil)))))
@@ -326,7 +320,7 @@ NonBlank is true if the token is not preceded by a blank."
; *** Current Token, Next Token, Advance Token
(defun try-get-token (token)
- (let ((tok (get-token token)))
+ (let ((tok (get-boot-token token)))
(if tok (progn (incf Valid-Tokens) token))))
(defun current-symbol () (make-symbol-of (current-token)))
@@ -366,14 +360,6 @@ NonBlank is true if the token is not preceded by a blank."
(decf Valid-Tokens))))
-(defparameter XTokenReader 'get-meta-token "Name of tokenizing function")
-
-; *** Get Token
-
-(defun get-token (token) (funcall XTokenReader token))
-
-
-
; 1D. A Reduction
;
@@ -446,23 +432,6 @@ NonBlank is true if the token is not preceded by a blank."
; *** 2. META Line Handling
-
-(defun next-META-line (&optional (in-stream t))
-
-"Get next line, trimming trailing blanks and trailing comments.
-One trailing blank is added to a non-blank line to ease between-line
-processing for Next Token (i.e., blank takes place of return). Returns T
-if it gets a non-blank line, and NIL at end of stream."
-
- (prog (string)
-empty (if File-Closed (return nil))
- (setq string (kill-trailing-blanks (kill-comments
- (get-a-line in-stream))))
- (if (= (length string) 0) (go empty))
- (Line-New-Line (suffix #\Space string) Current-Line)
- (if |$Echo| (Print-New-Line (Line-Buffer Current-Line) out-stream))
- (return t)))
-
(defparameter Comment-Character #\% "Delimiter of comments in Meta code.")
(defun kill-comments (string)
@@ -792,26 +761,3 @@ special character be the atom whose print name is the character itself."
(defparameter $num_of_meta_errors 0)
(defparameter Meta_Errors_Occurred nil "Did any errors occur")
-
-(defparameter Meta_Error_Handler 'meta-meta-error-handler)
-
-(defun meta-syntax-error (&optional (wanted nil) (parsing nil))
- (funcall Meta_Error_Handler wanted parsing))
-
-(defun meta-meta-error-handler (&optional (wanted nil) (parsing nil))
- "Print syntax error indication, underline character, scrub line."
- (format out-stream "~&% MetaLanguage syntax error: ")
- (if (Line-Past-End-P Current-Line)
- (cond ((and wanted parsing)
- (format out-stream "wanted ~A while parsing ~A.~%"
- wanted parsing))
- (wanted (format out-stream "wanted ~A.~%" wanted))
- (parsing (format out-stream "while parsing ~A.~%" parsing)))
- (progn (format out-stream "~:[here~;wanted ~A here~]" wanted wanted)
- (format out-stream "~:[~; while parsing ~A~]:~%" parsing parsing)
- (current-line-print)
- (current-line-clear)
- (current-token)
- (incf $num_of_meta_errors)
- (setq Meta_Errors_Occurred t)))
- nil)
diff --git a/src/interp/preparse.lisp b/src/interp/preparse.lisp
index dcab95f1..47acccb4 100644
--- a/src/interp/preparse.lisp
+++ b/src/interp/preparse.lisp
@@ -168,7 +168,7 @@
NOCOMS (setq SLOC (INDENT-POS A))
(setq A (DROPTRAILINGBLANKS A))
(cond ((NULL SLOC) (setq SLOC PSLOC) (GO READLOOP)))
- (cond ((EQ (ELT A (MAXINDEX A)) XCAPE)
+ (cond ((EQ (ELT A (MAXINDEX A)) #\_)
(setq CONTINUE T a (subseq A (MAXINDEX A))))
((setq CONTINUE NIL)))
(if (and (null LINES) (= SLOC 0)) ;;test for skipping constructors
@@ -346,7 +346,7 @@
(format out-stream "~&;~A~%" X)))
(setq $EchoLineStack ()))
-(defun ESCAPED (STR N) (and (> N 0) (EQ (CHAR STR (1- N)) XCAPE)))
+(defun ESCAPED (STR N) (and (> N 0) (EQ (CHAR STR (1- N)) #\_)))
(defun atEndOfUnit (X) (NULL (STRINGP X)) )
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index 3811bdc4..154f3920 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -77,7 +77,6 @@
(defvar sortpred)
(defvar SPADSYSKEY '(EOI EOL))
(defvar STAKCOLUMN -1)
-(defvar XTOKENREADER 'SPADTOK)
(defvar xtrans '|boot-new|)
(defvar |$IOAlist| '((|%i| . (|gauss| 0 1))))
(defvar |InteractiveMode|)
@@ -264,16 +263,13 @@
(S-PROCESS x))))
(defun |New,ENTRY,1| ()
- (let (ZZ str N RLGENSYMFG RLGENSYMLST |NewFLAG| XCAPE
+ (let (ZZ str N RLGENSYMFG RLGENSYMLST |NewFLAG|
SINGLELINEMODE OK ISID NBLNK COUNT CHR ULCASEFG ($LINESTACK 'BEGIN_UNIT)
$TOKSTACK COMMENTCHR TOK LINE BACK INPUTSTREAM XTRANS
- XTOKENREADER STACK STACKX TRAPFLAG)
- (SETQ XTRANS '|boot-New|
- XTOKENREADER 'NewSYSTOK
- Meta_Error_Handler 'SPAD_SYNTAX_ERROR)
+ STACK STACKX TRAPFLAG)
+ (SETQ XTRANS '|boot-New|)
(FLAG |boot-NewKEY| 'KEY)
(PROMPT)
- (SETQ XCAPE '_)
(SETQ COMMENTCHR 'IGNORE)
(SETQ INITCOLUMN 0)
(SETQ SINGLELINEMODE T) ; SEE NewSYSTOK
diff --git a/src/interp/util.lisp b/src/interp/util.lisp
index 873bb03c..61603c46 100644
--- a/src/interp/util.lisp
+++ b/src/interp/util.lisp
@@ -268,10 +268,8 @@
(ioclear)
(LET* ((BOOT-LINE-STACK (LIST (CONS 1 LINE)))
($SPAD T)
- (XTOKENREADER 'GET-BOOT-TOKEN)
- (LINE-HANDLER 'NEXT-BOOT-LINE)
(PARSEOUT (PROG2 (|PARSE-NewExpr|) (POP-STACK-1))))
- (DECLARE (SPECIAL BOOT-LINE-STACK $SPAD XTOKENREADER LINE-HANDLER))
+ (DECLARE (SPECIAL BOOT-LINE-STACK $SPAD))
PARSEOUT))
generated by cgit v1.2.3 (git 2.39.1) at 2024-10-31 13:33:06 +0000