From c65ac7da8c84d58b8acea7858987522957402b6a Mon Sep 17 00:00:00 2001 From: dos-reis Date: Tue, 4 Dec 2007 02:28:51 +0000 Subject: Support library function case. * i-spec1.boot (userDefinedCase): New. (upcase): Use it. --- src/interp/ChangeLog | 6 ++++++ src/interp/i-spec1.boot | 21 +++++++++++++++++++-- 2 files changed, 25 insertions(+), 2 deletions(-) (limited to 'src/interp') diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog index 462d22fa..f1c40d6f 100644 --- a/src/interp/ChangeLog +++ b/src/interp/ChangeLog @@ -1,3 +1,9 @@ +2007-12-03 Gabriel Dos Reis + + Support library function case. + * i-spec1.boot (userDefinedCase): New. + (upcase): Use it. + 2007-12-03 Gabriel Dos Reis * vmlisp.lisp (CGREATERP): Return canonical truthvalue. 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 -- cgit v1.2.3