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 16 - (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 :     | STRINGfrag of string
18 :     | REALfrag of string
19 :    
20 :     fun error msg = ErrorMsg.impossible ("Frag." ^ msg)
21 :    
22 :     val frags = ref ([]: (Label.label * frag) list)
23 :    
24 :     fun next () =
25 :     case !frags
26 :     of frag::rest => SOME frag before (frags := rest)
27 :     | [] => NONE
28 :    
29 :     fun add lf = frags := lf :: !frags
30 :    
31 :     (* make compilation fragments for this cluster *)
32 :     fun makeFrag (arg as (fk, f, vl, cl, e), lab) = let
33 :     val frag = (case fk
34 :     of (CPS.ESCAPE | CPS.CONT) => STANDARD{func=ref(SOME arg), fmlTyps=cl}
35 :     | CPS.KNOWN => KNOWNFUN (ref(UNGEN(f,vl,cl,e)))
36 :     | CPS.KNOWN_CHECK => KNOWNCHK (ref(UNGEN(f,vl,cl,e)))
37 :     | _ => error "makeFrag"
38 :     (*esac*))
39 :     in
40 :     frags:= (lab, frag) :: !frags;
41 :     frag
42 :     end
43 :    
44 :     end (* Frag *)
45 :    
46 :    
47 :    
48 :    
49 :     (*
50 :     * $Log: frag.sml,v $
51 :     * Revision 1.1.1.1 1997/01/14 01:38:34 george
52 :     * Version 109.24
53 :     *
54 :     *)

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