aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog14
-rw-r--r--src/interp/ax.boot14
-rw-r--r--src/interp/br-data.boot10
-rw-r--r--src/interp/br-op1.boot12
-rw-r--r--src/interp/br-prof.boot8
-rw-r--r--src/interp/br-search.boot6
-rw-r--r--src/interp/br-util.boot8
-rw-r--r--src/interp/cattable.boot8
-rw-r--r--src/interp/daase.lisp6
-rw-r--r--src/interp/g-util.boot2
-rw-r--r--src/interp/lisplib.boot12
-rw-r--r--src/interp/nrunopt.boot2
12 files changed, 60 insertions, 42 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index cfaa4bd7..0a1c821a 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,17 @@
+2008-04-12 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/ax.boot: Use getConstructorModemap throughout.
+ * interp/br-data.boot: Likewise.
+ * interp/br-op1.boot: Likewise.
+ * interp/br-prof.boot: Likewise.
+ * interp/br-search.boot: Likewise.
+ * interp/br-util.boot: Likewise.
+ * interp/cattable.boot: Likewise.
+ * interp/daase.lisp: Likewise.
+ * interp/g-util.boot: Likewise.
+ * interp/lisplib.boot: Likewise.
+ * interp/nrunopt.boot: Likewise.
+
2008-04-12 Juergen Weiss <weiss@uni-mainz.de>
* interp/define.boot (compCapsuleItems): Fix thinko.
diff --git a/src/interp/ax.boot b/src/interp/ax.boot
index 1f61ece4..8d7f4321 100644
--- a/src/interp/ax.boot
+++ b/src/interp/ax.boot
@@ -1,6 +1,6 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - Neither the name of The Numerical Algorithms Group Ltd. nor the
-- names of its contributors may be used to endorse or promote products
-- derived from this software without specific prior written permission.
--
@@ -60,7 +60,7 @@ makeAxFile(filename, constructors) ==
$literals := []
axForms :=
[modemapToAx(modemap) for cname in constructors |
- (modemap:=GETDATABASE(cname,'CONSTRUCTORMODEMAP)) and
+ (modemap:=getConstructorModemap cname) and
(not cname in '(Tuple Exit Type)) and
not isDefaultPackageName cname]
if $baseForms then
@@ -80,7 +80,7 @@ makeAxExportForm(filename, constructors) ==
$literals := []
axForms :=
[modemapToAx(modemap) for cname in constructors |
- (modemap:=GETDATABASE(cname,'CONSTRUCTORMODEMAP)) and
+ (modemap:=getConstructorModemap cname) and
(not cname in '(Tuple Exit Type)) and
not isDefaultPackageName cname]
if $baseForms then
@@ -226,13 +226,13 @@ axFormatType(typeform) ==
['PretendTo, axFormatType CADDR typeform, 'SetCategory]]
typeform is [op,:args] =>
$pretendFlag and constructor? op and
- GETDATABASE(op,'CONSTRUCTORMODEMAP) is [[.,target,:argtypes],.] =>
+ getConstructorModemap op is [[.,target,:argtypes],.] =>
['Apply, op,
:[['PretendTo, axFormatType a, axFormatType t]
for a in args for t in argtypes]]
MEMQ(op, '(SquareMatrix SquareMatrixCategory DirectProduct
DirectProductCategory RadixExpansion)) and
- GETDATABASE(op,'CONSTRUCTORMODEMAP) is [[.,target,arg1type,:restargs],.] =>
+ getConstructorModemap op is [[.,target,arg1type,:restargs],.] =>
['Apply, op,
['PretendTo, axFormatType first args, axFormatType arg1type],
:[axFormatType a for a in rest args]]
diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot
index 86b71b8b..e60107c6 100644
--- a/src/interp/br-data.boot
+++ b/src/interp/br-data.boot
@@ -1,4 +1,4 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - Neither the name of The Numerical Algorithms Group Ltd. nor the
-- names of its contributors may be used to endorse or promote products
-- derived from this software without specific prior written permission.
--
@@ -98,7 +98,7 @@ buildLibdb(:options) == --called by buildDatabase (database.boot)
deleteFile '"temp.text"
buildLibdbConEntry conname ==
- NULL GETDATABASE(conname, 'CONSTRUCTORMODEMAP) => nil
+ null getConstructorModemap conname => nil
abb:=GETDATABASE(conname,'ABBREVIATION)
$conname := conname
conform := GETDATABASE(conname,'CONSTRUCTORFORM) or [conname] --hack for Category,..
@@ -109,7 +109,7 @@ buildLibdbConEntry conname ==
pname := PNAME conname
kind := GETDATABASE(conname,'CONSTRUCTORKIND)
if kind = 'domain
- and GETDATABASE(conname,'CONSTRUCTORMODEMAP) is [[.,t,:.],:.]
+ and getConstructorModemap conname is [[.,t,:.],:.]
and t is ['CATEGORY,'package,:.] then kind := 'package
$kind :=
pname.(MAXINDEX pname) = char '_& => 'x
@@ -129,7 +129,7 @@ buildLibdbString [x,:u] ==
STRCONC(STRINGIMAGE x,"STRCONC"/[STRCONC('"`",STRINGIMAGE y) for y in u])
libConstructorSig [conname,:argl] ==
- [[.,:sig],:.] := GETDATABASE(conname,'CONSTRUCTORMODEMAP)
+ [[.,:sig],:.] := getConstructorModemap conname
formals := TAKE(#argl,$FormalMapVariableList)
sig := SUBLISLIS(formals,$TriangleVariableList,sig)
keys := [g(f,sig,i) for f in formals for i in 1..] where
diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot
index 3d8b4ce3..605f8fa3 100644
--- a/src/interp/br-op1.boot
+++ b/src/interp/br-op1.boot
@@ -1,6 +1,6 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - Neither the name of The Numerical Algorithms Group Ltd. nor the
-- names of its contributors may be used to endorse or promote products
-- derived from this software without specific prior written permission.
--
@@ -318,7 +318,7 @@ conform2StringList(form,opFn,argFn,exception) ==
rest GETDATABASE(op,'COSIG)
atypes :=
special => cosig
- rest CDAR GETDATABASE(op,'CONSTRUCTORMODEMAP)
+ rest CDAR getConstructorModemap op
sargl := [fn for x in args for atype in atypes for pred in cosig] where fn() ==
keyword :=
x is [":",y,t] =>
@@ -362,7 +362,7 @@ dbOuttran form ==
op := form
args := nil
cosig := rest GETDATABASE(op,'COSIG)
- atypes := rest CDAR GETDATABASE(op,'CONSTRUCTORMODEMAP)
+ atypes := rest CDAR getConstructorModemap op
argl := [fn for x in args for atype in atypes for pred in cosig] where fn() ==
pred => x
typ := sublisFormal(args,atype)
@@ -1028,7 +1028,7 @@ evalableConstructor2HtString domform ==
f = 'QUOTE => first args
[f,:[unquote x for x in args]]
arg
- fargtypes:=CDDAR GETDATABASE(conname,'CONSTRUCTORMODEMAP)
+ fargtypes:=CDDAR getConstructorModemap conname
--argtypes:= sublisFormal(arglist,fargtypes)
form2HtString([conname,:[fn for arg in arglist for x in coSig
for ftype in fargtypes]],nil,true) where
diff --git a/src/interp/br-prof.boot b/src/interp/br-prof.boot
index 1685fa07..876348b3 100644
--- a/src/interp/br-prof.boot
+++ b/src/interp/br-prof.boot
@@ -1,6 +1,6 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - Neither the name of The Numerical Algorithms Group Ltd. nor the
-- names of its contributors may be used to endorse or promote products
-- derived from this software without specific prior written permission.
--
@@ -80,7 +80,7 @@ dbShowInfoOp(htPage,op,sig,alist) ==
kind = 'category =>
[INTERN STRCONC(PNAME conname,'"&"),"$",:CDR conform]
conform
- faTypes := CDDAR GETDATABASE(conname,'CONSTRUCTORMODEMAP)
+ faTypes := CDDAR getConstructorModemap conname
conArgTypes :=
SUBLISLIS(IFCDR conform,TAKE(#faTypes,$FormalMapVariableList),faTypes)
diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot
index 1949c5ae..8cc82604 100644
--- a/src/interp/br-search.boot
+++ b/src/interp/br-search.boot
@@ -1,4 +1,4 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - Neither the name of The Numerical Algorithms Group Ltd. nor the
-- names of its contributors may be used to endorse or promote products
-- derived from this software without specific prior written permission.
--
@@ -313,7 +313,7 @@ conform2OutputForm(form) ==
[op,:args] := form
null args => form
cosig := rest GETDATABASE(op,'COSIG)
- atypes := rest CDAR GETDATABASE(op,'CONSTRUCTORMODEMAP)
+ atypes := rest CDAR getConstructorModemap op
sargl := [fn for x in args for atype in atypes for pred in cosig] where fn() ==
pp [x,atype,pred]
pred => conform2OutputForm x
diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot
index 2ce4347c..12556dd0 100644
--- a/src/interp/br-util.boot
+++ b/src/interp/br-util.boot
@@ -1,6 +1,6 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - Neither the name of The Numerical Algorithms Group Ltd. nor the
-- names of its contributors may be used to endorse or promote products
-- derived from this software without specific prior written permission.
--
@@ -264,7 +264,7 @@ args2LispString x ==
STRCONC('",",form2LispString first x,fnTailTail rest x)
dbConstructorKind x ==
- target := CADAR GETDATABASE(x,'CONSTRUCTORMODEMAP)
+ target := CADAR getConstructorModemap x
target = '(Category) => 'category
target is ['CATEGORY,'package,:.] => 'package
HGET($defaultPackageNamesHT,x) => 'default_ package
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index c69bb136..68c57dab 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -1,4 +1,6 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (C) 1991-2002, The Numerical Algorithms Group Ltd.
+-- All rights reserved.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -13,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - Neither the name of The Numerical Algorithms Group Ltd. nor the
-- names of its contributors may be used to endorse or promote products
-- derived from this software without specific prior written permission.
--
@@ -203,7 +205,7 @@ genTempCategoryTable() ==
addToCategoryTable con ==
-- adds an entry to $tempCategoryTable with key=con and alist entries
- u := CAAR GETDATABASE(con,'CONSTRUCTORMODEMAP) --domain
+ u := CAAR getConstructorModemap con --domain
alist := getCategoryExtensionAlist u
HPUT(_*ANCESTORS_-HASH_*,first u,alist)
alist
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 93524aff..dd9a7a8b 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -374,7 +374,7 @@
|UniversalSegment|
|Variable| |Vector|))
(dolist (con constructormodemapAndoperationalist)
- (getdatabase con 'constructormodemap)
+ (|getConstructorModemap| con)
(getdatabase con 'operationalist))
(setq operation '(
|+| |-| |*| |/| |**| |coerce| |convert| |elt| |equation|
@@ -573,7 +573,7 @@
(format t "~a: ~a~%" 'operation
(getdatabase constructor 'operation))
(format t "~a: ~%" 'constructormodemap)
- (pprint (getdatabase constructor 'constructormodemap))
+ (pprint (|getConstructorModemap| constructor))
(format t "~&~a: ~%" 'constructorcategory)
(pprint (getdatabase constructor 'constructorcategory))
(format t "~&~a: ~%" 'operationalist)
@@ -665,7 +665,7 @@
(when (setq struct (get constructor 'database))
(setq data (database-constructorcategory struct))
(when (null data) ;domain or package then subfield of constructormodemap
- (setq data (cadar (getdatabase constructor 'constructormodemap))))))
+ (setq data (cadar (|getConstructorModemap| constructor))))))
(operationalist
(setq stream *interp-stream*)
(when (setq struct (get constructor 'database))
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 3bcb22da..80dceba0 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -504,7 +504,7 @@ str2Tex s ==
val := objValUnwrap val
CAR val.1
-opOf: %Thing -> %Thing
+opOf: %Form -> %Symbol
opOf x ==
atom x => x
first x
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 5c5f50df..47501659 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -161,7 +161,7 @@ loadLib cname ==
clearConstructorCache cname
updateDatabase(cname,cname,systemdir?)
installConstructor(cname,kind)
- u := GETDATABASE(cname, 'CONSTRUCTORMODEMAP)
+ u := getConstructorModemap cname
updateCategoryTable(cname,kind)
coSig :=
u =>
@@ -227,14 +227,14 @@ convertOpAlist2compilerInfo(opalist) ==
updateCategoryFrameForConstructor(constructor) ==
opAlist := GETDATABASE(constructor, 'OPERATIONALIST)
- [[dc,:sig],[pred,impl]] := GETDATABASE(constructor, 'CONSTRUCTORMODEMAP)
+ [[dc,:sig],[pred,impl]] := getConstructorModemap constructor
$CategoryFrame := put(constructor,'isFunctor,
convertOpAlist2compilerInfo(opAlist),
addModemap(constructor, dc, sig, pred, impl,
put(constructor, 'mode, ['Mapping,:sig], $CategoryFrame)))
updateCategoryFrameForCategory(category) ==
- [[dc,:sig],[pred,impl]] := GETDATABASE(category, 'CONSTRUCTORMODEMAP)
+ [[dc,:sig],[pred,impl]] := getConstructorModemap category
$CategoryFrame :=
put(category, 'isCategory, 'T,
addModemap(category, dc, sig, pred, impl, $CategoryFrame))
@@ -626,12 +626,14 @@ findDomainSlotNumber(domain,op,sig) == --using slot 1 of the domain
tail is [.,["ELT",.,n]] => n
systemErrorHere '"findDomainSlotNumber"
-
+
+++ return the modemap of the constructor or the instantiation
+++ of the constructor `form'.
getConstructorModemap form ==
GETDATABASE(opOf form, 'CONSTRUCTORMODEMAP)
getConstructorSignature form ==
- (mm := GETDATABASE(opOf(form),'CONSTRUCTORMODEMAP)) =>
+ (mm := getConstructorModemap form) =>
[[.,:sig],:.] := mm
sig
NIL
diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot
index 26829cb2..b15c6722 100644
--- a/src/interp/nrunopt.boot
+++ b/src/interp/nrunopt.boot
@@ -810,7 +810,7 @@ getExportCategory form ==
[op,:argl] := form
op = 'Record => ['RecordCategory,:argl]
op = 'Union => ['UnionCategory,:argl]
- functorModemap := GETDATABASE(op,'CONSTRUCTORMODEMAP)
+ functorModemap := getConstructorModemap op
[[.,target,:tl],:.] := functorModemap
EQSUBSTLIST(argl,$FormalMapVariableList,target)