aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/preparse.lisp83
-rw-r--r--src/interp/spad-parser.boot41
2 files changed, 44 insertions, 80 deletions
diff --git a/src/interp/preparse.lisp b/src/interp/preparse.lisp
index dc4836ba..27e29538 100644
--- a/src/interp/preparse.lisp
+++ b/src/interp/preparse.lisp
@@ -102,7 +102,7 @@
INSTRING PCOUNT COMSYM STRSYM OPARSYM CPARSYM N NCOMSYM
(SLOC -1) (CONTINUE NIL) (PARENLEV 0) (NCOMBLOCK ())
(LINES ()) (LOCS ()) (NUMS ()) functor )
- READLOOP (DCQ (NUM . A) (preparseReadLine LineList))
+ READLOOP (DCQ (NUM . A) (|preparseReadLine| LineList))
(cond ((|atEndOfUnit?| A)
(PREPARSE-ECHO LineList)
(COND ((NULL LINES) (RETURN NIL))
@@ -219,62 +219,7 @@
(dolist (X L) (format t "~5d. ~a~%" (car x) (cdr x)))
(format t "~%"))))
-(DEFUN SKIP-IFBLOCK (X)
- (PROG (LINE IND)
- (DCQ (IND . LINE) (preparseReadLine1 X))
- (IF (NOT (STRINGP LINE)) (RETURN (CONS IND LINE)))
- (IF (ZEROP (SIZE LINE)) (RETURN (SKIP-IFBLOCK X)))
- (COND ((CHAR= (ELT LINE 0) #\) )
- (COND
- ((|stringPrefix?| ")if" LINE)
- (COND ((EVAL (|string2BootTree| (|storeBlanks!| LINE 3)))
- (RETURN (preparseReadLine X)))
- ('T (RETURN (SKIP-IFBLOCK X)))))
- ((|stringPrefix?| ")elseif" LINE)
- (COND ((EVAL (|string2BootTree| (|storeBlanks!| LINE 7)))
- (RETURN (preparseReadLine X)))
- ('T (RETURN (SKIP-IFBLOCK X)))))
- ((|stringPrefix?| ")else" LINE)
- (RETURN (preparseReadLine X)))
- ((|stringPrefix?| ")endif" LINE)
- (RETURN (preparseReadLine X)))
- ((|stringPrefix?| ")fin" LINE)
- (RETURN (CONS IND NIL))))))
- (RETURN (SKIP-IFBLOCK X)) ) )
-
-(DEFUN SKIP-TO-ENDIF (X)
- (PROG (LINE IND)
- (DCQ (IND . LINE) (preparseReadLine1 X))
- (COND ((NOT (STRINGP LINE)) (RETURN (CONS IND LINE)))
- ((|stringPrefix?| LINE ")endif")
- (RETURN (preparseReadLine X)))
- ((|stringPrefix?| LINE ")fin") (RETURN (CONS IND NIL)))
- ('T (RETURN (SKIP-TO-ENDIF X))))))
-
-(DEFUN preparseReadLine (X)
- (PROG (LINE IND)
- (DCQ (IND . LINE) (preparseReadLine1 X))
- (COND ((NOT (STRINGP LINE)) (RETURN (CONS IND LINE))))
- (COND ((ZEROP (SIZE LINE))
- (RETURN (CONS IND LINE))))
- (COND ((CHAR= (ELT LINE 0) #\) )
- (COND
- ((|stringPrefix?| ")if" LINE)
- (COND ((EVAL (|string2BootTree| (|storeBlanks!| LINE 3)))
- (RETURN (preparseReadLine X)))
- ('T (RETURN (SKIP-IFBLOCK X)))))
- ((|stringPrefix?| ")elseif" LINE)
- (RETURN (SKIP-TO-ENDIF X)))
- ((|stringPrefix?| ")else" LINE)
- (RETURN (SKIP-TO-ENDIF X)))
- ((|stringPrefix?| ")endif" LINE)
- (RETURN (preparseReadLine X)))
- ((|stringPrefix?| ")fin" LINE)
- (SETQ *EOF* T)
- (RETURN (CONS IND NIL)) ) )))
- (RETURN (CONS IND LINE)) ))
-
-(DEFUN preparseReadLine1 (X)
+(DEFUN |preparseReadLine1| (X)
(PROG (LINE IND)
(SETQ LINE (if $LINELIST
(pop $LINELIST)
@@ -293,32 +238,10 @@
(COND
( (AND (> (SETQ IND (MAXINDEX LINE)) -1) (char= (ELT LINE IND) #\_))
(setq $preparse-last-line
- (STRCONC (SUBSTRING LINE 0 IND) (CDR (preparseReadLine1 X))) ))
+ (STRCONC (SUBSTRING LINE 0 IND) (CDR (|preparseReadLine1| X))) ))
( 'T
LINE ) ))) ) )
-;;(defun preparseReadLine (X)
-;; (declare (special $LINELIST $echoLineStack))
-;; (PROG (LINE IND)
-;; (setq LINE
-;; (if $LINELIST
-;; (pop $LINELIST)
-;; (get-a-line in-stream)))
-;; (setq $preparse-last-line LINE)
-;; (and (stringp line) (incf $INDEX))
-;; (if (NOT (STRINGP LINE)) (RETURN (CONS $INDEX LINE)))
-;; (setq LINE (DROPTRAILINGBLANKS LINE))
-;; (if |$Echo| (PUSH (COPY-SEQ LINE) $EchoLineStack))
-;; ; next line must evaluate $INDEX before recursive call
-;; (RETURN
-;; (CONS $INDEX
-;; (if (and (> (setq IND (MAXINDEX LINE)) -1)
-;; (EQ (ELT LINE IND) #\_))
-;; (setq $preparse-last-line
-;; (STRCONC (SUBSEQ LINE 0 IND)
-;; (CDR (preparseReadLine X))))
-;; LINE)))))
-
(defun PREPARSE-ECHO (linelist)
(if |$Echo| (REPEAT (IN X (|reverse| $EchoLineStack))
(format out-stream "~&;~A~%" X)))
diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot
index 57229713..454b7a25 100644
--- a/src/interp/spad-parser.boot
+++ b/src/interp/spad-parser.boot
@@ -85,6 +85,47 @@ stringPrefix?(s1,s2) ==
n1 > #s2 => false
and/[s1.i = s2.i for i in 0..(n1-1)]
+skipIfBlock st ==
+ [n,:line] := z := preparseReadLine1 st
+ not string? line => z
+ #line = 0 => skipIfBlock st
+ line.0 = char ")" =>
+ stringPrefix?('")if",line) =>
+ EVAL string2BootTree storeBlanks!(line,2) => preparseReadLine st
+ skipIfBlock st
+ stringPrefix?('")elseif",line) =>
+ EVAL string2BootTree storeBlanks!(line,7) => preparseReadLine st
+ skipIfBlock st
+ stringPrefix?('")else",line) or stringPrefix?('")endif",line) =>
+ preparseReadLine st
+ stringPrefix?('")fin",line) => [n]
+ skipIfBlock st
+ skipIfBlock st
+
+skipToEndif st ==
+ [n,:line] := z := preparseReadLine1 st
+ not string? line => z
+ stringPrefix?(line,'")endif") => preparseReadLine st
+ stringPrefix?(line,'")fin") => [n]
+ skipToEndif st
+
+
+preparseReadLine st ==
+ [n,:line] := z := preparseReadLine1 st
+ not string? line or #line = 0 => z
+ line.0 = char ")" =>
+ stringPrefix?('")if",line) =>
+ EVAL string2BootTree storeBlanks!(line,3) => preparseReadLine st
+ skipIfBlock st
+ stringPrefix?('")elseif",line) or stringPrefix?('")else",line) =>
+ skipToEndif st
+ stringPrefix?('")endif",line) => preparseReadLine st
+ stringPrefix?('")fin",line) =>
+ SETQ(_*EOF_*,true)
+ [n]
+ z
+ z
+
--%
macro compulsorySyntax s ==
s or SPAD__SYNTAX__ERROR()