1 (* Copyright (C) 2014,2017 Matthew Fluet.
2 * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
3 * Jagannathan, and Stephen Weeks.
4 * Copyright (C) 1997-2000 NEC Research Institute.
6 * MLton is released under a BSD-style license.
7 * See the file MLton-LICENSE for details.
10 functor Const (S: CONST_STRUCTS): CONST =
15 structure ConstType = ConstType (struct
16 structure RealSize = RealX.RealSize
17 structure WordSize = WordX.WordSize
22 structure WordSize = WordX.WordSize
23 datatype t = Big of WordXVector.t | Small of WordX.t
24 fun fromIntInf (i: IntInf.t) : t =
26 val sws = WordSize.smallIntInfWord ()
27 val sws' = WordSize.fromBits (Bits.- (WordSize.bits sws, Bits.one))
29 if WordSize.isInRange (sws', i, {signed = true})
30 then Small (WordX.orb (WordX.one sws,
31 WordX.lshift (WordX.fromIntInf (i, sws), WordX.one sws)))
33 val bws = WordSize.bigIntInfWord ()
34 val bbws = Bits.toWord (WordSize.bits bws)
35 val mask = IntInf.- (WordSize.cardinality bws, IntInf.one)
38 then Big (WordXVector.fromListRev ({elementSize = bws}, acc))
40 val quot = IntInf.~>> (i, bbws)
41 val rem = IntInf.andb (i, mask)
43 loop (quot, (WordX.fromIntInf (rem, bws)) :: acc)
46 loop (if IntInf.>= (i, IntInf.zero)
47 then (i, [WordX.zero bws])
48 else (IntInf.~ i, [WordX.one bws]))
51 fun smallToIntInf (w: WordX.t): IntInf.t option =
53 val sws = WordSize.smallIntInfWord ()
54 val one = WordX.one sws
56 if WordSize.equals (WordX.size w, sws)
57 andalso WordX.isOne (WordX.andb (w, one))
58 then SOME (WordX.toIntInfX (WordX.rshift (w, one, {signed = true})))
61 fun bigToIntInf (v: WordXVector.t): IntInf.t option =
63 val bws = WordSize.bigIntInfWord ()
64 val bbws = Bits.toWord (WordSize.bits bws)
66 if WordSize.equals (WordXVector.elementSize v, bws)
67 andalso WordXVector.length v >= 2
69 val v0 = WordXVector.sub (v, 0)
72 (v, 1, IntInf.zero, fn (w, i) =>
73 IntInf.andb (IntInf.<< (i, bbws), WordX.toIntInf w))
77 else if WordX.isOne v0
78 then SOME (IntInf.~ (mag ()))
90 | WordVector of WordXVector.t
96 val wordVector = WordVector
99 fun make (s, deOpt : t -> 'a option) =
104 | NONE => Error.bug ("Const.de" ^ s)
105 val is: t -> bool = isSome o deOpt
110 val (deWordOpt,deWord,_) = make ("Word", fn Word ws => SOME ws | _ => NONE)
113 val string = wordVector o WordXVector.fromString
117 IntInf i => IntInf.layout i
118 | Null => Layout.str "NULL"
119 | Real r => RealX.layout r
120 | Word w => WordX.layout w
121 | WordVector v => WordXVector.layout v
123 val toString = Layout.toString o layout
125 fun hash (c: t): word =
127 IntInf i => IntInf.hash i
129 | Real r => RealX.hash r
130 | Word w => WordX.hash w
131 | WordVector v => WordXVector.hash v
135 (IntInf i, IntInf i') => IntInf.equals (i, i')
136 | (Null, Null) => true
137 | (Real r, Real r') => RealX.equals (r, r')
138 | (Word w, Word w') => WordX.equals (w, w')
139 | (WordVector v, WordVector v') => WordXVector.equals (v, v')
142 val equals = Trace.trace2 ("Const.equals", layout, layout, Bool.layout) equals
144 val lookup: ({default: string option, name: string} * ConstType.t -> t) ref =
145 ref (fn _ => Error.bug "Const.lookup: not set")