Return to reorder.sml CVS log

Up to [Research Unix] / researchv10no / cmd / sml / src / cps

Annotation of researchv10no/cmd/sml/src/cps/reorder.sml, revision 1.1

1.1     ! root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
        !             2: structure Reorder : sig val reorder : Lambda.lexp -> Lambda.lexp end = 
        !             3: struct
        !             4: 
        !             5: open Lambda
        !             6: 
        !             7: fun inorder({regs=ra:int,side=sa,exp=_}
        !             8:               :: (rest as {regs=rb,side=sb,exp=_} :: _)) =
        !             9:     (ra >= rb orelse sa andalso sb) andalso inorder rest
        !            10:   | inorder _ = true
        !            11: 
        !            12: fun cost(r::rest) = max(r, 1+cost rest)
        !            13:   | cost nil = 0
        !            14: 
        !            15: fun insert(a as{side=true,...}, l as {side=true,...}::_) = a::l
        !            16:   | insert(a as{regs=ra,side,exp,var}, l as (b as {regs=rb,...})::c) =
        !            17:        if (ra:int) >= rb then a::l else b::insert(a,c)
        !            18:   | insert(a,l) = a::l
        !            19: 
        !            20: fun sort(do_it, l) = if inorder l 
        !            21:      then {regs=cost(map (#regs) l), side=exists (#side) l, 
        !            22:           exp= do_it(map (#exp) l)}
        !            23:      else let val l' = map (fn{regs,side,exp}=>
        !            24:                              {regs=regs,side=side,exp=exp,
        !            25:                                        var=Access.mkLvar()})
        !            26:                           l
        !            27:               val e0 = do_it (map (fn {var,...}=> VAR var) l')
        !            28:               val l'' = fold insert l' nil
        !            29:           in {regs= cost(map (#regs) l''),
        !            30:               side = exists (#side) l'',
        !            31:               exp = fold (fn({var,exp,...},e)=>APP(FN(var,e),exp)) l'' e0}
        !            32:          end
        !            33: 
        !            34: val many = 12   (* how many regs to charge a function call *)
        !            35: 
        !            36: val rec reorder : lexp -> {regs: int, side: bool, exp: lexp} =
        !            37:   fn e as VAR _ => {regs=0, side=false, exp=e}
        !            38:    | FN(v,e) => {regs=1, side=false, exp= FN(v, #exp(reorder e))}
        !            39:    | FIX(vl,el,e) => let val {regs,side,exp} = reorder e 
        !            40:                       in {regs=regs+1,side=side,exp=FIX(vl,el,exp)}
        !            41:                      end
        !            42:    | APP(PRIM i, b) => let val {regs=r,side=s,exp=e1} = reorder b
        !            43:                           val e2 = APP(PRIM i, e1)
        !            44:                        in if Prim.pure i then {regs=r,side=s,exp=e2}
        !            45:                                          else {regs=many,side=true,exp=e2}
        !            46:                       end
        !            47:    | e as APP(a,b) => let val {regs=r,side=s,exp=e1} = 
        !            48:                            sort( fn[x,y]=>APP(x,y), map reorder [a,b])
        !            49:                       in {regs=many,side=true,exp=e1}
        !            50:                      end
        !            51:    | e as INT i => {regs=0, side=false, exp=e}
        !            52:    | e as REAL i => {regs=0, side=false, exp=e}
        !            53:    | e as STRING i => {regs=0, side=false, exp=e}
        !            54:    | SWITCH(e0,l,d) => 
        !            55:          let val {regs,side,exp}= reorder e0
        !            56:              val (lr,ls,l') = fold (fn((c,e),(r,s,l)) =>
        !            57:                                    let val {regs,side,exp}=reorder e
        !            58:                                      in (max(r,regs),s orelse side,(c,exp)::l)
        !            59:                                     end) l (regs,side,nil)
        !            60:           in case d 
        !            61:               of SOME d' => let val {regs=dr,side=ds,exp=de} = reorder d'
        !            62:                             in {regs=max(lr,dr),side=ls orelse ds,
        !            63:                                 exp=SWITCH(exp,l',SOME de)}
        !            64:                            end               
        !            65:                | NONE => {regs=lr,side=ls,exp=SWITCH(exp,l',NONE)}
        !            66:           end
        !            67:    | RECORD l => sort(RECORD, map reorder l)
        !            68:    | SELECT(i,e) => let val {regs,side,exp} = reorder e
        !            69:                      in {regs=max(1,regs),side=side,exp=SELECT(i,exp)}
        !            70:                     end
        !            71:    | RAISE e =>     let val {regs,side,exp} = reorder e
        !            72:                      in {regs=max(1,regs),side=side,exp=RAISE exp}
        !            73:                     end
        !            74:    | HANDLE(a,b) => let val {regs=ra,side=sa,exp=ea} = reorder a
        !            75:                         val {regs=rb,side=sb,exp=eb} = reorder b
        !            76:                      in {regs=ra,side=sa orelse sb,exp=HANDLE(ea,eb)}
        !            77:                     end
        !            78:    | e as PRIM i => {regs=0,side=false,exp=e}
        !            79: 
        !            80: val reorder = fn x => #exp (reorder x)
        !            81: 
        !            82: end

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.