aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog11
-rw-r--r--src/interp/c-util.boot4
-rw-r--r--src/interp/define.boot10
-rw-r--r--src/interp/g-opt.boot8
-rw-r--r--src/interp/g-util.boot33
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 ==