diff options
author | dos-reis <gdr@axiomatics.org> | 2008-11-16 05:35:54 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2008-11-16 05:35:54 +0000 |
commit | d4b6fd810d79d81b675967d52134f74967b53cf4 (patch) | |
tree | 772c30d2f627131b4ac8767a007203e05c47de00 | |
parent | 51b16d71759256e2ef9f9093e805432808516329 (diff) | |
download | open-axiom-d4b6fd810d79d81b675967d52134f74967b53cf4.tar.gz |
* interp/c-util.boot: Clean up.
* interp/database.boot: Likewise.
* interp/debug.lisp: Likewise.
* interp/define.boot: Likewise.
* interp/functor.boot: Likewise.
* interp/g-cndata.boot: Likewise.
* interp/g-opt.boot: Likewise.
* interp/g-util.boot: Likewise.
* interp/guess.boot: Likewise.
* interp/i-output.boot: Likewise.
* interp/macros.lisp: Likewise.
* interp/nrungo.boot: Likewise.
* interp/preparse.lisp: Likewise.
* interp/spad.lisp: Likewise.
* interp/sys-macros.lisp: Likewise.
* interp/trace.boot: Likewise.
* interp/types.boot: Likewise.
* interp/vmlisp.lisp: Likewise.
* interp/word.boot: Likewise.
-rw-r--r-- | src/ChangeLog | 22 | ||||
-rw-r--r-- | src/interp/Makefile.in | 8 | ||||
-rw-r--r-- | src/interp/Makefile.pamphlet | 8 | ||||
-rw-r--r-- | src/interp/c-util.boot | 8 | ||||
-rw-r--r-- | src/interp/database.boot | 1 | ||||
-rw-r--r-- | src/interp/debug.lisp | 18 | ||||
-rw-r--r-- | src/interp/define.boot | 4 | ||||
-rw-r--r-- | src/interp/functor.boot | 4 | ||||
-rw-r--r-- | src/interp/g-cndata.boot | 6 | ||||
-rw-r--r-- | src/interp/g-opt.boot | 4 | ||||
-rw-r--r-- | src/interp/g-util.boot | 2 | ||||
-rw-r--r-- | src/interp/guess.boot | 6 | ||||
-rw-r--r-- | src/interp/i-output.boot | 2 | ||||
-rw-r--r-- | src/interp/macros.lisp | 7 | ||||
-rw-r--r-- | src/interp/nrungo.boot | 4 | ||||
-rw-r--r-- | src/interp/preparse.lisp | 2 | ||||
-rw-r--r-- | src/interp/spad.lisp | 3 | ||||
-rw-r--r-- | src/interp/sys-macros.lisp | 8 | ||||
-rw-r--r-- | src/interp/trace.boot | 2 | ||||
-rw-r--r-- | src/interp/types.boot | 2 | ||||
-rw-r--r-- | src/interp/vmlisp.lisp | 40 | ||||
-rw-r--r-- | src/interp/word.boot | 6 |
22 files changed, 70 insertions, 97 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 07439f98..d42a58e8 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,27 @@ 2008-11-15 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/c-util.boot: Clean up. + * interp/database.boot: Likewise. + * interp/debug.lisp: Likewise. + * interp/define.boot: Likewise. + * interp/functor.boot: Likewise. + * interp/g-cndata.boot: Likewise. + * interp/g-opt.boot: Likewise. + * interp/g-util.boot: Likewise. + * interp/guess.boot: Likewise. + * interp/i-output.boot: Likewise. + * interp/macros.lisp: Likewise. + * interp/nrungo.boot: Likewise. + * interp/preparse.lisp: Likewise. + * interp/spad.lisp: Likewise. + * interp/sys-macros.lisp: Likewise. + * interp/trace.boot: Likewise. + * interp/types.boot: Likewise. + * interp/vmlisp.lisp: Likewise. + * interp/word.boot: Likewise. + +2008-11-15 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/package.boot: Fold content into functor.boot. Delete. * interp/Makefile.pamphlet: Adjust. diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index b15c1ed6..bac06488 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -302,18 +302,18 @@ setvart.$(FASLEXT): macros.$(FASLEXT) ## OpenAxiom's compiler wi2.$(FASLEXT): macros.$(FASLEXT) define.$(FASLEXT) wi1.$(FASLEXT): macros.$(FASLEXT) -compiler.$(FASLEXT): msgdb.$(FASLEXT) modemap.$(FASLEXT) \ +compiler.$(FASLEXT): msgdb.$(FASLEXT) \ pathname.$(FASLEXT) define.$(FASLEXT) iterator.$(FASLEXT) nrunopt.$(FASLEXT): c-util.$(FASLEXT) nrunfast.$(FASLEXT): c-util.$(FASLEXT) nruncomp.$(FASLEXT): nrunopt.$(FASLEXT) profile.$(FASLEXT) simpbool.$(FASLEXT) nrungo.$(FASLEXT): c-util.$(FASLEXT) clam.$(FASLEXT) interop.$(FASLEXT) iterator.$(FASLEXT): g-util.$(FASLEXT) -define.$(FASLEXT): g-error.$(FASLEXT) cattable.$(FASLEXT) \ - functor.$(FASLEXT) lisplib.$(FASLEXT) nruncomp.$(FASLEXT) +define.$(FASLEXT): g-error.$(FASLEXT) modemap.$(FASLEXT) \ + functor.$(FASLEXT) nruncomp.$(FASLEXT) database.$(FASLEXT) database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) \ cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT) -functor.$(FASLEXT): category.$(FASLEXT) c-util.$(FASLEXT) clam.$(FASLEXT) +functor.$(FASLEXT): category.$(FASLEXT) nrungo.$(FASLEXT) lisplib.$(FASLEXT) category.$(FASLEXT): g-util.$(FASLEXT) g-cndata.$(FASLEXT) cattable.$(FASLEXT): simpbool.$(FASLEXT) g-util.$(FASLEXT) compat.$(FASLEXT): pathname.$(FASLEXT) diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 8d53c817..a1dd3658 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -551,18 +551,18 @@ setvart.$(FASLEXT): macros.$(FASLEXT) ## OpenAxiom's compiler wi2.$(FASLEXT): macros.$(FASLEXT) define.$(FASLEXT) wi1.$(FASLEXT): macros.$(FASLEXT) -compiler.$(FASLEXT): msgdb.$(FASLEXT) modemap.$(FASLEXT) \ +compiler.$(FASLEXT): msgdb.$(FASLEXT) \ pathname.$(FASLEXT) define.$(FASLEXT) iterator.$(FASLEXT) nrunopt.$(FASLEXT): c-util.$(FASLEXT) nrunfast.$(FASLEXT): c-util.$(FASLEXT) nruncomp.$(FASLEXT): nrunopt.$(FASLEXT) profile.$(FASLEXT) simpbool.$(FASLEXT) nrungo.$(FASLEXT): c-util.$(FASLEXT) clam.$(FASLEXT) interop.$(FASLEXT) iterator.$(FASLEXT): g-util.$(FASLEXT) -define.$(FASLEXT): g-error.$(FASLEXT) cattable.$(FASLEXT) \ - functor.$(FASLEXT) lisplib.$(FASLEXT) nruncomp.$(FASLEXT) +define.$(FASLEXT): g-error.$(FASLEXT) modemap.$(FASLEXT) \ + functor.$(FASLEXT) nruncomp.$(FASLEXT) database.$(FASLEXT) database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) \ cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT) -functor.$(FASLEXT): category.$(FASLEXT) c-util.$(FASLEXT) clam.$(FASLEXT) +functor.$(FASLEXT): category.$(FASLEXT) nrungo.$(FASLEXT) lisplib.$(FASLEXT) category.$(FASLEXT): g-util.$(FASLEXT) g-cndata.$(FASLEXT) cattable.$(FASLEXT): simpbool.$(FASLEXT) g-util.$(FASLEXT) compat.$(FASLEXT): pathname.$(FASLEXT) diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index c680e8b9..b859fe80 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -357,7 +357,7 @@ printEnv E == TERPRI() SAY("Properties Of: ",first z) for u in rest z repeat - PRIN0 first u + PRIN1 first u printString ": " PRETTYPRINT tran(rest u,first u) where tran(val,prop) == @@ -372,7 +372,7 @@ prEnv E == TERPRI() SAY("Properties Of: ",first z) for u in rest z repeat - PRIN0 first u + PRIN1 first u printString ": " PRETTYPRINT tran(rest u,first u) where tran(val,prop) == @@ -387,7 +387,7 @@ prModemaps E == (modemap:= LASSOC("modemap",rest z)) repeat listOfOperatorsSeenSoFar:= [first z,:listOfOperatorsSeenSoFar] TERPRI() - PRIN0 first z + PRIN1 first z printString ": " PRETTYPRINT modemap @@ -671,7 +671,7 @@ stackAndThrow(msg, args == nil) == printString x == PRINTEXP (STRINGP x => x; PNAME x) -printAny x == if atom x then printString x else PRIN0 x +printAny x == if atom x then printString x else PRIN1 x printSignature(before,op,[target,:argSigList]) == printString before diff --git a/src/interp/database.boot b/src/interp/database.boot index 011f15c5..1b957c45 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -792,3 +792,4 @@ displayHiddenConstructors() == squeezeAll: %List -> %List squeezeAll x == [SQUEEZE t for t in x] + diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp index fbcdc575..a6cdc383 100644 --- a/src/interp/debug.lisp +++ b/src/interp/debug.lisp @@ -724,9 +724,9 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|)) (DEFUN MONITOR-BLANKS (N) (PRINC (MAKE-FULL-CVEC N " ") CURSTRM)) -(DEFUN MONITOR-EVALBEFORE (X) (EVALFUN (MONITOR-EVALTRAN X NIL)) X) +(DEFUN MONITOR-EVALBEFORE (X) (EVAL (MONITOR-EVALTRAN X NIL)) X) -(DEFUN MONITOR-EVALAFTER (X) (EVALFUN (MONITOR-EVALTRAN X 'T))) +(DEFUN MONITOR-EVALAFTER (X) (EVAL (MONITOR-EVALTRAN X 'T))) (DEFUN MONITOR-EVALTRAN (X FG) (if (HAS_SHARP_VAR X) (MONITOR-EVALTRAN1 X FG) X)) @@ -810,7 +810,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|)) ((PRINMATHOR0 X CURSTRM))))))) (DEFUN MONITOR-PRINARGS-1 (L N) - (COND ((OR (ATOM L) (LESSP N 1)) NIL) + (COND ((OR (ATOM L) (< N 1)) NIL) ((EQ N 1) (MONITOR-PRINT (CAR L) CURSTRM)) ((MONITOR-PRINARGS-1 (CDR L) (1- N))))) @@ -821,7 +821,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|)) (DEFUN PRINMATHOR0 (X CURSTRM) (if |$mathTrace| (|maprinSpecial| (|outputTran| X) /DEPTH 80) - (PRIN0 X CURSTRM))) + (PRIN1 X CURSTRM))) (DEFUN SMALL-ENOUGH (X) (if /TRACESIZE (SMALL-ENOUGH-COUNT X 0 /TRACESIZE) t)) @@ -997,7 +997,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|)) (RPLACD NOT_TOP_LEVEL (1+ (CDR NOT_TOP_LEVEL)))) (SETQ FUNDEPTH (CDR (ASSOC NAMEID |depthAlist| :test #'eq))) (SETQ CONDITION (MONITOR-EVALTRAN CONDITION NIL)) - (SETQ YES (EVALFUN CONDITION)) + (SETQ YES (EVAL CONDITION)) (if (member NAMEID |$mathTraceList| :test #'eq) (SETQ |$mathTrace| T)) (if (AND YES |$TraceFlag|) @@ -1006,14 +1006,14 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|)) (if (EQUAL TRACECODE "000") (RETURN NIL)) (TAB 0 CURSTRM) (MONITOR-BLANKS (1- /DEPTH)) - (PRIN0 FUNDEPTH CURSTRM) + (PRIN1 FUNDEPTH CURSTRM) (|sayBrightlyNT| (LIST "<enter" '|%b| NAME1 '|%d|) CURSTRM) (COND ((EQ 0 C) NIL) ((EQ TYPE 'MACRO) (PRINT " expanded" CURSTRM)) (T (PRINT " from " CURSTRM) - (PRIN0 /CALLER CURSTRM))) + (PRIN1 /CALLER CURSTRM))) (MONITOR-PRINARGS (if (SPADSYSNAMEP NAME) (NREVERSE (REVERSE (|coerceTraceArgs2E| @@ -1029,7 +1029,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|)) (if (member '|before| BREAK :test #'eq) (|break| (LIST "Break on entering" '|%b| NAME1 '|%d| ":"))) (if TIMERNAM (SETQ INIT_TIME (|startTimer|))) - (SETQ /VALUE (if (EQ TYPE 'MACRO) (MDEFX FUNCT /ARGS) + (SETQ /VALUE (if (EQ TYPE 'MACRO) (MDEF FUNCT /ARGS) (APPLY FUNCT /ARGS))) (|stopTimer|) (if TIMERNAM (SETQ EVAL_TIME (- (|clock|) INIT_TIME)) ) @@ -1041,7 +1041,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|)) (if (EQUAL TRACECODE "000") (GO SKIP)) (TAB 0 CURSTRM) (MONITOR-BLANKS (1- /DEPTH)) - (PRIN0 FUNDEPTH CURSTRM) + (PRIN1 FUNDEPTH CURSTRM) (|sayBrightlyNT| (LIST ">exit " '|%b| NAME1 '|%d|) CURSTRM) (COND (TIMERNAM (|sayBrightlyNT| '\( CURSTRM) diff --git a/src/interp/define.boot b/src/interp/define.boot index ee85d733..7fb4e2d4 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -33,9 +33,9 @@ import nruncomp import g_-error -import lisplib -import cattable +import database import functor +import modemap namespace BOOT diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 0d9db0d8..e77b50fa 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -32,8 +32,8 @@ -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -import c_-util -import clam +import lisplib +import nrungo import category namespace BOOT diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot index d6788b88..c0af28c2 100644 --- a/src/interp/g-cndata.boot +++ b/src/interp/g-cndata.boot @@ -112,7 +112,7 @@ getConstructorUnabbreviation op == abbreviation?(op) or throwKeyedMsg("S2IL0019",[op]) mkUserConstructorAbbreviation(c,a,type) == - if not atom c then c:= CAR c -- Existing constructors will be wrapped + if not atom c then c := first c -- Existing constructors will be wrapped constructorAbbreviationErrorCheck(c,a,type,'abbreviationError) clearClams() clearConstructorCache(c) @@ -135,10 +135,10 @@ constructorNameConflict(name,kind) == userError ["The name",:bright name,"conflicts with the name of an existing rule", "%l","please choose another ",kind] - + constructorAbbreviationErrorCheck(c,a,typ,errmess) == siz := SIZE (s := PNAME a) - if typ = 'category and siz > 7 + if typ = "category" and siz > 7 then throwKeyedErrorMsg('precompilation,"S2IL0021",NIL) if siz > 8 then throwKeyedErrorMsg('precompilation,"S2IL0006",NIL) if s ^= UPCASE s then throwKeyedMsg("S2IL0006",NIL) diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 8bf239fe..2a67c9c4 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -132,7 +132,7 @@ optSPADCALL(form is ['SPADCALL,:argl]) == null $InteractiveMode => form -- last arg is function/env, but may be a form argl is [:argl,fun] => - fun is ['ELT,dom,slot] or fun is ['LISPELT,dom,slot] => + fun is ['ELT,dom,slot] => optCall ['call,['ELT,dom,slot],:argl] form form @@ -338,7 +338,7 @@ optSETRECORDELT ["SETRECORDELT",name,ind,len,expr] == optRECORDCOPY ["RECORDCOPY",name,len] == len=1 => ["LIST",["CAR",name]] len=2 => ["CONS",["CAR",name],["CDR",name]] - ["MOVEVEC",["MAKE_-VEC",len],name] + ["REPLACE",["MAKE_-VEC",len],name] --mkRecordAccessFunction(ind,len) == -- stringOfDs:= $EmptyString diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 1d0efd2a..39302d6b 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -69,7 +69,7 @@ mkList u == ELEMN(x, n, d) == null x => d n = 1 => car x - ELEMN(cdr x, SUB1 n, d) + ELEMN(cdr x, n-1, d) PPtoFile(x, fname) == stream := DEFIOSTREAM([['MODE, :'OUTPUT], ['FILE, :fname]], 80, 0) diff --git a/src/interp/guess.boot b/src/interp/guess.boot index 1aeefc88..ccf9d9d2 100644 --- a/src/interp/guess.boot +++ b/src/interp/guess.boot @@ -69,13 +69,13 @@ wordsOfString(s) == [UPCASE x for x in wordsOfStringKeepCase s] wordsOfStringKeepCase s == wordsOfString1(s,0) or [COPY s] wordsOfString1(s,j) == - k := or/[i for i in j..SUB1(MAXINDEX(s)) | UPPER_-CASE_-P s.i] => + k := or/[i for i in j..(MAXINDEX(s)-1) | UPPER_-CASE_-P s.i] => tailWords:= UPPER_-CASE_-P s.(k+1) => - n:= or/[i for i in (k+2)..SUB1(MAXINDEX(s))|not UPPER_-CASE_-P s.i] + n:= or/[i for i in (k+2)..(MAXINDEX(s)-1)|not UPPER_-CASE_-P s.i] null n => [SUBSTRING(s,k,nil)] n > k+1 => [SUBSTRING(s,k,n-k-1),:wordsOfString1(s,n-1)] - m := or/[i for i in (k+2)..SUB1(MAXINDEX(s)) | UPPER_-CASE_-P s.i] => + m := or/[i for i in (k+2)..(MAXINDEX(s)-1) | UPPER_-CASE_-P s.i] => [SUBSTRING(s,k,m-k),:wordsOfString1(s,m)] [SUBSTRING(s,k,nil)] k > j+1 => [SUBSTRING(s,j,k-j),:tailWords] diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index be25b4ac..4d4841a1 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -1667,7 +1667,7 @@ printBasic x == x='(Zero) => PRIN1(0,$algebraOutputStream) IDENTP x => PRINTEXP(PNAME x,$algebraOutputStream) atom x => PRIN1(x,$algebraOutputStream) - PRIN0(x,$algebraOutputStream) + PRIN1(x,$algebraOutputStream) charybdis(u,start,linelength) == EQ(keyp u,'EQUATNUM) and ^(CDDR u) => diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp index 3426d93a..edb0b652 100644 --- a/src/interp/macros.lisp +++ b/src/interp/macros.lisp @@ -158,8 +158,6 @@ ; 14.1 Simple Sequence Functions -(define-function 'getchar #'elt) - (defun GETCHARN (A M) "Return the code of the Mth character of A" (let ((a (if (identp a) (symbol-name a) a))) (char-code (elt A M)))) @@ -177,9 +175,6 @@ (defun NSTRCONC (s1 s2) (concatenate 'string (string s1) (string s2))) -(define-function '|append| #'APPEND) - - (defun THETACHECK (VAL VAR OP) (if (EQL VAL VAR) (THETA_ERROR OP) val)) ; 15 LISTS @@ -203,8 +198,6 @@ (define-function 'LASTTAIL #'last) -(define-function 'LISPELT #'ELT) - (defun DROP (N X &aux m) "Return a pointer to the Nth cons of X, counting 0 as the first cons." (COND ((EQL N 0) X) diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot index 2acad7a1..b2a2f263 100644 --- a/src/interp/nrungo.boot +++ b/src/interp/nrungo.boot @@ -345,10 +345,10 @@ NRTisRecurrenceRelation(op,body,minivectorName) == pcl := [x for x in pcl | not (x is [''T,:mess] and (CONTAINED('throwMessage,mess) or CONTAINED('throwKeyedMsg,mess)))] - integer := EVALFUN $Integer + integer := eval $Integer iequalSlot:=compiledLookupCheck("=",[$Boolean,"$","$"],integer) lesspSlot:=compiledLookupCheck("<",[$Boolean,"$","$"],integer) - notpSlot:= compiledLookupCheck("not",["$","$"],EVALFUN $Boolean) + notpSlot:= compiledLookupCheck("not",["$","$"],eval $Boolean) for [p,c] in pcl repeat p is ['SPADCALL,sharpVar,n1,['ELT,=minivectorName,slot]] and EQ(iequalSlot,$minivector.slot) => diff --git a/src/interp/preparse.lisp b/src/interp/preparse.lisp index 2b92469e..48a44d41 100644 --- a/src/interp/preparse.lisp +++ b/src/interp/preparse.lisp @@ -158,7 +158,7 @@ (SETQ A "")) ('T (PUSH (STRCONC (GETFULLSTR N " ") (SUBSTRING A N ())) $LINELIST) - (SETQ $INDEX (SUB1 $INDEX)) + (SETQ $INDEX (1- $INDEX)) (SETQ A (SUBSEQ A 0 N)))) (GO NOCOMS)) ((= N OPARSYM) (setq PCOUNT (1+ PCOUNT))) diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp index a482848b..83283cfb 100644 --- a/src/interp/spad.lisp +++ b/src/interp/spad.lisp @@ -266,7 +266,6 @@ (if (zerop y) (truncate 1 Y) (multiple-value-call #'cons (TRUNCATE X Y)))) -(define-function 'list1 #'list) (define-function '|not| #'NOT) (defun |random| () (random (expt 2 26))) @@ -452,7 +451,7 @@ (DEFUN DECIMAL-LENGTH (X) (LET* ((K (FIX (* #.(LOG 2.0 10.) (INTEGER-LENGTH X)))) (X (TRUNCATE (ABS X) (EXPT 10 (1- K))))) - (IF (LESSP X 10) K (1+ K)))) + (IF (< X 10) K (1+ K)))) ;(DEFUN DECIMAL-LENGTH2 (X) ; (LET ((K (FIX (* #.(LOG 2.0 10.) (INTEGER-LENGTH X))))) diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp index 920d71d0..b66eb7c5 100644 --- a/src/interp/sys-macros.lisp +++ b/src/interp/sys-macros.lisp @@ -220,12 +220,12 @@ invocation of FN" (if (LT N 1) NIL - (CONS (EVAL FN) (NLIST (SUB1 N) FN)))) + (CONS (EVAL FN) (NLIST (1- N) FN)))) (defun TAILFN (X N) (if (LT N 1) X - (TAILFN (CDR X) (SUB1 N)))) + (TAILFN (CDR X) (1- N)))) )) @@ -374,8 +374,6 @@ (defmacro SPADDIFFERENCE (&rest x) `(- . ,x)) -(define-function 'QSEXPT #'expt) - ;; following macros assume 0 <= x,y < z (defmacro QSADDMOD (x y z) @@ -882,7 +880,7 @@ (defun NREVERSE-N (X AXIS) (COND ((EQL AXIS 0) (NREVERSE X)) - ((MAPCAR #'(LAMBDA (Y) (NREVERSE-N Y (SUB1 AXIS))) X)))) + ((MAPCAR #'(LAMBDA (Y) (NREVERSE-N Y (1- AXIS))) X)))) (defun REDUCE-1 (OP AXIS BOD) diff --git a/src/interp/trace.boot b/src/interp/trace.boot index 6d487e1f..e98991b5 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -589,7 +589,7 @@ letPrint(x,val,currentFunction) == if (y="all" or MEMQ(x,y)) and not (IS__GENVAR(x) or isSharpVarWithNum(x) or GENSYMP x) then sayBrightlyNT [:bright x,": "] - PRIN0 shortenForPrinting val + PRIN1 shortenForPrinting val TERPRI() if (y:= hasPair("BREAK",y)) and (y="all" or MEMQ(x,y) and diff --git a/src/interp/types.boot b/src/interp/types.boot index 66f3ce61..219b8d18 100644 --- a/src/interp/types.boot +++ b/src/interp/types.boot @@ -137,6 +137,6 @@ namespace BOOT %Modemap <=> %List -- modemap %ConstructorKind <=> -- kind of ctor instances - MEMBER("category","domain","package") + MEMBER(category,domain,package) %Shell <=> SIMPLE_-VECTOR -- constructor instantiation diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp index d08e6001..f3b49f6a 100644 --- a/src/interp/vmlisp.lisp +++ b/src/interp/vmlisp.lisp @@ -511,10 +511,6 @@ (defmacro subrp (x) `(compiled-function-p ,x)) -#-:CCL -(defmacro sub1 (x) - `(1- ,x)) - (defmacro throw-protect (exp1 exp2) `(unwind-protect ,exp1 ,exp2)) @@ -631,8 +627,6 @@ (declare (ignore sd)) (macroexpand `(,arg ,item))) -(define-function 'MDEFX #'MDEF) - ; 8.0 Operator Definition and Transformation ; 8.1 Definition and Transformation Operations @@ -697,8 +691,6 @@ (t (cons (remove-fluids (car arglist)) (remove-fluids (cdr arglist)))))) -(define-function 'KOMPILE #'COMP370) - ; 9.4 Vectors and Bpis (defun IVECP (x) (and (vectorp x) (subtypep (array-element-type x) 'integer))) @@ -826,25 +818,8 @@ (define-function 'FIX #'truncate) (define-function 'INT2RNUM #'float) -; 12.2 Predicates - -;(define-function 'lessp #'<) - -;(define-function 'greaterp #'>) - - -;(define-function 'fixp #'integerp) - ; 12.3 Computation -;(define-function 'add1 #'1+) -;(define-function 'sub1 #'1-) -;(define-function 'plus #'+) -;(define-function 'times #'*) -;(define-function 'difference #'-) -;(define-function 'minus #'-) -;(define-function 'absval #'abs) - (defun QUOTIENT (x y) (cond ((or (floatp x) (floatp y)) (/ x y)) (t (truncate x y)))) @@ -915,8 +890,6 @@ ; 14.2 Accessing -;(define-function 'lastnode #'last) -;(define-function 'lastpair #'last) (defun |last| (x) (car (lastpair x))) ; 14.3 Searching @@ -997,8 +970,6 @@ ; 16.2 Accessing -;(define-function 'FETCHCHAR #'char) - ;; Oddly, LENGTH is more efficient than LIST-LENGTH in CCL, since the former ;; is compiled and the latter is byte-coded! (defun size (l) @@ -1036,8 +1007,6 @@ (defun make-cvec (sint) (make-array sint :fill-pointer 0 :element-type 'character)) -;(define-function 'CVECP #'stringp) - (define-function 'getstr #'make-cvec) (defun make-full-cvec (sint &optional (char #\space)) @@ -1114,8 +1083,6 @@ (defun setsize (vector size) (adjust-array vector size)) -(define-function 'changelength #'setsize) - (defun trimstring (x) x) ;;-- (defun rplacstr (cvec1 start1 length1 cvec2 @@ -1492,13 +1459,10 @@ ; 24.0 Printing -;(define-function 'prin2cvec #'write-to-string) (define-function 'prin2cvec #'princ-to-string) -;(define-function 'stringimage #'write-to-string) (define-function 'stringimage #'princ-to-string) (define-function 'printexp #'princ) -(define-function 'prin0 #'prin1) (defun |F,PRINT-ONE| (form &optional (stream |$OutputStream|)) (declare (ignore stream)) @@ -1780,10 +1744,6 @@ (defun CALLBELOW (&rest junk) junk) ; to invoke system dependent code? -(define-function 'EVA1 #'eval) ;EVA1 and VMLISP EVAL make lexicals visible -(define-function 'EVALFUN #'eval) ;EVALFUN drops lexicals before evaluating -(define-function 'EVA1FUN #'EVALFUN) - (defun PLACEP (item) (eq item *read-place-holder*)) (defun VMREAD (&optional (st |$InputStream|) (eofval *read-place-holder*)) (read st nil eofval)) diff --git a/src/interp/word.boot b/src/interp/word.boot index 95dfc7a1..dc298f5f 100644 --- a/src/interp/word.boot +++ b/src/interp/word.boot @@ -106,13 +106,13 @@ wordsOfString(s) == [UPCASE x for x in wordsOfStringKeepCase s] wordsOfStringKeepCase s == wordsOfString1(s,0) or [COPY s] wordsOfString1(s,j) == - k := or/[i for i in j..SUB1(MAXINDEX(s)) | isBreakCharacter s.i] => + k := or/[i for i in j..(MAXINDEX(s)-1) | isBreakCharacter s.i] => tailWords:= isBreakCharacter s.(k+1) => - n:= or/[i for i in (k+2)..SUB1(MAXINDEX(s))|not isBreakCharacter s.i] + n:= or/[i for i in (k+2)..(MAXINDEX(s)-1)|not isBreakCharacter s.i] null n => [SUBSTRING(s,k,nil)] n > k+1 => [SUBSTRING(s,k,n-k-1),:wordsOfString1(s,n-1)] - m := or/[i for i in (k+2)..SUB1(MAXINDEX(s)) | isBreakCharacter s.i] => + m := or/[i for i in (k+2)..(MAXINDEX(s)-1) | isBreakCharacter s.i] => [SUBSTRING(s,k,m-k),:wordsOfString1(s,m)] [SUBSTRING(s,k,nil)] k > j+1 => [SUBSTRING(s,j,k-j),:tailWords] |