From 1dbbbe925423f63ad24be607081ced422eed5181 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sat, 5 May 2012 17:24:06 +0000
Subject: 	* interp/preparse.lisp (ADDCLOSE): Move to spad-parser.boot. 
 Renamed addClose. 	(ESCAPED): Move to spad-parser.boot.  Renamed
 escaped?. 	(INFIXTOK): Move spad-parser.boot.  Renamed infixToken?.

---
 src/interp/preparse.lisp    | 23 +++++------------------
 src/interp/spad-parser.boot | 18 ++++++++++++++++++
 2 files changed, 23 insertions(+), 18 deletions(-)

(limited to 'src/interp')

diff --git a/src/interp/preparse.lisp b/src/interp/preparse.lisp
index 8741a490..5b0e6193 100644
--- a/src/interp/preparse.lisp
+++ b/src/interp/preparse.lisp
@@ -103,7 +103,7 @@
         (SLOC -1) (CONTINUE NIL)  (PARENLEV 0) (NCOMBLOCK ())
         (LINES ()) (LOCS ()) (NUMS ()) functor  )
  READLOOP (DCQ (NUM . A) (preparseReadLine LineList))
-         (cond ((atEndOfUnit A)
+         (cond ((|atEndOfUnit?| A)
                 (PREPARSE-ECHO LineList)
                 (COND ((NULL LINES) (RETURN NIL))
                       (NCOMBLOCK
@@ -128,7 +128,7 @@
          (setq CPARSYM (OR (position #\) A :start I ) L))
          (setq N (MIN STRSYM COMSYM NCOMSYM OPARSYM CPARSYM))
          (cond ((= N L) (GO NOCOMS))
-               ((ESCAPED A N))
+               ((|escaped?| A N))
                ((= N STRSYM) (setq INSTRING (NOT INSTRING)))
                (INSTRING)
                ((= N COMSYM) (setq A (subseq A 0 N)) (GO NOCOMS)) ; discard trailing comment
@@ -331,10 +331,6 @@
                         (format out-stream "~&;~A~%" X)))
   (setq $EchoLineStack ()))
  
-(defun ESCAPED (STR N) (and (> N 0) (EQ (CHAR STR (1- N)) #\_)))
- 
-(defun atEndOfUnit (X) (NULL (STRINGP X)) )
- 
 (defun PARSEPILES (LOCS LINES)
   "Add parens and semis to lines to aid parsing."
   (mapl #'add-parens-and-semis-to-line 
@@ -373,10 +369,10 @@
 			     (cond 
 			      ((and (eq next-column start-column)
 				    (rplaca nlocs (- (car nlocs)))
-				    (not (infixtok next-line)))
+				    (not (|infixToken?| next-line)))
 			       (setq next-lines (|drop| (1- i) slines))
 			       (rplaca next-lines 
-				       (addclose (car next-lines) #\;))
+				       (|addClose| (car next-lines) #\;))
 			       (setq count (1+ count))))))))
                  (cdr slines) (cdr slocs)))
           (if (> count 0)
@@ -384,13 +380,4 @@
 		(setf (char (car slines) (1- (nonblankloc (car slines))))
 		      #\( )
 		(setq slines (|drop| (1- i) slines))
-		(rplaca slines (addclose (car slines) #\) ))))))))
- 
-(defun INFIXTOK (S) (MEMBER (STRING2ID-N S 1) '(|then| |else|) :test #'eq))
- 
- 
-(defun ADDCLOSE (LINE CHAR)
-  (cond ((char= (FETCHCHAR LINE (MAXINDEX LINE)) #\; )
-         (SETF (ELT LINE (MAXINDEX LINE)) CHAR)
-         (if (char= CHAR #\;) LINE (suffix #\; LINE)))
-        ((suffix char LINE))))
+		(rplaca slines (|addClose| (car slines) #\) ))))))))
diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot
index 197bd921..edf0cac0 100644
--- a/src/interp/spad-parser.boot
+++ b/src/interp/spad-parser.boot
@@ -46,6 +46,24 @@ import preparse
 import parse
 namespace BOOT
 
+--%
+
+addClose(line,ch) ==
+  FETCHCHAR(line,maxIndex line) = char ";" =>
+    ch = char ";" => line
+    line.(maxIndex line) := ch
+    SUFFIX(char ";",line)
+  SUFFIX(ch,line)
+
+escaped?(s,n) ==
+  n > 0 and FETCHCHAR(s,n-1) = char "__"
+
+infixToken? s ==
+  STRING2ID_-N(s,1) in '(_then _else)
+
+atEndOfUnit? x ==
+  not string? x
+  
 --%
 macro compulsorySyntax s ==
   s or SPAD__SYNTAX__ERROR()
-- 
cgit v1.2.3