@@ -55,7 +55,7 @@ transop1 :: Op1 a b -> C.Expr -> C.Expr
5555transop1 op e = case op of
5656 Not -> (C. .!) e
5757 Abs _ -> funcall " abs" [e]
58- Sign _ -> funcall " copysign " [ C. LitDouble 1.0 , e]
58+ Sign ty -> transSign ty e
5959 Recip _ -> C. LitDouble 1.0 C. ./ e
6060 Exp _ -> funcall " exp" [e]
6161 Sqrt _ -> funcall " sqrt" [e]
@@ -112,6 +112,58 @@ transop3 :: Op3 a b c d -> C.Expr -> C.Expr -> C.Expr -> C.Expr
112112transop3 op e1 e2 e3 = case op of
113113 Mux _ -> C. Cond e1 e2 e3
114114
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+
115167-- | Transform a Copilot Core literal, based on its value and type, into a C99
116168-- literal.
117169constty :: Type a -> a -> C. Expr
0 commit comments