diff options
| -rw-r--r-- | src/ChangeLog | 8 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 7 | ||||
| -rw-r--r-- | src/interp/define.boot | 2 | ||||
| -rw-r--r-- | src/interp/lisp-backend.boot | 9 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 4 | ||||
| -rw-r--r-- | src/interp/slam.boot | 2 |
6 files changed, 22 insertions, 10 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 4c2466d0..f4814f71 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,11 @@ +2011-12-07 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/compiler.boot (compReduce1): Tidy. + * interp/define.boot (compDefineCategory2): Likewise. + * interp/nruncomp.boot (buildFunctor): Likewise. + * interp/slam.boot (compileRecurrenceRelation): Likewise. + * interp/lisp-backend.boot (expandSeq): Use PROGN in absence of EXIT. + 2011-12-06 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/compiler.boot (setqMultipleExplicit): Introduced diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 59ea4e90..14dd801c 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -2418,9 +2418,10 @@ compReduce1(form is ["REDUCE",op,.,collectForm],m,e,$formalArgList) == finalCode := ['%loop, ['%init,accu,'%nil],['%init,firstTime,'%true],:itl, ['%bind,[[b,third bval]], - ['%when,[firstTime,move],['%otherwise,update]], - ['%store,firstTime,'%false]], - ['%when,[firstTime,nval],['%otherwise,accu]]] + ['%seq, + ['%when,[firstTime,move],['%otherwise,update]], + ['%store,firstTime,'%false]]], + ['%when,[firstTime,nval],['%otherwise,accu]]] T := coerce([finalCode,mode,e],m) or return nil [T.expr,T.mode,oldEnv] diff --git a/src/interp/define.boot b/src/interp/define.boot index 32517f80..089613b1 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1116,7 +1116,7 @@ compDefineCategory2(form,signature,body,m,e,$formalArgList) == [['devaluate,u] for u in sargl]]],body] body:= ["%bind",[[g:= gensym(),body]], - ['%store,['%tref,g,0],mkConstructor $form],g] + ['%seq,['%store,['%tref,g,0],mkConstructor $form],g]] fun := compile(db,[op',["LAM",sargl,body]],signature') -- 5. give operator a 'modemap property diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot index 2c801bed..e145828c 100644 --- a/src/interp/lisp-backend.boot +++ b/src/interp/lisp-backend.boot @@ -219,10 +219,13 @@ hasNoExit? x == ++ normal lexical exit. expandSeq(x is ['%seq,:stmts]) == [:stmts',val] := stmts - and/[hasNoExit? s for s in stmts'] and - val is ['%exit,val'] and hasNoExit? val' => + val is ['%exit,val'] and hasNoExit? val' and + (and/[hasNoExit? s for s in stmts']) => ['PROGN,:[expandToVMForm s for s in stmts'],expandToVMForm val'] - ['SEQ,:[expandToVMForm s for s in stmts]] + op := + and/[hasNoExit? s for s in stmts] => 'PROGN + 'SEQ + [op,:[expandToVMForm s for s in stmts]] -- Pointer operations expandPeq ['%peq,x,y] == diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 99e95197..cb78812a 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -516,8 +516,8 @@ buildFunctor(db,sig,code,$locals,$e) == [NRTputInLocalReferences(db,code) for code in $ConstantAssignments] codePart3 := [:$ConstantAssignments,:$epilogue] ans := ["%bind",bindings, - :washFunctorBody optFunctorBody - [:codePart1,:codePart2,:codePart3],"$"] + ['%seq,:washFunctorBody optFunctorBody + [:codePart1,:codePart2,:codePart3],"$"]] $getDomainCode := nil --if we didn't kill this, DEFINE would insert it in the wrong place SAY ['"time taken in buildFunctor: ",TEMPUS_-FUGIT()-oldtime] diff --git a/src/interp/slam.boot b/src/interp/slam.boot index 1f1f7d9e..64e5159a 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -294,7 +294,7 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) == returnValue:= ["PROGN",newStateCode,first gsList] cbody:= endTest:= - ['%when, [["EQL",sharpArg,gIndex],['RETURN,returnValue]]] + ['%when, [['%ieq,sharpArg,gIndex],['RETURN,returnValue]]] newValueCode:= ["%LET",g,substitute(gIndex,sharpArg, applySubst(pairList(rest $TriangleVariableList,gsList),body))] ['%bind,decomposeBindings, |