Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/compiler/FLINT/opt/fcontract.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/FLINT/opt/fcontract.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 603, Thu Apr 6 19:59:57 2000 UTC revision 604, Fri Apr 7 13:53:08 2000 UTC
# Line 421  Line 421 
421      val cdcon = cdcon m      val cdcon = cdcon m
422      val cpo = cpo m      val cpo = cpo m
423    
424  fun fcLet (lvs,le,body) =  fun fcLet (lvs,le,body) = let
425      loop m le  
426           (fn (nm,nle) =>      fun fcbody (nm,nle) =
427            let fun cbody () =            let fun cbody () =
428                    let val nm = (foldl (fn (lv,m) =>                    let val nm = (foldl (fn (lv,m) =>
429                                         addbind(m, lv, Var(lv, NONE)))                                         addbind(m, lv, Var(lv, NONE)))
# Line 447  Line 447 
447                   then loop nm body cont                   then loop nm body cont
448                   else cbody()                   else cbody()
449                 | _ => cbody()                 | _ => cbody()
450            end)          end
451    
452        (* this is a hack originally meant to cleanup the BRANCH
453         * mess introduced in flintnm (where each branch returns
454         * just true or false which is generally only used as
455         * input to a SWITCH).
456         * The present code does more than clean up this case. *)
457        fun cassoc (lv,F.SWITCH(F.VAR v,ac,arms,NONE),wrap) =
458            if lv <> v orelse C.usenb(C.get lv) > 1 then loop m le fcbody else
459            let val (narms,fdecs) =
460                    ListPair.unzip (map extract arms)
461                fun addswitch [v] =
462                    C.copylexp
463                        M.empty
464                        (F.SWITCH(v,ac,narms,NONE))
465                  | addswitch _ = bug "prob in addswitch"
466                (* replace each leaf `ret' with a copy
467                 * of the switch *)
468                val nle = append [lv] addswitch le
469                (* decorate with the functions extracted
470                 * from the switch arms *)
471                val nle =
472                    foldl (fn (f,le) => F.FIX([f],le))
473                          (wrap nle) fdecs
474            in
475                click_branch();
476                loop m nle cont
477            end
478          | cassoc _ = loop m le fcbody
479    
480    in case (lvs, le, body)
481        of ([lv],(F.BRANCH _ | F.SWITCH _),F.SWITCH _) =>
482           cassoc(lv, body, fn x => x)
483         | ([lv],(F.BRANCH _ | F.SWITCH _),F.LET(lvs,body as F.SWITCH _,rest)) =>
484           cassoc(lv, body, fn le => F.LET(lvs,le,rest))
485         | _ =>
486           loop m le fcbody
487    end
488    
489  fun fcFix (fs,le) =  fun fcFix (fs,le) =
490      let (* merge actual arguments to extract the constant subpart *)      let (* merge actual arguments to extract the constant subpart *)

Legend:
Removed from v.603  
changed lines
  Added in v.604

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0