From f94b3a2640bf842b92f22438fca79e58aeea5da9 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Wed, 15 May 2013 02:18:03 +0000
Subject: 	* interp/g-opt.boot (quoteMode): New. 	(optRetract): Use it. 
 (optPullback): Likewise.

---
 src/interp/g-opt.boot | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

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

diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index c65dcf2d..df9d1e75 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -805,17 +805,23 @@ optList form ==
   literalElts is "failed" => form
   quote literalElts
 
+quoteMode x ==
+  x isnt [.,:.] => x
+  ident? x.op and constructor? x.op =>
+    ['%list,quote x.op,:[quoteMode a for a in x.args]]
+  [quoteMode y for y in x]
+
 ++ Translate retraction of a value denoted by `e' to sub-domain `m'
 ++ defined by predicate `pred',
 optRetract ["%retract",e,m,pred] ==
   e isnt [.,:.] =>
     cond := simplifyVMForm substitute(e,"#1",pred)
     cond is '%true => e
-    ['%when,[cond,e],['%otherwise,['moanRetract,e,MKQ m]]]
+    ['%when,[cond,e],['%otherwise,['moanRetract,e,quoteMode m]]]
   g := gensym()
   ['%bind,[[g,e]],
     ['%when,[substitute(g,"#1",pred),g],
-      ['%otherwise,['moanRetract,g,MKQ m]]]]
+      ['%otherwise,['moanRetract,g,quoteMode m]]]]
 
 ++ We have an expression `x' of some Union type.  Expand an attempted
 ++ pullback to the `n'th branch of type `t'.
@@ -825,7 +831,7 @@ optPullback ['%pullback,x,t,n] ==
     gensym()
   expr :=
     ['%when,[['%ieq,['%head,y],n],['%tail,y]],
-      ['%otherwise,['moanRetract,y,MKQ t]]]
+      ['%otherwise,['moanRetract,y,quoteMode t]]]
   symbolEq?(x,y) => expr
   ['%bind,[[y,x]],expr]
 
-- 
cgit v1.2.3