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

SCM Repository

[smlnj] View of /sml/trunk/src/compiler/CodeGen/cpscompile/frag.sml
ViewVC logotype

View of /sml/trunk/src/compiler/CodeGen/cpscompile/frag.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 419 - (download) (annotate)
Fri Sep 3 23:51:27 1999 UTC (19 years, 10 months ago) by monnier
File size: 1168 byte(s)
This commit was generated by cvs2svn to compensate for changes in r418,
which included commits to RCS files with non-trunk default branches.
(* frag.sml --- code and data fragments that need to be compiled.
 *
 * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
 *
 *)
functor Frag(MLTree:MLTREE) : FRAG = struct
  structure T = MLTree
  datatype generated =
      UNGEN of CPS.lvar * CPS.lvar list * CPS.cty list * CPS.cexp
    | GEN of T.mlrisc list

  datatype frag =
      STANDARD of {func: CPS.function option ref, 
		   fmlTyps: CPS.cty list}
    | KNOWNFUN of generated ref 
    | KNOWNCHK of generated ref

  fun error msg = ErrorMsg.impossible ("Frag." ^ msg)

  val frags = ref ([]: (Label.label * frag) list)

  fun next () = 
    case !frags
     of frag::rest => SOME frag before (frags := rest)
      | [] => NONE

  fun add lf = frags := lf :: !frags

  (* make compilation fragments for this cluster *)
  fun makeFrag (arg as (fk, f, vl, cl, e), lab) = let
    val frag = (case fk
      of (CPS.ESCAPE | CPS.CONT) => STANDARD{func=ref(SOME arg), fmlTyps=cl}
       | CPS.KNOWN => KNOWNFUN (ref(UNGEN(f,vl,cl,e)))
       | CPS.KNOWN_CHECK => KNOWNCHK (ref(UNGEN(f,vl,cl,e)))
       | _  => error "makeFrag"
      (*esac*))
  in
    frags:=  (lab, frag) :: !frags;
    frag
  end

end (* Frag *)





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