github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-02-27 01:19:42 +00:00
Code Issues Projects Releases Wiki Activity

Add support for cl: loop for hash tables (#1605)

Browse Source 
* Add support for cl: loop for hash tables
* fix subtle package problems setting up LISP package & conflicts with CLOS
* include fix for 'repeat n' clause
* remake in lower-case p make diffs legible, dfasl for defuns
This commit is contained in:
Larry Masinter
2024-04-17 16:21:22 -07:00
committed by GitHub
parent 3564f502e4
commit 92fd33eaad
15 changed files with 578 additions and 461 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
clos/clos-env.DFASL
View File

Binary file not shown.

2
clos/clos-env.lisp
View File

@@ -1505,7 +1505,7 @@ window"
(setf (sedit:get-format 'call-next-method)
'(:indent (1) :args (:keyword nil)))
(setf (sedit:get-format 'symbol-macrolet) 'let)
(setf (sedit:get-format 'cl:symbol-macrolet) 'let)
(setf (sedit:get-format 'with-accessors)
'(:indent ((1) 1)

BIN
clos/pkg.dfasl
View File

Binary file not shown.

6
clos/pkg.lisp
View File

@@ -1,16 +1,12 @@
;;;-*- Package: CLOS; Syntax: Common-Lisp; Base: 10 -*-
;;; File converted on 26-Mar-91 10:23:29 from source pkg
;;;. Original source {dsk}<usr>local>users>welch>lisp>clos>rev4>il-format>pkg.;4 created 1-Mar-91 10:10:26
;;;. Copyright (c) 1991 by Venue
(in-package "CLOS")
;;; Some CommonLisps have more symbols in the Lisp package than the ones that are explicitly
;;; specified in CLtL. This causes trouble. Any Lisp that has extra symbols in the Lisp package
;;; should shadow those symbols in the CLOS package.
@@ -31,7 +27,7 @@
no-applicable-method no-next-method print-object reinitialize-instance remove-method
shared-initialize slot-boundp slot-exists-p slot-makunbound slot-missing slot-unbound
slot-value standard standard-class standard-generic-function standard-method
standard-object structure-class symbol-macrolet update-instance-for-different-class
standard-object structure-class update-instance-for-different-class
update-instance-for-redefined-class with-accessors with-added-methods with-slots))
(import '(xcl:false xcl:destructuring-bind xcl:true) *the-clos-package*)

15
internal/loadups/LOADUP-LISP
View File

@@ -1,13 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "14-Mar-2024 12:16:33" |{DSK}<home>larry>il>medley>internal>loadups>LOADUP-LISP.;2| 5426
(FILECREATED "21-Mar-2024 10:56:13" |{DSK}<home>larry>il>medley>internal>loadups>LOADUP-LISP.;4| 5586
:EDIT-BY "lmm"
:CHANGES-TO (FNS LOADUP-LISP)
:PREVIOUS-DATE "31-Jul-2023 18:22:53"
|{DSK}<home>larry>il>medley>internal>loadups>LOADUP-LISP.;1|)
:PREVIOUS-DATE "14-Mar-2024 12:16:33"
|{DSK}<home>larry>il>medley>internal>loadups>LOADUP-LISP.;3|)
(PRETTYCOMPRINT LOADUP-LISPCOMS)
@@ -20,7 +20,8 @@
(DEFINEQ
(LOADUP-LISP
(LAMBDA (DRIBBLEFILE) (* \; "Edited 14-Mar-2024 12:16 by lmm")
(LAMBDA (DRIBBLEFILE) (* \; "Edited 21-Mar-2024 10:55 by lmm")
(* \; "Edited 14-Mar-2024 12:16 by lmm")
(* \; "Edited 26-Feb-2023 12:17 by lmm")
(* \; "Edited 13-Jul-2022 14:09 by rmk")
(* \; "Edited 4-Mar-2022 19:13 by larry")
@@ -110,9 +111,9 @@
(PACKAGE-ENABLE)
(* |;;| " Added late")
(* |;;| " Added late, LOAD late to avoid any dependencies")
(LOADUP '(XCL-LOOP))
(LOADUP '(XCL-LOOP XCL-HASH-LOOP))
(* |;;| " networking code -- should make it optional but too many cross dependencies")
@@ -130,5 +131,5 @@
(GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
)
(DECLARE\: DONTCOPY
(FILEMAP (NIL (673 5220 (LOADUP-LISP 683 . 5218)))))
(FILEMAP (NIL (673 5380 (LOADUP-LISP 683 . 5378)))))
STOP

BIN
internal/loadups/LOADUP-LISP.LCOM
View File

Binary file not shown.

51
sources/PACKAGE-STARTUP
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "16-Mar-2024 08:28:55" |{DSK}<home>larry>il>medley>sources>PACKAGE-STARTUP.;2| 36546
(FILECREATED "21-Mar-2024 10:21:14" |{DSK}<home>larry>il>medley>sources>PACKAGE-STARTUP.;9| 36658
:EDIT-BY "lmm"
:CHANGES-TO (VARIABLES CMLSYMBOLS.MACROS)
:CHANGES-TO (VARIABLES CMLSYMBOLS.DECLARATORS CMLSYMBOLS.SHARED)
:PREVIOUS-DATE " 1-Aug-2021 18:08:23" |{DSK}<home>larry>il>medley>sources>PACKAGE-STARTUP.;1|
:PREVIOUS-DATE "20-Mar-2024 23:34:56" |{DSK}<home>larry>il>medley>sources>PACKAGE-STARTUP.;8|
)
@@ -311,8 +311,8 @@
"VECTOR-PUSH-EXTEND" "VECTORP" "WARN" "WRITE" "WRITE-BYTE" "WRITE-CHAR" "WRITE-LINE"
"WRITE-STRING" "WRITE-TO-STRING" "Y-OR-N-P" "YES-OR-NO-P" "ZEROP"))
(CL:DEFPARAMETER CMLSYMBOLS.DECLARATORS '("DECLARATION" "FTYPE" "FUNCTION" "IGNORE" "INLINE"
"NOTINLINE" "OPTIMIZE" "SPECIAL" "TYPE"))
(CL:DEFPARAMETER CMLSYMBOLS.DECLARATORS '("DECLARATION" "FTYPE" "FUNCTION" "IGNORE" "IGNORABLE"
"INLINE" "NOTINLINE" "OPTIMIZE" "SPECIAL" "TYPE"))
(CL:DEFPARAMETER CMLSYMBOLS.TYPENAMES
'("ARRAY" "ATOM" "BIGNUM" "BIT" "BIT-VECTOR" "CHARACTER" "COMMON" "COMPILED-FUNCTION" "COMPLEX"
@@ -327,10 +327,11 @@
"DEFINE-MODIFY-MACRO" "DEFINE-SETF-METHOD" "DEFMACRO" "DEFPARAMETER" "DEFSETF" "DEFSTRUCT"
"DEFTYPE" "DEFUN" "DEFVAR" "DO" "DO*" "DO-ALL-SYMBOLS" "DO-EXTERNAL-SYMBOLS" "DO-SYMBOLS"
"DOLIST" "DOTIMES" "ECASE" "ETYPECASE" "INCF" "LOCALLY" "LOOP" "LOOP-FINISH"
"MULTIPLE-VALUE-BIND" "MULTIPLE-VALUE-LIST" "MULTIPLE-VALUE-SETQ" "OR" "POP" "PROG"
"PROG*" "PROG1" "PROG2" "PSETF" "PSETQ" "PUSH" "PUSHNEW" "REMF" "RETURN" "ROTATEF" "SETF"
"SHIFTF" "STEP" "TIME" "TRACE" "TYPECASE" "UNLESS" "UNTRACE" "WHEN"
"WITH-INPUT-FROM-STRING" "WITH-OPEN-FILE" "WITH-OPEN-STREAM" "WITH-OUTPUT-TO-STRING"))
"WITH-HASH-TABLE-ITERATOR" "WITH-PACKAGE-ITERATOR" "MULTIPLE-VALUE-BIND"
"MULTIPLE-VALUE-LIST" "MULTIPLE-VALUE-SETQ" "OR" "POP" "PROG" "PROG*" "PROG1" "PROG2"
"PSETF" "PSETQ" "PUSH" "PUSHNEW" "REMF" "RETURN" "ROTATEF" "SETF" "SHIFTF" "STEP" "TIME"
"TRACE" "TYPECASE" "UNLESS" "UNTRACE" "WHEN" "WITH-INPUT-FROM-STRING" "WITH-OPEN-FILE"
"WITH-OPEN-STREAM" "WITH-OUTPUT-TO-STRING"))
(CL:DEFPARAMETER CMLSYMBOLS.SPECIALFORMS
'("BLOCK" "CATCH" "COMPILER-LET" "DECLARE" "EVAL-WHEN" "FLET" "FUNCTION" "GO" "IF" "LABELS"
@@ -353,12 +354,12 @@
"CADADR" "CADAR" "CADDAR" "CADDDR" "CADDR" "CADR" "CAR" "CASE" "CDAAAR" "CDAADR" "CDAAR"
"CDADAR" "CDADDR" "CDADR" "CDAR" "CDDAAR" "CDDADR" "CDDAR" "CDDDAR" "CDDDDR" "CDDDR" "CDDR"
"CDR" "CLRHASH" "COERCE" "COMPLEX" "COND" "CONS" "DECLARE" "DEFMACRO" "DPB" "DRIBBLE" "ED"
"EQ" "EQL" "EVENP" "EXPORT" "FLOAT" "GET" "GO" "IGNORE" "IMPORT" "INSPECT" "INTEGER" "LAST"
"LDB" "LET" "LET*" "LIST" "LIST*" "LOGAND" "LOGNOT" "LOGXOR" "MAX" "MIN" "MINUSP" "NCONC"
"NIL" "NOT" "NULL" "ODDP" "OPEN" "OR" "PACKAGE" "PATHNAME" "PROG" "PROG*" "PROG1" "PROG2"
"PROGN" "QUOTE" "RANDOM-STATE" "RATIO" "READTABLEP" "REMHASH" "REMPROP" "RETURN" "ROUND"
"RPLACA" "RPLACD" "SATISFIES" "SEQUENCE" "SET" "STRING" "STRING-EQUAL" "STREAM" "STREAMP"
"T" "TAILP" "THE" "TIME" "TRACE" "TYPE" "TYPEP" "UNTRACE" "WRITE")
"EQ" "EQL" "EVENP" "EXPORT" "FLOAT" "GET" "GO" "IGNORE" "IGNORABLE" "IMPORT" "INSPECT"
"INTEGER" "LAST" "LDB" "LET" "LET*" "LIST" "LIST*" "LOGAND" "LOGNOT" "LOGXOR" "MAX" "MIN"
"MINUSP" "NCONC" "NIL" "NOT" "NULL" "ODDP" "OPEN" "OR" "PACKAGE" "PATHNAME" "PROG" "PROG*"
"PROG1" "PROG2" "PROGN" "QUOTE" "RANDOM-STATE" "RATIO" "READTABLEP" "REMHASH" "REMPROP"
"RETURN" "ROUND" "RPLACA" "RPLACD" "SATISFIES" "SEQUENCE" "SET" "STRING" "STRING-EQUAL"
"STREAM" "STREAMP" "T" "TAILP" "THE" "TIME" "TRACE" "TYPE" "TYPEP" "UNTRACE" "WRITE")
(* |;;;| "Symbols shared by the Interlisp and Lisp packages.")
@@ -643,14 +644,14 @@
(PACKAGE-INIT)
)
(DECLARE\: DONTCOPY
(FILEMAP (NIL (3015 3110 (RETURN-FIRST-OF-THREE 3015 . 3110)) (3112 3250 (
ERROR-MISSING-EXTERNAL-SYMBOL 3112 . 3250)) (3857 4825 (CHECK-SYMBOL-NAMESTRING 3857 . 4825)) (4827
7985 (\\NEW.READ.SYMBOL 4827 . 7985)) (7987 9697 (\\NEW.MKATOM 7987 . 9697)) (23437 23519 (
LITATOM.EXISTS 23437 . 23519)) (24199 25205 (NAMESTRING-CONVERSION-CLAUSE 24199 . 25205)) (25207 26462
(CONVERT-LITATOM 25207 . 26462)) (26464 28537 (CONCOCT-SYMBOL 26464 . 28537)) (28539 28833 (
TRANSFER-SYMBOL 28539 . 28833)) (28835 29543 (INTERN-LITATOM 28835 . 29543)) (29545 30224 (
\\LITATOM.EATCHARS 29545 . 30224)) (30226 30503 (PACKAGE-INIT 30226 . 30503)) (30505 31078 (
PACKAGE-CLEAR 30505 . 31078)) (31080 32471 (PACKAGE-MAKE 31080 . 32471)) (32473 33785 (
PACKAGE-HIERARCHY-INIT 32473 . 33785)) (33787 35396 (PACKAGE-ENABLE 33787 . 35396)) (35398 36041 (
PACKAGE-DISABLE 35398 . 36041)) (36088 36114 (ID 36088 . 36114)))))
(FILEMAP (NIL (3038 3133 (RETURN-FIRST-OF-THREE 3038 . 3133)) (3135 3273 (
ERROR-MISSING-EXTERNAL-SYMBOL 3135 . 3273)) (3880 4848 (CHECK-SYMBOL-NAMESTRING 3880 . 4848)) (4850
8008 (\\NEW.READ.SYMBOL 4850 . 8008)) (8010 9720 (\\NEW.MKATOM 8010 . 9720)) (23549 23631 (
LITATOM.EXISTS 23549 . 23631)) (24311 25317 (NAMESTRING-CONVERSION-CLAUSE 24311 . 25317)) (25319 26574
(CONVERT-LITATOM 25319 . 26574)) (26576 28649 (CONCOCT-SYMBOL 26576 . 28649)) (28651 28945 (
TRANSFER-SYMBOL 28651 . 28945)) (28947 29655 (INTERN-LITATOM 28947 . 29655)) (29657 30336 (
\\LITATOM.EATCHARS 29657 . 30336)) (30338 30615 (PACKAGE-INIT 30338 . 30615)) (30617 31190 (
PACKAGE-CLEAR 30617 . 31190)) (31192 32583 (PACKAGE-MAKE 31192 . 32583)) (32585 33897 (
PACKAGE-HIERARCHY-INIT 32585 . 33897)) (33899 35508 (PACKAGE-ENABLE 33899 . 35508)) (35510 36153 (
PACKAGE-DISABLE 35510 . 36153)) (36200 36226 (ID 36200 . 36226)))))
STOP

BIN
sources/PACKAGE-STARTUP.LCOM
View File

Binary file not shown.

102
sources/XCL-HASH-LOOP Normal file
View File

@@ -0,0 +1,102 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "21-Mar-2024 13:31:40" {DSK}<home>larry>il>medley>sources>XCL-HASH-LOOP.;9 4865
:EDIT-BY "lmm"
:CHANGES-TO (FUNCTIONS TEST-HASH-LOOP)
:PREVIOUS-DATE "21-Mar-2024 11:19:24" {DSK}<home>larry>il>medley>sources>XCL-HASH-LOOP.;8)
(PRETTYCOMPRINT XCL-HASH-LOOPCOMS)
(RPAQQ XCL-HASH-LOOPCOMS ((FUNCTIONS HASH-TABLE-ITERATOR HASH-TABLE-ITERATOR-1 TEST-HASH-LOOP
CL:WITH-HASH-TABLE-ITERATOR)
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
LLARRAYELT))
(PROP FILETYPE XCL-HASH-LOOP)))
(CL:DEFUN HASH-TABLE-ITERATOR (HASH-TABLE-LIST) (* ; "Edited 21-Mar-2024 09:49 by lmm")
[LET ((TABLES (MKLIST HASH-TABLE-LIST)))
(COND
((NULL TABLES)
NIL)
((NULL (CDR TABLES))
(HASH-TABLE-ITERATOR-1 (CAR TABLES)))
(T (LET [(ITERATOR (HASH-TABLE-ITERATOR-1 (CL:POP TABLES]
#'(CL:LAMBDA NIL (CL:LOOP (CL:MULTIPLE-VALUE-BIND
(MORE KEY VALUE)
(CL:FUNCALL ITERATOR)
(COND
(MORE (RETURN (CL:VALUES MORE KEY VALUE)))
[TABLES (CL:SETQ ITERATOR (HASH-TABLE-ITERATOR-1
(CL:POP TABLES]
(T (RETURN NIL])
(CL:DEFUN HASH-TABLE-ITERATOR-1 (TABLE) (* ; "Edited 19-Mar-2024 12:31 by lmm")
[LET* ((SLOT (fetch HARRAYPBASE of TABLE))
[LASTSLOT (fetch (HASHSLOT NEXTSLOT) of (\HASHSLOT SLOT (fetch (HARRAYP LASTINDEX)
of TABLE]
(NULLVALUE \HASH.NULL.VALUE)
K V)
#'(CL:LAMBDA NIL (CL:BLOCK ITERATOR
(CL:LOOP (SETQ K (fetch (HASHSLOT KEY) of SLOT))
(SETQ V (fetch (HASHSLOT VALUE) of SLOT))
(CL:WHEN V
(* ;; "first non-empty slot")
(RETURN))
(SETQ SLOT (fetch (HASHSLOT NEXTSLOT) of SLOT))
(CL:WHEN (EQ SLOT LASTSLOT)
(* ;; "Out of slots to scan")
(CL:RETURN-FROM ITERATOR NIL)))
(* ;; "SLOT is set and not at end")
[CL:RETURN-FROM ITERATOR (CL:MULTIPLE-VALUE-PROG1
(CL:VALUES T K (AND (NEQ NULLVALUE V)
V))
(SETQ SLOT (fetch (HASHSLOT NEXTSLOT)
of SLOT])])
(CL:DEFUN TEST-HASH-LOOP (&OPTIONAL HA) (* ; "Edited 21-Mar-2024 10:39 by lmm")
[IF (NOT HA)
THEN (SETQ HA (HARRAY 7))
(LET [(TRIALDATA '(1 2 A B "C" "D" 'EEEE 'FFFF (G)
(H]
(CL:LOOP FOR X ON TRIALDATA BY #'CDDR DO (CL:SETF (GETHASH (CL:FIRST X)
HA)
(CL:SECOND X]
(LET (RESULT LOOPRESULT)
[MAPHASH HA #'(LAMBDA (V K)
(PUSH RESULT (LIST K V]
(SETQ RESULT (REVERSE RESULT))
(SETQ LOOPRESULT (CL:LOOP FOR X BEING EACH HASH-KEY OF HA USING (HASH-VALUE V)
COLLECT
(LIST X V)))
(OR (EQUAL RESULT LOOPRESULT)
(COMPARELISTS RESULT LOOPRESULT))))
(DEFMACRO CL:WITH-HASH-TABLE-ITERATOR ((NAME HASH-TABLE-FORM)
&BODY BODY) (* ; "Edited 18-Mar-2024 09:38 by larry")
[LET ((ITERATOR (CL:GENSYM)))
`(LET [(,ITERATOR (HASH-TABLE-ITERATOR ,HASH-TABLE-FORM]
(DECLARE (IGNORABLE ,ITERATOR))
(CL:MACROLET [(,NAME NIL '(CL:FUNCALL ,ITERATOR]
,@BODY])
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
LLARRAYELT)
)
(PUTPROPS XCL-HASH-LOOP FILETYPE CL:COMPILE-FILE)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (755 1731 (HASH-TABLE-ITERATOR 755 . 1731)) (1733 3354 (HASH-TABLE-ITERATOR-1 1733 .
3354)) (3356 4284 (TEST-HASH-LOOP 3356 . 4284)) (4286 4705 (CL:WITH-HASH-TABLE-ITERATOR 4286 . 4705)))
))
STOP

BIN
sources/XCL-HASH-LOOP.DFASL Normal file
View File

Binary file not shown.

145
sources/XCL-LOOP
View File

@@ -1,12 +1,13 @@
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "LOOP" (USE "LISP" "XCL")) READTABLE "XCL" BASE 10)
(il:filecreated "16-Mar-2024 17:53:42" il:|{DSK}<home>larry>il>medley>sources>XCL-LOOP.;23| 61443
(il:filecreated " 8-Apr-2024 19:38:27" il:|{DSK}<home>larry>il>medley>sources>XCL-LOOP.;13| 61862
:edit-by "lmm"
:changes-to (il:functions with-temporaries)
:changes-to (il:vars il:xcl-loopcoms)
(il:functions cl::symbol-macrolet with-list-accumulator)
:previous-date "16-Mar-2024 11:13:11" il:|{DSK}<home>larry>il>medley>sources>XCL-LOOP.;22|)
:previous-date " 2-Apr-2024 15:08:27" il:|{DSK}<home>larry>il>medley>sources>XCL-LOOP.;12|)
(il:prettycomprint il:xcl-loopcoms)
@@ -39,8 +40,8 @@
multiple-value-list-argument-form multiple-value-list-form-p name-clause? one
ordinary-bindings preposition1 preposition? psetq-forms quoted-form-p quoted-object
reduce-redundant-code repeat-clause return-clause selectable-clause simple-loop
simple-var-p simple-var1 stray-of-type-error type-spec? until-clause
using-other-var variable-clause* while-clause with with-accumulators
simple-var-p simple-var1 stray-of-type-error cl::symbol-macrolet type-spec?
until-clause using-other-var variable-clause* while-clause with with-accumulators
with-binding-forms with-clause with-iterator-forms with-list-accumulator
with-loop-context with-numeric-accumulator with-temporaries zero)
(il:functions loop)
@@ -1152,15 +1153,11 @@
(getf *loop-components* :tail)
(nreverse rtail)))))
(defun repeat-clause ()
(let* ((form (form1))
(type (typecase (if (quoted-form-p form)
(quoted-object form)
form)
(fixnum 'fixnum)
(t 'real))))
(lp :for (gensym)
:of-type type :downfrom form :to 1)))
(defun repeat-clause () (il:* il:\; "Edited 2-Apr-2024 12:55 by lmm")
(let ((form (form1)))
(lp :for (gensym)
:downfrom form :to 1)
(clause*)))
(defun return-clause ()
(lp :do `(return-from ,*loop-name* ,(form-or-it))))
@@ -1196,6 +1193,14 @@
(defun stray-of-type-error ()
(loop-error "OF-TYPE keyword should be followed by a type spec."))
(defmacro cl::symbol-macrolet (vardefs &body body) (il:* il:\; "Edited 24-Mar-2024 21:46 by lmm")
(il:* il:|;;| "")
`(progn ,@(il:subpair (cons 'setq (mapcar vardefs #'car))
(cons 'setf (mapcar vardefs #'cadr))
body)))
(defun type-spec? ()
(let ((type t)
(supplied-p nil))
@@ -1288,7 +1293,7 @@
iterator-forms
`(,iterator-macro ,spec ,(with-iterator-forms rest form)))))
(defun with-list-accumulator (accumulator-spec form)
(defun with-list-accumulator (accumulator-spec form) (il:* il:\; "Edited 8-Apr-2024 19:28 by lmm")
(destructuring-bind (name &key var splice &allow-other-keys)
accumulator-spec
(let* ((anonymous-p (null name))
@@ -1301,7 +1306,7 @@
'(list nil)))
(form (if (and (not anonymous-p)
(not (globally-special-p var)))
`(symbol-macrolet ((,var (cdr ,list-var)))
`(cl::symbol-macrolet ((,var (cdr ,list-var)))
,form)
form)))
`(let ((,list-var ,value-form))
@@ -1347,8 +1352,9 @@
(declare (type ,type ,var))
,form))))))
(defun with-temporaries (temporary-specs form) (il:* il:\; "Edited 16-Mar-2024 14:22 by lmm")
(destructuring-bind (temporaries &key ((:ignorable ignorable-vars)))
(defun with-temporaries (temporary-specs form) (il:* il:\; "Edited 21-Mar-2024 11:50 by lmm")
(il:* il:\; "Edited 16-Mar-2024 14:22 by lmm")
(destructuring-bind (temporaries &key ((:ignorable ignorable)))
temporary-specs
(if temporaries
`(let ,temporaries ,@(when ignorable
@@ -1411,55 +1417,56 @@
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.")
(il:declare\: il:dontcopy
(il:filemap (nil (6736 6821 (%keyword 6736 . 6821)) (6823 7006 (%list 6823 . 7006)) (7008 8265 (
accumulate-in-list 7008 . 8265)) (8267 9947 (accumulation-clause 8267 . 9947)) (9949 10183 (
accumulator-kind 9949 . 10183)) (10185 12074 (accumulator-spec 10185 . 12074)) (12076 12545 (
along-with 12076 . 12545)) (12547 13039 (always-never-thereis-clause 12547 . 13039)) (13041 13400 (
ambiguous-loop-result-error 13041 . 13400)) (13402 13617 (append-context 13402 . 13617)) (13696 14073
(bindings 13696 . 14073)) (14075 14415 (bound-variables 14075 . 14415)) (14417 14507 (by-step-fun
14417 . 14507)) (14509 14615 (car-type 14509 . 14615)) (14617 14723 (cdr-type 14617 . 14723)) (14725
15122 (check-multiple-bindings 14725 . 15122)) (15124 15344 (cl-external-p 15124 . 15344)) (15346
15475 (clause* 15346 . 15475)) (15477 15877 (clause1 15477 . 15877)) (15879 16036 (compound-forms*
15879 . 16036)) (16038 16162 (compound-forms+ 16038 . 16162)) (16164 17422 (conditional-clause 16164
. 17422)) (17424 18135 (constant-bindings 17424 . 18135)) (18137 18508 (constant-function-p 18137 .
18508)) (18510 18704 (constant-vector 18510 . 18704)) (18706 18797 (constant-vector-p 18706 . 18797))
(18799 18991 (d-var-spec-p 18799 . 18991)) (18993 19223 (d-var-spec1 18993 . 19223)) (19225 19550 (
d-var-type-spec 19225 . 19550)) (19552 20112 (declarations 19552 . 20112)) (20114 20224 (
default-binding 20114 . 20224)) (20226 20839 (default-bindings 20226 . 20839)) (20841 21302 (
default-type 20841 . 21302)) (21304 21825 (default-value 21304 . 21825)) (21827 23317 (
destructuring-multiple-value-bind 21827 . 23317)) (23319 24604 (destructuring-multiple-value-setq
23319 . 24604)) (24606 25133 (dispatch-for-as-subclause 24606 . 25133)) (25135 25204 (do-clause 25135
. 25204)) (25206 25382 (empty-p 25206 . 25382)) (25384 25658 (enumerate 25384 . 25658)) (25660 27386
(extended-loop 25660 . 27386)) (27388 27559 (fill-in 27388 . 27559)) (27561 27638 (finally-clause
27561 . 27638)) (27640 27758 (for 27640 . 27758)) (27760 29116 (for-as-across-subclause 27760 . 29116)
) (29118 30040 (for-as-arithmetic-possible-prepositions 29118 . 30040)) (30042 30758 (
for-as-arithmetic-step-and-test-functions 30042 . 30758)) (30760 32705 (for-as-arithmetic-subclause
30760 . 32705)) (32707 33157 (for-as-being-subclause 32707 . 33157)) (33159 34375 (for-as-clause 33159
. 34375)) (34377 35905 (for-as-equals-then-subclause 34377 . 35905)) (35907 36185 (for-as-fill-in
35907 . 36185)) (36187 38153 (for-as-hash-subclause 36187 . 38153)) (38155 38401 (
for-as-in-list-subclause 38155 . 38401)) (38403 39896 (for-as-on-list-subclause 38403 . 39896)) (39898
41600 (for-as-package-subclause 39898 . 41600)) (41602 41833 (for-as-parallel-p 41602 . 41833)) (
41835 41983 (form-or-it 41835 . 41983)) (41985 42104 (form1 41985 . 42104)) (42106 42206 (
gensym-ignorable 42106 . 42206)) (42208 42319 (globally-special-p 42208 . 42319)) (42321 42500 (
hash-d-var-spec 42321 . 42500)) (42502 42583 (initially-clause 42502 . 42583)) (42585 42742 (
invalid-accumulator-combination-error 42585 . 42742)) (42744 43361 (keyword1 42744 . 43361)) (43363
43833 (keyword? 43363 . 43833)) (43835 43944 (let-form 43835 . 43944)) (43946 44100 (loop-error 43946
. 44100)) (44102 44293 (loop-finish-test-forms 44102 . 44293)) (44295 44447 (loop-warn 44295 . 44447)
) (44449 44653 (lp 44449 . 44653)) (44655 45092 (main-clause* 44655 . 45092)) (45094 45190 (mapappend
45094 . 45190)) (45192 45722 (multiple-value-list-argument-form 45192 . 45722)) (45724 46117 (
multiple-value-list-form-p 45724 . 46117)) (46119 46457 (name-clause? 46119 . 46457)) (46459 46738 (
one 46459 . 46738)) (46740 48385 (ordinary-bindings 46740 . 48385)) (48387 48604 (preposition1 48387
. 48604)) (48606 48807 (preposition? 48606 . 48807)) (48809 48969 (psetq-forms 48809 . 48969)) (48971
49151 (quoted-form-p 48971 . 49151)) (49153 49408 (quoted-object 49153 . 49408)) (49410 50214 (
reduce-redundant-code 49410 . 50214)) (50216 50570 (repeat-clause 50216 . 50570)) (50572 50662 (
return-clause 50572 . 50662)) (50664 51499 (selectable-clause 50664 . 51499)) (51501 51652 (
simple-loop 51501 . 51652)) (51654 51732 (simple-var-p 51654 . 51732)) (51734 51918 (simple-var1 51734
. 51918)) (51920 52027 (stray-of-type-error 51920 . 52027)) (52029 52463 (type-spec? 52029 . 52463))
(52465 52531 (until-clause 52465 . 52531)) (52533 53114 (using-other-var 52533 . 53114)) (53116 53310
(variable-clause* 53116 . 53310)) (53312 53416 (while-clause 53312 . 53416)) (53418 53597 (with 53418
. 53597)) (53599 54044 (with-accumulators 53599 . 54044)) (54046 54296 (with-binding-forms 54046 .
54296)) (54298 55529 (with-clause 54298 . 55529)) (55531 55790 (with-iterator-forms 55531 . 55790)) (
55792 56875 (with-list-accumulator 55792 . 56875)) (56877 57314 (with-loop-context 56877 . 57314)) (
57316 58554 (with-numeric-accumulator 57316 . 58554)) (58556 58973 (with-temporaries 58556 . 58973)) (
58975 59255 (zero 58975 . 59255)) (59257 59390 (loop 59257 . 59390)))))
(il:filemap (nil (6825 6910 (%keyword 6825 . 6910)) (6912 7095 (%list 6912 . 7095)) (7097 8354 (
accumulate-in-list 7097 . 8354)) (8356 10036 (accumulation-clause 8356 . 10036)) (10038 10272 (
accumulator-kind 10038 . 10272)) (10274 12163 (accumulator-spec 10274 . 12163)) (12165 12634 (
along-with 12165 . 12634)) (12636 13128 (always-never-thereis-clause 12636 . 13128)) (13130 13489 (
ambiguous-loop-result-error 13130 . 13489)) (13491 13706 (append-context 13491 . 13706)) (13785 14162
(bindings 13785 . 14162)) (14164 14504 (bound-variables 14164 . 14504)) (14506 14596 (by-step-fun
14506 . 14596)) (14598 14704 (car-type 14598 . 14704)) (14706 14812 (cdr-type 14706 . 14812)) (14814
15211 (check-multiple-bindings 14814 . 15211)) (15213 15433 (cl-external-p 15213 . 15433)) (15435
15564 (clause* 15435 . 15564)) (15566 15966 (clause1 15566 . 15966)) (15968 16125 (compound-forms*
15968 . 16125)) (16127 16251 (compound-forms+ 16127 . 16251)) (16253 17511 (conditional-clause 16253
. 17511)) (17513 18224 (constant-bindings 17513 . 18224)) (18226 18597 (constant-function-p 18226 .
18597)) (18599 18793 (constant-vector 18599 . 18793)) (18795 18886 (constant-vector-p 18795 . 18886))
(18888 19080 (d-var-spec-p 18888 . 19080)) (19082 19312 (d-var-spec1 19082 . 19312)) (19314 19639 (
d-var-type-spec 19314 . 19639)) (19641 20201 (declarations 19641 . 20201)) (20203 20313 (
default-binding 20203 . 20313)) (20315 20928 (default-bindings 20315 . 20928)) (20930 21391 (
default-type 20930 . 21391)) (21393 21914 (default-value 21393 . 21914)) (21916 23406 (
destructuring-multiple-value-bind 21916 . 23406)) (23408 24693 (destructuring-multiple-value-setq
23408 . 24693)) (24695 25222 (dispatch-for-as-subclause 24695 . 25222)) (25224 25293 (do-clause 25224
. 25293)) (25295 25471 (empty-p 25295 . 25471)) (25473 25747 (enumerate 25473 . 25747)) (25749 27475
(extended-loop 25749 . 27475)) (27477 27648 (fill-in 27477 . 27648)) (27650 27727 (finally-clause
27650 . 27727)) (27729 27847 (for 27729 . 27847)) (27849 29205 (for-as-across-subclause 27849 . 29205)
) (29207 30129 (for-as-arithmetic-possible-prepositions 29207 . 30129)) (30131 30847 (
for-as-arithmetic-step-and-test-functions 30131 . 30847)) (30849 32794 (for-as-arithmetic-subclause
30849 . 32794)) (32796 33246 (for-as-being-subclause 32796 . 33246)) (33248 34464 (for-as-clause 33248
. 34464)) (34466 35994 (for-as-equals-then-subclause 34466 . 35994)) (35996 36274 (for-as-fill-in
35996 . 36274)) (36276 38242 (for-as-hash-subclause 36276 . 38242)) (38244 38490 (
for-as-in-list-subclause 38244 . 38490)) (38492 39985 (for-as-on-list-subclause 38492 . 39985)) (39987
41689 (for-as-package-subclause 39987 . 41689)) (41691 41922 (for-as-parallel-p 41691 . 41922)) (
41924 42072 (form-or-it 41924 . 42072)) (42074 42193 (form1 42074 . 42193)) (42195 42295 (
gensym-ignorable 42195 . 42295)) (42297 42408 (globally-special-p 42297 . 42408)) (42410 42589 (
hash-d-var-spec 42410 . 42589)) (42591 42672 (initially-clause 42591 . 42672)) (42674 42831 (
invalid-accumulator-combination-error 42674 . 42831)) (42833 43450 (keyword1 42833 . 43450)) (43452
43922 (keyword? 43452 . 43922)) (43924 44033 (let-form 43924 . 44033)) (44035 44189 (loop-error 44035
. 44189)) (44191 44382 (loop-finish-test-forms 44191 . 44382)) (44384 44536 (loop-warn 44384 . 44536)
) (44538 44742 (lp 44538 . 44742)) (44744 45181 (main-clause* 44744 . 45181)) (45183 45279 (mapappend
45183 . 45279)) (45281 45811 (multiple-value-list-argument-form 45281 . 45811)) (45813 46206 (
multiple-value-list-form-p 45813 . 46206)) (46208 46546 (name-clause? 46208 . 46546)) (46548 46827 (
one 46548 . 46827)) (46829 48474 (ordinary-bindings 46829 . 48474)) (48476 48693 (preposition1 48476
. 48693)) (48695 48896 (preposition? 48695 . 48896)) (48898 49058 (psetq-forms 48898 . 49058)) (49060
49240 (quoted-form-p 49060 . 49240)) (49242 49497 (quoted-object 49242 . 49497)) (49499 50303 (
reduce-redundant-code 49499 . 50303)) (50305 50534 (repeat-clause 50305 . 50534)) (50536 50626 (
return-clause 50536 . 50626)) (50628 51463 (selectable-clause 50628 . 51463)) (51465 51616 (
simple-loop 51465 . 51616)) (51618 51696 (simple-var-p 51618 . 51696)) (51698 51882 (simple-var1 51698
. 51882)) (51884 51991 (stray-of-type-error 51884 . 51991)) (51993 52278 (cl::symbol-macrolet 51993
. 52278)) (52280 52714 (type-spec? 52280 . 52714)) (52716 52782 (until-clause 52716 . 52782)) (52784
53365 (using-other-var 52784 . 53365)) (53367 53561 (variable-clause* 53367 . 53561)) (53563 53667 (
while-clause 53563 . 53667)) (53669 53848 (with 53669 . 53848)) (53850 54295 (with-accumulators 53850
. 54295)) (54297 54547 (with-binding-forms 54297 . 54547)) (54549 55780 (with-clause 54549 . 55780))
(55782 56041 (with-iterator-forms 55782 . 56041)) (56043 57190 (with-list-accumulator 56043 . 57190))
(57192 57629 (with-loop-context 57192 . 57629)) (57631 58869 (with-numeric-accumulator 57631 . 58869))
(58871 59392 (with-temporaries 58871 . 59392)) (59394 59674 (zero 59394 . 59674)) (59676 59809 (loop
59676 . 59809)))))
il:stop

BIN
sources/XCL-LOOP.DFASL
View File

Binary file not shown.

718
sources/XCLC-ALPHA
View File

File diff suppressed because it is too large Load Diff

BIN
sources/XCLC-ALPHA.DFASL Normal file
View File

Binary file not shown.

BIN
sources/XCLC-ALPHA.LCOM
View File

Binary file not shown.