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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 228 - (view) (download)

1 : monnier 16 (* frag.sml --- code and data fragments that need to be compiled.
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     *)
6 :     functor Frag(MLTree:MLTREE) : FRAG = struct
7 :     structure T = MLTree
8 :     datatype generated =
9 :     UNGEN of CPS.lvar * CPS.lvar list * CPS.cty list * CPS.cexp
10 :     | GEN of T.mlrisc list
11 :    
12 :     datatype frag =
13 :     STANDARD of {func: CPS.function option ref,
14 :     fmlTyps: CPS.cty list}
15 :     | KNOWNFUN of generated ref
16 :     | KNOWNCHK of generated ref
17 :    
18 :     fun error msg = ErrorMsg.impossible ("Frag." ^ msg)
19 :    
20 :     val frags = ref ([]: (Label.label * frag) list)
21 :    
22 :     fun next () =
23 :     case !frags
24 :     of frag::rest => SOME frag before (frags := rest)
25 :     | [] => NONE
26 :    
27 :     fun add lf = frags := lf :: !frags
28 :    
29 :     (* make compilation fragments for this cluster *)
30 :     fun makeFrag (arg as (fk, f, vl, cl, e), lab) = let
31 :     val frag = (case fk
32 :     of (CPS.ESCAPE | CPS.CONT) => STANDARD{func=ref(SOME arg), fmlTyps=cl}
33 :     | CPS.KNOWN => KNOWNFUN (ref(UNGEN(f,vl,cl,e)))
34 :     | CPS.KNOWN_CHECK => KNOWNCHK (ref(UNGEN(f,vl,cl,e)))
35 :     | _ => error "makeFrag"
36 :     (*esac*))
37 :     in
38 :     frags:= (lab, frag) :: !frags;
39 :     frag
40 :     end
41 :    
42 :     end (* Frag *)
43 :    
44 :    
45 :    
46 :    
47 :     (*
48 : monnier 223 * $Log: frag.sml,v $
49 :     * Revision 1.1.1.1 1998/04/08 18:39:54 george
50 :     * Version 110.5
51 :     *
52 : monnier 16 *)

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