{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Lib.Num.Test where import Test.Tasty import Prelude (Num) import Prelude hiding (Num(..)) import Language.Symantic import Language.Symantic.Lib import Compiling.Test -- * Tests type SS = [ Proxy (->) , Proxy Integer , Proxy Num , Proxy Num2 , Proxy Int , Proxy Integral , Proxy Foldable , Proxy Traversable , Proxy [] ] (==>) = test_readTerm @() @SS tests :: TestTree tests = testGroup "Num" [ "42" ==> Right (tyInteger, 42, "42") , "-42" ==> Right (tyInteger, -42, "negate 42") , "- -42" ==> Right (tyInteger, 42, "negate (negate 42)") , "1 + -2" ==> Right (tyInteger, -1, "1 + negate 2") , "-1 + -2" ==> Right (tyInteger, -3, "negate 1 + negate 2") , "-(1 + -2)" ==> Right (tyInteger, 1, "negate (1 + negate 2)") , "(+) 1 2" ==> Right (tyInteger, 3, "1 + 2") , "1 + 2" ==> Right (tyInteger, 3, "1 + 2") , "1 + 2 - 3" ==> Right (tyInteger, 0, "1 + 2 - 3") , "1 + 2 * 3" ==> Right (tyInteger, 7, "1 + 2 * 3") , "3 * 2 + 1" ==> Right (tyInteger, 7, "3 * 2 + 1") , "3 * (2 + 1)" ==> Right (tyInteger, 9, "3 * (2 + 1)") , "4 + 3 * 2 + 1" ==> Right (tyInteger, 11, "4 + 3 * 2 + 1") , "5 * 4 + 3 * 2 + 1" ==> Right (tyInteger, 27, "5 * 4 + 3 * 2 + 1") , "negate`42" ==> Right (tyInteger, -42, "negate 42") , "42`negate" ==> Right (tyInteger, -42, "negate 42") , "42`negate " ==> Right (tyInteger, -42, "negate 42") , "42`negate`negate" ==> Right (tyInteger, 42, "negate (negate 42)") , "42`abs`negate" ==> Right (tyInteger, -42, "negate (abs 42)") , "42`negate`abs" ==> Right (tyInteger, 42, "abs (negate 42)") , "abs`negate`42" ==> Right (tyInteger, 42, "abs (negate 42)") , "negate`abs`42" ==> Right (tyInteger, -42, "negate (abs 42)") , "negate`abs`42`mod`9" ==> Right (tyInteger, 3, "negate (abs 42) `mod` 9") , "negate abs`42" ==> Right (tyInteger, -42, "negate (abs 42)") , "negate 42`abs" ==> Right (tyInteger, -42, "negate (abs 42)") , "(+) negate`2 44" ==> Right (tyInteger, 42, "negate 2 + 44") , "(+) 2`negate 44" ==> Right (tyInteger, 42, "negate 2 + 44") , "(+) (negate`2) 44" ==> Right (tyInteger, 42, "negate 2 + 44") , "abs negate`42" ==> Right (tyInteger, 42, "abs (negate 42)") , "(+) 40 2" ==> Right (tyInteger, 42, "40 + 2") , "(+) 40 -2" ==> Right (tyInteger, 38, "40 + negate 2") , "negate 42 + 42`negate" ==> Right (tyInteger, -84, "negate 42 + negate 42") , "(+) (negate 42) 42`negate" ==> Right (tyInteger, -84, "negate 42 + negate 42") , "(+) negate`42 42`negate" ==> Right (tyInteger, -84, "negate 42 + negate 42") , "42`abs`negate`mod`abs`negate`9" ==> Right (tyInteger, 3, "negate (abs 42) `mod` abs (negate 9)") , "abs`42`negate" ==> Right (tyInteger, 42, "abs (negate 42)") , "negate`42`abs" ==> Right (tyInteger, 42, "abs (negate 42)") , testGroup "Error_Term" [ "(+) 40 - 2" ==> Left (tyInteger, Right $ Error_Term_Beta $ Error_Beta_Unify $ Error_Unify_Const_mismatch (TypeVT $ tyFun @_ @'[]) (TypeVT $ tyInteger @_ @'[])) ] ] -- | A newtype to test prefix and postfix. newtype Num2 a = Num2 a type instance Sym Num2 = Sym_Num2 class Sym_Num2 (term:: * -> *) where instance Sym_Num2 Eval where instance Sym_Num2 View where instance Sym_Num2 (Dup r1 r2) where instance Sym_Num2 term => Sym_Num2 (BetaT term) where instance NameTyOf Num2 where nameTyOf _c = ["Num2"] `Mod` "Num2" instance FixityOf Num2 instance ClassInstancesFor Num2 instance TypeInstancesFor Num2 instance Gram_Term_AtomsFor src ss g Num2 instance (Source src, SymInj ss Num) => ModuleFor src ss Num2 where moduleFor = ["Num2"] `moduleWhere` [ "abs" `withPrefix` 9 := teNum_abs , "negate" `withPrefix` 10 := teNum_negate , "abs" `withPostfix` 9 := teNum_abs , "negate" `withPostfix` 10 := teNum_negate ]