aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2008-04-08 00:26:02 +0000
committerdos-reis <gdr@axiomatics.org>2008-04-08 00:26:02 +0000
commitef59ff5d9433e6c3663d7f6f00c8ad6970b06582 (patch)
tree7722bed670495fe4b472a4de7bfe7abaccce2fc7
parent037f73f6e660f51447886aff6d0a60c122bd8507 (diff)
downloadopen-axiom-ef59ff5d9433e6c3663d7f6f00c8ad6970b06582.tar.gz
* interp/spad.lisp (|evalSharpOne|): Remove.
* interp/i-coerce.boot: New. (coerceUnion2Branch): Use it instead of evalSharpOne.
-rw-r--r--src/ChangeLog6
-rw-r--r--src/interp/i-coerce.boot7
-rw-r--r--src/interp/spad.lisp2
3 files changed, 12 insertions, 3 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index d4c3af6b..472eb831 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,11 @@
2008-04-07 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/spad.lisp (|evalSharpOne|): Remove.
+ * interp/i-coerce.boot: New.
+ (coerceUnion2Branch): Use it instead of evalSharpOne.
+
+2008-04-07 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/i-analy.boot (pushDownOp?): Use setShellEntry.
* interp/nrunfast.boot (replaceGoGetSlot): Likewise.
(lazyDomainSet): Likewise.
diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot
index e0c896e4..2f7c8db3 100644
--- a/src/interp/i-coerce.boot
+++ b/src/interp/i-coerce.boot
@@ -985,6 +985,11 @@ coerceIntAlgebraicConstant(object,t2) ==
objNewWrap(getConstantFromDomain('(Zero),t2),t2)
NIL
+++ returns true if `val' belongs to the Union branch guarded by `pred'.
+thisUnionBranch?: (%Code,%Thing) -> %Boolean
+thisUnionBranch?(pred,val) ==
+ eval ["LET",[["#1",MKQ val]],pred]
+
coerceUnion2Branch(object) ==
[.,:unionDoms] := objMode object
doms := orderUnionEntries unionDoms
@@ -994,7 +999,7 @@ coerceUnion2Branch(object) ==
predicate := NIL
targetType:= NIL
for typ in doms for pred in predList while ^targetType repeat
- evalSharpOne(pred,val') =>
+ thisUnionBranch?(pred,val') =>
predicate := pred
targetType := typ
null targetType => keyedSystemError("S2IC0013",NIL)
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index ee3dbd50..0ac5ef98 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -343,8 +343,6 @@
(if |$InteractiveMode| (|spadThrow|))
(S-PROCESS x))))
-(defun |evalSharpOne| (x \#1) (declare (special \#1)) (EVAL x))
-
(defun |New,ENTRY,1| ()
(let (ZZ str N RLGENSYMFG RLGENSYMLST |NewFLAG| XCAPE
SINGLELINEMODE OK ISID NBLNK COUNT CHR ULCASEFG ($LINESTACK 'BEGIN_UNIT)