@@ -30,13 +30,22 @@ import qualified Text.Megaparsec.Expr as P
3030-- using pre-build and user-defined operator/fixity declarations
3131table :: [FixDecl] -> [[P.Operator IdrisParser PTerm]]
3232table fixes
33− = [[prefix "-" (\fc x -> PApp fc (PRef fc [fc] (sUN "negate")) [pexp x])]] ++
33+ = [[prefix "-" negateExpr]] ++
3434 toTable (reverse fixes) ++
3535 [[noFixityBacktickOperator],
3636 [binary "$" P.InfixR $ \fc _ x y -> flatten $ PApp fc x [pexp y]],
3737 [binary "=" P.InfixL $ \fc _ x y -> PApp fc (PRef fc [fc] eqTy) [pexp x, pexp y]],
3838 [noFixityOperator]]
3939 where
40+
41+ negateExpr :: FC -> PTerm -> PTerm
42+ negateExpr _ (PConstant fc (I int)) = PConstant fc $ I $ negate int
43+ negateExpr _ (PConstant fc (BI bigInt)) = PConstant fc $ BI $ negate bigInt
44+ negateExpr _ (PConstant fc (Fl dbl)) = PConstant fc $ Fl $ negate dbl
45+ negateExpr _ (PConstSugar fc term) = negateExpr fc term
46+ negateExpr fc (PAlternative ns tp terms) = PAlternative ns tp $ map (negateExpr fc) terms
47+ negateExpr fc x = PApp fc (PRef fc [fc] (sUN "negate")) [pexp x]
48+
4049 flatten :: PTerm -> PTerm -- flatten application
4150 flatten (PApp fc (PApp _ f as) bs) = flatten (PApp fc f (as ++ bs))
4251 flatten t = t