From d08100e5c7cc7ebf2c30c490033f1ccd5b57fb86 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Tue, 25 May 2010 02:41:40 +0000
Subject: 	* interp/g-util.boot (expandToVMForm): New.  Export. 
 (getOpcodeExpander): move to here from c-util.boot. 	($middleEndOpcodes):
 Likewise.

---
 src/interp/g-util.boot | 25 +++++++++++++++++++++++++
 1 file changed, 25 insertions(+)

(limited to 'src/interp/g-util.boot')

diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 9b2ea472..3181c0c8 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -43,7 +43,32 @@ module g_-util where
   pairList: (%List,%List) -> %List
   mkList: %List -> %List
   isSubDomain: (%Mode,%Mode) -> %Form
+  expandToVMForm: %Thing -> %Thing
 
+
+--%
+--% Opcode expansion to VM codes.
+--%
+
+++ List of opcode-expander pairs.  
+$middleEndOpcodes == nil
+
+++ Return the expander of a middle-end opcode, or nil if there is none.
+getOpcodeExpander op ==
+  x := ASSOC(op,$middleEndOpcodes) => rest x
+  nil
+
+++ Expand all opcodes contained in the form `x' into a form
+++ suitable for evaluation by the VM.
+expandToVMForm x ==
+  isAtomicForm x => x
+  [op,:args] := x
+  IDENTP op and (fun:= getOpcodeExpander op) => apply(fun,x,nil)
+  op' := expandToVMForm op
+  args' := expandToVMForm args
+  EQ(op,op') and EQ(args,args') => x
+  [op',:args']
+  
 ++
 $interpOnly := false
 
-- 
cgit v1.2.3