aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2009-09-02 16:20:53 +0000
committerdos-reis <gdr@axiomatics.org>2009-09-02 16:20:53 +0000
commitd2c2747da6be576cc592bcb3f046356af2bfca9b (patch)
treea4108a95f284d9ee425f32d4027db0edab9975f4 /src/interp
parent327b4fb2c149c02dd72f3d8f6070b6e0144828ee (diff)
downloadopen-axiom-d2c2747da6be576cc592bcb3f046356af2bfca9b.tar.gz
* interp/cstream.boot: Cleanup.
* interp/g-boot.boot: Likewise. * interp/i-funsel.boot: Likewise. * interp/i-map.boot: Likewise. * interp/i-resolv.boot: Likewise. * interp/i-spec2.boot: Likewise. * interp/mark.boot: Likewise. * interp/nrungo.boot: Likewise. * interp/posit.boot: Likewise. * interp/sys-constants.boot: Define more constants.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/cstream.boot8
-rw-r--r--src/interp/g-boot.boot19
-rw-r--r--src/interp/i-funsel.boot26
-rw-r--r--src/interp/i-map.boot2
-rw-r--r--src/interp/i-output.boot4
-rw-r--r--src/interp/i-resolv.boot11
-rw-r--r--src/interp/i-spec2.boot8
-rw-r--r--src/interp/mark.boot4
-rw-r--r--src/interp/nrungo.boot4
-rw-r--r--src/interp/posit.boot4
-rw-r--r--src/interp/sys-constants.boot9
11 files changed, 52 insertions, 47 deletions
diff --git a/src/interp/cstream.boot b/src/interp/cstream.boot
index 08e8ab97..5695f37a 100644
--- a/src/interp/cstream.boot
+++ b/src/interp/cstream.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -40,12 +40,12 @@ namespace BOOT
npNull x== StreamNull x
StreamNull x==
- null x or EQCAR (x,"nullstream") => true
- while EQCAR(x,"nonnullstream") repeat
+ null x or x is ["nullstream",:.] => true
+ while x is ["nonnullstream",:.] repeat
st:=APPLY(CADR x,CDDR x)
RPLACA(x,CAR st)
RPLACD(x,CDR st)
- EQCAR(x,"nullstream")
+ x is ["nullstream",:.]
Delay(f,x)==cons("nonnullstream",[f,:x])
diff --git a/src/interp/g-boot.boot b/src/interp/g-boot.boot
index db7efaff..8151d16f 100644
--- a/src/interp/g-boot.boot
+++ b/src/interp/g-boot.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -114,13 +114,12 @@ removeEXITFromCOND c ==
ATOM cl => z := CONS(cl,z)
cond := QCAR cl
length1? cl =>
- PAIRP(cond) and EQCAR(cond,'EXIT) =>
- z := CONS(QCDR cond,z)
+ cond is ["EXIT",:.] => z := CONS(QCDR cond,z)
z := CONS(cl,z)
cl' := REVERSE cl
lastSE := QCAR cl'
ATOM lastSE => z := CONS(cl,z)
- EQCAR(lastSE,'EXIT) =>
+ lastSE is ["EXIT",:.] =>
z := CONS(REVERSE CONS(CADR lastSE,CDR cl'),z)
z := CONS(cl,z)
CONS('COND,NREVERSE z)
@@ -258,21 +257,21 @@ defLET1(lhs,rhs) ==
IDENTP rhs and not CONTAINED(rhs,lhs) =>
rhs' := defLET2(lhs,rhs)
EQCAR(rhs',$LET) => MKPROGN [rhs',rhs]
- EQCAR(rhs','PROGN) => APPEND(rhs',[rhs])
+ rhs' is ["PROGN",:.] => APPEND(rhs',[rhs])
if IDENTP CAR rhs' then rhs' := CONS(rhs',NIL)
MKPROGN [:rhs',rhs]
- PAIRP(rhs) and EQCAR(rhs, $LET) and IDENTP(name := CADR rhs) =>
+ rhs is [=$LET,:.] and IDENTP(name := CADR rhs) =>
-- handle things like [a] := x := foo
l1 := defLET1(name,CADDR rhs)
l2 := defLET1(lhs,name)
- EQCAR(l2,'PROGN) => MKPROGN [l1,:CDR l2]
+ l2 is ["PROGN",:.] => MKPROGN [l1,:CDR l2]
if IDENTP CAR l2 then l2 := cons(l2,nil)
MKPROGN [l1,:l2,name]
g := INTERN STRCONC('"LETTMP#",STRINGIMAGE $letGenVarCounter)
$letGenVarCounter := $letGenVarCounter + 1
rhs' := [$LET,g,rhs]
let' := defLET1(lhs,g)
- EQCAR(let','PROGN) => MKPROGN [rhs',:CDR let']
+ let' is ["PROGN",:.] => MKPROGN [rhs',:CDR let']
if IDENTP CAR let' then let' := CONS(let',NIL)
MKPROGN [rhs',:let',g]
@@ -287,7 +286,7 @@ defLET2(lhs,rhs) ==
PAIRP QCAR b => CONS(a,b)
[a,b]
lhs is ['CONS,var1,var2] =>
- var1 = "." or (PAIRP(var1) and EQCAR(var1,'QUOTE)) =>
+ var1 = "." or (var1 is ["QUOTE",:.]) =>
defLET2(var2,addCARorCDR('CDR,rhs))
l1 := defLET2(var1,addCARorCDR('CAR,rhs))
MEMQ(var2,'(NIL _.)) => l1
@@ -324,7 +323,7 @@ defLET(lhs,rhs) ==
addCARorCDR(acc,expr) ==
NULL PAIRP expr => [acc,expr]
- acc = 'CAR and EQCAR(expr,'REVERSE) =>
+ acc = 'CAR and expr is ["REVERSE",:.] =>
cons('last,QCDR expr)
funs := '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR
CDAAR CDDAR CDADR CDDDR)
diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot
index acdf2bd1..9fcff10e 100644
--- a/src/interp/i-funsel.boot
+++ b/src/interp/i-funsel.boot
@@ -460,7 +460,7 @@ defaultTargetFE(a,:options) ==
[$FunctionalExpression, a]
altTypeOf(type,val,$declaredMode) ==
- (EQCAR(type,'Symbol) or EQCAR(type,'Variable)) and
+ (type = $Symbol or type is ["Variable",:.]) and
(a := getMinimalVarMode(objValUnwrap getValue(val),$declaredMode)) =>
a
type is ['OrderedVariableList,vl] and
@@ -1123,19 +1123,19 @@ matchTypes(pm,args1,args2) ==
for v in pm for t1 in args1 for t2 in args2 until $Subst='failed repeat
p:= ASSQ(v,$Subst) =>
t:= CDR p
- t=t1 => $Coerce and EQCAR(t1,'Symbol) and
+ t=t1 => $Coerce and t1 = $Symbol and
(q := ASSQ(v,$SymbolType)) and t2 and
(t3 := resolveTT(CDR q, t2)) and
RPLACD(q, t3)
$Coerce =>
- if EQCAR(t,'Symbol) and (q := ASSQ(v,$SymbolType)) then
+ if t = $Symbol and (q := ASSQ(v,$SymbolType)) then
t := CDR q
- if EQCAR(t1,'Symbol) and t2 then t1:= t2
+ if t1 = $Symbol and t2 then t1:= t2
t0 := resolveTT(t,t1) => RPLACD(p,t0)
$Subst:= 'failed
$Subst:= 'failed
$Subst:= CONS(CONS(v,t1),$Subst)
- if EQCAR(t1,'Symbol) and t2 then $SymbolType:= CONS(CONS(v,t2),$SymbolType)
+ if t1 = $Symbol and t2 then $SymbolType:= CONS(CONS(v,t2),$SymbolType)
evalMm(op,tar,sig,mmC) ==
-- evaluates a modemap with signature sig and condition mmC
@@ -1211,7 +1211,7 @@ evalMmCond0(op,sig,st) ==
t:= CDR p
t=t1 or
containsVars t =>
- if $Coerce and EQCAR(t1,'Symbol) then t1:= getSymbolType CAR p
+ if $Coerce and t1 = $Symbol then t1:= getSymbolType CAR p
resolveTM1(t1,t)
$Coerce and
-- if we are looking at the result of a function, the coerce
@@ -1222,7 +1222,7 @@ evalMmCond0(op,sig,st) ==
NIL
canCoerceFrom(t1,t) => 'T
isSubDomain(t,t1) => RPLACD(p,t1)
- EQCAR(t1,'Symbol) and canCoerceFrom(getSymbolType CAR p,t)
+ t1 = $Symbol and canCoerceFrom(getSymbolType CAR p,t)
( SL and p1 and not b and 'failed ) or evalMmCat(op,sig,st,SL)
fixUpTypeArgs SL ==
@@ -1326,7 +1326,7 @@ evalMmCat(op,sig,stack,SL) ==
-- evaluates all ofCategory's of stack as soon as possible
$hope:local:= NIL
numConds:= #stack
- stack:= orderMmCatStack [mmC for mmC in stack | EQCAR(mmC,'ofCategory)]
+ stack:= orderMmCatStack [mmC for mmC in stack | mmC is ["ofCategory",:.]]
while stack until not makingProgress repeat
st := stack
stack := NIL
@@ -1349,7 +1349,7 @@ evalMmCat1(mmC is ['ofCategory,d,c],op, SL) ==
$hope:= NIL
NSL:= hasCate(d,c,SL)
NSL='failed and isPatternVar d and $Coerce and ( p:= ASSQ(d,$Subst) )
- and (EQCAR(CDR p,'Variable) or EQCAR(CDR p,'Symbol)) =>
+ and (rest(p) is ["Variable",:.] or rest(p) = $Symbol) =>
RPLACD(p,getSymbolType d)
hasCate(d,c,SL)
NSL='failed and isPatternVar d =>
@@ -1405,7 +1405,7 @@ hasCateSpecial(v,dom,cat,SL) ==
SL:= hasCate(arg,'(Ring),augmentSub(v,d,SL))
SL = 'failed => 'failed
hasCaty(d,cat,SL)
- EQCAR(cat,'Field) or EQCAR(cat, 'DivisionRing) =>
+ cat = $Field or cat = $DivisionRing =>
if isSubDomain(dom,$Integer) then dom := $Integer
d:= eqType [$QuotientField, dom]
hasCaty(dom,'(IntegralDomain),augmentSub(v,d,SL))
@@ -1430,15 +1430,15 @@ hasCateSpecialNew(v,dom,cat,SL) ==
AlgebraicallyClosedFunctionSpace ExpressionSpace
LiouvillianFunctionCategory FunctionSpace))
alg := member(QCAR cat, '(RadicalCategory AlgebraicallyClosedField))
- fefull := fe or alg or EQCAR(cat, 'CombinatorialFunctionCategory)
+ fefull := fe or alg or cat = $CombinatorialFunctionCategory
partialResult :=
- EQCAR(dom, 'Variable) or EQCAR(dom, 'Symbol) =>
+ dom is ["Variable",:.] or dom = $Symbol =>
CAR(cat) in
'(SemiGroup AbelianSemiGroup Monoid AbelianGroup AbelianMonoid
PartialDifferentialRing Ring InputForm) =>
d := ['Polynomial, $Integer]
augmentSub(v, d, SL)
- EQCAR(cat, 'Group) =>
+ cat = $Group =>
d := ['Fraction, ['Polynomial, $Integer]]
augmentSub(v, d, SL)
fefull =>
diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot
index e50f0b4e..0b2807df 100644
--- a/src/interp/i-map.boot
+++ b/src/interp/i-map.boot
@@ -138,7 +138,7 @@ addDefMap(['DEF,lhs,mapsig,.,rhs],pred) ==
-- if map is declared, check that signature arg count is the
-- same as what is given.
if get(op,'mode,$e) is ['Mapping,.,:mapargs] then
- EQCAR(rhs,'rules) =>
+ rhs is ["rules",:.] =>
0 ~= (numargs := # rest lhs) =>
throwKeyedMsg("S2IM0027",[numargs,op])
# rest lhs ~= # mapargs => throwKeyedMsg("S2IM0008",[op])
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index 011ee11f..3ff2f418 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -1963,7 +1963,7 @@ appext(u,x,y,d) ==
d := APP(agg(4,u), x, yptr, d)
temp := 1 + WIDTH agg(2,u) + WIDTH agg(3,u)
n := MAX(WIDTH CADR u, WIDTH agg(4,u), temp)
- if EQCAR(first(z := agg(5,u)), 'EXT) and
+ if first(z := agg(5,u)) is ["EXT",:.] and
(n=3 or (n > 3 and not (atom z)) ) then
n := 1 + n
d := APP(z, x + n, y, d)
@@ -2039,7 +2039,7 @@ extwidth(u) ==
WIDTH agg(4, u),
1 + WIDTH agg(2, u) + WIDTH agg(3, u) )
nil or
- (EQCAR(first(z := agg(5, u)), 'EXT) and _
+ (first(z := agg(5, u)) is ["EXT",:.] and _
(n=3 or ((n > 3) and null atom z) ) =>
n := 1 + n)
true => n + WIDTH agg(5, u)
diff --git a/src/interp/i-resolv.boot b/src/interp/i-resolv.boot
index 31ff3c46..35ca24ce 100644
--- a/src/interp/i-resolv.boot
+++ b/src/interp/i-resolv.boot
@@ -198,7 +198,7 @@ resolveTTSpecial(t1,t2) ==
ofCategory(t2,'(Ring)) => resolveTT(['Polynomial,$Integer],t2)
resolveTT($Symbol,t2)
t1 is ['Variable,x] =>
- EQCAR(t2,'SimpleAlgebraicExtension) => resolveTTSpecial(t2,t1)
+ t2 is ["SimpleAlgebraicExtension",:.] => resolveTTSpecial(t2,t1)
t2 is ['UnivariatePolynomial,y,S] =>
x = y => t2
resolveTT1(['UnivariatePolynomial,x,$Integer],t2)
@@ -218,18 +218,15 @@ resolveTTSpecial(t1,t2) ==
mf ~= mg => NIL
mf
t1 is ['UnivariatePolynomial,x,S] =>
- EQCAR(t2,'Variable) =>
- resolveTTSpecial(t2,t1)
- EQCAR(t2,'SimpleAlgebraicExtension) =>
- resolveTTSpecial(t2,t1)
+ t2 is ["Variable",:.] => resolveTTSpecial(t2,t1)
+ t2 is ["SimpleAlgebraicExtension",:.] => resolveTTSpecial(t2,t1)
t2 is ['UnivariatePolynomial,y,T] =>
(x = y) and (U := resolveTT1(S,T)) and ['UnivariatePolynomial,x,U]
nil
t1 = '(Pi) =>
t2 is ['Complex,d] => defaultTargetFE t2
t2 is ['AlgebraicNumber] => defaultTargetFE t2
- EQCAR(t2, 'Variable) or t2 = $Symbol =>
- defaultTargetFE($Symbol)
+ t2 is ["Variable",:.] or t2 = $Symbol => defaultTargetFE($Symbol)
t2 is ['Polynomial, .] or t2 is ['Fraction, ['Polynomial, .]] =>
defaultTargetFE(t2)
nil
diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot
index 80595c9c..794568e5 100644
--- a/src/interp/i-spec2.boot
+++ b/src/interp/i-spec2.boot
@@ -275,9 +275,9 @@ compileIF(op,cond,a,b,t) ==
m2=m1 => m1
m2 = $Exit => m1
m1 = $Exit => m2
- if EQCAR(m1,"Symbol") then
+ if m1 = $Symbol then
m1:=getMinimalVarMode(getUnname a,$declaredMode)
- if EQCAR(m2,"Symbol") then
+ if m2 = $Symbol then
m2:=getMinimalVarMode(getUnname b,$declaredMode)
(r := resolveTTAny(m2,m1)) => r
rempropI($mapName,'localModemap)
@@ -553,7 +553,7 @@ evalLET(lhs,rhs) ==
$genValue => v
objNew(getValueNormalForm v,objMode v)
if isPartialMode t2 then
- if EQCAR(t1,'Symbol) and $declaredMode then
+ if t1 = $Symbol and $declaredMode then
t1:= getMinimalVarMode(objValUnwrap v,$declaredMode)
t' := t2
null (t2 := resolveTM(t1,t2)) =>
@@ -1174,7 +1174,7 @@ copyHack(env) ==
-- (localModemap . something)
c:= CAAR env
d:= [fn p for p in c] where fn(p) ==
- CONS(CAR p,[(EQCAR(q,'localModemap) => q; copy q) for q in CDR p])
+ CONS(CAR p,[(q is ["localModemap",:.] => q; copy q) for q in CDR p])
[[d]]
diff --git a/src/interp/mark.boot b/src/interp/mark.boot
index 87b66121..84430fb6 100644
--- a/src/interp/mark.boot
+++ b/src/interp/mark.boot
@@ -794,8 +794,8 @@ markInsertChanges(code,form,t,loc) ==
t = $EmptyMode => form
["pretend",form,t]
MEMQ(t,'(rep per)) =>
- t = 'rep and EQCAR(form,'per) => CADR form
- t = 'per and EQCAR(form,'rep) => CADR form
+ t = 'rep and form is ["per",:.] => CADR form
+ t = 'per and form is ["rep",:.] => CADR form
[t,form]
code is [op,x,t1] and MEMQ(op,'(_@ _: _:_: _pretend)) and t1 = t => form
FIXP form and MEMQ(opOf t,$markPrimitiveNumbers) => ['_@,form,t]
diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot
index 4f393257..171dcdcf 100644
--- a/src/interp/nrungo.boot
+++ b/src/interp/nrungo.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
@@ -165,7 +165,7 @@ lookupInTable(op,sig,dollar,[domain,table]) ==
someMatch := true
nil
slot := domain.loc
- EQCAR(slot,'goGet) =>
+ slot is ["goGet",:.] =>
lookupDisplay(op,sig,domain,'" !! goGet found, will ignore")
lookupInAddChain(op,sig,domain,dollar) or 'failed
NULL slot =>
diff --git a/src/interp/posit.boot b/src/interp/posit.boot
index 77911e8b..d1d80a31 100644
--- a/src/interp/posit.boot
+++ b/src/interp/posit.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
@@ -46,7 +46,7 @@ $nopos ==
poNoPosition() == $nopos
pfNoPosition() == poNoPosition()
-poNoPosition? pos == EQCAR(pos,'noposition)
+poNoPosition? pos == pos is ["noposition",:.]
pfNoPosition? pos == poNoPosition? pos
pfSourceText pf ==
diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot
index b8aa8983..bb8c8575 100644
--- a/src/interp/sys-constants.boot
+++ b/src/interp/sys-constants.boot
@@ -343,6 +343,15 @@ $SideEffectFreeFunctionList ==
$Field ==
'(Field)
+$DivisionRing ==
+ '(DivisionRing)
+
+$CombinatorialFunctionCategory ==
+ '(CombinatorialFunctionCategory)
+
+$Group ==
+ '(Group)
+
++ The Void domain constructor form
$Void ==
'(Void)