diff options
| -rw-r--r-- | src/ChangeLog | 5 | ||||
| -rw-r--r-- | src/interp/clam.boot | 56 | ||||
| -rw-r--r-- | src/interp/slam.boot | 36 |
3 files changed, 51 insertions, 46 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 50c71f07..38b6724f 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,10 @@ 2011-02-02 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/clam.boot: Tidy. + * interp/slam.boot: Likewise. + +2011-02-02 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/lisp-backend.boot: New file. Consolidate Common Lisp backend module. * interp/Makefile.in (OBJS): Include it. diff --git a/src/interp/clam.boot b/src/interp/clam.boot index 4699dc8b..8a50b780 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -109,8 +109,8 @@ compClam(op,argl,body,$clamList) == callCounter:= INTERNL(op,'";calls") setDynamicBinding(hitCounter,0) setDynamicBinding(callCounter,0) - callCountCode:= [['SETQ,callCounter,['QSADD1,callCounter]]] - hitCountCode:= [['SETQ,hitCounter,['QSADD1,hitCounter]]] + callCountCode:= [['%store,callCounter,['%iinc,callCounter]]] + hitCountCode:= [['%store,hitCounter,['%iinc,hitCounter]]] g2:= gensym() --length of cache or arg-value pair g3:= gensym() --value computed by calling function lookUpFunction:= @@ -121,28 +121,28 @@ compClam(op,argl,body,$clamList) == 'assocCache returnFoundValue:= countFl => ['CDDR,g3] - ['CDR,g3] + ['%tail,g3] namePart:= countFl => cacheName MKQ cacheName secondPredPair:= -- null argl => [cacheName] - [['SETQ,g3,[lookUpFunction,g1,namePart,eqEtc]], + [['%store,g3,[lookUpFunction,g1,namePart,eqEtc]], :hitCountCode, returnFoundValue] resetCacheEntry:= - countFl => ['CONS,1,g2] + countFl => ['%makepair,1,g2] g2 thirdPredPair:= ['%true, ['%store,g2,computeValue], - ['%store,g3,['CAR,cacheName]], - ['RPLACA,g3,g1], - ['RPLACD,g3,resetCacheEntry], + ['%store,g3,['%head,cacheName]], + ['%store,['%head,g3],g1], + ['%store,['%tail,g3],resetCacheEntry], g2] codeBody:= ['PROG,[g2,g3], :callCountCode, - ['RETURN,['COND,secondPredPair,thirdPredPair]]] + ['RETURN,['%when,secondPredPair,thirdPredPair]]] lamex:= ['LAM,arg,codeBody] mainFunction:= [op,lamex] computeFunction:= [auxfn,['LAMBDA,argl,:body]] @@ -157,7 +157,7 @@ compClam(op,argl,body,$clamList) == compileQuietly [computeFunction] cacheType:= 'function - cacheResetCode:= ['SETQ,cacheName,['initCache,cacheCount]] + cacheResetCode:= ['%store,cacheName,['initCache,cacheCount]] cacheCountCode:= ['countCircularAlist,cacheName,cacheCount] cacheVector:= mkCacheVec(op,cacheName,cacheType, cacheResetCode,cacheCountCode) @@ -199,7 +199,7 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == null argl => [nil,nil,[auxfn]] argl is [.] => key:= (cacheNameOrNil => ['devaluate,g1]; g1) - [[g1],['LIST,key],[auxfn,g1]] --g1 is a parameter + [[g1],['%listlit,key],[auxfn,g1]] --g1 is a parameter key:= (cacheNameOrNil => ['devaluateList,g1] ; g1) [g1,key,['APPLY,['function,auxfn],g1]] --g1 is a parameter list cacheName:= cacheNameOrNil or mkCacheName op @@ -208,8 +208,8 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == callCounter:= INTERNL(op,'";calls") setDynamicBinding(hitCounter,0) setDynamicBinding(callCounter,0) - callCountCode:= [['SETQ,callCounter,['QSADD1,callCounter]]] - hitCountCode:= [['SETQ,hitCounter,['QSADD1,hitCounter]]] + callCountCode:= [['%store,callCounter,['%iinc,callCounter]]] + hitCountCode:= [['%store,hitCounter,['%iinc,hitCounter]]] g2:= gensym() --value computed by calling function returnFoundValue:= null argl => @@ -229,26 +229,26 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == ['HGET,cacheNameOrNil,MKQ op],MKQ eqEtc] ['lassocShift,cacheArgKey,['HGET,cacheNameOrNil,MKQ op]] ['HGET,cacheName,g1] - secondPredPair:= [['SETQ,g2,getCode],:hitCountCode,returnFoundValue] + secondPredPair:= [['%store,g2,getCode],:hitCountCode,returnFoundValue] putCode:= null argl => cacheNameOrNil => - countFl => ['CDDAR,['HPUT,cacheNameOrNil,MKQ op, - ['LIST,['CONS,nil,['CONS,1,computeValue]]]]] - ['HPUT,cacheNameOrNil,MKQ op,['LIST,['CONS,nil,computeValue]]] + countFl => + ['CDDAR,['HPUT,cacheNameOrNil,MKQ op, + ['%listlit,['%makepair,'%nil,['%makepair,1,computeValue]]]]] + ['HPUT,cacheNameOrNil,MKQ op, + ['%listlit,['%makepair,'%nil,computeValue]]] systemError '"unexpected" cacheNameOrNil => computeValue - --countFl => ['CDR,['hputNewProp,cacheNameOrNil,MKQ op,cacheArgKey, --*** - -- ['CONS,1,computeValue]]] --*** - --['hputNewProp,cacheNameOrNil,MKQ op,cacheArgKey,computeValue] --*** - countFl => ['CDR,['HPUT,cacheName,g1,['CONS,1,computeValue]]] + countFl => ['%tail,['HPUT,cacheName,g1,['%makepair,1,computeValue]]] ['HPUT,cacheName,g1,computeValue] if cacheNameOrNil then putCode := - ['UNWIND_-PROTECT,['PROG1,putCode,['SETQ,g2,'T]], - ['COND,[['NOT,g2],['HREM,cacheName,MKQ op]]]] + ['UNWIND_-PROTECT,['PROG1,putCode,['%store,g2,'%true]], + ['%when,[['%not,g2],['HREM,cacheName,MKQ op]]]] thirdPredPair:= ['%true,putCode] - codeBody:= ['PROG,[g2], - :callCountCode,['RETURN,['COND,secondPredPair,thirdPredPair]]] + codeBody:= + ['PROG,[g2], + :callCountCode,['RETURN,['%when,secondPredPair,thirdPredPair]]] lamex:= ['LAM,arg,codeBody] mainFunction:= [op,lamex] computeFunction:= [auxfn,['LAMBDA,argl,:body]] @@ -299,12 +299,12 @@ compHashGlobal(op,argl,body,cacheName,eqEtc,countFl) == g2 getCode:= ['HGET,cacheName,cacheArgKey] secondPredPair:= [['%store,g2,getCode],returnFoundValue] - putForm:= ['CONS,MKQ op,g1] + putForm:= ['%makepair,MKQ op,g1] putCode:= - countFl => ['HPUT,cacheName,putForm,['CONS,1,computeValue]] + countFl => ['HPUT,cacheName,putForm,['%makepair,1,computeValue]] ['HPUT,cacheName,putForm,computeValue] thirdPredPair:= ['%true,putCode] - codeBody:= ['PROG,[g2], ['RETURN,['COND,secondPredPair,thirdPredPair]]] + codeBody:= ['PROG,[g2], ['RETURN,['%when,secondPredPair,thirdPredPair]]] lamex:= ['LAM,arg,codeBody] mainFunction:= [op,lamex] computeFunction:= [auxfn,['LAMBDA,argl,:body]] diff --git a/src/interp/slam.boot b/src/interp/slam.boot index fb0afcc2..dfea7745 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -184,7 +184,7 @@ reportFunctionCompilation(op,nam,argl,body,isRecursive) == ["RPLACD",g3,g2], g2] codeBody:= - ["PROG",[g2,g3],["RETURN",["COND",secondPredPair,thirdPredPair]]] + ["PROG",[g2,g3],["RETURN",['%when,secondPredPair,thirdPredPair]]] -- cannot use envArg in next statement without redoing much -- of above. lamex:= ["LAM",arg,codeBody] @@ -217,9 +217,9 @@ reportFunctionCacheAll(op,nam,argl,body) == if null argl then g1:=nil cacheName:= mkCacheName nam g2:= gensym() --value computed by calling function - secondPredPair:= [["SETQ",g2,["HGET",["%dynval",MKQ cacheName],g1]],g2] + secondPredPair:= [['%store,g2,["HGET",['%dynval,MKQ cacheName],g1]],g2] thirdPredPair:= ['%true,["HPUT",['%dynval,MKQ cacheName],g1,computeValue]] - codeBody:= ["PROG",[g2],["RETURN",["COND",secondPredPair,thirdPredPair]]] + codeBody:= ["PROG",[g2],["RETURN",['%when,secondPredPair,thirdPredPair]]] lamex:= ["LAM",arg,codeBody] mainFunction:= [nam,lamex] parms := [:argl, "envArg"] @@ -227,7 +227,7 @@ reportFunctionCacheAll(op,nam,argl,body) == compileInteractive mainFunction compileInteractive computeFunction cacheType:= 'hash_-table - cacheResetCode:= ["%store",["%dynval",MKQ cacheName],['hashTable,''EQUAL]] + cacheResetCode:= ['%store,['%dynval,MKQ cacheName],['hashTable,''EQUAL]] cacheCountCode:= ['hashCount,cacheName] cacheVector:= mkCacheVec(op,cacheName,cacheType,cacheResetCode,cacheCountCode) @@ -290,10 +290,10 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) == returnValue:= ["PROGN",newStateCode,first gsList] cbody:= endTest:= - ["COND", [["EQL",sharpArg,gIndex],['RETURN,returnValue]]] + ['%when, [["EQL",sharpArg,gIndex],['RETURN,returnValue]]] newValueCode:= ["%LET",g,substitute(gIndex,sharpArg, EQSUBSTLIST(gsList,rest $TriangleVariableList,body))] - ["%bind",decomposeBindings, + ['%bind,decomposeBindings, ['%loop,["WHILE",true],["PROGN",endTest,advanceCode, newValueCode,:rotateCode],voidValue()]] fromScratchInit:= @@ -304,7 +304,7 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) == mainFunction:= [nam,["LAM",margl,mbody]] where margl:= [:argl,'envArg] max:= gensym() - tripleCode := ["CONS",n,['%listlit,:initCode]] + tripleCode := ['%makepair,n,['%listlit,:initCode]] -- initialSetCode initializes the global variable if necessary and -- also binds "stateVar" to its current value @@ -312,31 +312,31 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) == initialValueCode := extraArguments => ["hashTable",''EQUAL] tripleCode - cacheResetCode := ["%store",["%dynval", MKQ stateNam],initialValueCode] - ["COND",[["%not",["%and",["BOUNDP",MKQ stateNam], _ - ["CONSP",["%dynval",MKQ stateNam]]]], _ + cacheResetCode := ['%store,['%dynval, MKQ stateNam],initialValueCode] + ['%when,[['%not,['%and,["BOUNDP",MKQ stateNam], _ + ['%pair?,['%dynval,MKQ stateNam]]]], _ ["%LET",stateVar,cacheResetCode]], _ - [''T, ["%LET",stateVar,["%dynval",MKQ stateNam]]]] + ['%true, ["%LET",stateVar,['%dynval,MKQ stateNam]]]] -- when there are extra arguments, initialResetCode resets "stateVar" -- to the hashtable entry for the extra arguments initialResetCode := null extraArguments => nil - [["%LET",stateVar,["OR", + [["%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]],["%ige",sharpArg,max]], + phrase1:= [['%and,["%LET",max,["ELT",stateVar,0]],['%ige,sharpArg,max]], [auxfn,:argl,stateVar]] - phrase2:= [["%igt",sharpArg,["SETQ",max,["DIFFERENCE",max,k]]], - ["ELT",stateVar,["QSADD1",["QSDIFFERENCE",k,["DIFFERENCE",sharpArg,max]]]]] - phrase3:= [["%igt",sharpArg,n],[auxfn,:argl,['%listlit,n,:initCode]]] - phrase4:= [["%igt",sharpArg,n-k], + phrase2:= [['%igt,sharpArg,['%store,max,["DIFFERENCE",max,k]]], + ["ELT",stateVar,['%iinc,["QSDIFFERENCE",k,["DIFFERENCE",sharpArg,max]]]]] + phrase3:= [['%igt,sharpArg,n],[auxfn,:argl,['%listlit,n,:initCode]]] + phrase4:= [['%igt,sharpArg,n-k], ["ELT",['%listlit,:initCode],["QSDIFFERENCE",n,sharpArg]]] phrase5:= ['%true,['recurrenceError,MKQ op,sharpArg]] - ['PROGN,:preset,['COND,phrase1,phrase2,phrase3,phrase4,phrase5]] + ['PROGN,:preset,['%when,phrase1,phrase2,phrase3,phrase4,phrase5]] if $verbose then sayKeyedMsg("S2IX0001",[op]) compileInteractive computeFunction |