-
Notifications
You must be signed in to change notification settings - Fork 10
/
Copy pathsints.clj
150 lines (130 loc) · 3.79 KB
/
sints.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
(ns
^{:doc
"The namespaces defines a signed twos-complement numeric
type that saturates on overflow and underflow."}
piplin.types.sints
(:require [piplin.types.core-impl :as impl])
(:use [piplin.types
[binops :only [defbinopimpl defcoercions defunopimpl]]
bits])
(:use [piplin [types :exclude [cast]] protocols])
(:use [slingshot.slingshot]))
(defpiplintype SIntS [n])
(defn sints
"Makes a new sints type object with the
given number of bits."
[n]
(merge (SIntS. n)
{:kind :sints}))
(defn- bounds
"Returns the min and max value for a signed
number of `n` bits."
[n]
(let [base (bit-shift-left 1 (dec n))]
{:min (- base)
:max (dec base)}))
(defn min-value
"Returns the minimum value possible to store in `type`"
[type]
(let [{:keys [min]} (bounds (:n type))]
(type min)))
(defn max-value
"Returns the maximum value possible to store in `type`"
[type]
(let [{:keys [max]} (bounds (:n type))]
(type max)))
(defn sign-extend
"Takes an sints and a longer width and sign-extends
the sints."
[width' num]
(assert (= :sints (kindof num)))
(assert (<= (bit-width-of (typeof num)) width'))
(let [wider-sints (sints width')]
(if (pipinst? num)
(wider-sints (value num))
(mkast wider-sints :sign-extend [num] (partial sign-extend width')))))
(defmethod constrain
:sints
[sints init-val]
(let [{:keys [min max]} (bounds (:n sints))]
(cond
(< init-val min) min
(> init-val max) max
:else init-val)))
(defmethod check
:sints
[inst]
(let [n (-> inst typeof :n)
v (value inst)
{:keys [min max]} (bounds n)]
(when-not (integer? v)
(throw+ (error "sints requires an integer, got" v)))
(when (> v max)
(throw+ (error "sints" n "is too big:" v)))
(when (< v min)
(throw+ (error "sints" n "is too small:" v)))
inst))
(defmethod promote
:sints
[this obj]
(cond
(= (typeof obj) this) obj
(= (kindof obj) (:kind this))
(throw+ (error (str "Cannot convert " obj " to " this)))
(isa-type? :j-integral (kindof obj))
(instance this (promote (anontype :j-long) obj))
:else (throw+ (error "Don't know how to promote to :sints from"
(typeof obj)))))
(defbinopimpl impl/+ :sints [:j-integral]
[lhs rhs]
(+ (value lhs) (value rhs)))
(defbinopimpl impl/- :sints [:j-integral]
[lhs rhs]
(- (value lhs) (value rhs)))
(defbinopimpl impl/* :sints [:j-integral]
[lhs rhs]
(* (value lhs) (value rhs)))
(defmethod impl/> [:sints :sints]
[lhs rhs]
(if (and (pipinst? lhs) (pipinst? rhs))
(> (value lhs) (value rhs))
(mkast (anontype :boolean) :> [lhs rhs] impl/>)))
(defcoercions impl/> :sints [:j-integral])
(defmethod impl/>= [:sints :sints]
[lhs rhs]
(if (and (pipinst? lhs) (pipinst? rhs))
(>= (value lhs) (value rhs))
(mkast (anontype :boolean) :>= [lhs rhs] impl/>=)))
(defcoercions impl/>= :sints [:j-integral])
(defmethod impl/< [:sints :sints]
[lhs rhs]
(if (and (pipinst? lhs) (pipinst? rhs))
(< (value lhs) (value rhs))
(mkast (anontype :boolean) :< [lhs rhs] impl/<)))
(defcoercions impl/< :sints [:j-integral])
(defmethod impl/<= [:sints :sints]
[lhs rhs]
(if (and (pipinst? lhs) (pipinst? rhs))
(<= (value lhs) (value rhs))
(mkast (anontype :boolean) :<= [lhs rhs] impl/<=)))
(defcoercions impl/<= :sints [:j-integral])
(defcoercions piplin.types.binops/= :sints [:j-integral])
(defmethod bit-width-of
:sints
[type]
(:n type))
(defmethod get-bits
:sints
[expr]
(let [n (bit-width-of (typeof expr))]
(long-to-bitvec (value expr) n)))
(defmethod from-bits
:sints
[type bits]
(let [n (:n type)
[sign & body] (value bits)
body (bitvec-to-long body)
{:keys [min]} (bounds n)]
(if (= 0 sign)
body
(+ min body))))