From 3351c2b4a9ce2106178bd1eae40b7559b03ba621 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Tue, 9 Dec 2008 02:35:52 +0000 Subject: r12415@gauss: gdr | 2008-12-06 11:42:45 -0600 Implement basic support for pattern matching. r12416@gauss: gdr | 2008-12-06 18:09:19 -0600 Parse case pattern match. r12417@gauss: gdr | 2008-12-06 21:28:30 -0600 Implement basic case pattern matching for retractable domain. r12418@gauss: gdr | 2008-12-07 00:58:58 -0600 Refine retractability implementation. r12419@gauss: gdr | 2008-12-07 01:39:32 -0600 Update cached Lisp translation r12420@gauss: gdr | 2008-12-07 03:52:09 -0600 r12421@gauss: gdr | 2008-12-07 10:30:44 -0600 Implement type recovery too. r12422@gauss: gdr | 2008-12-07 19:18:09 -0600 Simplify LET-forms and COND-forms. r12423@gauss: gdr | 2008-12-07 21:21:12 -0600 Fix typos r12424@gauss: gdr | 2008-12-08 01:14:54 -0600 Parse case-pattern in the interpreter. r12427@gauss: gdr | 2008-12-08 20:32:29 -0600 Handle RetractableTo T. --- src/algebra/strap/ILIST.lsp | 21 +++++++-------------- 1 file changed, 7 insertions(+), 14 deletions(-) (limited to 'src/algebra/strap/ILIST.lsp') diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp index 872490b2..addea91c 100644 --- a/src/algebra/strap/ILIST.lsp +++ b/src/algebra/strap/ILIST.lsp @@ -151,26 +151,22 @@ (DEFUN |ILIST;setfirst!;$2S;10| (|x| |s| $) (COND - ((SPADCALL |x| (|getShellEntry| $ 17)) - (|error| "Cannot update an empty list")) + ((NULL |x|) (|error| "Cannot update an empty list")) ('T (QCAR (RPLACA |x| |s|))))) (DEFUN |ILIST;setelt;$first2S;11| (|x| T2 |s| $) (COND - ((SPADCALL |x| (|getShellEntry| $ 17)) - (|error| "Cannot update an empty list")) + ((NULL |x|) (|error| "Cannot update an empty list")) ('T (QCAR (RPLACA |x| |s|))))) (DEFUN |ILIST;setrest!;3$;12| (|x| |y| $) (COND - ((SPADCALL |x| (|getShellEntry| $ 17)) - (|error| "Cannot update an empty list")) + ((NULL |x|) (|error| "Cannot update an empty list")) ('T (QCDR (RPLACD |x| |y|))))) (DEFUN |ILIST;setelt;$rest2$;13| (|x| T3 |y| $) (COND - ((SPADCALL |x| (|getShellEntry| $ 17)) - (|error| "Cannot update an empty list")) + ((NULL |x|) (|error| "Cannot update an empty list")) ('T (QCDR (RPLACD |x| |y|))))) (DEFUN |ILIST;construct;L$;14| (|l| $) (DECLARE (IGNORE $)) |l|) @@ -235,8 +231,7 @@ NIL (GO G190) G191 (EXIT NIL)) (LETT |y| (NREVERSE |y|) |ILIST;coerce;$Of;21|) (EXIT (COND - ((SPADCALL |s| (|getShellEntry| $ 17)) - (SPADCALL |y| (|getShellEntry| $ 40))) + ((NULL |s|) (SPADCALL |y| (|getShellEntry| $ 40))) ('T (SEQ (LETT |z| (SPADCALL @@ -475,10 +470,8 @@ (SEQ (COND ((EQL |n| 2) (COND - ((SPADCALL - (SPADCALL (SPADCALL |p| (|getShellEntry| $ 18)) - (|getShellEntry| $ 13)) - (SPADCALL |p| (|getShellEntry| $ 13)) |f|) + ((SPADCALL (|SPADfirst| (CDR |p|)) (|SPADfirst| |p|) + |f|) (LETT |p| (NREVERSE |p|) |ILIST;mergeSort|))))) (EXIT (COND ((< |n| 3) |p|) -- cgit v1.2.3