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/system/Init/built-in.sml
ViewVC logotype

Annotation of /sml/trunk/src/system/Init/built-in.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 417 - (view) (download)
Original Path: sml/branches/SMLNJ/src/system/Init/built-in.sml

1 : monnier 416 (* built-in.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     * Interfaces to the compiler built-ins, infixes, etc.
6 :     *
7 :     *)
8 :    
9 :     infix 7 * / mod div
10 :     infix 6 ^ + -
11 :     infix 3 := o
12 :     infix 4 > < >= <= = <>
13 :     infixr 5 :: @
14 :     infix 0 before
15 :    
16 :     structure PrimTypes = struct open PrimTypes end
17 :     (* this silliness is to prevent elabstr.sml from sticking a NO_ACCESS
18 :     in the wrong place *)
19 :    
20 :     open PrimTypes
21 :    
22 :     structure Assembly = Core.Assembly
23 :    
24 :     (* create a type-safe version of the InLine structure while preserving
25 :     * the inline property of the functions.
26 :     *)
27 :     structure InlineT =
28 :     struct
29 :     type 'a control_cont = 'a control_cont
30 :    
31 :     val callcc : ('a cont -> 'a) -> 'a = InLine.callcc
32 :     val throw : 'a cont -> 'a -> 'b = InLine.throw
33 :     val capture : ('a control_cont -> 'a) -> 'a = InLine.capture
34 :     val escape : 'a control_cont -> 'a -> 'b = InLine.cthrow
35 :     val isolate : ('a -> unit) -> 'a cont = InLine.isolate
36 :     val ! : 'a ref -> 'a = InLine.!
37 :     val op := : 'a ref * 'a -> unit = InLine.:=
38 :     val makeref : 'a -> 'a ref = InLine.makeref
39 :     val op = : ''a * ''a -> bool = InLine.=
40 :     val op <> : ''a * ''a -> bool = InLine.<>
41 :     val boxed : 'a -> bool = InLine.boxed
42 :     val unboxed : 'a -> bool = InLine.unboxed
43 :     val cast : 'a -> 'b = InLine.cast
44 :     val identity : 'a -> 'a = InLine.cast
45 :     val objlength : 'a -> int = InLine.objlength
46 :     val mkspecial : int * 'a -> 'b = InLine.mkspecial
47 :     val getspecial : 'a -> int = InLine.getspecial
48 :     val setspecial : ('a * int) -> unit = InLine.setspecial
49 :     val getpseudo : int -> 'a = InLine.getpseudo
50 :     val setpseudo : 'a * int -> unit = InLine.setpseudo
51 :     val gethdlr : unit -> 'a cont = InLine.gethdlr
52 :     val sethdlr : 'a cont -> unit = InLine.sethdlr
53 :     val getvar : unit -> 'a = InLine.getvar
54 :     val setvar : 'a -> unit = InLine.setvar
55 :     val compose : ('b -> 'c) * ('a -> 'b) -> ('a -> 'c) = InLine.compose
56 :     val op before : ('a * 'b) -> 'a = InLine.before
57 :     val gettag : 'a -> int = InLine.gettag
58 :     val setmark : 'a -> unit = InLine.setmark
59 :     val dispose : 'a -> unit = InLine.dispose
60 :     val inlnot : bool -> bool = InLine.inlnot
61 :     val real : int -> real = InLine.real
62 :     val recordSub : ('a * int) -> 'b = InLine.recordSub
63 :     val raw64Sub : ('a * int) -> real = InLine.raw64Sub
64 :    
65 :     structure Int31 =
66 :     struct
67 :     val fromInt : int -> int = InLine.copy_31_31
68 :     val toInt : int -> int = InLine.copy_31_31
69 :     val op * : int * int -> int = InLine.i31mul
70 :     val op quot : int * int -> int = InLine.i31quot
71 :     val op rem : int * int -> int = InLine.i31rem
72 :     val op + : int * int -> int = InLine.i31add
73 :     val op - : int * int -> int = InLine.i31sub
74 :     val ~ : int -> int = InLine.i31neg
75 :     val andb : int * int -> int = InLine.i31andb
76 :     val orb : int * int -> int = InLine.i31orb
77 :     val xorb : int * int -> int = InLine.i31xorb
78 :     val rshift : int * int -> int = InLine.i31rshift
79 :     val lshift : int * int -> int = InLine.i31lshift
80 :     val notb : int -> int = InLine.i31notb
81 :     val op < : int * int -> bool = InLine.i31lt
82 :     val op <= : int * int -> bool = InLine.i31le
83 :     val op > : int * int -> bool = InLine.i31gt
84 :     val op >= : int * int -> bool = InLine.i31ge
85 :     val op = : int * int -> bool = InLine.i31eq
86 :     val op <> : int * int -> bool = InLine.i31ne
87 :     val ltu : int * int -> bool = InLine.i31ltu
88 :     val geu : int * int -> bool = InLine.i31geu
89 :    
90 :     val op mod : int * int -> int = InLine.i31mod
91 :     val op div : int * int -> int = InLine.i31div
92 :     val min : int * int -> int = InLine.i31min
93 :     val max : int * int -> int = InLine.i31max
94 :     val abs : int -> int = InLine.i31abs
95 :     end
96 :    
97 :     structure Int32 =
98 :     struct
99 :     val toLarge : int32 -> int32 = InLine.copy_32_32
100 :     val fromInt : int -> int32 = InLine.extend_31_32
101 :     val toInt : int32 -> int = InLine.test_32_31
102 :     val fromLarge : int32 -> int32 = InLine.copy_32_32
103 :    
104 :     val op * : int32 * int32 -> int32 = InLine.i32mul
105 :     val op quot : int32 * int32 -> int32 = InLine.i32quot
106 :     val op + : int32 * int32 -> int32 = InLine.i32add
107 :     val op - : int32 * int32 -> int32 = InLine.i32sub
108 :     val ~ : int32 -> int32 = InLine.i32neg
109 :     val andb : int32 * int32 -> int32 = InLine.i32andb
110 :     val orb : int32 * int32 -> int32 = InLine.i32orb
111 :     val xorb : int32 * int32 -> int32 = InLine.i32xorb
112 :     val rshift : int32 * int32 -> int32 = InLine.i32rshift
113 :     val lshift : int32 * int32 -> int32 = InLine.i32lshift
114 :     val op < : int32 * int32 -> bool = InLine.i32lt
115 :     val op <= : int32 * int32 -> bool = InLine.i32le
116 :     val op > : int32 * int32 -> bool = InLine.i32gt
117 :     val op >= : int32 * int32 -> bool = InLine.i32ge
118 :     val op = : int32 * int32 -> bool = InLine.i32eq
119 :     val op <> : int32 * int32 -> bool = InLine.i32ne
120 :     end
121 :    
122 :    
123 :     structure Real64 =
124 :     struct
125 :     val op + : real * real -> real = InLine.f64add
126 :     val op - : real * real -> real = InLine.f64sub
127 :     val op / : real * real -> real = InLine.f64div
128 :     val op * : real * real -> real = InLine.f64mul
129 :     val op == : real * real -> bool = InLine.f64eq
130 :     val op != : real * real -> bool = InLine.f64ne
131 :     val op >= : real * real -> bool = InLine.f64ge
132 :     val op > : real * real -> bool = InLine.f64gt
133 :     val op <= : real * real -> bool = InLine.f64le
134 :     val op < : real * real -> bool = InLine.f64lt
135 :     val ~ : real -> real = InLine.f64neg
136 :     val abs : real -> real = InLine.f64abs
137 :     end
138 :    
139 :     structure Word32 =
140 :     struct
141 :     val toLargeInt : word32 -> int32 = InLine.testu_32_32
142 :     val toLargeIntX : word32 -> int32 = InLine.copy_32_32
143 :     val fromLargeInt : int32 -> word32 = InLine.copy_32_32
144 :     val fromInt : int -> word32 = InLine.extend_31_32
145 :     val toLargeWord : word32 -> word32 = InLine.copy_32_32
146 :     val toLargeWordX : word32 -> word32 = InLine.copy_32_32
147 :     val fromLargeWord : word32 -> word32 = InLine.copy_32_32
148 :     val toIntX : word32 -> int = InLine.test_32_31
149 :     val toInt : word32 -> int = InLine.testu_32_31
150 :    
151 :     val orb : word32 * word32 -> word32 = InLine.w32orb
152 :     val xorb : word32 * word32 -> word32 = InLine.w32xorb
153 :     val andb : word32 * word32 -> word32 = InLine.w32andb
154 :     val op * : word32 * word32 -> word32 = InLine.w32mul
155 :     val op + : word32 * word32 -> word32 = InLine.w32add
156 :     val op - : word32 * word32 -> word32 = InLine.w32sub
157 :     val op div : word32 * word32 -> word32 = InLine.w32div
158 :     val op > : word32 * word32 -> bool = InLine.w32gt
159 :     val op >= : word32 * word32 -> bool = InLine.w32ge
160 :     val op < : word32 * word32 -> bool = InLine.w32lt
161 :     val op <= : word32 * word32 -> bool = InLine.w32le
162 :     val rshift : word32 * word -> word32 = InLine.w32rshift
163 :     val rshiftl : word32 * word -> word32 = InLine.w32rshiftl
164 :     val lshift : word32 * word -> word32 = InLine.w32lshift
165 :     val notb : word32 -> word32 = InLine.w32notb
166 :     val chkLshift : word32 * word -> word32 = InLine.w32ChkLshift
167 :     val chkRshift : word32 * word -> word32 = InLine.w32ChkRshift
168 :     val chkRshiftl : word32 * word -> word32 = InLine.w32ChkRshiftl
169 :     end
170 :    
171 :     structure Word31 =
172 :     struct
173 :     val toLargeInt : word -> int32 = InLine.copy_31_32
174 :     val toLargeIntX : word -> int32 = InLine.extend_31_32
175 :     val toInt : word -> int = InLine.testu_31_31
176 :     val toLargeWord : word -> word32 = InLine.copy_31_32
177 :     val toLargeWordX : word -> word32 = InLine.extend_31_32
178 :     val fromInt : int -> word = InLine.copy_31_31
179 :     val fromLargeWord : word32 -> word = InLine.trunc_32_31
180 :     val fromLargeInt : int32 -> word = InLine.trunc_32_31
181 :     val toIntX : word -> int = InLine.copy_31_31
182 :    
183 :     val orb : word * word -> word = InLine.w31orb
184 :     val xorb : word * word -> word = InLine.w31xorb
185 :     val andb : word * word -> word = InLine.w31andb
186 :     val op * : word * word -> word = InLine.w31mul
187 :     val op + : word * word -> word = InLine.w31add
188 :     val op - : word * word -> word = InLine.w31sub
189 :     val op div : word * word -> word = InLine.w31div
190 :     val op > : word * word -> bool = InLine.w31gt
191 :     val op >= : word * word -> bool = InLine.w31ge
192 :     val op < : word * word -> bool = InLine.w31lt
193 :     val op <= : word * word -> bool = InLine.w31le
194 :     val rshift : word * word -> word = InLine.w31rshift
195 :     val rshiftl : word * word -> word = InLine.w31rshiftl
196 :     val lshift : word * word -> word = InLine.w31lshift
197 :     val chkLshift : word * word -> word = InLine.w31ChkLshift
198 :     val chkRshift : word * word -> word = InLine.w31ChkRshift
199 :     val chkRshiftl : word * word -> word = InLine.w31ChkRshiftl
200 :     val notb : word -> word = InLine.w31notb
201 :     end
202 :    
203 :     structure Word8 =
204 :     struct
205 :     val toLargeIntX : word8 -> int32 = InLine.extend_8_32
206 :     val toLargeInt : word8 -> int32 = InLine.copy_8_32
207 :     val toIntX : word8 -> int = InLine.extend_8_31
208 :     val toInt : word8 -> int = InLine.copy_8_31
209 :     val toLargeWordX : word8 -> word32 = InLine.extend_8_32
210 :     val toLargeWord : word8 -> word32 = InLine.copy_8_32
211 :     val fromLargeWord : word32 -> word8 = InLine.trunc_32_8
212 :     val fromInt : int -> word8 = InLine.trunc_31_8
213 :     val fromLargeInt : int32 -> word8 = InLine.trunc_32_8
214 :    
215 :     (* temporary framework, because the actual word8 operators
216 :     * are not implemented*)
217 :     val orb : word8 * word8 -> word8 = InLine.i31orb
218 :     val xorb : word8 * word8 -> word8 = InLine.i31xorb
219 :     val op div : word8 * word8 -> word8 = InLine.i31div
220 :     val andb : word8 * word8 -> word8 = InLine.i31andb
221 :     val op > : word8 * word8 -> bool = InLine.i31gt
222 :     val op >= : word8 * word8 -> bool = InLine.i31ge
223 :     val op < : word8 * word8 -> bool = InLine.i31lt
224 :     val op <= : word8 * word8 -> bool = InLine.i31le
225 :     val rshift : word8 * word -> word8 = InLine.i31rshift
226 :     val rshiftl : word8 * word -> word8 = InLine.i31rshift (* high bits always 0 *)
227 :     val lshift : word8 * word -> word8 = InLine.i31lshift
228 :     (* WARNING! the following operators don't get the high-order bits right *)
229 :     val notb : word8 -> word8 = InLine.i31notb
230 :     val op * : word8 * word8 -> word8 = InLine.i31mul
231 :     val op + : word8 * word8 -> word8 = InLine.i31add
232 :     val op - : word8 * word8 -> word8 = InLine.i31sub
233 :     end
234 :    
235 :     structure Char =
236 :     struct
237 :    
238 :     val maxOrd = 255
239 :     exception Chr
240 :    
241 :     (* the following should be an inline operator *)
242 :     fun chr i = if (Int31.geu(i, Int31.+(maxOrd,1)))
243 :     then raise Chr
244 :     else ((InLine.cast i) : char)
245 :    
246 :     val ord : char -> int = InLine.cast
247 :    
248 :     val (op <) : (char * char) -> bool = InLine.i31lt
249 :     val (op <=) : (char * char) -> bool = InLine.i31le
250 :     val (op >) : (char * char) -> bool = InLine.i31gt
251 :     val (op >=) : (char * char) -> bool = InLine.i31ge
252 :     end
253 :    
254 :     structure PolyArray =
255 :     struct
256 :     val newArray0 : unit -> 'a array = InLine.newArray0
257 :     val array : int * 'a -> 'a array = InLine.mkarray
258 :     val length : 'a array -> int = InLine.length
259 :     val sub : 'a array * int -> 'a = InLine.arrSub
260 :     val chkSub : 'a array * int -> 'a = InLine.arrChkSub
261 :     val update : 'a array * int * 'a -> unit = InLine.arrUpdate
262 :     val chkUpdate : 'a array * int * 'a -> unit = InLine.arrChkUpdate
263 :     val getData : 'a array -> 'b = InLine.getSeqData
264 :     end
265 :    
266 :     structure PolyVector =
267 :     struct
268 :     val length : 'a vector -> int = InLine.length
269 :     val sub : 'a vector * int -> 'a = InLine.vecSub
270 :     val chkSub : 'a vector * int -> 'a = InLine.vecChkSub
271 :     val getData : 'a vector -> 'b = InLine.getSeqData
272 :     end
273 :    
274 :     (* The type of this ought to be float64array *)
275 :     structure Real64Array =
276 :     struct
277 :     val newArray0 : unit -> Assembly.A.real64array = InLine.newArray0
278 :     val length : Assembly.A.real64array -> int = InLine.length
279 :     val sub : Assembly.A.real64array * int -> real = InLine.f64Sub
280 :     val chkSub : Assembly.A.real64array * int -> real = InLine.f64chkSub
281 :     val update : Assembly.A.real64array * int * real -> unit = InLine.f64Update
282 :     val chkUpdate : Assembly.A.real64array * int * real -> unit = InLine.f64chkUpdate
283 :     val getData : Assembly.A.real64array -> 'b = InLine.getSeqData
284 :     end
285 :    
286 :     (** NOTE: we are currently using polymorphic vectors to implement the Real64Vector
287 :     ** structure.
288 :     **)
289 :     structure Real64Vector =
290 :     struct
291 :     val length : real vector -> int = InLine.length
292 :     val sub : real vector * int -> real = InLine.vecSub
293 :     val chkSub : real vector * int -> real = InLine.vecChkSub
294 :     val getData : real vector -> 'b = InLine.getSeqData
295 :     end
296 :    
297 :     structure Word8Array =
298 :     struct
299 :     type array = Assembly.A.word8array
300 :     val newArray0 : unit -> array = InLine.newArray0
301 :     val length : array -> int = InLine.length
302 :     (* BUG: using "ordof" for W8A.sub is dangerous, because ordof is
303 :     (technically) fetching from immutable things. A fancy optimizer might
304 :     someday be confused. *)
305 :     val sub : array * int -> word8 = InLine.ordof
306 :     val chkSub : array * int -> word8 = InLine.inlbyteof
307 :     val update : array * int * word8 -> unit = InLine.store
308 :     val chkUpdate : array * int * word8 -> unit = InLine.inlstore
309 :     val getData : array -> 'a = InLine.getSeqData
310 :     end
311 :    
312 :     structure Word8Vector =
313 :     struct
314 :     local
315 :     structure V :> sig
316 :     eqtype vector
317 :     val create : int -> vector
318 :     end = struct
319 :     type vector = string
320 :     val create = Assembly.A.create_s
321 :     end
322 :     in
323 :     open V
324 :     end
325 :     val length : vector -> int = InLine.length
326 :     val sub : vector * int -> word8 = InLine.ordof
327 :     val chkSub : vector * int -> word8 = InLine.inlordof
328 :     val update : vector * int * word8 -> unit = InLine.store
329 :     val getData : vector -> 'a = InLine.getSeqData
330 :     end
331 :    
332 :     structure CharArray =
333 :     struct
334 :     local
335 :     structure A :> sig
336 :     eqtype array
337 :     val newArray0 : unit -> array
338 :     val create : int -> array
339 :     end = struct
340 :     type array = Assembly.A.word8array
341 :     val newArray0 : unit -> array = InLine.newArray0
342 :     val create = Assembly.A.create_b
343 :     end
344 :     in
345 :     open A
346 :     end
347 :     val length : array -> int = InLine.length
348 :     val chkSub : (array * int) -> char = InLine.inlordof
349 :     val chkUpdate : (array * int * char) -> unit = InLine.inlstore
350 :     val sub : (array * int) -> char = InLine.ordof
351 :     val update : (array * int * char) -> unit = InLine.store
352 :     val getData : array -> 'a = InLine.getSeqData
353 :     end
354 :    
355 :     structure CharVector =
356 :     struct
357 :     val length : string -> int = InLine.length
358 :     val chkSub : (string * int) -> char = InLine.inlordof
359 :     val sub : (string * int) -> char = InLine.ordof
360 :     val update : (string * int * char) -> unit = InLine.store
361 :     val getData : string -> 'a = InLine.getSeqData
362 :     end
363 :    
364 :     structure DfltInt = Int31
365 :     structure DfltWord = Word31
366 :     structure DfltReal = Real64
367 :    
368 :     end (* structure InlineT *)
369 :    

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