basis-library/primitive/prim1.sml

   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)