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

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.