aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2008-09-24 22:42:55 +0000
committerdos-reis <gdr@axiomatics.org>2008-09-24 22:42:55 +0000
commite2b728ff9a53eb2ff4518ad10beb649b5e636f74 (patch)
treee517298dcf8a392a14fc982e84c333abc6f56e5f /src/interp
parent0f3130aad8de041f2ddda3acd8a9ef5b931027ec (diff)
downloadopen-axiom-e2b728ff9a53eb2ff4518ad10beb649b5e636f74.tar.gz
* interp/i-analy.boot (putCallInfo): New.
(bottomUp): Use it. * interp/i-spec1.boot (upand): Likewise. (upor): Likewise. (upcase): Likewise. * interp/i-spec2.boot (uperror): Likewise.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/i-analy.boot11
-rw-r--r--src/interp/i-spec1.boot9
-rw-r--r--src/interp/i-spec2.boot2
3 files changed, 17 insertions, 5 deletions
diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot
index d288eb80..26a1309d 100644
--- a/src/interp/i-analy.boot
+++ b/src/interp/i-analy.boot
@@ -52,6 +52,13 @@ $inRetract := false
--% Interpreter Analysis Functions
+++ Record calling context information in the VAT `t'.
+putCallInfo(t,op,arg,nargs) ==
+ putAtree(t,"callingFunction",op)
+ putAtree(t,"argumentNumber",arg)
+ putAtree(t,"totalArgs",nargs)
+ t
+
getMinimalVariableTower(var,t) ==
-- gets the minimal polynomial subtower of t that contains the
-- given variable. Returns NIL if none.
@@ -228,9 +235,7 @@ bottomUp t ==
(null dol) and (fn:= GETL(opName,"up")) and (u:= FUNCALL(fn, t)) => u
nargs := #argl
if opName then for x in argl for i in 1.. repeat
- putAtree(x,'callingFunction,opName)
- putAtree(x,'argumentNumber,i)
- putAtree(x,'totalArgs,nargs)
+ putCallInfo(x,opName,i,nargs)
if tar then pushDownTargetInfo(opName,tar,argl)
diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot
index b8f6121d..f8820697 100644
--- a/src/interp/i-spec1.boot
+++ b/src/interp/i-spec1.boot
@@ -249,7 +249,9 @@ upand x ==
-- evaluated if the first argument is true.
x isnt [op,term1,term2] => NIL
putTarget(term1,$Boolean)
+ putCallInfo(term1,"and",1,2)
putTarget(term2,$Boolean)
+ putCallInfo(term2,"and",2,2)
ms := bottomUp term1
ms isnt [=$Boolean] => nil -- use general modemap
$genValue =>
@@ -284,7 +286,9 @@ upor x ==
-- evaluated if the first argument is false.
x isnt [op,term1,term2] => NIL
putTarget(term1,$Boolean)
+ putCallInfo(term1,"or",1,2)
putTarget(term2,$Boolean)
+ putCallInfo(term2,"or",2,2)
ms := bottomUp term1
ms isnt [=$Boolean] => nil
$genValue =>
@@ -331,6 +335,7 @@ userDefinedCase(t is [op, lhs, rhs]) ==
upcase t ==
t isnt [op,lhs,rhs] => nil
+ putCallInfo(lhs,"case",1,2)
bottomUp lhs
triple := getValue lhs
objMode(triple) isnt ['Union,:unionDoms] => userDefinedCase t
@@ -964,7 +969,9 @@ upconstruct t ==
CAR(tar) in '(Matrix SquareMatrix RectangularMatrix) =>
vec := ['List,underDomainOf tar]
for x in l repeat if not getTarget(x) then putTarget(x,vec)
- argModeSetList:= [bottomUp x for x in l]
+ nargs := #l
+ argModeSetList:= [bottomUp putCallInfo(x,"construct",i,nargs)
+ for x in l for i in 1..]
dol and dol is [topType,:.] and not (topType in aggs) =>
(mmS:= selectMms(op,l,tar)) and (mS:= evalForm(op,getUnname op,l,mmS)) =>
putModeSet(op,mS)
diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot
index f4256a06..fb5079a6 100644
--- a/src/interp/i-spec2.boot
+++ b/src/interp/i-spec2.boot
@@ -183,7 +183,7 @@ uperror t ==
-- which is the name of the function.
not $compilingMap => NIL
t isnt [op,msg] => NIL
- msgMs := bottomUp msg
+ msgMs := bottomUp putCallInfo(msg,"error",1,1)
msgMs isnt [=$String] => NIL
RPLACD(t,[mkAtree object2String $mapName,msg])
bottomUp t