From 3351c2b4a9ce2106178bd1eae40b7559b03ba621 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
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/ISTRING.lsp | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

(limited to 'src/algebra/strap/ISTRING.lsp')

diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index d3c63504..d9dea6b1 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -702,8 +702,7 @@
                        (|getShellEntry| $ 6))))
                  |ISTRING;elt;$Us$;31|)
            (COND
-             ((OR (< |l| 0)
-                  (NULL (< |h| (SPADCALL |s| (|getShellEntry| $ 13)))))
+             ((OR (< |l| 0) (NULL (< |h| (QCSIZE |s|))))
               (EXIT (|error| "index out of bound"))))
            (EXIT (SUBSTRING |s| |l| (MAX 0 (+ (- |h| |l|) 1)))))))) 
 
@@ -768,10 +767,11 @@
                                        (COND
                                          ((NULL
                                            (SPADCALL
-                                            (SPADCALL |pattern|
+                                            (|ISTRING;elt;$Us$;31|
+                                             |pattern|
                                              (SPADCALL |m| (- |p| 1)
                                               (|getShellEntry| $ 20))
-                                             (|getShellEntry| $ 21))
+                                             $)
                                             |target|
                                             (|getShellEntry| $ 72)))
                                           (EXIT 'NIL)))))
@@ -842,13 +842,13 @@
                                         (|getShellEntry| $ 71))
                                        (COND
                                          ((NULL
-                                           (SPADCALL
-                                            (SPADCALL |pattern|
+                                           (|ISTRING;suffix?;2$B;21|
+                                            (|ISTRING;elt;$Us$;31|
+                                             |pattern|
                                              (SPADCALL (+ |p| 1) |n|
                                               (|getShellEntry| $ 20))
-                                             (|getShellEntry| $ 21))
-                                            |target|
-                                            (|getShellEntry| $ 51)))
+                                             $)
+                                            |target| $))
                                           (EXIT 'NIL)))))
                                     (EXIT 'T)))))))
            #3# (EXIT #3#))))) 
-- 
cgit v1.2.3