aboutsummaryrefslogtreecommitdiff
path: root/src/interp/g-opt.boot
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2010-04-30 14:53:30 +0000
committerdos-reis <gdr@axiomatics.org>2010-04-30 14:53:30 +0000
commitf0b6be21e20a76251afe2bc2ae92800fb267da0b (patch)
tree738bf6386eb25b036815808639ae1dd5e78d8cc9 /src/interp/g-opt.boot
parent95a8891a808572509f7449aa32022df42f8b7ab8 (diff)
downloadopen-axiom-f0b6be21e20a76251afe2bc2ae92800fb267da0b.tar.gz
* interp/macros.lisp (|check-subtype|): Return coerced value if can.
(|check-union|): Likewise. * interp/compiler.boot (coerceSuperset): Tidy. Generate %Retract instruction. * interp/g-opt.boot (optRetract): New.
Diffstat (limited to 'src/interp/g-opt.boot')
-rw-r--r--src/interp/g-opt.boot10
1 files changed, 9 insertions, 1 deletions
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 38613f11..31420217 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -571,7 +571,14 @@ optCollectVector form ==
["LET",[[vec,["makeSimpleArray",["getVMType",eltType],vecSize]]],
["REPEAT",:iters,["setSimpleArrayEntry",vec,index,body]],
vec]
-
+
+++ Translate retraction of a value denoted by `e' to sub-domain `m'
+++ defined by predicate `pred',
+optRetract ["%Retract",e,m,pred] ==
+ atom e => ["check-subtype",substitute(e,"#1",pred),MKQ m,e]
+ g := GENSYM()
+ ["LET",[[g,e]],["check-subtype",substitute(g,"#1",pred),MKQ m,g]]
+
lispize x == first optimize [x]
--% optimizer hash table
@@ -588,6 +595,7 @@ for x in '( (call optCall) _
(_| optSuchthat)_
(CATCH optCatch)_
(COND optCond)_
+ (%Retract optRetract)_
(%CollectV optCollectVector)_
(mkRecord optMkRecord)_
(RECORDELT optRECORDELT)_