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/branches/SMLNJ/src/compiler/FLINT/kernel/primtyc.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/compiler/FLINT/kernel/primtyc.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 245 - (view) (download)

1 : monnier 245 (* Copyright 1996 - 1998 by YALE FLINT PROJECT *)
2 :     (* primtyc.sml *)
3 :    
4 :     structure PrimTyc :> PRIM_TYC =
5 :     struct
6 :    
7 :     local fun bug s = ErrorMsg.impossible ("PrimTyc: " ^ s)
8 :    
9 :     in
10 :    
11 :     (*
12 :     * This datatype defines the set of primitive type constructors. They
13 :     * probably don't have to be defined as a datatype. A environment-like
14 :     * thing would serve better. The intermediate language can be thought
15 :     * as a language parameterized by the set of primitive type constructors
16 :     * and primitive functions --- which can be represented by a higher-order
17 :     * functors. By the way, PT_VOID is an object we know nothing but that
18 :     * it is a pointer; or so-called canonical word representations; on a
19 :     * 32-bit machine, it can be a Pointer or a 31-bit integer; on 64-bit
20 :     * machines, it could be something else. In the future, we should also
21 :     * add arrow_kind and tuple_kind, or even array_kind, and vector_kind to
22 :     * denote various possible representation types. (ZHONG)
23 :     *)
24 :    
25 :     datatype ptyc
26 :     = PT_INT31 (* 31-bit integer *)
27 :     | PT_INT32 (* 32-bit integer *)
28 :     | PT_REAL (* 64-bit real *)
29 :     | PT_STRING (* string type; always a pointer *)
30 :     | PT_EXN (* exception type *)
31 :    
32 :     | PT_ARRAY (* the polymorphic array tyc *)
33 :     | PT_VECTOR (* the polymorphic vector tyc *)
34 :     | PT_REF (* the polymorphic reference tyc *)
35 :     | PT_LIST (* the polymorphic list tyc *)
36 :     | PT_ETAG (* the exception tag type *)
37 :    
38 :     | PT_CONT (* the general-continuation tyc *)
39 :     | PT_CCONT (* the control-continuation tyc *)
40 :     | PT_ARROW (* the function tyc *)
41 :     | PT_OPTION (* the option tyc is optional *)
42 :    
43 :     | PT_BOXED (* the boxed tyc; used for wrapping *)
44 :     | PT_TGD (* the tagged tyc; with a integer *)
45 :     | PT_UTGD (* the untagged tyc; no int tags *)
46 :     | PT_TNSP (* the transparent tyc; fit-in-1-word *)
47 :    
48 :     | PT_DYN (* the dynamic type; with runtime ty *)
49 :     | PT_VOID (* generic machine word; supports GC *)
50 :     | PT_OBJ
51 :     | PT_CFUN
52 :     | PT_BARRAY
53 :     | PT_RARRAY
54 :     | PT_SLOCK
55 :    
56 :     (** the primtive type constructor *)
57 :     type primtyc = ptyc * int * int
58 :    
59 :     (** the set of primitive type constructors *)
60 :     val ptc_int31 = (PT_INT31, 0, 1)
61 :     val ptc_int32 = (PT_INT32, 0, 2)
62 :     val ptc_real = (PT_REAL, 0, 3)
63 :     val ptc_string = (PT_STRING,0, 4)
64 :     val ptc_exn = (PT_EXN, 0, 5)
65 :     val ptc_void = (PT_VOID, 0, 6)
66 :     val ptc_array = (PT_ARRAY, 1, 7)
67 :     val ptc_vector = (PT_VECTOR,1, 8)
68 :     val ptc_ref = (PT_REF, 1, 9)
69 :     val ptc_list = (PT_LIST, 1, 10)
70 :     val ptc_etag = (PT_ETAG, 1, 11)
71 :     val ptc_cont = (PT_CONT, 1, 12)
72 :     val ptc_ccont = (PT_CCONT, 1, 13)
73 :     val ptc_arrow = (PT_ARROW, 2, 14)
74 :     val ptc_option = (PT_OPTION,1, 15)
75 :     val ptc_boxed = (PT_BOXED, 1, 16)
76 :     val ptc_tgd = (PT_TGD, 1, 17)
77 :     val ptc_utgd = (PT_UTGD, 1, 18)
78 :     val ptc_tnsp = (PT_TNSP, 1, 19)
79 :     val ptc_dyn = (PT_DYN, 1, 20)
80 :     val ptc_obj = (PT_OBJ, 0, 21)
81 :     val ptc_cfun = (PT_CFUN, 0, 22)
82 :     val ptc_barray = (PT_BARRAY,0, 23)
83 :     val ptc_rarray = (PT_RARRAY,0, 24)
84 :     val ptc_slock = (PT_SLOCK, 0, 25)
85 :    
86 :    
87 :     (** get the arity of a particular primitive tycon *)
88 :     fun pt_arity(_, i, _) = i
89 :    
90 :     (** each primitive type constructor is equipped with a key *)
91 :     fun pt_toint (_, _, k) = k
92 :    
93 :     fun pt_fromint k =
94 :     (case k
95 :     of 1 => ptc_int31
96 :     | 2 => ptc_int32
97 :     | 3 => ptc_real
98 :     | 4 => ptc_string
99 :     | 5 => ptc_exn
100 :     | 6 => ptc_void
101 :     | 7 => ptc_array
102 :     | 8 => ptc_vector
103 :     | 9 => ptc_ref
104 :     | 10 => ptc_list
105 :     | 11 => ptc_etag
106 :     | 12 => ptc_cont
107 :     | 13 => ptc_ccont
108 :     | 14 => ptc_arrow
109 :     | 15 => ptc_option
110 :     | 16 => ptc_boxed
111 :     | 17 => ptc_tgd
112 :     | 18 => ptc_utgd
113 :     | 19 => ptc_tnsp
114 :     | 20 => ptc_dyn
115 :     | 21 => ptc_obj
116 :     | 22 => ptc_cfun
117 :     | 23 => ptc_barray
118 :     | 24 => ptc_rarray
119 :     | 25 => ptc_slock
120 :     | _ => bug "unexpected integer in pt_fromint")
121 :    
122 :     (** printing out the primitive type constructor *)
123 :     fun pt_print (pt, _, _) =
124 :     let fun g (PT_INT31) = "I"
125 :     | g (PT_INT32) = "W"
126 :     | g (PT_REAL) = "F"
127 :     | g (PT_STRING) = "N"
128 :     | g (PT_EXN) = "X"
129 :     | g (PT_ARRAY) = "A"
130 :     | g (PT_VECTOR) = "V"
131 :     | g (PT_REF) = "P"
132 :     | g (PT_LIST) = "L"
133 :     | g (PT_ETAG) = "G"
134 :     | g (PT_CONT) = "D"
135 :     | g (PT_CCONT) = "C"
136 :     | g (PT_ARROW) = "R"
137 :     | g (PT_OPTION) = "O"
138 :     | g (PT_BOXED) = "K"
139 :     | g (PT_TGD) = "T"
140 :     | g (PT_UTGD) = "U"
141 :     | g (PT_TNSP) = "S"
142 :     | g (PT_DYN) = "Y"
143 :     | g (PT_VOID) = "Z"
144 :     | g (PT_OBJ) = "OB"
145 :     | g (PT_CFUN) = "CF"
146 :     | g (PT_BARRAY) = "BA"
147 :     | g (PT_RARRAY) = "RA"
148 :     | g (PT_SLOCK) = "SL"
149 :     in g pt
150 :     end
151 :    
152 :     (** check the boxity of values of each prim tyc *)
153 :     fun unboxed ((PT_INT32 | PT_REAL), _, _) = true
154 :     | unboxed _ = false
155 :    
156 :     fun bxupd ((PT_INT31 | PT_INT32 | PT_REAL), _, _) = false
157 :     | bxupd ((PT_LIST | PT_OPTION | PT_VOID), _, _) = false
158 :     | bxupd ((PT_TNSP | PT_TGD | PT_UTGD | PT_BOXED | PT_DYN), _, _) = false
159 :     | bxupd _ = true
160 :    
161 :     fun ubxupd (PT_INT31, _, _) = true
162 :     | ubxupd _ = false
163 :    
164 :     fun isvoid ((PT_INT31 | PT_INT32 | PT_REAL | PT_STRING), _, _) = false
165 :     | isvoid _ = true
166 :    
167 :     end (* toplevel local *)
168 :     end (* structure PrimTyc *)
169 :    
170 :    
171 :     (*
172 :     * $Log$
173 :     *)

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