aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2010-05-03 20:51:40 +0000
committerdos-reis <gdr@axiomatics.org>2010-05-03 20:51:40 +0000
commit6c0cc18deacadb592fe3d68c5585979f6902cd1a (patch)
treee6a692a4192af9746f755e855c3dfb33e99cfcfd /src/interp
parent41cb0a1a53d9022c9461c6c9137329a252b455dd (diff)
downloadopen-axiom-6c0cc18deacadb592fe3d68c5585979f6902cd1a.tar.gz
Generate more readable code for functor definitions.
* interp/nruncomp.boot (washFunctorBody): New. (buildFunctor): Use it. * interp/g-opt.boot (optBind): New. (optLIST): Likewise.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/g-opt.boot9
-rw-r--r--src/interp/nruncomp.boot50
2 files changed, 46 insertions, 13 deletions
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 31420217..3b0e5b28 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -529,6 +529,13 @@ optLET_* form ==
rplac(first form,"LET")
optLET form
+optBind form ==
+ rplac(first form,"LET*")
+ optLET_* form
+
+optLIST form ==
+ form is ["LIST"] => nil
+ form
optCollectVector form ==
[.,eltType,:iters,body] := form
@@ -587,6 +594,8 @@ for x in '( (call optCall) _
(SEQ optSEQ)_
(LET optLET)_
(LET_* optLET_*)_
+ (%Bind optBind)_
+ (LIST optLIST)_
(MINUS optMINUS)_
(QSMINUS optQSMINUS)_
(_- opt_-)_
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 69a50c7a..e4612f58 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -377,6 +377,26 @@ NRTdescendCodeTran(u,condList) ==
u is ['PROGN,:c] => for x in c repeat NRTdescendCodeTran(x,condList)
nil
+++ Remove useless statements from the elaboration `form' of
+++ a function definition.
+washFunctorBody form == main form where
+ main form ==
+ form' := nil
+ for x in form repeat
+ stmt := clean x
+ stmt = nil => nil
+ stmt is ["PROGN",:l] => form' := [:form',:l]
+ form' := [:form',stmt]
+ form'
+
+ clean x ==
+ x is ["PROGN",:stmts] =>
+ stmts := [s' for s in stmts | (s' := clean s) ~= nil]
+ stmts = nil => nil
+ rest stmts = nil => first stmts
+ ["PROGN",:stmts]
+ x is ["LIST"] => nil
+ x
buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
--PARAMETERS
@@ -459,24 +479,27 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
:predBitVectorCode2,storeOperationCode]
$CheckVectorList := NRTcheckVector domainShell
- --CODE: part 1
- codePart1:= [:devaluateCode,createDomainCode,
- createViewCode,setVector0Code, slot3Code,:slamCode] where
- devaluateCode:= [["%LET",b,['devaluate,a]] for [a,:b] in $devaluateList]
+ -- Local bindings
+ bindings := [:devaluateCode,createDomainCode,
+ createViewCode,createPredVecCode] where
+ devaluateCode:= [[b,["devaluate",a]] for [a,:b] in $devaluateList]
createDomainCode:=
- ["%LET",domname,['LIST,MKQ first $definition,:ASSOCRIGHT $devaluateList]]
- createViewCode:= ["%LET",'$,["newShell", $NRTbase + $NRTdeltaLength]]
- setVector0Code:=[$setelt,'$,0,'dv_$]
- slot3Code := ["setShellEntry",'$,3,["%LET",'pv_$,predBitVectorCode1]]
+ [domname,['LIST,MKQ first $definition,:ASSOCRIGHT $devaluateList]]
+ createViewCode:= ["$",["newShell", $NRTbase + $NRTdeltaLength]]
+ createPredVecCode := ["pv$",predBitVectorCode1]
+
+ --CODE: part 1
+ codePart1:= [setVector0Code, slot3Code,:slamCode] where
+ setVector0Code:=[$setelt,"$",0,"dv$"]
+ slot3Code := ["setShellEntry","$",3,"pv$"]
slamCode:=
isCategoryPackageName opOf $definition => nil
- [NRTaddToSlam($definition,'$)]
+ [NRTaddToSlam($definition,"$")]
--CODE: part 3
$ConstantAssignments :=
[NRTputInLocalReferences code for code in $ConstantAssignments]
- codePart3:= [:constantCode1,
- :constantCode2,:epilogue] where
+ codePart3:= [:constantCode1, :constantCode2,:epilogue] where
constantCode1:=
name='Integer => $ConstantAssignments
nil
@@ -493,8 +516,9 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
name='Integer => nil
$ConstantAssignments
epilogue:= $epilogue
- ans :=
- ['PROGN,:optFunctorPROGN [:codePart1,:codePart2,:codePart3], '$]
+ ans := ["%Bind",bindings,
+ :washFunctorBody optFunctorBody
+ [:codePart1,:codePart2,:codePart3],"$"]
$getDomainCode:= nil
--if we didn't kill this, DEFINE would insert it in the wrong place
ans:= minimalise ans