Add negation as a primitive unop. (#2188)

Previously -x was defined as 0-x, but this is wrong when x==0.

This commit also consolidates numerical and logical negation, so there
is no longer a 'not' unop.

CHANGELOG.md

@@ -15,6 +15,9 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.
 
 ### Fixed
 
+* Negation of floating-point positive zero now produces a negative
+  zero.
+
 ## [0.25.23]
 
 ### Added

src/Futhark/AD/Derivatives.hs

@@ -26,7 +26,10 @@ untyped2 = bimap untyped untyped
 pdUnOp :: UnOp -> PrimExp VName -> PrimExp VName
 pdUnOp (Abs it) a = UnOpExp (SSignum it) a
 pdUnOp (FAbs ft) a = UnOpExp (FSignum ft) a
-pdUnOp Not x = x
+pdUnOp (Neg Bool) x = x
+pdUnOp (Neg Unit) x = x
+pdUnOp (Neg (IntType it)) _ = iConst it (-1)
+pdUnOp (Neg (FloatType ft)) _ = fConst ft (-1)
 pdUnOp (Complement it) x = UnOpExp (Complement it) x
 pdUnOp (SSignum it) _ = iConst it 0
 pdUnOp (USignum it) _ = iConst it 0

src/Futhark/Analysis/PrimExp.hs

@@ -230,7 +230,7 @@ constFoldPrimExp (BinOpExp LogOr x y)
   | zeroIshExp y = x
 constFoldPrimExp (UnOpExp Abs {} x)
   | not $ negativeIshExp x = x
-constFoldPrimExp (UnOpExp Not {} (ValueExp (BoolValue x))) =
+constFoldPrimExp (UnOpExp (Neg _) (ValueExp (BoolValue x))) =
   ValueExp $ BoolValue $ not x
 constFoldPrimExp (BinOpExp UMod {} x y)
   | sameIshExp x y,
@@ -642,7 +642,7 @@ fromBool b = if b then true else false
 
 -- | Boolean negation smart constructor.
 bNot :: TPrimExp Bool v -> TPrimExp Bool v
-bNot = TPrimExp . UnOpExp Not . untyped
+bNot = TPrimExp . UnOpExp (Neg Bool) . untyped
 
 -- | SMax on 32-bit integers.
 sMax32 :: TPrimExp Int32 v -> TPrimExp Int32 v -> TPrimExp Int32 v

src/Futhark/CodeGen/Backends/GenericC/Code.hs

@@ -56,15 +56,18 @@ compilePrimExp f (LeafExp v _) =
 compilePrimExp f (UnOpExp Complement {} x) = do
   x' <- compilePrimExp f x
   pure [C.cexp|~$exp:x'|]
-compilePrimExp f (UnOpExp Not {} x) = do
-  x' <- compilePrimExp f x
-  pure [C.cexp|!$exp:x'|]
 compilePrimExp f (UnOpExp SSignum {} x) = do
   x' <- compilePrimExp f x
   pure [C.cexp|($exp:x' > 0 ? 1 : 0) - ($exp:x' < 0 ? 1 : 0)|]
 compilePrimExp f (UnOpExp USignum {} x) = do
   x' <- compilePrimExp f x
   pure [C.cexp|($exp:x' > 0 ? 1 : 0) - ($exp:x' < 0 ? 1 : 0) != 0|]
+compilePrimExp f (UnOpExp (Neg Bool) x) = do
+  x' <- compilePrimExp f x
+  pure [C.cexp|!$exp:x'|]
+compilePrimExp f (UnOpExp Neg {} x) = do
+  x' <- compilePrimExp f x
+  pure [C.cexp|-$exp:x'|]
 compilePrimExp f (UnOpExp op x) = do
   x' <- compilePrimExp f x
   pure [C.cexp|$id:(prettyString op)($exp:x')|]

src/Futhark/CodeGen/Backends/GenericPython.hs

@@ -992,7 +992,8 @@ toMicroseconds x =
 compileUnOp :: Imp.UnOp -> String
 compileUnOp op =
   case op of
-    Not -> "not"
+    Neg Imp.Bool -> "not"
+    Neg _ -> "-"
     Complement {} -> "~"
     Abs {} -> "abs"
     FAbs {} -> "abs"

src/Futhark/CodeGen/Backends/MulticoreISPC.hs

@@ -415,9 +415,12 @@ compileExp (LeafExp v _) =
 compileExp (UnOpExp Complement {} x) = do
   x' <- compileExp x
   pure [C.cexp|~$exp:x'|]
-compileExp (UnOpExp Not {} x) = do
+compileExp (UnOpExp (Neg Bool) x) = do
   x' <- compileExp x
   pure [C.cexp|!$exp:x'|]
+compileExp (UnOpExp Neg {} x) = do
+  x' <- compileExp x
+  pure [C.cexp|-$exp:x'|]
 compileExp (UnOpExp (FAbs Float32) x) = do
   x' <- compileExp x
   pure [C.cexp|(float)fabs($exp:x')|]

src/Futhark/Internalise/Exps.hs

@@ -316,7 +316,7 @@ internaliseAppExp desc _ (E.Range start maybe_second end loc) = do
     letSubExp "range_invalid" $
       I.BasicOp $
         I.BinOp I.LogOr step_invalid bounds_invalid
-  valid <- letSubExp "valid" $ I.BasicOp $ I.UnOp I.Not invalid
+  valid <- letSubExp "valid" $ I.BasicOp $ I.UnOp (I.Neg I.Bool) invalid
   cs <- assert "range_valid_c" valid errmsg loc
 
   step_i64 <- asIntS Int64 step
@@ -720,19 +720,17 @@ internaliseExp desc (E.Negate e _) = do
   e' <- internaliseExp1 "negate_arg" e
   et <- subExpType e'
   case et of
-    I.Prim (I.IntType t) ->
-      letTupExp' desc $ I.BasicOp $ I.BinOp (I.Sub t I.OverflowWrap) (I.intConst t 0) e'
-    I.Prim (I.FloatType t) ->
-      letTupExp' desc $ I.BasicOp $ I.BinOp (I.FSub t) (I.floatConst t 0) e'
-    _ -> error "Futhark.Internalise.internaliseExp: non-numeric type in Negate"
+    I.Prim pt ->
+      letTupExp' desc $ I.BasicOp $ I.UnOp (I.Neg pt) e'
+    _ -> error "Futhark.Internalise.internaliseExp: non-primitive type in Negate"
 internaliseExp desc (E.Not e _) = do
   e' <- internaliseExp1 "not_arg" e
   et <- subExpType e'
   case et of
     I.Prim (I.IntType t) ->
       letTupExp' desc $ I.BasicOp $ I.UnOp (I.Complement t) e'
     I.Prim I.Bool ->
-      letTupExp' desc $ I.BasicOp $ I.UnOp I.Not e'
+      letTupExp' desc $ I.BasicOp $ I.UnOp (I.Neg I.Bool) e'
     _ ->
       error "Futhark.Internalise.internaliseExp: non-int/bool type in Not"
 internaliseExp desc (E.Update src slice ve loc) = do
@@ -1083,7 +1081,7 @@ internaliseDimIndex w (E.DimSlice i j s) = do
   n <- letSubExp "n" =<< divRounding (toExp j_m_i) (toExp s')
 
   zero_stride <- letSubExp "zero_stride" $ I.BasicOp $ I.CmpOp (CmpEq int64) s_sign zero
-  nonzero_stride <- letSubExp "nonzero_stride" $ I.BasicOp $ I.UnOp I.Not zero_stride
+  nonzero_stride <- letSubExp "nonzero_stride" $ I.BasicOp $ I.UnOp (I.Neg I.Bool) zero_stride
 
   -- Bounds checks depend on whether we are slicing forwards or
   -- backwards.  If forwards, we must check '0 <= i && i <= j'.  If
@@ -1320,7 +1318,7 @@ certifyingNonzero loc t x m = do
     letSubExp "zero" $
       I.BasicOp $
         CmpOp (CmpEq (IntType t)) x (intConst t 0)
-  nonzero <- letSubExp "nonzero" $ I.BasicOp $ UnOp I.Not zero
+  nonzero <- letSubExp "nonzero" $ I.BasicOp $ UnOp (I.Neg I.Bool) zero
   c <- assert "nonzero_cert" nonzero "division by zero" loc
   certifying c m
 
@@ -1427,7 +1425,7 @@ internaliseBinOp _ desc E.Equal x y t _ =
   simpleCmpOp desc (I.CmpEq $ internalisePrimType t) x y
 internaliseBinOp _ desc E.NotEqual x y t _ = do
   eq <- letSubExp (desc ++ "true") $ I.BasicOp $ I.CmpOp (I.CmpEq $ internalisePrimType t) x y
-  fmap pure $ letSubExp desc $ I.BasicOp $ I.UnOp I.Not eq
+  fmap pure $ letSubExp desc $ I.BasicOp $ I.UnOp (I.Neg I.Bool) eq
 internaliseBinOp _ desc E.Less x y (E.Signed t) _ =
   simpleCmpOp desc (I.CmpSlt t) x y
 internaliseBinOp _ desc E.Less x y (E.Unsigned t) _ =
@@ -1552,7 +1550,7 @@ isOverloadedFunction qname desc loc = do
           cmp_f =<< letSubExp "eq" =<< eAll rs
       where
         isEqlOp "!=" = Just $ \eq ->
-          letTupExp' desc $ I.BasicOp $ I.UnOp I.Not eq
+          letTupExp' desc $ I.BasicOp $ I.UnOp (I.Neg I.Bool) eq
         isEqlOp "==" = Just $ \eq ->
           pure [eq]
         isEqlOp _ = Nothing

src/Futhark/Optimise/ArrayLayout/Layout.hs

@@ -87,7 +87,7 @@ reduceStrideAndOffset (BinOpExp oper a b) = case (a, b) of
           Sub _ _ -> Just (s, o - valueIntegral v)
           Mul _ _ -> Just (s * valueIntegral v, o * valueIntegral v)
           _ -> Nothing
-    reduce _ (UnOpExp Not _) = Nothing
+    reduce _ (UnOpExp (Neg Bool) _) = Nothing
     reduce _ (UnOpExp (Complement _) _) = Nothing
     reduce _ (UnOpExp (Abs _) _) = Nothing
     reduce _ (UnOpExp _ sub_op) = reduceStrideAndOffset sub_op

src/Futhark/Optimise/Simplify/Engine.hs

@@ -297,7 +297,7 @@ protectIf _ _ taken (Let pat aux (Match [cond] [Case [Just (BoolValue True)] tak
     Match [cond'] [Case [Just (BoolValue True)] taken_body] untaken_body $
       MatchDec if_ts MatchFallback
 protectIf _ _ taken (Let pat aux (BasicOp (Assert cond msg loc))) = do
-  not_taken <- letSubExp "loop_not_taken" $ BasicOp $ UnOp Not taken
+  not_taken <- letSubExp "loop_not_taken" $ BasicOp $ UnOp (Neg Bool) taken
   cond' <- letSubExp "protect_assert_disj" $ BasicOp $ BinOp LogOr not_taken cond
   auxing aux $ letBind pat $ BasicOp $ Assert cond' msg loc
 protectIf protect _ taken (Let pat aux (Op op))
@@ -380,7 +380,7 @@ matchingExactlyThis ses prior this = do
   letSubExp "matching_just_this"
     =<< eBinOp
       LogAnd
-      (eUnOp Not (eAny prior_matches))
+      (eUnOp (Neg Bool) (eAny prior_matches))
       (eSubExp =<< matching (zip ses this))
 
 -- | We are willing to hoist potentially unsafe statements out of

src/Futhark/Optimise/Simplify/Rules/BasicOp.hs

@@ -224,7 +224,7 @@ ruleBasicOp vtable pat _ (CmpOp (CmpEq t) se1 se2)
           p_and_eq_x_y <-
             letSubExp "p_and_eq_x_y" $ BasicOp $ BinOp LogAnd p eq_x_y
           not_p <-
-            letSubExp "not_p" $ BasicOp $ UnOp Not p
+            letSubExp "not_p" $ BasicOp $ UnOp (Neg Bool) p
           not_p_and_eq_x_z <-
             letSubExp "p_and_eq_x_y" $ BasicOp $ BinOp LogAnd not_p eq_x_z
           letBind pat $

src/Futhark/Optimise/Simplify/Rules/Match.hs

@@ -80,7 +80,7 @@ ruleMatch _ pat _ ([cond], [Case [Just (BoolValue True)] tb], fb, MatchDec ts _)
           (pure $ BasicOp $ BinOp LogAnd cond tres)
           ( eBinOp
               LogAnd
-              (pure $ BasicOp $ UnOp Not cond)
+              (pure $ BasicOp $ UnOp (Neg Bool) cond)
               (pure $ BasicOp $ SubExp fres)
           )
       certifying (tcs <> fcs) $ letBind pat e
@@ -102,7 +102,7 @@ ruleMatch _ pat _ ([cond], [Case [Just (BoolValue True)] tb], fb, _)
         else
           if zeroIshInt t && oneIshInt f
             then Simplify $ do
-              cond_neg <- letSubExp "cond_neg" $ BasicOp $ UnOp Not cond
+              cond_neg <- letSubExp "cond_neg" $ BasicOp $ UnOp (Neg Bool) cond
               letBind pat $ BasicOp $ ConvOp (BToI (intValueType t)) cond_neg
             else Skip
 -- Simplify

src/Futhark/Optimise/Simplify/Rules/Simple.hs

@@ -51,7 +51,7 @@ simplifyCmpOp look _ (CmpOp CmpEq {} (Constant (IntValue x)) (Var v))
   | Just (BasicOp (ConvOp BToI {} b), cs) <- look v =
       case valueIntegral x :: Int of
         1 -> Just (SubExp b, cs)
-        0 -> Just (UnOp Not b, cs)
+        0 -> Just (UnOp (Neg Bool) b, cs)
         _ -> Just (SubExp (Constant (BoolValue False)), cs)
 simplifyCmpOp _ _ _ = Nothing
 
@@ -176,11 +176,11 @@ simplifyBinOp defOf _ (BinOp LogAnd e1 e2)
   | isCt1 e1 = resIsSubExp e2
   | isCt1 e2 = resIsSubExp e1
   | Var v <- e1,
-    Just (BasicOp (UnOp Not e1'), v_cs) <- defOf v,
+    Just (BasicOp (UnOp (Neg Bool) e1'), v_cs) <- defOf v,
     e1' == e2 =
       Just (SubExp $ Constant $ BoolValue False, v_cs)
   | Var v <- e2,
-    Just (BasicOp (UnOp Not e2'), v_cs) <- defOf v,
+    Just (BasicOp (UnOp (Neg Bool) e2'), v_cs) <- defOf v,
     e2' == e1 =
       Just (SubExp $ Constant $ BoolValue False, v_cs)
 simplifyBinOp defOf _ (BinOp LogOr e1 e2)
@@ -189,11 +189,11 @@ simplifyBinOp defOf _ (BinOp LogOr e1 e2)
   | isCt1 e1 = constRes $ BoolValue True
   | isCt1 e2 = constRes $ BoolValue True
   | Var v <- e1,
-    Just (BasicOp (UnOp Not e1'), v_cs) <- defOf v,
+    Just (BasicOp (UnOp (Neg Bool) e1'), v_cs) <- defOf v,
     e1' == e2 =
       Just (SubExp $ Constant $ BoolValue True, v_cs)
   | Var v <- e2,
-    Just (BasicOp (UnOp Not e2'), v_cs) <- defOf v,
+    Just (BasicOp (UnOp (Neg Bool) e2'), v_cs) <- defOf v,
     e2' == e1 =
       Just (SubExp $ Constant $ BoolValue True, v_cs)
 simplifyBinOp defOf _ (BinOp (SMax it) e1 e2)
@@ -226,8 +226,8 @@ resIsSubExp = Just . (,mempty) . SubExp
 simplifyUnOp :: SimpleRule rep
 simplifyUnOp _ _ (UnOp op (Constant v)) =
   constRes =<< doUnOp op v
-simplifyUnOp defOf _ (UnOp Not (Var v))
-  | Just (BasicOp (UnOp Not v2), v_cs) <- defOf v =
+simplifyUnOp defOf _ (UnOp (Neg Bool) (Var v))
+  | Just (BasicOp (UnOp (Neg Bool) v2), v_cs) <- defOf v =
       Just (SubExp v2, v_cs)
 simplifyUnOp _ _ _ =
   Nothing

src/Language/Futhark/Interpreter.hs

@@ -945,12 +945,6 @@ evalAppExp env (Match e cs _) = do
         Just v' -> pure v'
         Nothing -> match v cs'
 
-zeroOfType :: PrimType -> Value
-zeroOfType (Signed it) = ValuePrim $ SignedValue $ P.intValue it (0 :: Int)
-zeroOfType (Unsigned it) = ValuePrim $ UnsignedValue $ P.intValue it (0 :: Int)
-zeroOfType (FloatType ft) = ValuePrim $ FloatValue $ P.floatValue ft (0 :: Int)
-zeroOfType Bool = ValuePrim $ BoolValue False
-
 eval :: Env -> Exp -> EvalM Value
 eval _ (Literal v _) = pure $ ValuePrim v
 eval env (Hole (Info t) loc) =
@@ -1022,13 +1016,9 @@ eval _ (FloatLit v (Info t) _) =
     Scalar (Prim (FloatType ft)) ->
       pure $ ValuePrim $ FloatValue $ floatValue ft v
     _ -> error $ "eval: nonsensical type for float literal: " <> prettyString t
-eval env (Negate e loc) =
-  -- -x = 0-x
-  case typeOf e of
-    Scalar (Prim pt) -> do
-      ev <- eval env e
-      apply2 loc env intrinsicsMinus (zeroOfType pt) ev
-    t -> error $ "Cannot negate expression of type  " <> prettyString t
+eval env (Negate e loc) = do
+  ev <- eval env e
+  apply loc env intrinsicsNeg ev
 eval env (Not e loc) =
   apply loc env intrinsicsNot =<< eval env e
 eval env (Update src is v loc) =
@@ -1493,7 +1483,23 @@ initialCtx =
             (getU, putU, P.doUnOp $ P.Complement Int16, adUnOp $ AD.OpUn $ P.Complement Int16),
             (getU, putU, P.doUnOp $ P.Complement Int32, adUnOp $ AD.OpUn $ P.Complement Int32),
             (getU, putU, P.doUnOp $ P.Complement Int64, adUnOp $ AD.OpUn $ P.Complement Int64),
-            (getB, putB, P.doUnOp P.Not, adUnOp $ AD.OpUn P.Not)
+            (getB, putB, P.doUnOp $ P.Neg P.Bool, adUnOp $ AD.OpUn $ P.Neg P.Bool)
+          ]
+    def "neg" =
+      Just $
+        unopDef
+          [ (getS, putS, P.doUnOp $ P.Neg $ P.IntType Int8, adUnOp $ AD.OpUn $ P.Neg $ P.IntType Int8),
+            (getS, putS, P.doUnOp $ P.Neg $ P.IntType Int16, adUnOp $ AD.OpUn $ P.Neg $ P.IntType Int16),
+            (getS, putS, P.doUnOp $ P.Neg $ P.IntType Int32, adUnOp $ AD.OpUn $ P.Neg $ P.IntType Int32),
+            (getS, putS, P.doUnOp $ P.Neg $ P.IntType Int64, adUnOp $ AD.OpUn $ P.Neg $ P.IntType Int64),
+            (getU, putU, P.doUnOp $ P.Neg $ P.IntType Int8, adUnOp $ AD.OpUn $ P.Neg $ P.IntType Int8),
+            (getU, putU, P.doUnOp $ P.Neg $ P.IntType Int16, adUnOp $ AD.OpUn $ P.Neg $ P.IntType Int16),
+            (getU, putU, P.doUnOp $ P.Neg $ P.IntType Int32, adUnOp $ AD.OpUn $ P.Neg $ P.IntType Int32),
+            (getU, putU, P.doUnOp $ P.Neg $ P.IntType Int64, adUnOp $ AD.OpUn $ P.Neg $ P.IntType Int64),
+            (getF, putF, P.doUnOp $ P.Neg $ P.FloatType Float16, adUnOp $ AD.OpUn $ P.Neg $ P.FloatType Float16),
+            (getF, putF, P.doUnOp $ P.Neg $ P.FloatType Float32, adUnOp $ AD.OpUn $ P.Neg $ P.FloatType Float32),
+            (getF, putF, P.doUnOp $ P.Neg $ P.FloatType Float64, adUnOp $ AD.OpUn $ P.Neg $ P.FloatType Float64),
+            (getB, putB, P.doUnOp $ P.Neg P.Bool, adUnOp $ AD.OpUn $ P.Neg P.Bool)
           ]
     def "+" = arithOp (`P.Add` P.OverflowWrap) P.FAdd
     def "-" = arithOp (`P.Sub` P.OverflowWrap) P.FSub
@@ -2107,8 +2113,8 @@ intrinsicVal name =
     Just (TermValue _ v) -> v
     _ -> error $ "intrinsicVal: " <> prettyString name
 
-intrinsicsMinus :: Value
-intrinsicsMinus = intrinsicVal "-"
+intrinsicsNeg :: Value
+intrinsicsNeg = intrinsicVal "neg"
 
 intrinsicsNot :: Value
 intrinsicsNot = intrinsicVal "!"

src/Language/Futhark/Primitive.hs

@@ -378,8 +378,8 @@ onePrimValue Unit = UnitValue
 -- operator and what is a built-in function.  Perhaps these should all
 -- go away eventually.
 data UnOp
-  = -- | E.g., @! True == False@.
-    Not
+  = -- | Flip sign. Logical negation for booleans.
+    Neg PrimType
   | -- | E.g., @~(~1) = 1@.
     Complement IntType
   | -- | @abs(-2) = 2@.
@@ -580,8 +580,8 @@ data ConvOp
 -- | A list of all unary operators for all types.
 allUnOps :: [UnOp]
 allUnOps =
-  Not
-    : map Complement [minBound .. maxBound]
+  map Neg [minBound .. maxBound]
+    ++ map Complement [minBound .. maxBound]
     ++ map Abs [minBound .. maxBound]
     ++ map FAbs [minBound .. maxBound]
     ++ map SSignum [minBound .. maxBound]
@@ -659,7 +659,9 @@ allConvOps =
 -- | Apply an 'UnOp' to an operand.  Returns 'Nothing' if the
 -- application is mistyped.
 doUnOp :: UnOp -> PrimValue -> Maybe PrimValue
-doUnOp Not (BoolValue b) = Just $ BoolValue $ not b
+doUnOp (Neg _) (BoolValue b) = Just $ BoolValue $ not b
+doUnOp (Neg _) (FloatValue v) = Just $ FloatValue $ doFNeg v
+doUnOp (Neg _) (IntValue v) = Just $ IntValue $ doIntNeg v
 doUnOp Complement {} (IntValue v) = Just $ IntValue $ doComplement v
 doUnOp Abs {} (IntValue v) = Just $ IntValue $ doAbs v
 doUnOp FAbs {} (FloatValue v) = Just $ FloatValue $ doFAbs v
@@ -668,6 +670,17 @@ doUnOp USignum {} (IntValue v) = Just $ IntValue $ doUSignum v
 doUnOp FSignum {} (FloatValue v) = Just $ FloatValue $ doFSignum v
 doUnOp _ _ = Nothing
 
+doFNeg :: FloatValue -> FloatValue
+doFNeg (Float16Value x) = Float16Value $ negate x
+doFNeg (Float32Value x) = Float32Value $ negate x
+doFNeg (Float64Value x) = Float64Value $ negate x
+
+doIntNeg :: IntValue -> IntValue
+doIntNeg (Int8Value x) = Int8Value $ -x
+doIntNeg (Int16Value x) = Int16Value $ -x
+doIntNeg (Int32Value x) = Int32Value $ -x
+doIntNeg (Int64Value x) = Int64Value $ -x
+
 -- | E.g., @~(~1) = 1@.
 doComplement :: IntValue -> IntValue
 doComplement v = intValue (intValueType v) $ complement $ intToInt64 v
@@ -1130,7 +1143,7 @@ cmpOpType CmpLle = Bool
 unOpType :: UnOp -> PrimType
 unOpType (SSignum t) = IntType t
 unOpType (USignum t) = IntType t
-unOpType Not = Bool
+unOpType (Neg t) = t
 unOpType (Complement t) = IntType t
 unOpType (Abs t) = IntType t
 unOpType (FAbs t) = FloatType t
@@ -1839,7 +1852,7 @@ instance Pretty ConvOp where
       (from, to) = convOpType op
 
 instance Pretty UnOp where
-  pretty Not = "not"
+  pretty (Neg t) = "neg_" <> pretty t
   pretty (Abs t) = taggedI "abs" t
   pretty (FAbs t) = taggedF "fabs" t
   pretty (SSignum t) = taggedI "ssignum" t