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/ChangeLog               | 22 ++++++++++++++++++++++
 src/boot/strap/tokens.clisp | 13 +++++++------
 src/boot/tokens.boot        |  6 +++---
 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 ---
 src/lisp/core.lisp.in       |  5 +++++
 18 files changed, 73 insertions(+), 53 deletions(-)

diff --git a/src/ChangeLog b/src/ChangeLog
index 9124b020..8e1bee19 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,25 @@
+2012-05-08  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* 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.
+
 2012-05-07  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/spad.lisp (INIT-BOOT/SPAD-READER): Don't set FILE-CLOSED.
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 7b16a885..8dd98d44 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -6,7 +6,9 @@
 (PROVIDE "tokens")
 
 (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
-  (EXPORT '|$InteractiveMode|))
+  (EXPORT '(|$InteractiveMode| |char|)))
+
+(DECLAIM (FTYPE (FUNCTION (|%Symbol|) |%Char|) |char|))
 
 (DEFPARAMETER |$InteractiveMode| NIL)
 
@@ -211,11 +213,10 @@
              (LIST '|genvar| 'GENVAR) (LIST '|integer?| 'INTEGERP)
              (LIST 'LAST '|last|) (LIST '|list| 'LIST) (LIST '|listEq?| 'EQUAL)
              (LIST '|lowerCase?| 'LOWER-CASE-P) (LIST '|makeSymbol| 'INTERN)
-             (LIST '|maxIndex| 'MAXINDEX) (LIST '|mkpf| 'MKPF)
-             (LIST '|newVector| 'MAKE-ARRAY) (LIST '|nil| NIL)
-             (LIST '|not| 'NOT) (LIST '|null| 'NULL) (LIST '|odd?| 'ODDP)
-             (LIST '|or| 'OR) (LIST '|otherwise| 'T) (LIST '|property| 'GET)
-             (LIST '|readInteger| 'PARSE-INTEGER)
+             (LIST '|mkpf| 'MKPF) (LIST '|newVector| 'MAKE-ARRAY)
+             (LIST '|nil| NIL) (LIST '|not| 'NOT) (LIST '|null| 'NULL)
+             (LIST '|odd?| 'ODDP) (LIST '|or| 'OR) (LIST '|otherwise| 'T)
+             (LIST '|property| 'GET) (LIST '|readInteger| 'PARSE-INTEGER)
              (LIST '|readLispFromString| 'READ-FROM-STRING)
              (LIST '|readOnly?| 'CONSTANTP) (LIST '|removeDuplicates| 'REMDUP)
              (LIST '|rest| 'CDR) (LIST '|sameObject?| 'EQ)
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index b9a2e2a8..bcfa8e52 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.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
@@ -34,7 +34,8 @@
 
 import utility
 namespace BOOTTRAN
-module tokens ($InteractiveMode)
+module tokens ($InteractiveMode, char) where
+  char: %Symbol -> %Char
 
 ++ If true, means the system is in interactive mode.
 $InteractiveMode := false
@@ -279,7 +280,6 @@ for i in [ _
   ["listEq?",    "EQUAL"] , _
   ["lowerCase?", "LOWER-CASE-P"], _
   ["makeSymbol", "INTERN"] , _
-  ["maxIndex", "MAXINDEX"] , _
   ["mkpf",        "MKPF"]  , _
   ["newVector", "MAKE-ARRAY"], _
   ["nil"           ,NIL ]  , _
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))
 
diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in
index 27808ad2..3fe31dae 100644
--- a/src/lisp/core.lisp.in
+++ b/src/lisp/core.lisp.in
@@ -152,6 +152,7 @@
 	   "mkVector"
 	   "mkIntArray"
 	   "listToString"
+	   "maxIndex"
 
            "%hasFeature"
 	   "%systemOptions"
@@ -1396,6 +1397,10 @@
 ;; -*- Native Datatype correspondance -*-
 ;; 
 
+(defmacro |maxIndex| (x)
+  `(1- (length ,x)))
+
+
 ;; Datatype for buffers mostly used for transmitting data between
 ;; the Lisp world and Native World.
 (deftype |%ByteArray| ()
-- 
cgit v1.2.3