diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/preparse.lisp | 83 | ||||
| -rw-r--r-- | src/interp/spad-parser.boot | 41 |
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() |