aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog7
-rw-r--r--src/interp/define.boot9
-rw-r--r--src/interp/g-util.boot8
-rw-r--r--src/lisp/core.lisp.in6
-rw-r--r--src/share/algebra/browse.daase2
-rw-r--r--src/share/algebra/category.daase2
-rw-r--r--src/share/algebra/compress.daase2
-rw-r--r--src/share/algebra/interp.daase2
-rw-r--r--src/share/algebra/operation.daase2
9 files changed, 32 insertions, 8 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index b4549289..594729cc 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,12 @@
2011-08-11 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/define.boot (NRTgetLookupFunction): Handle the case where
+ the base domain is a parameter.
+ * interp/g-util.boot (formalVarNumber): New.
+ * lisp/core.lisp.in (readIntegerIfCan): Likewise.
+
+2011-08-11 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/define.boot (extendsCategoryBasic): Handle attribute
third argument too.
diff --git a/src/interp/define.boot b/src/interp/define.boot
index c854eb27..8df914ac 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -270,10 +270,15 @@ hasDefaultPackage catname ==
-- Compute the lookup function (complete or incomplete)
--=======================================================================
NRTgetLookupFunction(domform,exCategory,addForm,env) ==
+ $why: local := nil
domform := applySubst($pairlis,domform)
+ addForm isnt [.,:.] =>
+ IDENTP addForm and (m := getmode(addForm,env)) ~= nil
+ and isCategoryForm(m,env)
+ and extendsCategory(domform,exCategory,applySubst($pairlis,m),env) =>
+ 'lookupIncomplete
+ 'lookupComplete
addForm := applySubst($pairlis,addForm)
- $why: local := nil
- addForm isnt [.,:.] => 'lookupComplete
NRTextendsCategory1(domform,exCategory,getExportCategory addForm,env) =>
'lookupIncomplete
[u,msg,:v] := $why
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index f6584a37..dc663fa7 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -94,7 +94,13 @@ homogeneousListToVector(t,l) ==
++ tests if x is an identifier beginning with #
isSharpVar x ==
ident? x and stringChar(symbolName x,0) = char "#"
-
+
+++ If `x' is a formal variable, return its numeral position.
+++ Otherwise return nil.
+formalVarNumber x ==
+ not isSharpVar x => nil
+ readIntegerIfCan subsString(symbolName x,1)
+
isSharpVarWithNum x ==
not isSharpVar x => nil
p := symbolName x
diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in
index 46d5306f..3ecb6c48 100644
--- a/src/lisp/core.lisp.in
+++ b/src/lisp/core.lisp.in
@@ -101,6 +101,7 @@
"prettyPrint"
"readLine"
"readExpr"
+ "readIntegerIfCan"
;; compiler data structures
"%Mode"
@@ -527,6 +528,11 @@
(defmacro |readExpr| (f)
`(read ,f nil |%nothing|))
+(defun |readIntegerIfCan| (s)
+ (let ((r (multiple-value-call #'cons (parse-integer s :junk-allowed t))))
+ (cond ((eql (cdr r) (length s)) (car r))
+ (t nil))))
+
;; Pretty-print a lisp form on a given output stream.
(defun |prettyPrint| (x &optional (s |$OutputStream|))
(let ((*print-pretty* t)
diff --git a/src/share/algebra/browse.daase b/src/share/algebra/browse.daase
index 54a96203..a3867f68 100644
--- a/src/share/algebra/browse.daase
+++ b/src/share/algebra/browse.daase
@@ -1,5 +1,5 @@
-(2277097 . 3522040293)
+(2277097 . 3522089942)
(-18 A S)
((|constructor| (NIL "One-dimensional-array aggregates serves as models for one-dimensional arrays. Categorically,{} these aggregates are finite linear aggregates with the \\spadatt{shallowlyMutable} property,{} that is,{} any component of the array may be changed without affecting the identity of the overall array. Array data structures are typically represented by a fixed area in storage and therefore cannot efficiently grow or shrink on demand as can list structures (see however \\spadtype{FlexibleArray} for a data structure which is a cross between a list and an array). Iteration over,{} and access to,{} elements of arrays is extremely fast (and often can be optimized to open-code). Insertion and deletion however is generally slow since an entirely new data structure must be created for the result.")))
NIL
diff --git a/src/share/algebra/category.daase b/src/share/algebra/category.daase
index f86da748..34cfecf9 100644
--- a/src/share/algebra/category.daase
+++ b/src/share/algebra/category.daase
@@ -1,5 +1,5 @@
-(205500 . 3522040297)
+(205500 . 3522089946)
((((-877)) . T))
((((-877)) . T))
((((-877)) . T))
diff --git a/src/share/algebra/compress.daase b/src/share/algebra/compress.daase
index 49efc9c5..bb6808d3 100644
--- a/src/share/algebra/compress.daase
+++ b/src/share/algebra/compress.daase
@@ -1,5 +1,5 @@
-(30 . 3522040291)
+(30 . 3522089941)
(4428 |Enumeration| |Mapping| |Record| |Union| |ofCategory| |isDomain|
ATTRIBUTE |package| |domain| |category| CATEGORY |nobranch| AND |Join|
|ofType| SIGNATURE "failed" "algebra" |OneDimensionalArrayAggregate&|
diff --git a/src/share/algebra/interp.daase b/src/share/algebra/interp.daase
index e3bf8476..14d6e281 100644
--- a/src/share/algebra/interp.daase
+++ b/src/share/algebra/interp.daase
@@ -1,5 +1,5 @@
-(3432448 . 3522040306)
+(3432448 . 3522089955)
((-1935 (((-114) (-1 (-114) |#2| |#2|) $) 86 T ELT) (((-114) $) NIL T ELT)) (-1933 (($ (-1 (-114) |#2| |#2|) $) 18 T ELT) (($ $) NIL T ELT)) (-4218 ((|#2| $ (-558) |#2|) NIL T ELT) ((|#2| $ (-1255 (-558)) |#2|) 44 T ELT)) (-2510 (($ $) 80 T ELT)) (-4272 ((|#2| (-1 |#2| |#2| |#2|) $ |#2| |#2|) 52 T ELT) ((|#2| (-1 |#2| |#2| |#2|) $ |#2|) 50 T ELT) ((|#2| (-1 |#2| |#2| |#2|) $) 49 T ELT)) (-3839 (((-558) (-1 (-114) |#2|) $) 27 T ELT) (((-558) |#2| $) NIL T ELT) (((-558) |#2| $ (-558)) 96 T ELT)) (-3290 (((-661 |#2|) $) 13 T ELT)) (-3938 (($ (-1 (-114) |#2| |#2|) $ $) 64 T ELT) (($ $ $) NIL T ELT)) (-2160 (($ (-1 |#2| |#2|) $) 37 T ELT)) (-4388 (($ (-1 |#2| |#2|) $) NIL T ELT) (($ (-1 |#2| |#2| |#2|) $ $) 60 T ELT)) (-2517 (($ |#2| $ (-558)) NIL T ELT) (($ $ $ (-558)) 67 T ELT)) (-1468 (((-3 |#2| "failed") (-1 (-114) |#2|) $) 29 T ELT)) (-2158 (((-114) (-1 (-114) |#2|) $) 23 T ELT)) (-4230 ((|#2| $ (-558) |#2|) NIL T ELT) ((|#2| $ (-558)) NIL T ELT) (($ $ (-1255 (-558))) 66 T ELT)) (-2518 (($ $ (-558)) 76 T ELT) (($ $ (-1255 (-558))) 75 T ELT)) (-2157 (((-791) (-1 (-114) |#2|) $) 34 T ELT) (((-791) |#2| $) NIL T ELT)) (-1934 (($ $ $ (-558)) 69 T ELT)) (-3820 (($ $) 68 T ELT)) (-3950 (($ (-661 |#2|)) 73 T ELT)) (-4232 (($ $ |#2|) NIL T ELT) (($ |#2| $) NIL T ELT) (($ $ $) 87 T ELT) (($ (-661 $)) 85 T ELT)) (-4376 (((-877) $) 92 T ELT)) (-2159 (((-114) (-1 (-114) |#2|) $) 22 T ELT)) (-3454 (((-114) $ $) 95 T ELT)) (-3086 (((-114) $ $) 99 T ELT)))
(((-18 |#1| |#2|) (-10 -8 (-15 -3454 ((-114) |#1| |#1|)) (-15 -4376 ((-877) |#1|)) (-15 -3086 ((-114) |#1| |#1|)) (-15 -1933 (|#1| |#1|)) (-15 -1933 (|#1| (-1 (-114) |#2| |#2|) |#1|)) (-15 -2510 (|#1| |#1|)) (-15 -1934 (|#1| |#1| |#1| (-558))) (-15 -1935 ((-114) |#1|)) (-15 -3938 (|#1| |#1| |#1|)) (-15 -3839 ((-558) |#2| |#1| (-558))) (-15 -3839 ((-558) |#2| |#1|)) (-15 -3839 ((-558) (-1 (-114) |#2|) |#1|)) (-15 -1935 ((-114) (-1 (-114) |#2| |#2|) |#1|)) (-15 -3938 (|#1| (-1 (-114) |#2| |#2|) |#1| |#1|)) (-15 -4218 (|#2| |#1| (-1255 (-558)) |#2|)) (-15 -2517 (|#1| |#1| |#1| (-558))) (-15 -2517 (|#1| |#2| |#1| (-558))) (-15 -2518 (|#1| |#1| (-1255 (-558)))) (-15 -2518 (|#1| |#1| (-558))) (-15 -4388 (|#1| (-1 |#2| |#2| |#2|) |#1| |#1|)) (-15 -4232 (|#1| (-661 |#1|))) (-15 -4232 (|#1| |#1| |#1|)) (-15 -4232 (|#1| |#2| |#1|)) (-15 -4232 (|#1| |#1| |#2|)) (-15 -4230 (|#1| |#1| (-1255 (-558)))) (-15 -3950 (|#1| (-661 |#2|))) (-15 -1468 ((-3 |#2| "failed") (-1 (-114) |#2|) |#1|)) (-15 -4272 (|#2| (-1 |#2| |#2| |#2|) |#1|)) (-15 -4272 (|#2| (-1 |#2| |#2| |#2|) |#1| |#2|)) (-15 -4272 (|#2| (-1 |#2| |#2| |#2|) |#1| |#2| |#2|)) (-15 -4230 (|#2| |#1| (-558))) (-15 -4230 (|#2| |#1| (-558) |#2|)) (-15 -4218 (|#2| |#1| (-558) |#2|)) (-15 -2157 ((-791) |#2| |#1|)) (-15 -3290 ((-661 |#2|) |#1|)) (-15 -2157 ((-791) (-1 (-114) |#2|) |#1|)) (-15 -2158 ((-114) (-1 (-114) |#2|) |#1|)) (-15 -2159 ((-114) (-1 (-114) |#2|) |#1|)) (-15 -2160 (|#1| (-1 |#2| |#2|) |#1|)) (-15 -4388 (|#1| (-1 |#2| |#2|) |#1|)) (-15 -3820 (|#1| |#1|))) (-19 |#2|) (-1238)) (T -18))
NIL
diff --git a/src/share/algebra/operation.daase b/src/share/algebra/operation.daase
index e9b80e92..8ed2af39 100644
--- a/src/share/algebra/operation.daase
+++ b/src/share/algebra/operation.daase
@@ -1,5 +1,5 @@
-(719417 . 3522040294)
+(719417 . 3522089943)
(((*1 *2 *3 *4)
(|partial| -12 (-5 *3 (-1288 *4)) (-4 *4 (-13 (-1070) (-658 (-558))))
(-5 *2 (-1288 (-419 (-558)))) (-5 *1 (-1317 *4)))))