diff options
author | dos-reis <gdr@axiomatics.org> | 2009-09-02 16:20:53 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2009-09-02 16:20:53 +0000 |
commit | d2c2747da6be576cc592bcb3f046356af2bfca9b (patch) | |
tree | a4108a95f284d9ee425f32d4027db0edab9975f4 /src/interp | |
parent | 327b4fb2c149c02dd72f3d8f6070b6e0144828ee (diff) | |
download | open-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.boot | 8 | ||||
-rw-r--r-- | src/interp/g-boot.boot | 19 | ||||
-rw-r--r-- | src/interp/i-funsel.boot | 26 | ||||
-rw-r--r-- | src/interp/i-map.boot | 2 | ||||
-rw-r--r-- | src/interp/i-output.boot | 4 | ||||
-rw-r--r-- | src/interp/i-resolv.boot | 11 | ||||
-rw-r--r-- | src/interp/i-spec2.boot | 8 | ||||
-rw-r--r-- | src/interp/mark.boot | 4 | ||||
-rw-r--r-- | src/interp/nrungo.boot | 4 | ||||
-rw-r--r-- | src/interp/posit.boot | 4 | ||||
-rw-r--r-- | src/interp/sys-constants.boot | 9 |
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) |