HCoop / hcoop / debian / mlton.git / blame
| Commit | Line | Data |
|---|---|---|
| 7f918cf1 CE |
1 | (* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh |
| 2 | * Jagannathan, and Stephen Weeks. | |
| 3 | * Copyright (C) 1997-2000 NEC Research Institute. | |
| 4 | * | |
| 5 | * MLton is released under a BSD-style license. | |
| 6 | * See the file MLton-LICENSE for details. | |
| 7 | *) | |
| 8 | ||
| 9 | (* Primitive names are special -- see atoms/prim.fun. *) | |
| 10 | ||
| 11 | structure Primitive = struct | |
| 12 | ||
| 13 | open Primitive | |
| 14 | ||
| 15 | structure GetSet = | |
| 16 | struct | |
| 17 | type 'a t = (unit -> 'a) * ('a -> unit) | |
| 18 | end | |
| 19 | ||
| 20 | structure PreThread :> sig type t end = struct type t = Thread.t end | |
| 21 | structure Thread :> sig type t end = struct type t = Thread.t end | |
| 22 | ||
| 23 | (**************************************************************************) | |
| 24 | ||
| 25 | structure Bool = | |
| 26 | struct | |
| 27 | open Bool | |
| 28 | fun not b = if b then false else true | |
| 29 | end | |
| 30 | ||
| 31 | structure Controls = | |
| 32 | struct | |
| 33 | val debug = _command_line_const "MLton.debug": bool = false; | |
| 34 | val detectOverflow = _command_line_const "MLton.detectOverflow": bool = true; | |
| 35 | val safe = _command_line_const "MLton.safe": bool = true; | |
| 36 | val bufSize = _command_line_const "TextIO.bufSize": Int32.int = 4096; | |
| 37 | end | |
| 38 | ||
| 39 | structure Exn = | |
| 40 | struct | |
| 41 | open Exn | |
| 42 | ||
| 43 | val name = _prim "Exn_name": exn -> String8.string; | |
| 44 | ||
| 45 | exception Div | |
| 46 | exception Domain | |
| 47 | exception Fail8 of String8.string | |
| 48 | exception Fail16 of String16.string | |
| 49 | exception Fail32 of String32.string | |
| 50 | exception Overflow | |
| 51 | exception Size | |
| 52 | exception Span | |
| 53 | exception Subscript | |
| 54 | ||
| 55 | val wrapOverflow: ('a -> 'b) -> ('a -> 'b) = | |
| 56 | fn f => fn a => f a handle PrimOverflow => raise Overflow | |
| 57 | end | |
| 58 | ||
| 59 | structure Order = | |
| 60 | struct | |
| 61 | datatype t = LESS | EQUAL | GREATER | |
| 62 | datatype order = datatype t | |
| 63 | end | |
| 64 | ||
| 65 | structure Option = | |
| 66 | struct | |
| 67 | datatype 'a t = NONE | SOME of 'a | |
| 68 | datatype option = datatype t | |
| 69 | end | |
| 70 | ||
| 71 | structure Ref = | |
| 72 | struct | |
| 73 | open Ref | |
| 74 | val deref = _prim "Ref_deref": 'a ref -> 'a; | |
| 75 | val assign = _prim "Ref_assign": 'a ref * 'a -> unit; | |
| 76 | end | |
| 77 | ||
| 78 | structure TopLevel = | |
| 79 | struct | |
| 80 | val getHandler = _prim "TopLevel_getHandler": unit -> (exn -> unit); | |
| 81 | val getSuffix = _prim "TopLevel_getSuffix": unit -> (unit -> unit); | |
| 82 | val setHandler = _prim "TopLevel_setHandler": (exn -> unit) -> unit; | |
| 83 | val setSuffix = _prim "TopLevel_setSuffix": (unit -> unit) -> unit; | |
| 84 | end | |
| 85 | ||
| 86 | end | |
| 87 | ||
| 88 | val not = Primitive.Bool.not | |
| 89 | ||
| 90 | exception Bind = Primitive.Exn.Bind | |
| 91 | exception Div = Primitive.Exn.Div | |
| 92 | exception Domain = Primitive.Exn.Domain | |
| 93 | exception Match = Primitive.Exn.Match | |
| 94 | exception Overflow = Primitive.Exn.Overflow | |
| 95 | exception Size = Primitive.Exn.Size | |
| 96 | exception Span = Primitive.Exn.Span | |
| 97 | exception Subscript = Primitive.Exn.Subscript | |
| 98 | ||
| 99 | datatype option = datatype Primitive.Option.option | |
| 100 | datatype order = datatype Primitive.Order.order | |
| 101 | ||
| 102 | infix 4 = <> | |
| 103 | val op = = _prim "MLton_equal": ''a * ''a -> bool; | |
| 104 | val op <> = fn (x, y) => not (x = y) |