aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/algebra/ChangeLog4
-rw-r--r--src/algebra/mkfunc.spad.pamphlet2
-rw-r--r--src/interp/ChangeLog14
-rw-r--r--src/interp/g-util.boot2
-rw-r--r--src/interp/i-code.boot.pamphlet2
-rw-r--r--src/interp/i-coerce.boot.pamphlet2
-rw-r--r--src/interp/i-coerfn.boot.pamphlet2
-rw-r--r--src/interp/i-intern.boot.pamphlet2
-rw-r--r--src/interp/i-object.boot8
-rw-r--r--src/interp/i-output.boot2
-rw-r--r--src/interp/msgdb.boot.pamphlet2
-rw-r--r--src/interp/slam.boot104
12 files changed, 80 insertions, 66 deletions
diff --git a/src/algebra/ChangeLog b/src/algebra/ChangeLog
index cbb2b4fc..3e0ecfe4 100644
--- a/src/algebra/ChangeLog
+++ b/src/algebra/ChangeLog
@@ -1,3 +1,7 @@
+2007-10-22 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * mkfunc.spad.pamphlet (InputForm$interpret): Use objNew.
+
2007-10-18 Gabriel Dos Reis <gdr@cs.tamu.edu>
Fix SF/1790912
diff --git a/src/algebra/mkfunc.spad.pamphlet b/src/algebra/mkfunc.spad.pamphlet
index 7b1ad3ee..770cfd42 100644
--- a/src/algebra/mkfunc.spad.pamphlet
+++ b/src/algebra/mkfunc.spad.pamphlet
@@ -98,7 +98,7 @@ InputForm():
interpret x ==
v := interpret(x)$Lisp
- mkObj(unwrap(objVal(v)$Lisp)$Lisp, objMode(v)$Lisp)$Lisp
+ objNew(unwrap(objVal(v)$Lisp)$Lisp, objMode(v)$Lisp)$Lisp
convert(x:DoubleFloat):% ==
zero? x => 0
diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog
index 69d030df..65143060 100644
--- a/src/interp/ChangeLog
+++ b/src/interp/ChangeLog
@@ -1,3 +1,17 @@
+2007-10-22 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * i-object.boot (mkObj): Remove.
+ (mkObjWrap): Likewise.
+ (mkObjCode): Likewise.
+ * g-util.boot (str2Tex): Use objNew.
+ * i-code.boot.pamphlet (intCodeGenCoerce1): Likewise.
+ * i-coerce.boot.pamphlet (coerceByFunction): Likewise.
+ * i-coerfn.boot.pamphlet (L2Tuple): Likewise.
+ * i-intern.boot.pamphlet (mkAtree2): Likewise.
+ * i-output.boot (outputTran): Likewise.
+ * msgdb.boot.pamphlet (throwKeyedMsgCannotCoerceWithValue): Likewise.
+ * slam.boot (clearLocalModemaps): Likewise.
+
2007-10-21 Gabriel Dos Reis <gdr@cs.tamu.edu>
* Makefile.pamphlet (<<fortcall.clisp>>): Remove.
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 4ee943ba..ae571bd9 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -411,7 +411,7 @@ parse2Outform x ==
str2Tex s ==
outf := str2Outform s
- val := coerceInt(mkObj(wrap outf, '(OutputForm)), '(TexFormat))
+ val := coerceInt(objNew(wrap outf, '(OutputForm)), '(TexFormat))
val := objValUnwrap val
CAR val.1
diff --git a/src/interp/i-code.boot.pamphlet b/src/interp/i-code.boot.pamphlet
index c58ff15e..c6551bb5 100644
--- a/src/interp/i-code.boot.pamphlet
+++ b/src/interp/i-code.boot.pamphlet
@@ -138,7 +138,7 @@ intCodeGenCoerce1(val,t1,t2) ==
-- Internal function to previous one
-- designed to ensure that we don't use coerceOrCroak on mappings
--(t2 is ['Mapping,:.]) => THROW('coerceOrCroaker, 'croaked)
- objNew(['coerceOrCroak,mkObjCode(['wrap,val],t1),
+ objNew(['coerceOrCroak,objNewCode(['wrap,val],t1),
MKQ t2, MKQ $mapName],t2)
--% Map components
diff --git a/src/interp/i-coerce.boot.pamphlet b/src/interp/i-coerce.boot.pamphlet
index f7c690a4..a3bc0760 100644
--- a/src/interp/i-coerce.boot.pamphlet
+++ b/src/interp/i-coerce.boot.pamphlet
@@ -1400,7 +1400,7 @@ coerceByFunction(T,m2) ==
[fn,:d]:= fun
isWrapped x =>
x:= unwrap x
- mkObjWrap(SPADCALL(CAR x,CDR x,fun),m2)
+ objNewWrap(SPADCALL(CAR x,CDR x,fun),m2)
x isnt ['SPADCALL,a,b,:.] => keyedSystemError("S2IC0015",NIL)
code := ['SPADCALL, a, b, fun]
objNew(code,$Boolean)
diff --git a/src/interp/i-coerfn.boot.pamphlet b/src/interp/i-coerfn.boot.pamphlet
index 034067d3..16eb1850 100644
--- a/src/interp/i-coerfn.boot.pamphlet
+++ b/src/interp/i-coerfn.boot.pamphlet
@@ -635,7 +635,7 @@ I2NNI(n,source,target) ==
L2Tuple(val, source is [.,S], target is [.,T]) ==
val = '_$fromCoerceable_$ => canCoerce(S,T)
- null (object := coerceInt1(mkObjWrap(val,source), ['List, T])) =>
+ null (object := coerceInt1(objNewWrap(val,source), ['List, T])) =>
coercionFailure()
asTupleNew0 objValUnwrap object
diff --git a/src/interp/i-intern.boot.pamphlet b/src/interp/i-intern.boot.pamphlet
index 46bd68c9..1257ee0d 100644
--- a/src/interp/i-intern.boot.pamphlet
+++ b/src/interp/i-intern.boot.pamphlet
@@ -219,7 +219,7 @@ mkAtree2(x,op,argl) ==
t := evaluateType unabbrev [D]
typeIsASmallInteger(t) and SINTP a =>
v := mkAtreeNode $immediateDataSymbol
- putValue(v,mkObjWrap(a, t))
+ putValue(v,objNewWrap(a, t))
v
mkAtree1 ["*",a,[['_$elt,D,'One]]]
[mkAtreeNode 'Dollar,D,mkAtree1 a]
diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot
index 39b96214..2c6515c1 100644
--- a/src/interp/i-object.boot
+++ b/src/interp/i-object.boot
@@ -51,13 +51,9 @@ import '"sys-macros"
-- These are the new structure functions.
-mkObj(val, mode) == CONS(mode,val) -- old names
-mkObjWrap(val, mode) == CONS(mode,wrap val)
-mkObjCode(val, mode) == ['CONS, MKQ mode,val ]
-
objNew(val, mode) == CONS(mode,val) -- new names as of 10/14/93
objNewWrap(val, mode) == CONS(mode,wrap val)
-objNewCode(val, mode) == ['CONS, MKQ mode,val ]
+objNewCode(val, mode) == ["CONS", MKQ mode,val ]
objSetVal(obj,val) == RPLACD(obj,val)
objSetMode(obj,mode) == RPLACA(obj,mode)
@@ -77,7 +73,7 @@ objCodeMode obj == CADR obj
asTupleNew(size, listOfElts) == CONS(size, LIST2VEC listOfElts)
asTupleNew0(listOfElts) == CONS(#listOfElts, LIST2VEC listOfElts)
-asTupleNewCode(size, listOfElts) == ["asTupleNew", size, ['LIST, :listOfElts]]
+asTupleNewCode(size, listOfElts) == ["asTupleNew", size, ["LIST", :listOfElts]]
asTupleNewCode0(listForm) == ["asTupleNew0", listForm]
asTupleSize(at) == CAR at
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index 055ddbc5..e2c83fd9 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -344,7 +344,7 @@ outputTran x ==
domain is ['Float]) and INTEGERP x and INTEGERP y and INTEGERP z and
z > 0 and (float := getFunctionFromDomain("float",domain,[$Integer,$Integer,$PositiveInteger])) =>
f := SPADCALL(x,y,z,float)
- o := coerceInteractive(mkObjWrap(f, domain), '(OutputForm))
+ o := coerceInteractive(objNewWrap(f, domain), '(OutputForm))
objValUnwrap o
[op,:l]:= flattenOps x
diff --git a/src/interp/msgdb.boot.pamphlet b/src/interp/msgdb.boot.pamphlet
index e5b10a14..1535d8cc 100644
--- a/src/interp/msgdb.boot.pamphlet
+++ b/src/interp/msgdb.boot.pamphlet
@@ -567,7 +567,7 @@ keyedMsgCompFailureSP(key,args,atree) ==
THROW('mapCompiler,'tryInterpOnly)
throwKeyedMsgCannotCoerceWithValue(val,t1,t2) ==
- null (val' := coerceInteractive(mkObj(val,t1),$OutputForm)) =>
+ null (val' := coerceInteractive(objNew(val,t1),$OutputForm)) =>
throwKeyedMsg("S2IC0002",[t1,t2])
val' := objValUnwrap(val')
throwKeyedMsg("S2IC0003",[t1,t2,val'])
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index d9832a9a..7c84b6e1 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -54,7 +54,7 @@ reportFunctionCompilation(op,nam,argl,body,isRecursive) ==
cacheCount:= getCacheCount op
cacheCount = "all" => reportFunctionCacheAll(op,nam,argl,body)
cacheCount = 0 or null argl =>
- function:= [nam,['LAMBDA,[:argl,'envArg],body]]
+ function:= [nam,["LAMBDA",[:argl,'envArg],body]]
compileInteractive function
nam
num :=
@@ -79,23 +79,23 @@ reportFunctionCompilation(op,nam,argl,body,isRecursive) ==
thirdPredPair:=
null argl => ['(QUOTE T),['SETQ,cacheName,computeValue]]
['(QUOTE T),
- ['SETQ,g2,computeValue],
- ['SETQ,g3,
- ['CAR,['SETQ,cacheName,['predCircular,cacheName,cacheCount]]]],
- ['RPLACA,g3,g1],
- ['RPLACD,g3,g2],
+ ["SETQ",g2,computeValue],
+ ["SETQ",g3,
+ ["CAR",["SETQ",cacheName,['predCircular,cacheName,cacheCount]]]],
+ ["RPLACA",g3,g1],
+ ["RPLACD",g3,g2],
g2]
codeBody:=
- ['PROG,[g2,g3],['RETURN,['COND,secondPredPair,thirdPredPair]]]
+ ["PROG",[g2,g3],["RETURN",["COND",secondPredPair,thirdPredPair]]]
-- cannot use envArg in next statement without redoing much
-- of above.
- lamex:= ['LAM,arg,codeBody]
+ lamex:= ["LAM",arg,codeBody]
mainFunction:= [nam,lamex]
- computeFunction:= [auxfn,['LAMBDA,[:argl, 'envArg],body]]
+ computeFunction:= [auxfn,["LAMBDA",[:argl, 'envArg],body]]
compileInteractive mainFunction
compileInteractive computeFunction
- cacheType:= 'function
- cacheResetCode:= ['SETQ,cacheName,['mkCircularAlist,cacheCount]]
+ cacheType:= "function"
+ cacheResetCode:= ["SETQ",cacheName,['mkCircularAlist,cacheCount]]
cacheCountCode:= ['countCircularAlist,cacheName,cacheCount]
cacheVector:=
mkCacheVec(op,cacheName,cacheType,cacheResetCode,cacheCountCode)
@@ -115,20 +115,20 @@ reportFunctionCacheAll(op,nam,argl,body) ==
[arg,computeValue] :=
null argl => [['envArg],[auxfn, 'envArg]]
argl is [.] => [[g1, 'envArg],[auxfn,g1, 'envArg]] --g1 is a parameter
- [g1,['APPLX,MKQ auxfn,g1]] --g1 is a parameter list
+ [g1,["APPLX",MKQ auxfn,g1]] --g1 is a parameter list
if null argl then g1:=nil
cacheName:= mkCacheName nam
g2:= GENSYM() --value computed by calling function
- secondPredPair:= [['SETQ,g2,['HGET,cacheName,g1]],g2]
- thirdPredPair:= ['(QUOTE T),['HPUT,cacheName,g1,computeValue]]
- codeBody:= ['PROG,[g2],['RETURN,['COND,secondPredPair,thirdPredPair]]]
- lamex:= ['LAM,arg,codeBody]
+ secondPredPair:= [["SETQ",g2,["HGET",cacheName,g1]],g2]
+ thirdPredPair:= ['(QUOTE T),["HPUT",cacheName,g1,computeValue]]
+ codeBody:= ["PROG",[g2],["RETURN",["COND",secondPredPair,thirdPredPair]]]
+ lamex:= ["LAM",arg,codeBody]
mainFunction:= [nam,lamex]
- computeFunction:= [auxfn,['LAMBDA,[:argl, 'envArg],body]]
+ computeFunction:= [auxfn,["LAMBDA",[:argl, 'envArg],body]]
compileInteractive mainFunction
compileInteractive computeFunction
cacheType:= 'hash_-table
- cacheResetCode:= ['SETQ,cacheName,['MAKE_-HASHTABLE,''UEQUAL]]
+ cacheResetCode:= ["SETQ",cacheName,['MAKE_-HASHTABLE,''UEQUAL]]
cacheCountCode:= ['hashCount,cacheName]
cacheVector:=
mkCacheVec(op,cacheName,cacheType,cacheResetCode,cacheCountCode)
@@ -175,67 +175,67 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) ==
stateVal:= GENSYM()
lastArg := INTERNL STRCONC('"#",STRINGIMAGE QSADD1 LENGTH argl)
decomposeCode:=
- [['LET,gIndex,['ELT,lastArg,0]],:[['LET,g,['ELT,lastArg,i]]
+ [["LET",gIndex,["ELT",lastArg,0]],:[["LET",g,["ELT",lastArg,i]]
for g in gsList for i in 1..]]
gsRev:= REVERSE gsList
- rotateCode:= [['LET,p,q] for p in gsRev for q in [:rest gsRev,g]]
- advanceCode:= ['LET,gIndex,['ADD1,gIndex]]
+ rotateCode:= [["LET",p,q] for p in gsRev for q in [:rest gsRev,g]]
+ advanceCode:= ["LET",gIndex,['ADD1,gIndex]]
- newTripleCode := ['LIST,sharpArg,:gsList]
+ newTripleCode := ["LIST",sharpArg,:gsList]
newStateCode :=
- null extraArguments => ['SETQ,stateNam,newTripleCode]
- ['HPUT,stateNam,extraArgumentCode,newTripleCode]
+ null extraArguments => ["SETQ",stateNam,newTripleCode]
+ ["HPUT",stateNam,extraArgumentCode,newTripleCode]
- computeFunction:= [auxfn,['LAM,cargl,cbody]] where
+ computeFunction:= [auxfn,["LAM",cargl,cbody]] where
cargl:= [:argl,lastArg]
- returnValue:= ['PROGN,newStateCode,first gsList]
+ returnValue:= ["PROGN",newStateCode,first gsList]
cbody:=
endTest:=
- ['COND, [['EQL,sharpArg,gIndex],['RETURN,returnValue]]]
- newValueCode:= ['LET,g,SUBST(gIndex,sharpArg,
+ ["COND", [["EQL",sharpArg,gIndex],['RETURN,returnValue]]]
+ newValueCode:= ["LET",g,SUBST(gIndex,sharpArg,
EQSUBSTLIST(gsList,rest $TriangleVariableList,body))]
- ['PROGN,:decomposeCode,
- ['REPEAT,['WHILE,'T],['PROGN,endTest,advanceCode,
+ ["PROGN",:decomposeCode,
+ ["REPEAT",["WHILE",'T],["PROGN",endTest,advanceCode,
newValueCode,:rotateCode]]]
fromScratchInit:=
- [['LET,gIndex,n],:[['LET,g,x] for g in gsList for x in initCode]]
+ [["LET",gIndex,n],:[["LET",g,x] for g in gsList for x in initCode]]
continueInit:=
- [['LET,gIndex,['ELT,stateVar,0]],
- :[['LET,g,['ELT,stateVar,i]] for g in gsList for i in 1..]]
- mainFunction:= [nam,['LAM,margl,mbody]] where
+ [["LET",gIndex,["ELT",stateVar,0]],
+ :[["LET",g,["ELT",stateVar,i]] for g in gsList for i in 1..]]
+ mainFunction:= [nam,["LAM",margl,mbody]] where
margl:= [:argl,'envArg]
max:= GENSYM()
- tripleCode := ['CONS,n,['LIST,:initCode]]
+ tripleCode := ["CONS",n,["LIST",:initCode]]
-- initialSetCode initializes the global variable if necessary and
-- also binds "stateVar" to its current value
initialSetCode :=
initialValueCode :=
- extraArguments => ['MAKE_-HASHTABLE,''UEQUAL]
+ extraArguments => ["MAKE_-HASHTABLE",''UEQUAL]
tripleCode
- cacheResetCode := ['SETQ,stateNam,initialValueCode]
- ['COND,[['NULL,['AND,['BOUNDP,MKQ stateNam], _
- ['PAIRP,stateNam]]], _
- ['LET,stateVar,cacheResetCode]], _
- [''T, ['LET,stateVar,stateNam]]]
+ cacheResetCode := ["SETQ",stateNam,initialValueCode]
+ ["COND",[["NULL",["AND",["BOUNDP",MKQ stateNam], _
+ ["PAIRP",stateNam]]], _
+ ["LET",stateVar,cacheResetCode]], _
+ [''T, ["LET",stateVar,stateNam]]]
-- when there are extra arguments, initialResetCode resets "stateVar"
-- to the hashtable entry for the extra arguments
initialResetCode :=
null extraArguments => nil
- [['LET,stateVar,['OR,
- ['HGET,stateVar,extraArgumentCode],
- ['HPUT,stateVar,extraArgumentCode,tripleCode]]]]
+ [["LET",stateVar,["OR",
+ ["HGET",stateVar,extraArgumentCode],
+ ["HPUT",stateVar,extraArgumentCode,tripleCode]]]]
mbody :=
- preset := [initialSetCode,:initialResetCode,['LET,max,['ELT,stateVar,0]]]
- phrase1:= [['AND,['LET,max,['ELT,stateVar,0]],['GE,sharpArg,max]],
+ preset := [initialSetCode,:initialResetCode,["LET",max,["ELT",stateVar,0]]]
+ phrase1:= [["AND",["LET",max,["ELT",stateVar,0]],["GE",sharpArg,max]],
[auxfn,:argl,stateVar]]
- phrase2:= [['GT,sharpArg,['SETQ,max,['DIFFERENCE,max,k]]],
- ['ELT,stateVar,['QSADD1,['QSDIFFERENCE,k,['DIFFERENCE,sharpArg,max]]]]]
- phrase3:= [['GT,sharpArg,n],[auxfn,:argl,['LIST,n,:initCode]]]
- phrase4:= [['GT,sharpArg,n-k],
- ['ELT,['LIST,:initCode],['QSDIFFERENCE,n,sharpArg]]]
+ phrase2:= [["GT",sharpArg,["SETQ",max,["DIFFERENCE",max,k]]],
+ ["ELT",stateVar,["QSADD1",["QSDIFFERENCE",k,["DIFFERENCE",sharpArg,max]]]]]
+ phrase3:= [["GT",sharpArg,n],[auxfn,:argl,["LIST",n,:initCode]]]
+ phrase4:= [["GT",sharpArg,n-k],
+ ["ELT",["LIST",:initCode],["QSDIFFERENCE",n,sharpArg]]]
phrase5:= ['(QUOTE T),['recurrenceError,MKQ op,sharpArg]]
['PROGN,:preset,['COND,phrase1,phrase2,phrase3,phrase4,phrase5]]
sayKeyedMsg("S2IX0001",[op])
@@ -300,7 +300,7 @@ clearLocalModemaps x ==
for mm in u repeat
[.,fn,:.] := mm
if def:= get(fn,'definition,$e) then
- $e:= putHist(x,'value,mkObj(def,$EmptyMode),$e)
+ $e:= putHist(x,'value,objNew(def,$EmptyMode),$e)
if cacheVec:= get(fn,'cacheInfo,$e) then
SET(cacheVec.cacheName,NIL)
-- now clear the property list of the identifier