aboutsummaryrefslogtreecommitdiff
path: root/src/interp/g-util.boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp/g-util.boot')
-rw-r--r--src/interp/g-util.boot21
1 files changed, 21 insertions, 0 deletions
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 7e15d637..a43ff7c7 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -38,6 +38,7 @@ import daase
namespace BOOT
module g_-util where
+ abstraction?: %Form -> %Boolean
getTypeOfSyntax: %Form -> %Mode
pairList: (%List %Form,%List %Form) -> %List %Pair(%Form,%Form)
mkList: %List %Form -> %Form
@@ -46,9 +47,13 @@ module g_-util where
isDefaultPackageName: %Symbol -> %Boolean
makeDefaultPackageName: %String -> %Symbol
spliceSeqArgs: %List %Code -> %Code
+ mkSeq: %List %Code -> %Code
--%
+abstraction? x ==
+ x is [op,:.] and ident? op and abstractionOperator? op
+
hasNoLeave?(expr,g) ==
expr is ['%leave, =g,:.] => false
expr isnt [.,:.] => true
@@ -68,6 +73,10 @@ mkBind(inits,expr) ==
mkBind([:inits,:inits'],expr')
['%bind,inits,expr]
+mkSeq stmts ==
+ stmts is [s] => s
+ ['%seq,:stmts]
+
++ Given a (possibly multiple) assignment expression `u', return
++ the list of all assignment sub-expressions that must be evaluated before
++ effecting the toplevel assignment indicated by `u'. In that case,
@@ -101,6 +110,18 @@ spliceSeqArgs l ==
l.rest := spliceSeqArgs rest l
l
+++ Apply the function `f' on all non-atomic subforms of `x' in
+++ depth-first walk. Mutate `x' in place, replacing each sub-form
+++ with the result of applying `f' to that subform.
+walkWith!(x,f) ==
+ atomic? x => x
+ abstraction? x =>
+ x.absBody := walkWith!(x.absBody,f)
+ x
+ for ys in tails x | not atomic? first ys repeat
+ ys.first := walkWith!(first ys,f)
+ apply(f,x,nil)
+
--%
++ List of category constructors that do not have entries in the