aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog22
-rw-r--r--src/boot/strap/tokens.clisp13
-rw-r--r--src/boot/tokens.boot6
-rw-r--r--src/interp/bootlex.lisp2
-rw-r--r--src/interp/br-search.boot4
-rw-r--r--src/interp/database.boot2
-rw-r--r--src/interp/debug.lisp8
-rw-r--r--src/interp/g-util.boot2
-rw-r--r--src/interp/ht-root.boot4
-rw-r--r--src/interp/i-output.boot2
-rw-r--r--src/interp/i-syscmd.boot3
-rw-r--r--src/interp/io.boot13
-rw-r--r--src/interp/macros.lisp12
-rw-r--r--src/interp/parsing.lisp2
-rw-r--r--src/interp/preparse.lisp12
-rw-r--r--src/interp/sys-macros.lisp11
-rw-r--r--src/interp/vmlisp.lisp3
-rw-r--r--src/lisp/core.lisp.in5
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| ()
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-27 02:18:20 +0000