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/specialize.sml
ViewVC logotype

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

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

revision 183, Sun Nov 8 16:58:19 1998 UTC revision 184, Sun Nov 8 21:18:20 1998 UTC
# Line 400  Line 400 
400          | lpcon (c, e) = (c, loop e)          | lpcon (c, e) = (c, loop e)
401    
402        (* lpfd : fundec -> fundec *** requires REWORK *** *)        (* lpfd : fundec -> fundec *** requires REWORK *** *)
403        and lpfd (fk as FK_FCT, f, vts, be) =        and lpfd (fk as {cconv=CC_FCT, ...}, f, vts, be) =
404             (fk, f, map (fn (v,t) => (v, ltf t)) vts,             (fk, f, map (fn (v,t) => (v, ltf t)) vts,
405                     lplets (map #1 vts, be, fn e => e))                     lplets (map #1 vts, be, fn e => e))
406          | lpfd (fk as FK_FUN {fixed=fflag,isrec,known,inline}, f, vts, be) =          | lpfd (fk as {cconv=CC_FUN fflag,isrec,known,inline}, f, vts, be) =
407             let (** first get the original arg and res types of f *)             let (** first get the original arg and res types of f *)
408                 val (fflag', atys, rtys) = LT.ltd_arrow (getlty (VAR f))                 val (fflag', atys, rtys) = LT.ltd_arrow (getlty (VAR f))
409    
# Line 431  Line 431 
431    
432                 (** fix the isrec information *)                 (** fix the isrec information *)
433                 val nisrec = case isrec of NONE => NONE                 val nisrec = case isrec of NONE => NONE
434                                          | SOME _ => SOME body_ltys                                          | SOME _ => SOME(body_ltys, LK_UNKNOWN)
435                 val nfixed = LT.ffc_fspec(fflag, (arg_raw, body_raw))                 val nfixed = LT.ffc_fspec(fflag, (arg_raw, body_raw))
436                 val nfk = FK_FUN {isrec=nisrec, fixed=nfixed,                 val nfk = {isrec=nisrec, cconv=CC_FUN nfixed,
437                                   known=known, inline=inline}                                   known=known, inline=inline}
438    
439              in (nfk, f, ListPair.zip(arg_lvs, arg_ltys), nnbe)              in (nfk, f, ListPair.zip(arg_lvs, arg_ltys), nnbe)
# Line 603  Line 603 
603    
604  in  in
605  (case fdec  (case fdec
606    of (fk as FK_FCT, f, vts, e) =>    of (fk as {cconv=CC_FCT, ...}, f, vts, e) =>
607        let val tcfg = fn (d : DI.depth) => fn (x : LD.tyc) => x        let val tcfg = fn (d : DI.depth) => fn (x : LD.tyc) => x
608            val ltfg = fn (d : DI.depth) => fn (x : LD.lty) => x            val ltfg = fn (d : DI.depth) => fn (x : LD.lty) => x
609            val ienv = initInfoEnv()            val ienv = initInfoEnv()
# Line 616  Line 616 
616            (* if we did specialize, we run a round of lcontract on the result *)            (* if we did specialize, we run a round of lcontract on the result *)
617            else nfdec            else nfdec
618        end        end
619     | _ => bug "non FK_FCT program in specialize")     | _ => bug "non functor program in specialize")
620  end (* function specialize *)  end (* function specialize *)
621    
622  end (* toplevel local *)  end (* toplevel local *)

Legend:
Removed from v.183  
changed lines
  Added in v.184

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