diff options
| -rw-r--r-- | src/algebra/ChangeLog | 4 | ||||
| -rw-r--r-- | src/algebra/mkfunc.spad.pamphlet | 2 | ||||
| -rw-r--r-- | src/interp/ChangeLog | 14 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 2 | ||||
| -rw-r--r-- | src/interp/i-code.boot.pamphlet | 2 | ||||
| -rw-r--r-- | src/interp/i-coerce.boot.pamphlet | 2 | ||||
| -rw-r--r-- | src/interp/i-coerfn.boot.pamphlet | 2 | ||||
| -rw-r--r-- | src/interp/i-intern.boot.pamphlet | 2 | ||||
| -rw-r--r-- | src/interp/i-object.boot | 8 | ||||
| -rw-r--r-- | src/interp/i-output.boot | 2 | ||||
| -rw-r--r-- | src/interp/msgdb.boot.pamphlet | 2 | ||||
| -rw-r--r-- | src/interp/slam.boot | 104 |
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 |