diff options
author | dos-reis <gdr@axiomatics.org> | 2012-05-08 10:10:34 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2012-05-08 10:10:34 +0000 |
commit | 5852b522a6637ecde8dbc53204b3cd00c565fae9 (patch) | |
tree | c8ec7d45df02f249ee88568a30145305879ff32b | |
parent | aaf651bcb0b8b0cef21cc4e5cceb1be231d5a2b7 (diff) | |
download | open-axiom-5852b522a6637ecde8dbc53204b3cd00c565fae9.tar.gz |
* 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.
-rw-r--r-- | src/ChangeLog | 22 | ||||
-rw-r--r-- | src/boot/strap/tokens.clisp | 13 | ||||
-rw-r--r-- | src/boot/tokens.boot | 6 | ||||
-rw-r--r-- | src/interp/bootlex.lisp | 2 | ||||
-rw-r--r-- | src/interp/br-search.boot | 4 | ||||
-rw-r--r-- | src/interp/database.boot | 2 | ||||
-rw-r--r-- | src/interp/debug.lisp | 8 | ||||
-rw-r--r-- | src/interp/g-util.boot | 2 | ||||
-rw-r--r-- | src/interp/ht-root.boot | 4 | ||||
-rw-r--r-- | src/interp/i-output.boot | 2 | ||||
-rw-r--r-- | src/interp/i-syscmd.boot | 3 | ||||
-rw-r--r-- | src/interp/io.boot | 13 | ||||
-rw-r--r-- | src/interp/macros.lisp | 12 | ||||
-rw-r--r-- | src/interp/parsing.lisp | 2 | ||||
-rw-r--r-- | src/interp/preparse.lisp | 12 | ||||
-rw-r--r-- | src/interp/sys-macros.lisp | 11 | ||||
-rw-r--r-- | src/interp/vmlisp.lisp | 3 | ||||
-rw-r--r-- | 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| () |