diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/c-util.boot | 8 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 2 | ||||
| -rw-r--r-- | src/interp/define.boot | 20 | ||||
| -rw-r--r-- | src/interp/functor.boot | 28 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 48 | ||||
| -rw-r--r-- | src/interp/i-code.boot | 12 | ||||
| -rw-r--r-- | src/interp/i-output.boot | 4 | ||||
| -rw-r--r-- | src/interp/i-spec1.boot | 10 | ||||
| -rw-r--r-- | src/interp/i-spec2.boot | 14 | ||||
| -rw-r--r-- | src/interp/i-util.boot | 16 | ||||
| -rw-r--r-- | src/interp/info.boot | 18 | ||||
| -rw-r--r-- | src/interp/modemap.boot | 4 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 6 | ||||
| -rw-r--r-- | src/interp/pspad1.boot | 2 | ||||
| -rw-r--r-- | src/interp/pspad2.boot | 4 | ||||
| -rw-r--r-- | src/interp/slam.boot | 6 | ||||
| -rw-r--r-- | src/interp/wi1.boot | 2 | ||||
| -rw-r--r-- | src/interp/wi2.boot | 6 |
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 |