aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2009-01-11 03:06:06 +0000
committerdos-reis <gdr@axiomatics.org>2009-01-11 03:06:06 +0000
commit7f4d5ba0d11c5c7f5bc106655ffb07f37ed453a0 (patch)
tree16fc67934b5fd41478d4afcf7fdbff90503ed412 /src
parent3abfe0a7f15ff760fe7c6f95957f705e1301bfc6 (diff)
downloadopen-axiom-7f4d5ba0d11c5c7f5bc106655ffb07f37ed453a0.tar.gz
* interp/compiler.boot (getSuccessEnvironment): Don't specialize
on `has'. (getInverseEnvironment): Likewise. * algebra/equation2.spad.pamphlet (factorAndSplit$Equation): Fix misuses of `has'. * interp/functor.boot (mkTypeForm): Rename from mkDomainConstructor.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog9
-rw-r--r--src/algebra/equation2.spad.pamphlet2
-rw-r--r--src/interp/compiler.boot20
-rw-r--r--src/interp/define.boot6
-rw-r--r--src/interp/functor.boot20
5 files changed, 26 insertions, 31 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index daccd105..0acd88b9 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,14 @@
2009-01-10 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/compiler.boot (getSuccessEnvironment): Don't specialize
+ on `has'.
+ (getInverseEnvironment): Likewise.
+ * algebra/equation2.spad.pamphlet (factorAndSplit$Equation): Fix
+ misuses of `has'.
+ * interp/functor.boot (mkTypeForm): Rename from mkDomainConstructor.
+
+2009-01-10 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
Fix SF/2491986
* interp/i-syscmd.boot (displayValue): Fix thinko.
* testsuite/interpreter/sf-2491986.input (a): New.
diff --git a/src/algebra/equation2.spad.pamphlet b/src/algebra/equation2.spad.pamphlet
index 169df9ed..e0d3bd30 100644
--- a/src/algebra/equation2.spad.pamphlet
+++ b/src/algebra/equation2.spad.pamphlet
@@ -213,7 +213,7 @@ Equation(S: Type): public == private where
(S has factor : S -> Factored S) =>
eq0 := rightZero eq
[equation(rcf.factor,0) for rcf in factors factor lhs eq0]
- (S has Polynomial Integer) =>
+ (S is Polynomial Integer) =>
eq0 := rightZero eq
MF ==> MultivariateFactorize(Symbol, IndexedExponents Symbol, _
Integer, Polynomial Integer)
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 72baf917..6cf3cc84 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1138,9 +1138,9 @@ compHasFormat (pred is ["has",olda,b]) ==
b is ["ATTRIBUTE",c] => ["HasAttribute",a,["QUOTE",c]]
b is ["SIGNATURE",op,sig] =>
["HasSignature",a,
- mkList [MKQ op,mkList [mkDomainConstructor type for type in sig]]]
- isDomainForm(b,$EmptyEnvironment) => ["EQUAL",a,b]
- ["HasCategory",a,mkDomainConstructor b]
+ mkList [MKQ op,mkList [mkTypeForm type for type in sig]]]
+ isCategoryForm(b,$e) => ["HasCategory",a,mkTypeForm b]
+ stackAndThrow('"Second argument to %1b must be a category, or a signature or an attribute",["has"])
--% IF
@@ -1215,12 +1215,6 @@ compPredicate(p,E) ==
[p',m,getSuccessEnvironment(p,E),getInverseEnvironment(p,E)]
getSuccessEnvironment(a,e) ==
-
- -- the next four lines try to ensure that explicit special-case tests
- -- prevent implicit ones from being generated
- a is ["has",x,m] =>
- IDENTP x and isDomainForm(m,$EmptyEnvironment) => put(x,"specialCase",m,e)
- e
a is ["is",id,m] =>
IDENTP id and isDomainForm(m,$EmptyEnvironment) =>
e:=put(id,"specialCase",m,e)
@@ -1234,14 +1228,6 @@ getSuccessEnvironment(a,e) ==
e
getInverseEnvironment(a,E) ==
- atom a => E
- [op,:argl]:= a
--- the next five lines try to ensure that explicit special-case tests
--- prevent implicit ones from being generated
- op="has" =>
- [x,m]:= argl
- IDENTP x and isDomainForm(m,$EmptyEnvironment) => put(x,"specialCase",m,E)
- E
a is ["case",x,m] and IDENTP x =>
--the next two lines are necessary to get 3-branched Unions to work
-- old-style unions, that is
diff --git a/src/interp/define.boot b/src/interp/define.boot
index e3dc8934..a4c31697 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -870,7 +870,7 @@ genDomainView(viewName,originalName,c,viewSelector) ==
c is ['SubsetCategory,c',.] => c'
c
$e:= augModemapsFromCategory(originalName,viewName,nil,c,$e)
- cd:= ["%LET",viewName,[viewSelector,originalName,mkDomainConstructor code]]
+ cd:= ["%LET",viewName,[viewSelector,originalName,mkTypeForm code]]
if null member(cd,$getDomainCode) then
$getDomainCode:= [cd,:$getDomainCode]
viewName
@@ -881,7 +881,7 @@ genDomainOps(viewName,dom,cat) ==
oplist:= substNames(dom,viewName,dom,oplist)
cd:=
["%LET",viewName,['mkOpVec,dom,['LIST,:
- [['LIST,MKQ op,['LIST,:[mkDomainConstructor mode for mode in sig]]]
+ [['LIST,MKQ op,['LIST,:[mkTypeForm mode for mode in sig]]]
for [op,sig] in siglist]]]]
$getDomainCode:= [cd,:$getDomainCode]
for [opsig,cond,:.] in oplist for i in 0.. repeat
@@ -1417,7 +1417,7 @@ uncons x ==
bootStrapError(functorForm,sourceFile) ==
['COND, _
['$bootStrapMode, _
- ['VECTOR,mkDomainConstructor functorForm,nil,nil,nil,nil,nil]],
+ ['VECTOR,mkTypeForm functorForm,nil,nil,nil,nil,nil]],
[''T, ['systemError,['LIST,''%b,MKQ CAR functorForm,''%d,'"from", _
''%b,MKQ namestring sourceFile,''%d,'"needs to be compiled"]]]]
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 5d2409f5..f2cab9ca 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -311,10 +311,10 @@ cons5(p,l) ==
setVector0(catNames,definition) ==
--returns code to set element 0 of the vector
--to the definition of the category
- definition:= mkDomainConstructor definition
+ definition:= mkTypeForm definition
-- If we call addMutableArg this early, then recurise calls to this domain
-- (e.g. while testing predicates) will generate new domains => trouble
---definition:= addMutableArg mkDomainConstructor definition
+--definition:= addMutableArg mkTypeForm definition
for u in catNames repeat
definition:= ["setShellEntry",u,0,definition]
definition
@@ -387,7 +387,7 @@ setVector3(name,instantiator) ==
--element 3 is data structure representing category
--returns a single LISP statement
instantiator is ['DomainSubstitutionMacro,.,body] => setVector3(name,body)
- ["setShellEntry",name,3,mkDomainConstructor instantiator]
+ ["setShellEntry",name,3,mkTypeForm instantiator]
mkDomainFormer x ==
if x is ['DomainSubstitutionMacro,parms,body] then
@@ -398,23 +398,23 @@ mkDomainFormer x ==
x is ['Join,:.] => ['eval,['QUOTE,x]]
x
-mkDomainConstructor x ==
+mkTypeForm x ==
atom x => mkDevaluate x
x is ['Join] => nil
x is ['LIST] => nil
x is ['CATEGORY,:.] => MKQ x
x is ['mkCategory,:.] => MKQ x
x is ['_:,selector,dom] =>
- ['LIST,MKQ '_:,MKQ selector,mkDomainConstructor dom]
+ ['LIST,MKQ '_:,MKQ selector,mkTypeForm dom]
x is ['Record,:argl] =>
- ['LIST,MKQ 'Record,:[mkDomainConstructor y for y in argl]]
+ ['LIST,MKQ 'Record,:[mkTypeForm y for y in argl]]
x is ['Join,:argl] =>
- ['LIST,MKQ 'Join,:[mkDomainConstructor y for y in argl]]
+ ['LIST,MKQ 'Join,:[mkTypeForm y for y in argl]]
x is ['call,:argl] => ['MKQ, optCall x]
--The previous line added JHD/BMT 20/3/84
--Necessary for proper compilation of DPOLY SPAD
x is [op] => MKQ x
- x is [op,:argl] => ['LIST,MKQ op,:[mkDomainConstructor a for a in argl]]
+ x is [op,:argl] => ['LIST,MKQ op,:[mkTypeForm a for a in argl]]
setVector4(catNames,catsig,conditions) ==
if $HackSlot4 then
@@ -437,7 +437,7 @@ setVector4Onecat(name,instantiator,info) ==
data:=
--CAR name.4 contains all the names except itself
--hence we need to add this on, by the above CONS
- ['CONS,['CONS,mkDomainConstructor instantiator,['CAR,['ELT,name,4]]],
+ ['CONS,['CONS,mkTypeForm instantiator,['CAR,['ELT,name,4]]],
name]
data:= ['SETQ,'TrueDomain,['CONS,data,'TrueDomain]]
TruthP info => data