From 5852b522a6637ecde8dbc53204b3cd00c565fae9 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Tue, 8 May 2012 10:10:34 +0000
Subject: 	* boot/tokens.boot: Export char.  Do not rename maxIndex. 
 * lisp/core.lisp.in (maxIndex): Define and export. 	* interp/bootlex.lisp:
 Adjust. 	* interp/parsing.lisp: Likewise. 	* interp/macros.lisp:
 Likewise. 	(DROPTRAILINGBLANKS): Remove. 	(BLANKP): Likewise. 
 (NONBLANKLOC): Likewise. 	* interp/io.boot (trimTrailingBlank): New. 
 (firstNonblankCharPosition): Likewise. 	* interp/preparse.lisp: Use
 them. Adjust. 	* interp/sys-macros.lisp (char): Remove. 	*
 interp/vmlisp.lisp (MAXINDEX): Likewise. 	* interp/br-search.boot
 (pmTransFilter): Fix bogus uses of char. 	* interp/debug.lisp: Likewise.
 	* interp/g-util.boot: Likewise. 	* interp/ht-root.boot:
 Likewise. 	* interp/i-output.boot: Likewise. 	*
 interp/i-syscmd.boot: Likewise.

---
 src/interp/bootlex.lisp    |  2 +-
 src/interp/br-search.boot  |  4 ++--
 src/interp/database.boot   |  2 +-
 src/interp/debug.lisp      |  8 ++++----
 src/interp/g-util.boot     |  2 +-
 src/interp/ht-root.boot    |  4 ++--
 src/interp/i-output.boot   |  2 +-
 src/interp/i-syscmd.boot   |  3 +--
 src/interp/io.boot         | 13 +++++++++++++
 src/interp/macros.lisp     | 12 +++---------
 src/interp/parsing.lisp    |  2 +-
 src/interp/preparse.lisp   | 12 ++++++------
 src/interp/sys-macros.lisp | 11 -----------
 src/interp/vmlisp.lisp     |  3 ---
 14 files changed, 36 insertions(+), 44 deletions(-)

(limited to 'src/interp')

diff --git a/src/interp/bootlex.lisp b/src/interp/bootlex.lisp
index 77147e7a..ec75471d 100644
--- a/src/interp/bootlex.lisp
+++ b/src/interp/bootlex.lisp
@@ -122,7 +122,7 @@
  "Transforms X according to AL = ((<label> . Sexpr) ..)."
   (COND ((simple-vector-p X)
          (do ((i 0 (1+ i))
-              (k (maxindex x)))
+              (k (|maxIndex| x)))
              ((> i k))
            (if (LET ((Y (LASSOC (ELT X I) AL))) (SETF (ELT X I) Y))
                (TRANSLABEL1 (ELT X I) AL))))
diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot
index fa44b8e1..f4c1a81d 100644
--- a/src/interp/br-search.boot
+++ b/src/interp/br-search.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2011, Gabriel Dos Reis.
+-- Copyright (C) 2007-2012, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -143,7 +143,7 @@ pmTransFilter s ==
     => (parse := pmParseFromString s) and checkPmParse parse or
         ['error,'"Illegal search string",'"\vspace{3}\center{{\em Your search string} ",escapeSpecialChars s,'" {\em has incorrect syntax}}"]
   or/[s . i = char "*" and s.(i + 1) = char "*"
-      and (i=0 or stringChar(s,i - 1) ~= char $charUnderscore) for i in 0..(maxIndex s - 1)]
+      and (i=0 or stringChar(s,i - 1) ~= $charUnderscore) for i in 0..(maxIndex s - 1)]
        => ['error,'"Illegal search string",'"\vspace{3}\center{Consecutive {\em *}'s are not allowed in search patterns}"]
   s
 
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 943b635f..8ba828f8 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -701,7 +701,7 @@ dropPrefix(fn) ==
 --++  egName  := nil
 --++  egFiles := nil
 --++  while (x:= readLine stream) ~= %nothing repeat
---++    x := DROPTRAILINGBLANKS x
+--++    x := trimTrailingBlank x
 --++    # x = 0 => 'iterate                         -- blank line
 --++    (x.0 = char "#") or (x.0 = char "*") => 'iterate    -- comment
 --++    x.0 = char " " =>
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index bb51443d..21bacd14 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -679,7 +679,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
                  (T (COND (|$mathTrace| (TERPRI)))
                     (PRINMATHOR0 VAL CURSTRM)))))))
  
-(DEFUN MONITOR-BLANKS (N) (PRINC (|makeString| N (|char| " ")) CURSTRM))
+(DEFUN MONITOR-BLANKS (N) (PRINC (|makeString| N (|char| '| |)) CURSTRM))
  
 (DEFUN MONITOR-EVALBEFORE (X) (EVAL (MONITOR-EVALTRAN X NIL)) X)
  
@@ -748,7 +748,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
                    (MONITOR-PRINT (CAR L) CURSTRM) (SETQ L (CDR L))))
             (mapcar #'monitor-printrest L))))
       ((do ((istep 2 (+ istep 1))
-            (k (maxindex code)))
+            (k (|maxIndex| code)))
            ((> istep k) nil)
         (when (not (= 0 (SETQ N (digit-char-p (elt CODE ISTEP)))))
          (PRINC "\\" CURSTRM)
@@ -786,7 +786,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
   "Returns number if number of nodes < M otherwise nil."
   (COND ((< M N) NIL)
         ((simple-vector-p X)
-         (do ((i 0 (1+ i)) (k (maxindex x)))
+         (do ((i 0 (1+ i)) (k (|maxIndex| x)))
              ((> i k) n)
            (if (NOT (SETQ N (SMALL-ENOUGH-COUNT (ELT X I) (1+ N) M)))
                (RETURN NIL))))
@@ -1053,7 +1053,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
  
 (defun SPADSYSNAMEP (STR)
   (let (n i j)
-    (AND (SETQ N (MAXINDEX STR))
+    (AND (SETQ N (|maxIndex| STR))
          (SETQ I (position #\. STR :start 1))
          (SETQ J (position #\, STR :start (1+ I)))
          (do ((k (1+ j) (1+ k)))
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 4c93b215..8865e32a 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -215,7 +215,7 @@ $AbstractionOperator ==
 ++ Return the character designated by the string `s'.
 stringToChar: %String -> %Char
 stringToChar s ==
-  #s = 1 => char s
+  #s = 1 => stringChar(s,0)
   s = '"\a" => $Bell
   s = '"\n" => $Newline
   s = '"\f" => $FormFeed
diff --git a/src/interp/ht-root.boot b/src/interp/ht-root.boot
index 831d36d4..231d9096 100644
--- a/src/interp/ht-root.boot
+++ b/src/interp/ht-root.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2011, Gabriel Dos Reis.
+-- Copyright (C) 2007-2012, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -36,7 +36,7 @@ import ht_-util
 namespace BOOT
 
 $historyDisplayWidth := 120
-$newline := char 10
+$newline := abstractChar 10
 
 downlink page ==
   htInitPage('"Bridge",nil)
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index 84377c5e..2f08582c 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -1917,7 +1917,7 @@ charyElse(u,v,start,linelength) ==
 scylla(n,v) ==
   y := LASSOC(n,v)
   null y => nil
-  if string?(y) then y := DROPTRAILINGBLANKS copyTree y
+  if string?(y) then y := trimTrailingBlank copyString y
   if $collectOutput then
     $outputLines := [y, :$outputLines]
   else
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index 8e3d5867..735e4681 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -2814,8 +2814,7 @@ stripLisp str ==
   strIndex := 0
   lispStr := '"lisp"
   for c0 in 0..#str-1 for c1 in 0..#lispStr-1 repeat
-    (char str.c0) ~= (char lispStr.c1) =>
-      return nil
+    str.c0 ~= lispStr.c1 => return nil
     strIndex := c0+1
   subSequence(str, strIndex)
 
diff --git a/src/interp/io.boot b/src/interp/io.boot
index 4214fcf8..c9fdb800 100644
--- a/src/interp/io.boot
+++ b/src/interp/io.boot
@@ -35,6 +35,8 @@ namespace BOOT
 
 module io where
   blankChar? : %Char -> %Boolean
+  firstNonblankCharPosition: %String -> %Maybe %Short
+  trimTrailingBlank: %String -> %String
 
 --%
 --%  Individual character routines
@@ -63,3 +65,14 @@ storeBlank!(s,n) ==
   for i in 0..maxIndex s repeat
     s.i := char " "
   s
+
+++ Return the position of the first nonblank character in line, if any.
+firstNonblankCharPosition line ==
+  or/[i for i in 0..maxIndex line | not blankChar? line.i]
+
+trimTrailingBlank line ==
+  n := sz := #line
+  for i in (sz-1)..0 by -1 while blankChar? line.i repeat
+    n := n - 1
+  n = sz => line
+  subString(line,0,n)
diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp
index a3fa1b4e..e431b682 100644
--- a/src/interp/macros.lisp
+++ b/src/interp/macros.lisp
@@ -147,7 +147,7 @@
   (declare (simple-vector vec))
   (let ((n (position 0 vec :from-end t :test-not #'eql)))
      (cond ((null n) (vector))
-           ((eql n (maxindex vec)) vec)
+           ((eql n (|maxIndex| vec)) vec)
            (t (subseq vec 0 (+ n 1))))))
  
 ; 14 SEQUENCES
@@ -374,8 +374,6 @@ terminals and empty or at-end files.  In Common Lisp, we must assume record size
 #-(OR IBCL AKCL)
 (defmacro |elapsedGcTime| () '0)
  
-(defun DROPTRAILINGBLANKS  (LINE) (string-right-trim " " LINE))
-
 ; This function was modified by Greg Vanuxem on March 31, 2005
 ; to handle the special case of #'(lambda ..... which expands
 ; into (function (lambda .....
@@ -477,7 +475,7 @@ terminals and empty or at-end files.  In Common Lisp, we must assume record size
 
 (defun expand-tabs (str)
    (if (and (stringp str) (> (length str) 0))
-      (let ((bpos (nonblankloc str))
+      (let ((bpos (|firstNonblankCharPosition| str))
             (tpos (|indentationLocation| str)))
         (setq str 
               (if (eql bpos tpos)
@@ -486,14 +484,10 @@ terminals and empty or at-end files.  In Common Lisp, we must assume record size
                                (make-string tpos :initial-element #\space)
                                (subseq str bpos))))
          ;; remove dos CR
-        (let ((lpos (maxindex str)))
+        (let ((lpos (|maxIndex| str)))
           (if (eq (char str lpos) #\Return) (subseq str 0 lpos) str)))
     str))
 
-(defun blankp (char) (or (eq char #\Space) (eq char #\tab)))
- 
-(defun nonblankloc (str) (position-if-not #'blankp str))
- 
 ;; stream handling for paste-in generation
 
 (defun |applyWithOutputToString| (func args)
diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp
index 6e30ab91..aa53480a 100644
--- a/src/interp/parsing.lisp
+++ b/src/interp/parsing.lisp
@@ -562,7 +562,7 @@ the stack, then stack a NIL. Return the value of prod."
 (Defun FLOATEXPID (X &aux S)
   (if (AND (|ident?| X) (char= (char-upcase (ELT (SETQ S (PNAME X)) 0)) #\E)
            (> (LENGTH S) 1)
-           (SPADREDUCE AND 0 (COLLECT (STEP I 1 1 (MAXINDEX S))
+           (SPADREDUCE AND 0 (COLLECT (STEP I 1 1 (|maxIndex| S))
                                       (DIGITP (ELT S I)))))
        (READ-FROM-STRING S t nil :start 1)
     NIL))
diff --git a/src/interp/preparse.lisp b/src/interp/preparse.lisp
index bab9621c..7eeb3cbd 100644
--- a/src/interp/preparse.lisp
+++ b/src/interp/preparse.lisp
@@ -151,10 +151,10 @@
          (setq I (1+ N))
          (GO STRLOOP)
  NOCOMS  (setq SLOC (|indentationLocation| A))
-         (setq A (DROPTRAILINGBLANKS A))
+         (setq A (|trimTrailingBlank| A))
          (cond ((NULL SLOC) (setq SLOC PSLOC) (GO READLOOP)))
-         (cond ((EQ (ELT A (MAXINDEX A)) #\_)
-                (setq CONTINUE T a (subseq A (MAXINDEX A))))
+         (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
              (if (and |$byConstructors|
@@ -229,14 +229,14 @@
       (COND
         ( (NOT (STRINGP LINE))
           (RETURN (LIST $INDEX)) ) )
-      (SETQ LINE (DROPTRAILINGBLANKS LINE))
+      (SETQ LINE (|trimTrailingBlank| LINE))
       (PUSH (COPY-SEQ LINE) $EchoLineStack)
     ;; next line must evaluate $INDEX before recursive call
       (RETURN
         (CONS
           $INDEX
           (COND
-            ( (AND (> (SETQ IND (MAXINDEX LINE)) -1) (char= (ELT LINE IND) #\_))
+            ( (AND (> (SETQ IND (|maxIndex| LINE)) -1) (char= (ELT LINE IND) #\_))
               (setq $preparse-last-line
                     (STRCONC (SUBSTRING LINE 0 IND) (CDR (|preparseReadLine1| X))) ))
             ( 'T
@@ -293,7 +293,7 @@
                  (cdr slines) (cdr slocs)))
           (if (> count 0)
               (progn 
-		(setf (char (car slines) (1- (nonblankloc (car slines))))
+		(setf (char (car slines) (1- (|firstNonblankCharPosition| (car slines))))
 		      #\( )
 		(setq slines (|drop| (1- i) slines))
 		(rplaca slines (|addClose| (car slines) #\) ))))))))
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index 307a5d7d..ee189ac1 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -52,17 +52,6 @@
 (defconstant |$CarriageReturn| #\Return)
 
 
-(defmacro |char| (arg)
-  (cond ((stringp arg)
-	 (character arg))
-        ((integerp arg)
-	 (code-char arg))
-	((and (consp arg)
-	      (eq (car arg) 'quote))
-	 (character (cadr arg)))
-	(t `(character ,arg))))
-
-
 (defmacro |startsId?| (x)
  `(or (alpha-char-p ,x)
       (member ,x '(#\? #\% #\!) :test #'char=)))
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index e4729fe5..4277b954 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -146,9 +146,6 @@
       `(let ((,xx ,x))
          (and (consp ,xx) (qcdr ,xx))))))
 
-(defmacro maxindex (x)
- `(the fixnum (1- (the fixnum (length ,x)))))
-
 (defmacro minus (x)
  `(- ,x))
 
-- 
cgit v1.2.3