aboutsummaryrefslogtreecommitdiff
path: root/src/interp/i-spec1.boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp/i-spec1.boot')
-rw-r--r--src/interp/i-spec1.boot21
1 files changed, 19 insertions, 2 deletions
diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot
index 444cb15f..6316a23f 100644
--- a/src/interp/i-spec1.boot
+++ b/src/interp/i-spec1.boot
@@ -300,12 +300,29 @@ upor x ==
--% Handlers for case
+++ subroutine of upcase. Handles the situation where `case' may
+++ have been defined as a library function.
+++ `op', `lhs' are VATs; `rhs' is a parse form.
+++ Note: Some of the code here needs to be refactored with code
+++ in bottomUp and elsewhere to avoid logic duplication.
+userDefinedCase(op, lhs, rhs) ==
+ -- At this point, op and lhs have already been bottomUp'd.
+ rhs := mkAtree rhs
+ bottomUp rhs
+ -- Prepare for evaluating call to a library function.
+ for x in [lhs, rhs] for i in 1.. repeat
+ putAtree(x, "callingFunction", "case")
+ putAtree(x, "argumentNumber", i)
+ putAtree(x, "totalArgs", 2)
+ bottomUpForm([op, lhs, rhs], op, "case", [lhs, rhs],
+ [bottomUp lhs, bottomUp rhs])
+
+
upcase t ==
t isnt [op,lhs,rhs] => nil
bottomUp lhs
triple := getValue lhs
- objMode(triple) isnt ['Union,:unionDoms] =>
- throwKeyedMsg("S2IS0004",NIL)
+ objMode(triple) isnt ['Union,:unionDoms] => userDefinedCase(op,lhs,rhs)
if (rhs' := isDomainValuedVariable(rhs)) then rhs := rhs'
if first unionDoms is [":",.,.] then
for i in 0.. for d in unionDoms repeat