aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/c-util.boot8
-rw-r--r--src/interp/compiler.boot2
-rw-r--r--src/interp/define.boot20
-rw-r--r--src/interp/functor.boot28
-rw-r--r--src/interp/g-opt.boot48
-rw-r--r--src/interp/i-code.boot12
-rw-r--r--src/interp/i-output.boot4
-rw-r--r--src/interp/i-spec1.boot10
-rw-r--r--src/interp/i-spec2.boot14
-rw-r--r--src/interp/i-util.boot16
-rw-r--r--src/interp/info.boot18
-rw-r--r--src/interp/modemap.boot4
-rw-r--r--src/interp/nruncomp.boot6
-rw-r--r--src/interp/pspad1.boot2
-rw-r--r--src/interp/pspad2.boot4
-rw-r--r--src/interp/slam.boot6
-rw-r--r--src/interp/wi1.boot2
-rw-r--r--src/interp/wi2.boot6
18 files changed, 107 insertions, 103 deletions
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 08bfb572..e124a198 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1029,10 +1029,10 @@ updateCapsuleDirectory(item,pred) ==
--% Tree walkers
-++ Walk VM COND-form mutating sub-forms with unary
+++ Walk VM conditional forms mutating sub-forms with the unary
++ function `fun'
mutateCONDFormWithUnaryFunction(form,fun) ==
- form isnt ["COND",:body] => form
+ form isnt ['%when,:body] => form
for clauses in tails body repeat
-- a clause is a list of forms
for subForms in tails first clauses repeat
@@ -1106,7 +1106,7 @@ eqSubst(args,parms,body) ==
++ Walk `form' and replace simple functions as appropriate.
replaceSimpleFunctions form ==
atomic? form => form
- form is ["COND",:body] =>
+ form is ['%when,:body] =>
mutateCONDFormWithUnaryFunction(form,"replaceSimpleFunctions")
form is ["LET",:.] =>
optLET mutateLETFormWithUnaryFunction(form,"replaceSimpleFunctions")
@@ -1198,7 +1198,7 @@ foldSpadcall form ==
form is ["DECLARE",:.] => form -- don't walk declarations
form is ["LET",inits,:body] =>
mutateLETFormWithUnaryFunction(form,"foldSpadcall")
- form is ["COND",:stmts] =>
+ form is ['%when,:stmts] =>
mutateCONDFormWithUnaryFunction(form,"foldSpadcall")
for args in tails rest form repeat
foldSpadcall first args
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 01e04e22..857ed4b0 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1273,7 +1273,7 @@ canReturn(expr,level,exitCount,ValueFlag) == --SPAD: exit and friends
or/[findThrow(gs,u,level+1,exitCount,ValueFlag) for u in l]
or/[findThrow(gs,u,level,exitCount,ValueFlag) for u in rest expr]
canReturn(data,level,exitCount,ValueFlag)
- op = "COND" or op = '%when =>
+ op = '%when =>
level = exitCount =>
or/[canReturn(last u,level,exitCount,ValueFlag) for u in rest expr]
or/[or/[canReturn(u,level,exitCount,ValueFlag) for u in v]
diff --git a/src/interp/define.boot b/src/interp/define.boot
index c9948720..76b8cc3c 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1187,8 +1187,8 @@ addArgumentConditions($body,$functionName) ==
fn $argumentConditionList where
fn clist ==
clist is [[n,untypedCondition,typedCondition],:.] =>
- ['COND,[typedCondition,fn rest clist],
- ['%true,["argumentDataError",n,
+ ['%when,[typedCondition,fn rest clist],
+ ['%otherwise,["argumentDataError",n,
MKQ untypedCondition,MKQ $functionName]]]
null clist => $body
systemErrorHere ["addArgumentConditions",clist]
@@ -1340,10 +1340,10 @@ uncons x ==
--% CAPSULE
bootStrapError(functorForm,sourceFile) ==
- ['COND, _
+ ['%when, _
['$bootStrapMode, _
['%veclit,mkTypeForm functorForm,nil,nil,nil,nil,nil]],
- [''T, ['systemError,['%listlit,'"%b",MKQ functorForm.op,'"%d",'"from", _
+ ['%otherwise, ['systemError,['%listlit,'"%b",MKQ functorForm.op,'"%d",'"from", _
'"%b",MKQ namestring sourceFile,'"%d",'"needs to be compiled"]]]]
registerInlinableDomain(x,e) ==
@@ -1363,10 +1363,10 @@ compAdd(['add,$addForm,capsule],m,e) ==
$bootStrapMode = true =>
if $addForm is ["%Comma",:.] then code := nil
else [code,m,e]:= comp($addForm,m,e)
- [['COND, _
+ [['%when, _
['$bootStrapMode, _
code],_
- [''T, ['systemError,['%listlit,'"%b",MKQ $functorForm.op,'"%d",'"from", _
+ ['%otherwise, ['systemError,['%listlit,'"%b",MKQ $functorForm.op,'"%d",'"from", _
'"%b",MKQ namestring _/EDITFILE,'"%d",'"needs to be compiled"]]]],m,e]
$addFormLhs: local:= $addForm
if $addForm is ["SubDomain",domainForm,predicate] then
@@ -1569,8 +1569,8 @@ doItIf(item is [.,p,x,y],$predl,$e) ==
if y~="%noBranch" then
compSingleCapsuleItem(y,[["not",p],:$predl],getInverseEnvironment(p,olde))
y':=localExtras(oldFLP)
- item.op := "COND"
- item.rest := [[p',x,:x'],['%true,y,:y']]
+ item.op := '%when
+ item.rest := [[p',x,:x'],['%otherwise,y,:y']]
where localExtras(oldFLP) ==
EQ(oldFLP,$functorLocalParameters) => nil
flp1:=$functorLocalParameters
@@ -1691,7 +1691,7 @@ DomainSubstitutionFunction(parameters,body) ==
--should not bother if it will only be called once
name:= INTERN strconc(KAR $definition,";CAT")
SETANDFILE(name,nil)
- body:= ["COND",[name],['%true,['%store,name,body]]]
+ body:= ['%when,[name],['%otherwise,['%store,name,body]]]
body
@@ -1712,7 +1712,7 @@ compSignature(opsig,pred,env) ==
compCategoryItem(x,predl,env) ==
x is nil => nil
--1. if x is a conditional expression, recurse; otherwise, form the predicate
- x is ["COND",[p,e]] =>
+ x is ['%when,[p,e]] =>
predl':= [p,:predl]
e is ["PROGN",:l] =>
for y in l repeat compCategoryItem(y,predl',env)
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 2ddcff80..fff6c141 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-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -249,22 +249,22 @@ optFunctorBody x ==
l=rest x => x --CONS-saving hack
['%listlit,:l]
x is ['PROGN,:l] => ['PROGN,:optFunctorPROGN l]
- x is ['COND,:l] =>
+ x is ['%when,:l] =>
l:=
[CondClause u for u in l | u and first u] where
CondClause [pred,:conseq] ==
[optFunctorBody pred,:optFunctorPROGN conseq]
- l:= EFFACE(['%true],l) --delete any trailing ("T)
+ l:= EFFACE(['%otherwise],l) --delete any trailing default statement
null l => nil
- CAAR l='%true =>
+ CAAR l='%otherwise =>
(null CDAR l => nil; null CDDAR l => CADAR l; ["PROGN",:CDAR l])
null rest l and null CDAR l =>
- --there is no meat to this COND
+ --there is no meat to this conditional form
pred:= CAAR l
atom pred => nil
first pred="HasCategory" => nil
- ['COND,:l]
- ['COND,:l]
+ ['%when,:l]
+ ['%when,:l]
[optFunctorBody u for u in x]
optFunctorBodyQuotable u ==
@@ -288,7 +288,7 @@ optFunctorPROGN l ==
l
worthlessCode x ==
- x is ['COND,:l] and (and/[x is [.,y] and worthlessCode y for x in l]) => true
+ x is ['%when,:l] and (and/[x is [.,y] and worthlessCode y for x in l]) => true
x is ['PROGN,:l] => (null (l':= optFunctorPROGN l) => true; false)
x is ['%listlit] => true
null x => true
@@ -509,7 +509,7 @@ DescendCode(code,flag,viewAssoc,EnvToPass) ==
--Two REVERSEs leave original order, but ensure last guy wins
nreverse [v for u in reverse codelist |
(v:= DescendCode(u,flag,viewAssoc,EnvToPass))~=nil]]
- code is ['COND,:condlist] =>
+ code is ['%when,:condlist] =>
c:= [[u2:= ProcessCond first u,:q] for u in condlist] where q() ==
null u2 => nil
f:=
@@ -529,7 +529,7 @@ DescendCode(code,flag,viewAssoc,EnvToPass) ==
--strip out some worthless junk at the end
c:=nreverse rest nreverse c
null c => '(LIST)
- ['COND,:c]
+ ['%when,:c]
code is ["%LET",name,body,:.] =>
--only keep the names that are useful
u:=member(name,$locals) =>
@@ -538,7 +538,7 @@ DescendCode(code,flag,viewAssoc,EnvToPass) ==
code:=["setShellEntry",["getShellEntry",'$,5],#$locals-#u,code]
$epilogue:=
TruthP flag => [code,:$epilogue]
- [['COND,[ProcessCond flag,code]],:$epilogue]
+ [['%when,[ProcessCond flag,code]],:$epilogue]
nil
code
code -- doItIf deletes entries from $locals so can't optimize this
@@ -554,7 +554,7 @@ DescendCode(code,flag,viewAssoc,EnvToPass) ==
if not $insideCategoryPackageIfTrue then
updateCapsuleDirectory(rest u, flag)
ConstantCreator u =>
- if not (flag=true) then u:= ['COND,[ProcessCond flag,u]]
+ if not (flag=true) then u:= ['%when,[ProcessCond flag,u]]
$ConstantAssignments:= [u,:$ConstantAssignments]
nil
u
@@ -744,8 +744,8 @@ InvestigateConditions catvecListMaker ==
-- here we build the code necessary to remove spurious extensions
($HackSlot4:= [reshape u for u in $HackSlot4]) where
reshape u ==
- ['COND,[TryGDC ICformat rest u],
- ['%true,['RPLACA,'(CAR TrueDomain),
+ ['%when,[TryGDC ICformat rest u],
+ ['%otherwise,['RPLACA,'(CAR TrueDomain),
['delete,['QUOTE,first u],'(CAAR TrueDomain)]]]]
$supplementaries:=
[u
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index b02b81b3..9d971018 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -268,19 +268,20 @@ optMkRecord ["mkRecord",:u] ==
#u=2 => ['%makepair,:u]
['%veclit,:u]
-optCond (x is ['COND,:l]) ==
- if l is [a,[aa,b]] and aa = '%true and b is ['COND,:c] then
+optCond (x is ['%when,:l]) ==
+ if l is [a,[aa,b]] and aa = '%otherwise and b is ['%when,:c] then
x.rest.rest := c
if l is [[p1,:c1],[p2,:c2],:.] then
if (p1 is ['%not,=p2]) or (p2 is ['%not,=p1]) then
- l:=[[p1,:c1],['%true,:c2]]
+ l:=[[p1,:c1],['%otherwise,:c2]]
x.rest := l
- c1 is ['NIL] and p2 = '%true and first c2 = '%true =>
+ c1 is ['NIL] and p2 = '%otherwise and first c2 = '%otherwise =>
return optNot ['%not,p1]
- l is [[p1,:c1],[p2,:c2],[p3,:c3]] and p3 = '%true =>
+ l is [[p1,:c1],[p2,:c2],[p3,:c3]] and p3 = '%otherwise =>
EqualBarGensym(c1,c3) =>
- optCond ['COND,[['%or,p1,['%not,p2]],:c1],['%true,:c2]]
- EqualBarGensym(c1,c2) => optCond ['COND,[['%or,p1,p2],:c1],['%true,:c3]]
+ optCond ['%when,[['%or,p1,['%not,p2]],:c1],['%otherwise,:c2]]
+ EqualBarGensym(c1,c2) =>
+ optCond ['%when,[['%or,p1,p2],:c1],['%otherwise,:c3]]
x
for y in tails l repeat
while y is [[a1,c1],[a2,c2],:y'] and EqualBarGensym(c1,c2) repeat
@@ -308,18 +309,19 @@ EqualBarGensym(x,y) ==
atom x or atom y => false
fn(first x,first y) and fn(rest x,rest y)
---Called early, to change IF to COND
+--Called early, to change IF to conditional form
optIF2COND ["IF",a,b,c] ==
- b is "%noBranch" => ["COND",[['%not,a],c]]
- c is "%noBranch" => ["COND",[a,b]]
- c is ["IF",:.] => ["COND",[a,b],:rest optIF2COND c]
- c is ["COND",:p] => ["COND",[a,b],:p]
- ["COND",[a,b],['%true,c]]
+ b is "%noBranch" => ['%when,[['%not,a],c]]
+ c is "%noBranch" => ['%when,[a,b]]
+ c is ["IF",:.] => ['%when,[a,b],:rest optIF2COND c]
+ c is ['%when,:p] => ['%when,[a,b],:p]
+ ['%when,[a,b],['%otherwise,c]]
optXLAMCond x ==
- x is ["COND",u:= [p,c],:l] =>
- (p = '%true => c; ["COND",u,:optCONDtail l])
+ x is ['%when,u:= [p,c],:l] =>
+ p = '%otherwise => c
+ ['%when,u,:optCONDtail l]
atom x => x
x.first := optXLAMCond first x
x.rest := optXLAMCond rest x
@@ -328,8 +330,8 @@ optXLAMCond x ==
optCONDtail l ==
null l => nil
[frst:= [p,c],:l']:= l
- p = '%true => [['%true,c]]
- null rest l => [frst,['%true,["CondError"]]]
+ p = '%otherwise => [['%otherwise,c]]
+ null rest l => [frst,['%otherwise,["CondError"]]]
[frst,:optCONDtail l']
++ Determine whether the symbol `g' is the name of a temporary that
@@ -357,12 +359,12 @@ optSEQ ["SEQ",:l] ==
--this gets rid of unwanted labels generated by declarations in SEQs
[first l,:getRidOfTemps rest l]
SEQToCOND l ==
- transform:= [[a,b] for x in l while (x is ["COND",[a,["EXIT",b]]])]
+ transform:= [[a,b] for x in l while (x is ['%when,[a,["EXIT",b]]])]
before:= take(#transform,l)
aft:= after(l,before)
null before => ["SEQ",:aft]
- null aft => ["COND",:transform,'(%true (conderr))]
- optCond ["COND",:transform,['%true,optSEQ ["SEQ",:aft]]]
+ null aft => ['%when,:transform,'(%otherwise (conderr))]
+ optCond ['%when,:transform,['%otherwise,optSEQ ["SEQ",:aft]]]
tryToRemoveSEQ l ==
l is ["SEQ",[op,a]] and op in '(EXIT RETURN THROW) => a
l
@@ -425,7 +427,7 @@ $simpleVMoperators ==
append($VMsideEffectFreeOperators,
['STRINGIMAGE,'FUNCALL,'%gensym, '%lreverse_!,
'%strstc,'%makepair,'%makebitvec,'%makevector,
- "MAKE-FULL-CVEC","BVEC-MAKE-FULL","COND"])
+ "MAKE-FULL-CVEC","BVEC-MAKE-FULL"])
++ Return true if the `form' is semi-simple with respect to
++ to the list of operators `ops'.
@@ -509,7 +511,7 @@ optLET u ==
body isnt [op,:args] => u
-- Well, with case-patterns, it is beneficial to try a bit harder
-- with conditional forms.
- op = "COND" =>
+ op = '%when =>
continue := true -- shall be continue let-inlining?
-- Since we do a single pass, we can't reuse the inits list
-- as we may find later that we can't really inline into
@@ -760,7 +762,7 @@ for x in '( (%call optCall) _
(SPADCALL optSPADCALL)_
(_| optSuchthat)_
(CATCH optCatch)_
- (COND optCond)_
+ (%when optCond)_
(%retract optRetract)_
(%CollectV optCollectVector)_
(mkRecord optMkRecord)_
diff --git a/src/interp/i-code.boot b/src/interp/i-code.boot
index 5794e271..8dc692df 100644
--- a/src/interp/i-code.boot
+++ b/src/interp/i-code.boot
@@ -1,5 +1,7 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
+-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are
@@ -72,8 +74,8 @@ intCodeGenCOERCE(triple,t2) ==
objNew(['PROGN,:code,getValueNormalForm
intCodeGenCOERCE(objNew(lastCode,t1),t2)],t2)
- val is ['COND,:conds] =>
- objNew(['COND,
+ val is ['%when,:conds] =>
+ objNew(['%when,
:[[p,getValueNormalForm intCodeGenCOERCE(objNew(v,t1),t2)]
for [p,v] in conds]],t2)
@@ -92,10 +94,10 @@ intCodeGenCOERCE(triple,t2) ==
coerceByFunction(triple,t2)
-- next is hack for if-then-elses
- (t1 = '$NoValueMode) and (val is ['COND,pred]) =>
+ (t1 = '$NoValueMode) and (val is ['%when,pred]) =>
code :=
- ['COND,pred,
- [MKQ true,['throwKeyedMsg,MKQ "S2IM0016",MKQ $mapName]]]
+ ['%when,pred,
+ ['%otherwise,['throwKeyedMsg,MKQ "S2IM0016",MKQ $mapName]]]
objNew(code,t2)
-- optimize coerces to Expression
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index 41693905..cda260f4 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -971,7 +971,7 @@ getBindingPowerOf(key,x) ==
--binding powers can be found in file NEWAUX LISP
x is ['REDUCE,:.] => (key='left => 130; key='right => 0)
x is ["REPEAT",:.] => (key="left" => 130; key="right" => 0)
- x is ["COND",:.] => (key="left" => 130; key="right" => 0)
+ x is ['%when,:.] => (key="left" => 130; key="right" => 0)
x is [op,:argl] =>
if op is [a,:.] then op:= a
op = 'SLASH => getBindingPowerOf(key,["/",:argl]) - 1
diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot
index e7ea5044..3c692e3d 100644
--- a/src/interp/i-spec1.boot
+++ b/src/interp/i-spec1.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -347,10 +347,10 @@ upcase t ==
rhstag = first unwrap objVal triple => code := wrap true
code := wrap false
code :=
- ["COND",
+ ['%when,
[["EQL",rhstag,["CAR",["unwrap",objVal triple]]],
true],
- [''T,false]]
+ ['%otherwise,false]]
else
$genValue =>
t' := coerceUnion2Branch triple
@@ -358,10 +358,10 @@ upcase t ==
code := wrap false
triple' := objNewCode(["wrap",objVal triple],objMode triple)
code :=
- ["COND",
+ ['%when,
[["EQUAL",MKQ rhs,["objMode",['coerceUnion2Branch,triple']]],
true],
- [''T,false]]
+ ['%otherwise,false]]
putValue(op,objNew(code,$Boolean))
putModeSet(op,[$Boolean])
diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot
index 1f6d4707..882d5795 100644
--- a/src/interp/i-spec2.boot
+++ b/src/interp/i-spec2.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -294,7 +294,7 @@ evalIF(op,[cond,a,b],m) ==
$lastLineInSEQ => [[MKQ true,["voidValue"]]]
NIL
[[MKQ true,genIFvalCode(b,m)]]
- code:=["COND",[getArgValue(cond,$Boolean),
+ code:=['%when,[getArgValue(cond,$Boolean),
genIFvalCode(a,m)],:elseCode]
triple:= objNew(code,m)
putValue(op,triple)
@@ -312,14 +312,14 @@ IFcodeTran(code,m,m1) ==
null code => code
code is ["spadThrowBrightly",:.] => code
m1 = $Exit => code
- code isnt ["COND",[p1,a1],[''T,a2]] =>
+ code isnt ['%when,[p1,a1],['%otherwise,a2]] =>
m = $Void => code
code' := coerceInteractive(objNew(quote2Wrapped code,m1),m) =>
getValueNormalForm code'
throwKeyedMsgCannotCoerceWithValue(quote2Wrapped code,m1,m)
a1:=IFcodeTran(a1,m,m1)
a2:=IFcodeTran(a2,m,m1)
- ['COND,[p1,a1],[''T,a2]]
+ ['%when,[p1,a1],['%otherwise,a2]]
interpIF(op,cond,a,b) ==
-- non-compiled version of IF type analyzer. Doesn't resolve accross
@@ -402,8 +402,8 @@ compileIs(val,pattern) ==
for var in removeDuplicates vars repeat
assignCode:=[["%LET",var,["CDR",["ASSQ",MKQ var,g]]],:assignCode]
null $opIsIs =>
- ["COND",[["EQ",predCode,MKQ "failed"],["SEQ",:assignCode,MKQ 'T]]]
- ["COND",[["NOT",["EQ",predCode,MKQ "failed"]],["SEQ",:assignCode,MKQ 'T]]]
+ ['%when,[["EQ",predCode,MKQ "failed"],["SEQ",:assignCode,'%true]]]
+ ['%when,[['%not,["EQ",predCode,MKQ "failed"]],["SEQ",:assignCode,'%true]]]
evalIsPredicate(value,pattern,mode) ==
--This function pattern matches value to pattern, and returns
@@ -606,7 +606,7 @@ upLETWithPatternOnLhs(t := [op,pattern,a]) ==
null objValUnwrap object => eval failCode
putValue(op,getValue a)
else
- code := ['COND,[objVal object,objVal getValue a],[''T,failCode]]
+ code := ['%when,[objVal object,objVal getValue a],['%otherwise,failCode]]
putValue(op,objNew(code,m))
putModeSet(op,[m])
diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot
index 6563be32..fde45dfb 100644
--- a/src/interp/i-util.boot
+++ b/src/interp/i-util.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -160,18 +160,18 @@ validateVariableNameOrElse var ==
--%
flattenCOND body ==
- -- transforms nested COND clauses to flat ones, if possible
- body isnt ['COND,:.] => body
- ['COND,:extractCONDClauses body]
+ -- transforms nested conditional clauses to flat ones, if possible
+ body isnt ['%when,:.] => body
+ ['%when,:extractCONDClauses body]
extractCONDClauses clauses ==
- -- extracts nested COND clauses into a flat structure
- clauses is ['COND, [pred1,:act1],:restClauses] =>
+ -- extracts nested conditional clauses into a flat structure
+ clauses is ['%when, [pred1,:act1],:restClauses] =>
if act1 is [['PROGN,:acts]] then act1 := acts
- restClauses is [[''T,restCond]] =>
+ restClauses is [['%otherwise,restCond]] =>
[[pred1,:act1],:extractCONDClauses restCond]
[[pred1,:act1],:restClauses]
- [[''T,clauses]]
+ [['%otherwise,clauses]]
++ Returns true if symbol `id' is either a local variable
++ or an iterator variable.
diff --git a/src/interp/info.boot b/src/interp/info.boot
index 9eba51de..4584a2a8 100644
--- a/src/interp/info.boot
+++ b/src/interp/info.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2009, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -45,7 +45,7 @@
--% (has domainname categoryexpression)
--% --These are also stored as 'value' properties
--% Conditional attributes are of the form
---% (COND
+--% (%when
--% (condition info info ...)
--% ... )
--% where the condition looks like a 'has' clause, or the 'and' of several
@@ -93,14 +93,14 @@ formatInfo u ==
isCategoryForm(v,$e) => ["has","$",v]
["ATTRIBUTE","$",v]
u is ["IF",a,b,c] =>
- c="%noBranch" => ["COND",:liftCond [formatPred a,formatInfo b]]
- b="%noBranch" => ["COND",:liftCond [["not",formatPred a],formatInfo c]]
- ["COND",:liftCond [formatPred a,formatInfo b],:
+ c="%noBranch" => ['%when,:liftCond [formatPred a,formatInfo b]]
+ b="%noBranch" => ['%when,:liftCond [["not",formatPred a],formatInfo c]]
+ ['%when,:liftCond [formatPred a,formatInfo b],:
liftCond [["not",formatPred a],formatInfo c]]
systemError ['"formatInfo",u]
liftCond (clause is [ante,conseq]) ==
- conseq is ["COND",:l] =>
+ conseq is ['%when,:l] =>
[[lcAnd(ante,a),:b] for [a,:b] in l] where
lcAnd(pred,conj) ==
conj is ["and",:ll] => ["and",pred,:ll]
@@ -127,7 +127,7 @@ chaseInferences(pred,$e) ==
$e:= actOnInfo(pred,$e)
pred:= infoToHas pred
for u in get("$Information","special",$e) repeat
- u is ["COND",:l] =>
+ u is ['%when,:l] =>
for [ante,:conseq] in l repeat
ante=pred => [foo w for w in conseq]
ante is ["and",:ante'] and member(pred,ante') =>
@@ -135,7 +135,7 @@ chaseInferences(pred,$e) ==
v':=
# ante'=1 => first ante'
["and",:ante']
- v':= ["COND",[v',:conseq]]
+ v':= ['%when,[v',:conseq]]
member(v',get("$Information","special",$e)) => nil
$e:=
put("$Information","special",[v',:
@@ -212,7 +212,7 @@ actOnInfo(u,$e) ==
$e:=
put("$Information","special",Info:= [u,:get("$Information","special",$e)],$e
)
- u is ["COND",:l] =>
+ u is ['%when,:l] =>
--there is nowhere %else that this sort of thing exists
for [ante,:conseq] in l repeat
if member(hasToInfo ante,Info) then for v in conseq repeat
diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot
index 1fabebd8..545d56e3 100644
--- a/src/interp/modemap.boot
+++ b/src/interp/modemap.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -277,7 +277,7 @@ AMFCR_,redefined(opname,u) ==
not(u is [op,:l]) => nil
op = 'DEF => opname = CAAR l
op in '(PROGN SEQ) => AMFCR_,redefinedList(opname,l)
- op = 'COND => "OR"/[AMFCR_,redefinedList(opname,rest u) for u in l]
+ op = '%when => "OR"/[AMFCR_,redefinedList(opname,rest u) for u in l]
augModemapsFromCategory(domainName,domainView,functorForm,categoryForm,e) ==
[fnAlist,e]:= evalAndSub(domainName,domainView,functorForm,categoryForm,e)
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index ddcbb16e..f09d5b67 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -374,7 +374,7 @@ NRTdescendCodeTran(u,condList) ==
fn is ['dispatchFunction,fn'] => fn'
fn
nil --code for this will be generated by the instantiator
- u is ['COND,:c] =>
+ u is ['%when,:c] =>
for [pred,:y] in c|y repeat NRTdescendCodeTran(first y,[pred,:condList])
u is ['PROGN,:c] => for x in c repeat NRTdescendCodeTran(x,condList)
nil
@@ -408,7 +408,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
-- (PROGN (%LET Rep ...)
-- (: (ListOf x y) $)
-- (CodeDefine (<op> <signature> <functionName>))
--- (COND ((HasCategory $ ...) (PROGN ...))) ..)
+-- (%when ((HasCategory $ ...) (PROGN ...))) ..)
-- $locals: list of variables to go into slot 5, e.g. (R Rep R,1 R,2 R,3 R,4)
-- same as $functorLocalParameters
-- this list is not augmented by this function
@@ -693,7 +693,7 @@ NRTputInHead bod ==
nil
NRTputInHead fn
bod
- bod is ["COND",:clauses] =>
+ bod is ['%when,:clauses] =>
for cc in clauses repeat NRTputInTail cc
bod
bod is ["QUOTE",:.] => bod
diff --git a/src/interp/pspad1.boot b/src/interp/pspad1.boot
index 9d6c301b..b478826c 100644
--- a/src/interp/pspad1.boot
+++ b/src/interp/pspad1.boot
@@ -524,7 +524,7 @@ pspadBindingPowerOf(key,x) ==
--binding powers can be found in file NEWAUX LISP
x is ['REDUCE,:.] => (key='left => 130; key='right => 0)
x is ["REPEAT",:.] => (key="left" => 130; key="right" => 0)
- x is ["COND",:.] => (key="left" => 130; key="right" => 0)
+ x is ['%when,:.] => (key="left" => 130; key="right" => 0)
x is [op,:argl] =>
if op is [a,:.] then op:= a
op = 'SLASH => pspadBindingPowerOf(key,["/",:argl]) - 1
diff --git a/src/interp/pspad2.boot b/src/interp/pspad2.boot
index a3106eab..aac07f64 100644
--- a/src/interp/pspad2.boot
+++ b/src/interp/pspad2.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -298,7 +298,7 @@ formatColonWith(form,a,b) ==
and format a and format " with ",first b,"with","Led")
tryBreak(formatDefForm form and format ": with ",a,"with","Nud")
-formatCOND ["COND",:l] ==
+formatCOND ['%when,:l] ==
originalC:= $c
and/[x is [a,[.,.,b]] for x in l] =>
(originalC=$m or indent() and newLine()) and first l is [a,[.,.,b]] and
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index 7bc05b3b..9855b201 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -46,13 +46,13 @@ isRecurrenceRelation(op,body,minivectorName) ==
-- p1,...,pk respectively; body has #2,#3,... in place of
-- f(k-1),f(k-2),...
- body isnt ['COND,:pcl] => false
+ body isnt ['%when,:pcl] => false
-- body should have a conditional expression which
-- gives k boundary values, one general term plus possibly an
-- "out of domain" condition
--pcl is [:.,[ ''T,:mess]] and not (CONTAINED('throwMessage,mess) or
-- CONTAINED('throwKeyedMsg,mess)) => NIL
- pcl := [x for x in pcl | not (x is [''T,:mess] and
+ pcl := [x for x in pcl | not (x is ['%otherwise,:mess] and
(CONTAINED('throwMessage,mess) or
CONTAINED('throwKeyedMsg,mess)))]
integer := eval $Integer
@@ -125,7 +125,7 @@ mkDiffAssoc(op,body,k,sharpPosition,sharpArg,diffSlot,vecname) ==
-- ( ((f (,DIFFERENCE #1 1)) . #2) ((f (,DIFFERENCE #1 2)) . #3) ...)
-- but also checking that all difference values lie in 1..k
atom body => nil
- body is ['COND,:pl] =>
+ body is ['%when,:pl] =>
"union"/[mkDiffAssoc(op,c,k,sharpPosition,sharpArg,diffSlot,vecname) for [p,c] in pl]
body is [fn,:argl] =>
(fn = op) and argl.(sharpPosition-1) is
diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot
index 120500d4..508213c5 100644
--- a/src/interp/wi1.boot
+++ b/src/interp/wi1.boot
@@ -664,7 +664,7 @@ canReturn(expr,level,exitCount,ValueFlag) == --SPAD: exit and friends
or/[findThrow(gs,u,level+1,exitCount,ValueFlag) for u in l]
or/[findThrow(gs,u,level,exitCount,ValueFlag) for u in rest expr]
canReturn(data,level,exitCount,ValueFlag)
- op = "COND" =>
+ op = '%when =>
level = exitCount =>
or/[canReturn(last u,level,exitCount,ValueFlag) for u in rest expr]
or/[or/[canReturn(u,level,exitCount,ValueFlag) for u in v]
diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot
index f519b830..c20dfa18 100644
--- a/src/interp/wi2.boot
+++ b/src/interp/wi2.boot
@@ -927,7 +927,7 @@ chaseInferences(origPred,$e) ==
$e:= actOnInfo(pred,$e)
pred:= infoToHas pred
for u in get("$Information","special",$e) repeat
- u is ["COND",:l] =>
+ u is ['%when,:l] =>
for [ante,:conseq] in l repeat
ante=pred => [foo w for w in conseq]
ante is ["and",:ante'] and member(pred,ante') =>
@@ -935,7 +935,7 @@ chaseInferences(origPred,$e) ==
v':=
# ante'=1 => first ante'
["and",:ante']
- v':= ["COND",[v',:conseq]]
+ v':= ['%when,[v',:conseq]]
member(v',get("$Information","special",$e)) => nil
$e:=
put("$Information","special",[v',:
@@ -1013,7 +1013,7 @@ doItIf(item is [.,p,x,y],$predl,$e) ==
qe(21,compSingleCapsuleItem(y,[['not, p],:$predl],getInverseEnvironment(markKillAll p,olde)))
--> -----------
y':=localExtras(oldFLP)
- wiReplaceNode(item,["COND",[p',x,:x'],['%true,y,:y']],12)
+ wiReplaceNode(item,['%when,[p',x,:x'],['%otherwise,y,:y']],12)
doItSeq item ==
['SEQ,:l,['exit,1,x]] := item