diff --git a/changelog b/changelog index d7408fa..6aa90a8 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20091027 tpd src/axiom-website/patches.html 20091027.03.tpd.patch +20091027 tpd src/interp/interp-proclaims migrate functions to boot package +20091027 tpd src/interp/vmlisp migrate functions to boot package 20091027 tpd src/axiom-website/patches.html 20091027.02.tpd.patch 20091027 tpd src/interp/interp-proclaims remove vmlisp 20091027 tpd src/interp/buildom.lisp remove vmlisp diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index eda57d6..f81c816 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2177,5 +2177,7 @@ src/axiom-website/developers.html identify Scott Penberthy
src/interp/vmlisp.lisp remove vmlisp package, conditionals
20091027.02.tpd.patch slam, buildom, interp-proclaims remove vmlisp
+20091027.03.tpd.patch +src/interp/vmlisp migrate functions to boot package
diff --git a/src/interp/interp-proclaims.lisp b/src/interp/interp-proclaims.lisp index afd29ce..c357db0 100644 --- a/src/interp/interp-proclaims.lisp +++ b/src/interp/interp-proclaims.lisp @@ -30,7 +30,7 @@ (PROCLAIM '(FTYPE (FUNCTION (STRING FIXNUM) T) BOOT::|subWord|)) (PROCLAIM '(FTYPE (FUNCTION (T T) FIXNUM) VMLISP:QSQUOTIENT - VMLISP:QSREMAINDER VMLISP:QENUM FOAM:|SetProgHashCode| + VMLISP:QSREMAINDER BOOT::QENUM FOAM:|SetProgHashCode| BOOT:GETCHARN BOOT::|attributeCategoryParentCount|)) (PROCLAIM '(FTYPE (FUNCTION (T T) (VALUES T T)) BOOT::|htMakeLabel| @@ -252,7 +252,7 @@ BOOT::L2DP BOOT::|Up2Expr| BOOT::|Qf2Qf| BOOT::|NDmp2NDmp| BOOT::|V2Rm| BOOT::|Qf2PF| BOOT::|Dmp2Mp| BOOT::|Up2Dmp| BOOT::|Sy2Var| BOOT::|Agg2Agg| BOOT::|Expr2Up| - BOOT::|Sy2Up| VMLISP:HPUT BOOT::|pvarCondList1| + BOOT::|Sy2Up| BOOT::HPUT BOOT::|pvarCondList1| VMLISP:SUBSTRING BOOT::|interpRewriteRule| BOOT::|putAtree| BOOT::|isEltable| BOOT::|selectMms| BOOT::|throwKeyedMsgSP| BOOT::|pushDownTargetInfo| @@ -529,7 +529,7 @@ BOOT::|braceApp| BOOT::|compSetq1| BOOT::|timesApp| BOOT::|rootApp| BOOT::|bracketApp| BOOT::|plusApp| BOOT::|appparu1| BOOT::|bigopWidth| BOOT::|P2Us| - BOOT::|pi2App| BOOT::|boxLApp| VMLISP:STRPOSL + BOOT::|pi2App| BOOT::|boxLApp| BOOT::STRPOSL BOOT::|compOrCroak1| BOOT::|piApp| BOOT::|compForm2| BOOT::|compForm3| BOOT::|getConditionalCategoryOfType1| BOOT::|indefIntegralApp| BOOT::|nothingApp| @@ -1302,7 +1302,7 @@ BOOT::|args2HtString| BOOT::|dc| BOOT::|bcNameCountTable| VMLISP::MAKE-LIBSTREAM BOOT::|nextown1| BOOT::|next1| BOOT::|incAppend1| BOOT::|synonym| BOOT::|grepConstruct| - VMLISP::LOTSOF BOOT::|htBeginMenu| BOOT::|bcCon| + BOOT::LOTSOF BOOT::|htBeginMenu| BOOT::|bcCon| BOOT::|koOps| BOOT::|dbWriteLines| BOOT::|catsOf| BOOT::|getDomainOpTable| BOOT:|PlainError| BOOT:|PlainPrint| BOOT::|htInitPageNoScroll| @@ -1590,10 +1590,10 @@ BOOT::|htEscapeString| BOOT::|e01safSolve,f| BOOT::|e04ucfSolve,fe| BOOT::|e01befSolve,f| BOOT::|e01bffSolve,g| VMLISP:LOG2 BOOT::|e01dafSolve,g| - BOOT::|e01dafSolve,f| VMLISP:SIZE VMLISP:EOFP + BOOT::|e01dafSolve,f| BOOT::SIZE VMLISP:EOFP BOOT::|e01bffSolve,f| VMLISP:RSHUT BOOT::|e04ucfSolve,fd| BOOT::|e01bhfSolve,f| BOOT::|objVal| BOOT::|getValue| - BOOT::|getMode| BOOT::|getUnname| VMLISP:DIGITP + BOOT::|getMode| BOOT::|getUnname| BOOT::DIGITP BOOT::|bottomUp| BOOT::|mkAtreeNode| VMLISP:VEC2LIST VMLISP:MAKE-VEC VMLISP:GCMSG BOOT::|retract| BOOT::|getUnionOrRecordTags| BOOT::|e02dcfColdSolve,h| diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index 6eeab54..2843530 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -1,4 +1,4 @@ -\documentclass{article} +documentclass{article} \usepackage{axiom} \begin{document} \title{\$SPAD/src/interp depsys.lisp} @@ -27,9 +27,19 @@ (in-package "VMLISP") -(export '(MAKE-HASHTABLE HGET HKEYS HCOUNT HPUT HPUT* HREM HCLEAR HREMPROP +(export '(MAKE-HASHTABLE HCOUNT HPUT* HREM HCLEAR HREMPROP HASHEQ HASHUEQUAL HASHCVEC HASHID HASHTABLEP CVEC UEQUAL ID HPUTPROP HASHTABLE-CLASS)) +(import '(BOOT::QENUM )) +(import '(BOOT::STRPOSL )) +(import '(BOOT::STRPOS )) +(import '(BOOT::SIZE )) +(import '(BOOT::DIGITP)) +(import '(BOOT::HGET )) +(import '(BOOT::HPUT )) +(import '(BOOT::|startsId?| )) +(import '(BOOT::LOTSOF )) +(import '(BOOT::WRAP)) (setq *features* (adjoin :common-lisp *features*)) @@ -458,9 +468,6 @@ (defmacro smintp (n) `(typep ,n 'fixnum)) -(defmacro |startsId?| (x) - `(or (alpha-char-p ,x) (member ,x '(#\? #\% #\!) :test #'char=))) - (defmacro stringlength (x) `(length (the string ,x))) @@ -519,18 +526,6 @@ (CONS (QUOTE ,INNER-FUNC) (WRAP (cdr ,ARGS) ',CONTROL))))))) -(defun WRAP (LIST-OF-ITEMS WRAPPER) - (prog nil - (COND ((OR (NOT (PAIRP LIST-OF-ITEMS)) (not WRAPPER)) - (RETURN LIST-OF-ITEMS)) - ((NOT (consp WRAPPER)) - (SETQ WRAPPER (LOTSOF WRAPPER)))) - (RETURN - (CONS (if (first WRAPPER) - `(,(first WRAPPER) ,(first LIST-OF-ITEMS)) - (first LIST-OF-ITEMS)) - (WRAP (cdr LIST-OF-ITEMS) (cdr WRAPPER)))))) - (defun ISQUOTEDP (bv) (COND ((NOT (consp BV)) NIL) ((EQ (first BV) 'QUOTE)) @@ -551,10 +546,6 @@ ((CONS (if (EQ 'QUOTE (IFCAR (CAR BV))) (CADAR BV) (first BV)) (DEQUOTE (cdr BV)))))) -(defun lotsof (&rest items) - (setq items (copy-list items)) - (nconc items items)) - ; 7.4 Using Macros ; Beats me how to simulate macro expansion "in the environment of sd"...: @@ -644,11 +635,6 @@ (defun gensymp (x) (and (symbolp x) (null (symbol-package x)))) -(defun digitp (x) - (or (and (symbolp x) (digitp (symbol-name x))) - (and (characterp x) (digit-char-p x)) - (and (stringp x) (= (length x) 1) (digit-char-p (char x 0))))) - (defun dig2fix (x) (if (symbolp x) (digit-char-p (char (symbol-name x) 0)) @@ -944,13 +930,6 @@ can be restored. ;(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) - (cond ((vectorp l) (length l)) - ((consp l) (list-length l)) - (t 0))) - (define-function 'MOVEVEC #'replace) ; 17.0 Operations on Character and Bit Vectors @@ -981,8 +960,6 @@ can be restored. ; 17.2 Accessing -(defun QENUM (cvec ind) (char-code (char cvec ind))) - (defun QESET (cvec ind charnum) (setf (char cvec ind) (code-char charnum))) @@ -1003,25 +980,6 @@ can be restored. ; 17.3 Searching -(defun strpos (what in start dontcare) - (setq what (string what) in (string in)) - (if dontcare (progn (setq dontcare (character dontcare)) - (search what in :start2 start - :test #'(lambda (x y) (or (eql x dontcare) - (eql x y))))) - (if (= start 0) - (search what in) - (search what in :start2 start)) - )) - -; In the following, table should be a string: - -(defun strposl (table cvec sint item) - (setq cvec (string cvec)) - (if (not item) - (position table cvec :test #'(lambda (x y) (position y x)) :start sint) - (position table cvec :test-not #'(lambda (x y) (position y x)) :start sint))) - ; 17.4 Updating operators (defun suffix (id cvec) @@ -1859,14 +1817,6 @@ and works properly. ;17.2 Accessing -(defmacro HGET (table key &rest default) - `(gethash ,key ,table ,@default)) - -(defun HKEYS (table) - (let (keys) - (maphash - #'(lambda (key val) (declare (ignore val)) (push key keys)) table) - keys)) @ The static declaration causes a problem as of GCL-2.6.8pre. @@ -1893,8 +1843,6 @@ Camm issued a fix. This used to read: ;17.4 Searching and Updating -(defun HPUT (table key value) (setf (gethash key table) value)) - (defun HPUT* (table alist) (mapc #'(lambda (pair) (hput table (car pair) (cdr pair))) alist))