]> Git — Sourcephile - haskell/symantic.git/blob - Language/Symantic/Expr/Int/Test.hs
revamp Repr/*
[haskell/symantic.git] / Language / Symantic / Expr / Int / Test.hs
1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE GADTs #-}
3 {-# LANGUAGE NoMonomorphismRestriction #-}
4 {-# LANGUAGE Rank2Types #-}
5 {-# LANGUAGE ScopedTypeVariables #-}
6 {-# LANGUAGE TypeOperators #-}
7 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
8 module Expr.Int.Test where
9
10 import Test.Tasty
11 import Test.Tasty.HUnit
12
13 import qualified Control.Arrow as Arrow
14 import qualified Control.Monad as Monad
15 import Data.Proxy (Proxy(..))
16 import Data.Text (Text)
17 import Data.Type.Equality ((:~:)(Refl))
18 import Prelude hiding ((&&), not, (||), (+), negate)
19
20 import Language.Symantic.Repr
21 import Language.Symantic.Expr
22 import Language.Symantic.Type
23 -- import Language.Symantic.Trans
24
25 import AST.Test
26
27 -- * Class 'Sym_Int_Vars'
28
29 -- | A few boolean variables.
30 class Sym_Int_Vars repr where
31 x :: repr Int
32 y :: repr Int
33 z :: repr Int
34 instance Sym_Int_Vars Repr_Text where
35 x = Repr_Text $ \_p _v -> "x"
36 y = Repr_Text $ \_p _v -> "y"
37 z = Repr_Text $ \_p _v -> "z"
38
39 -- * Expressions
40 e1 = int 1 + int 0
41 e2 = (int 1 + int 0) + negate (int 1 + int 1)
42 e3 = (int 1 + negate (int 0)) + (int 1 + negate (int 1))
43 e4 = int 0 + negate (int 1)
44 e5 = int 1 + negate x
45 e6 = x + y
46 e7 = (x + y) + z
47 e8 = x + (y + int 1)
48
49 -- * Tests
50 type Ex = Expr_Root
51 ( Expr_Lambda
52 .|. Expr_Int
53 .|. Expr_Num
54 )
55 ex_from = root_expr_from (Proxy::Proxy Ex)
56
57 (==>) ast expected =
58 testCase (show ast) $
59 case ex_from ast of
60 Left err -> Left err @?= Prelude.snd `Arrow.left` expected
61 Right (Exists_Type_and_Repr ty (Forall_Repr r)) ->
62 case expected of
63 Left (_, err) -> Right ("…"::String) @?= Left err
64 Right (ty_expected::Type_Root_of_Expr Ex h, _::h, _::Text) ->
65 (Monad.>>= (@?= (\(_::Proxy h, err) -> err) `Arrow.left` expected)) $
66 case ty `eq_type` ty_expected of
67 Nothing -> Monad.return $ Left $
68 error_expr (Proxy::Proxy Ex) $
69 Error_Expr_Type_mismatch ast
70 (Exists_Type ty)
71 (Exists_Type ty_expected)
72 Just Refl -> do
73 let h = host_from_expr r
74 Monad.return $
75 Right
76 ( ty
77 , h
78 , text_from_expr r
79 -- , (text_from_expr :: Repr_Text h -> Text) r
80 )
81
82 tests :: TestTree
83 tests = testGroup "Int" $
84 [ AST "int" [AST "1" []] ==> Right
85 ( type_int
86 , 1
87 , "1" )
88 , AST "bool" [AST "True" []] ==> Left (Proxy::Proxy Bool,
89 Error_Expr_Alt_Curr $
90 Error_Expr_Unsupported $ AST "bool" [AST "True" []])
91 , AST "+"
92 [ AST "int" [AST "1" []]
93 , AST "int" [AST "1" []]
94 ] ==> Right
95 ( type_int
96 , 2
97 , "1 + 1" )
98 , let ast = AST "$"
99 [ AST "int" [AST "1" []]
100 , AST "int" [AST "1" []]
101 ] in ast ==> Left (Proxy::Proxy Int,
102 Error_Expr_Alt_Curr $
103 Error_Expr_Type_mismatch ast
104 (Exists_Type (type_var0 SZero `type_fun` type_var0 (SSucc SZero)
105 ::Type_Root (Type_Var0 :|: Type_Var1 :|: Type_Fun :|: Type_Int)
106 ((->) Var0 Var0)))
107 (Exists_Type type_int))
108 , AST "$"
109 [ AST "\\"
110 [ AST "x" []
111 , AST "Int" []
112 , AST "var" [AST "x" []]
113 ]
114 , AST "int" [AST "1" []]
115 ] ==> Right
116 ( type_int
117 , 1
118 , "(\\x0 -> x0) 1" )
119 , AST "$"
120 [ AST "\\"
121 [ AST "x" []
122 , AST "Int" []
123 , AST "+"
124 [ AST "var" [AST "x" []]
125 , AST "int" [AST "1" []]
126 ]
127 ]
128 , AST "int" [AST "1" []]
129 ] ==> Right
130 ( type_int
131 , 2
132 , "(\\x0 -> x0 + 1) 1" )
133 , AST "let"
134 [ AST "x" []
135 , AST "int" [AST "1" []]
136 , AST "+"
137 [ AST "var" [AST "x" []]
138 , AST "int" [AST "1" []]
139 ]
140 ] ==> Right
141 ( type_int
142 , 2
143 , "let x0 = 1 in x0 + 1" )
144 ]