From 8993bc2fe00eb48b57945b850c14bde8fae1dfb7 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Mon, 24 May 2010 15:31:17 +0000 Subject: * interp/i-object.boot (object): New. Abstract over boilerplate. * interp/i-analy.boot: Use it in place of boilerplate. * interp/i-eval.boot: Likewise. * interp/i-spec1.boot: Likewise. * interp/i-spec2.boot: Likewise. --- src/interp/i-analy.boot | 3 +-- src/interp/i-eval.boot | 9 ++------- src/interp/i-object.boot | 6 ++++++ src/interp/i-spec1.boot | 18 +++++------------- src/interp/i-spec2.boot | 18 +++++------------- 5 files changed, 19 insertions(+), 35 deletions(-) (limited to 'src/interp') diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot index b42551f3..30d8603a 100644 --- a/src/interp/i-analy.boot +++ b/src/interp/i-analy.boot @@ -598,8 +598,7 @@ bottomUpForm0(t,op,opName,argl,argModeSetList) == rtype := ['Record,:rargs] code := optRECORDCOPY(['RECORDCOPY,getArgValue(first argl, rtype),#rargs]) - if $genValue then code := wrap timedEVALFUN code - val := objNew(code,rtype) + val := object(code,rtype) putValue(t,val) putModeSet(t,[rtype]) diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot index a172534b..652818fb 100644 --- a/src/interp/i-eval.boot +++ b/src/interp/i-eval.boot @@ -355,15 +355,10 @@ getArgValueComp(arg,type,cond) == keyedMsgCompFailure("S2IE0010",[n]) evalFormMkValue(op,form,tm) == - val:= - u:= - $genValue => wrap timedEVALFUN form - form - objNew(u,tm) ---+ + val := object(form,tm) if $NRTmonitorIfTrue = true then sayBrightlyNT ['"Value of ",op.0,'" ===> "] - pp unwrap u + pp objValUnwrap val putValue(op,val) [tm] diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot index c8b9774d..ea3ddff7 100644 --- a/src/interp/i-object.boot +++ b/src/interp/i-object.boot @@ -78,6 +78,12 @@ objValUnwrap obj == unwrap rest obj objMode obj == first obj objEnv obj == $EmptyEnvironment +++ Return a newly constructed interpreter object, with fully evaluated +++ underlying value if in evaluation context. +object(v,m) == + $genValue => objNewWrap(timedEVALFUN v,m) + objNew(v,m) + objCodeVal obj == third obj objCodeMode obj == second obj diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot index 16405b14..cf2c649d 100644 --- a/src/interp/i-spec1.boot +++ b/src/interp/i-spec1.boot @@ -545,8 +545,7 @@ evalCOLLECT(op,[:itrl,body],m) == bod := getArgValue(body,computedMode body) if bod isnt ['SPADCALL,:.] then bod := ['unwrap,bod] code := timedOptimization asTupleNewCode0(second m, ['COLLECT,:iters,bod]) - if $genValue then code := wrap timedEVALFUN code - putValue(op,objNew(code,m)) + putValue(op,object(code,m)) falseFun(x) == nil @@ -1015,9 +1014,7 @@ evalTupleConstruct(op,l,m,tar) == ['List, ud] := m code := ['APPEND, :([["asTupleAsList", getArgValueOrThrow(x,['Tuple, ud])] for x in l])] - val := - $genValue => objNewWrap(timedEVALFUN code,m) - objNew(code,m) + val := object(code,m) (val1 := coerceInteractive(val,tar or m)) => putValue(op,val1) @@ -1029,9 +1026,7 @@ evalInfiniteTupleConstruct(op,l,m,tar) == ['Stream, ud] := m code := first [(getArgValue(x,['InfiniteTuple, ud]) or throwKeyedMsg("S2IC0007",[['InifinteTuple, ud]])) for x in l] - val := - $genValue => objNewWrap(timedEVALFUN code,m) - objNew(code,m) + val := object(code,m) if tar then val1 := coerceInteractive(val,tar) else val1 := val val1 => @@ -1044,9 +1039,7 @@ evalconstruct(op,l,m,tar) == [agg,:.,underMode]:= m code := ['LIST, :(argCode:=[(getArgValue(x,underMode) or throwKeyedMsg("S2IC0007",[underMode])) for x in l])] - val := - $genValue => objNewWrap(timedEVALFUN code,m) - objNew(code,m) + val := object(code,m) if tar then val1 := coerceInteractive(val,tar) else val1 := val val1 => @@ -1103,8 +1096,7 @@ upRecordConstruct(op,l,tar) == (len = 1) => ["CONS", :argCode, '()] (len = 2) => ["CONS",:argCode] ['VECTOR,:argCode] - if $genValue then code := wrap timedEVALFUN code - putValue(op,objNew(code,tar)) + putValue(op,object(code,tar)) putModeSet(op,[tar]) --% Handlers for declarations diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot index ebcdbf79..d874e184 100644 --- a/src/interp/i-spec2.boot +++ b/src/interp/i-spec2.boot @@ -173,11 +173,8 @@ upLispCall(op,t) == for arg in argl repeat bottomUp arg code:=[getUnname lispOp, :[getArgValue(arg,computedMode arg) for arg in argl]] - code := - $genValue => wrap timedEVALFUN code - code rt := '(SExpression) - putValue(op,objNew(code,rt)) + putValue(op,object(code,rt)) putModeSet(op,[rt]) --% Handlers for equation @@ -239,8 +236,7 @@ uphas t == evaluateType0 prop => ["evaluateType", MKQ prop] MKQ prop code := ["NOT",["NULL",["newHasTest",type, catCode]]] - if $genValue then code := wrap timedEVALFUN code - putValue(op,objNew(code,$Boolean)) + putValue(op,object(code,$Boolean)) putModeSet(op,[$Boolean]) --hasTest(a,b) == @@ -383,9 +379,7 @@ evalis(op,[a,pattern],mode) == code:= compileIs(a,pattern) else code:=[fun,getArgValue(a,mode), MKQ pattern,MKQ mode] - triple:= - $genValue => objNewWrap(timedEVALFUN code,$Boolean) - objNew(code,$Boolean) + triple := object(code,$Boolean) putValue(op,triple) isLocalPred pattern == @@ -564,7 +558,7 @@ evalLET(lhs,rhs) == isWrapped(objVal v') and (v2:=coerceInteractive(v',$OutputForm)) => throwKeyedMsg("S2IS0036",[objValUnwrap v2,t2]) throwKeyedMsg("S2IS0037",[t2]) - t2 and objNew(($genValue => wrap timedEVALFUN v ; v),t2) + t2 and object(v,t2) value => evalLETput(lhs,value) throwKeyedMsgCannotCoerceWithValue(objVal v,t1,getMode lhs) @@ -1094,9 +1088,7 @@ evalTuple(op,l,m,tar) == [agg,:.,underMode]:= m code := asTupleNewCode(underMode, #l, [(getArgValue(x,underMode) or throwKeyedMsg("S2IC0007",[underMode])) for x in l]) - val := - $genValue => objNewWrap(timedEVALFUN code,m) - objNew(code,m) + val := object(code,m) if tar then val1 := coerceInteractive(val,tar) else val1 := val val1 => -- cgit v1.2.3