diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 11 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 4 | ||||
| -rw-r--r-- | src/interp/define.boot | 10 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 8 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 33 |
5 files changed, 39 insertions, 27 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 7211d968..4e86d93b 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,16 @@ 2012-02-26 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/g-util.boot (usedSymbol?): Remove. + (bindingForm?): New. + (usesVariable?): Likewise. + * interp/compiler.boot (declareUnusedParameters): Use it. + * interp/g-opt.boot (inlineLocals): Likewise. + (optClosure): Likewise. + (optBind): Likewise. + * interp/define.boot (compContained): Remove. + +2012-02-26 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/c-util.boot (numOfOccurencesOf): Tidy. * interp/compiler.boot (compUnnamedMapping): Fix thinko. * interp/g-opt.boot (semiSimpleRelativeTo?): Likewise. diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 0e4b2705..d0c24e38 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -336,7 +336,7 @@ declareUnusedParameters x == (augment x; x) where atomic? x => nil x is [op,parms,body] and abstractionOperator? op => augment body - unused := [p for p in parms | not usedSymbol?(p,body)] + unused := [p for p in parms | not usesVariable?(body,p)] null unused => [body] x.rest.rest := [["DECLARE",["IGNORE",:unused]],body] for x' in x repeat @@ -1398,7 +1398,7 @@ expandableDefinition?(vars,body) == expand? := -- We definitely don't want to expand a form that uses -- the domain of computation environment. - vars isnt [:vars',env] or CONTAINED(env,body) => false + vars isnt [:vars',env] or usesVariable?(body,env) => false -- Constants are currently implemented as niladic functions, and -- we want to avoid disturbing object identity, so we rule diff --git a/src/interp/define.boot b/src/interp/define.boot index 495a9cc9..025eb880 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -2207,7 +2207,7 @@ compSubDomain1(domainForm,predicate,m,e) == " cannot be interpreted with #1: ",domainForm],nil) pred := simplifyVMForm u.expr -- For now, reject predicates that directly reference domains - CONTAINED("$",pred) => + usesVariable?(pred,'$) => stackAndThrow('"predicate %1pb is not simple enough",[predicate]) emitSubdomainInfo($form,domainForm,pred) [domainForm,m,e] @@ -2386,14 +2386,6 @@ doItIf(item is [.,p,x,y],$predl,$e) == --% CATEGORY AND DOMAIN FUNCTIONS -compContained: (%Form, %Mode, %Env) -> %Maybe %Triple -compContained(["CONTAINED",a,b],m,e) == - [a,ma,e]:= comp(a,$EmptyMode,e) or return nil - [b,mb,e]:= comp(b,$EmptyMode,e) or return nil - isCategoryForm(ma,e) and isCategoryForm(mb,e) => - (T:= [["CONTAINED",a,b],$Boolean,e]; convert(T,m)) - nil - compJoin(["Join",:argl],m,e) == catList:= [(compForMode(x,$Category,e) or return 'failed).expr for x in argl] catList='failed => stackSemanticError(["cannot form Join of: ",argl],nil) diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index c953c3e3..51bc8cef 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -244,8 +244,8 @@ inlineLocals! x == walkWith!(x,function f) where kept := nil while inits is [u,:inits] repeat [y,z] := u - usedSymbol?(y,z) or usedSymbol?(y,inits) => kept := [u,:kept] - or/[usedSymbol?(v,z) for [v,.] in kept] => kept := [u,:kept] + usesVariable?(z,y) or usesVariable?(inits,y) => kept := [u,:kept] + or/[usesVariable?(z,v) for [v,.] in kept] => kept := [u,:kept] canInlineVarDefinition(y,z,x.absBody) => x.absBody := substitute!(z,y,x.absBody) kept := [u,:kept] @@ -560,7 +560,7 @@ optClosure(x is ['%closure,fun,env]) == do vars is [:vars',=env] => body is [op,: =vars] => x.args := [['%function,op],env] - not CONTAINED(env,body) => x.args := [fun,'%nil] + not usesVariable?(body,env) => x.args := [fun,'%nil] x x @@ -776,7 +776,7 @@ optBind form == form isnt ['%bind,inits,.] => form -- accept only simple bodies while inits ~= nil repeat [var,expr] := first inits - usedSymbol?(var,rest inits) => leave nil -- no dependency, please. + usesVariable?(rest inits,var) => leave nil -- no dependency, please. body := third form canInlineVarDefinition(var,expr,body) => third(form) := substitute!(expr,var,body) diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 2d921148..95d26cb4 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -43,17 +43,37 @@ module g_-util where pairList: (%List %Form,%List %Form) -> %List %Pair(%Form,%Form) mkList: %List %Form -> %Form isSubDomain: (%Mode,%Mode) -> %Form - usedSymbol?: (%Symbol,%Code) -> %Boolean isDefaultPackageName: %Symbol -> %Boolean makeDefaultPackageName: %String -> %Symbol spliceSeqArgs: %List %Code -> %Code mkSeq: %List %Code -> %Code + usesVariable?: (%Code,%Symbol) -> %Boolean --% abstraction? x == x is [op,:.] and ident? op and abstractionOperator? op +bindingForm? x == + x is [op,:.] and ident? op and op in '(%bind LET) + +++ Return true if `form' uses symbol `var'. +usesVariable?(form,var) == + symbol? form => symbolEq?(form,var) + atomic? form => false + abstraction? form => + not symbolMember?(var,form.absParms) and usesVariable?(form.absBody,var) + form.op is [.,:.] and usesVariable?(form.op,var) => true + bindingForm? form => + x := + or/[usesVariable?(second parm,var) + or symbolEq?(first parm,var) and leave 'bound + for parm in form.absParms] + x is 'bound => false + x or usesVariable?(form.absBody,var) + -- a variable can be used only in argument position. + or/[usesVariable?(x,var) for x in form.args] + hasNoLeave?(expr,g) == atomic? expr => true expr is ['%leave, =g,:.] => false @@ -192,17 +212,6 @@ macro builtinConstructor? s == $AbstractionOperator == '(LAM ILAM SLAM XLAM SPADSLAM LAMBDA %lambda) -++ Return true if the symbol 's' is used in the form 'x'. -usedSymbol?(s,x) == - symbol? x => s = x - x isnt [.,:.] => false - x is ['QUOTE,:.] => false - x is [op,parms,:body] and abstractionOperator? op => - symbolMember?(s,parms) => false - usedSymbol?(s,body) - or/[usedSymbol?(s,x') for x' in x] - - ++ Return the character designated by the string `s'. stringToChar: %String -> %Char stringToChar s == |