@@ -55,7 +55,7 @@ transop1 :: Op1 a b -> C.Expr -> C.Expr
55
55
transop1 op e = case op of
56
56
Not -> (C. .!) e
57
57
Abs _ -> funcall " abs" [e]
58
- Sign _ -> funcall " copysign " [ C. LitDouble 1.0 , e]
58
+ Sign ty -> transSign ty e
59
59
Recip _ -> C. LitDouble 1.0 C. ./ e
60
60
Exp _ -> funcall " exp" [e]
61
61
Sqrt _ -> funcall " sqrt" [e]
@@ -112,6 +112,58 @@ transop3 :: Op3 a b c d -> C.Expr -> C.Expr -> C.Expr -> C.Expr
112
112
transop3 op e1 e2 e3 = case op of
113
113
Mux _ -> C. Cond e1 e2 e3
114
114
115
+ -- | Translate @'Sign' e@ in Copilot Core into a C99 expression.
116
+ --
117
+ -- Sign is is translated as @e > 0 ? 1 : (e < 0 ? -1 : e)@, that is:
118
+ --
119
+ -- 1. If @e@ is positive, return @1@.
120
+ --
121
+ -- 2. If @e@ is negative, return @-1@.
122
+ --
123
+ -- 3. Otherwise, return @e@. This handles the case where @e@ is @0@ when the
124
+ -- type is an integral type. If the type is a floating-point type, it also
125
+ -- handles the cases where @e@ is @-0@ or @NaN@.
126
+ --
127
+ -- This implementation is modeled after how GHC implements 'signum'
128
+ -- <https://gitlab.haskell.org/ghc/ghc/-/blob/aed98ddaf72cc38fb570d8415cac5de9d8888818/libraries/base/GHC/Float.hs#L523-L525 here>.
129
+ transSign :: Type a -> C. Expr -> C. Expr
130
+ transSign ty e = positiveCase $ negativeCase e
131
+ where
132
+ -- If @e@ is positive, return @1@, otherwise fall back to argument.
133
+ --
134
+ -- Produces the following code, where @<arg>@ is the argument to this
135
+ -- function:
136
+ -- @
137
+ -- e > 0 ? 1 : <arg>
138
+ -- @
139
+ positiveCase :: C. Expr -- ^ Value returned if @e@ is not positive.
140
+ -> C. Expr
141
+ positiveCase =
142
+ C. Cond (C. BinaryOp C. GT e (constNumTy ty 0 )) (constNumTy ty 1 )
143
+
144
+ -- If @e@ is negative, return @1@, otherwise fall back to argument.
145
+ --
146
+ -- Produces the following code, where @<arg>@ is the argument to this
147
+ -- function:
148
+ -- @
149
+ -- e < 0 ? -1 : <arg>
150
+ -- @
151
+ negativeCase :: C. Expr -- ^ Value returned if @e@ is not negative.
152
+ -> C. Expr
153
+ negativeCase =
154
+ C. Cond (C. BinaryOp C. LT e (constNumTy ty 0 )) (constNumTy ty (- 1 ))
155
+
156
+ -- Translate a literal number of type @ty@ into a C99 literal.
157
+ --
158
+ -- PRE: The type of PRE is numeric (integer or floating-point), that
159
+ -- is, not boolean, struct or array.
160
+ constNumTy :: Type a -> Integer -> C. Expr
161
+ constNumTy ty =
162
+ case ty of
163
+ Float -> C. LitFloat . fromInteger
164
+ Double -> C. LitDouble . fromInteger
165
+ _ -> C. LitInt
166
+
115
167
-- | Transform a Copilot Core literal, based on its value and type, into a C99
116
168
-- literal.
117
169
constty :: Type a -> a -> C. Expr
0 commit comments