Language/Symantic/Compiling/Map/Test.hs

   1 {-# LANGUAGE NoMonomorphismRestriction #-}
   2 {-# LANGUAGE UndecidableInstances #-}
   3 {-# OPTIONS_GHC -fno-warn-orphans #-}
   4 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
   5 {-# OPTIONS_GHC -O0 #-} -- speedup compiling…
   6 module Compiling.Map.Test where
   7
   8 import Test.Tasty
   9
  10 import Data.Map.Strict (Map)
  11 import qualified Data.Map.Strict as Map
  12 import Data.Proxy (Proxy(..))
  13 import Data.Text (Text)
  14 import qualified Data.Text as Text
  15 import Prelude hiding (zipWith)
  16
  17 import Language.Symantic.Parsing
  18 import Language.Symantic.Typing
  19 import Language.Symantic.Compiling
  20 import Compiling.Term.Test
  21 import Compiling.Bool.Test ()
  22 import Compiling.Foldable.Test ()
  23 import Parsing.Test
  24
  25 -- * Terms
  26 e1 = map_fromList $ zipWith (lam (lam . tuple2))
  27  (list $ int Prelude.<$> [1..5])
  28  (list $ (text . Text.singleton) Prelude.<$> ['a'..'e'])
  29
  30 -- * Tests
  31 type Ifaces =
  32  [ Proxy (->)
  33  , Proxy []
  34  , Proxy Int
  35  , Proxy Map
  36  , Proxy Text
  37  , Proxy (,)
  38  , Proxy Num
  39  , Proxy Monoid
  40  ]
  41 (==>) = test_compile (Proxy::Proxy Ifaces)
  42
  43 instance
  44  ( Inj_Token (Syntax Text) ts Map
  45  , Tokenize (Syntax Text) (Syntax Text) ts ) =>
  46  TokenizeT (Syntax Text) (Syntax Text) ts (Proxy Map) where
  47         tokenizeT _t (Syntax "Map.fromList" (ast_f : as)) = Just $ do
  48                 f <- tokenize ast_f
  49                 Right $ (as,) $ EToken $ inj_token (Syntax "Map.fromList" [ast_f]) $
  50                         Token_Term_Map_fromList f
  51         tokenizeT _t (Syntax "Map.foldrWithKey" (ast_f : as)) = Just $ do
  52                 f <- tokenize ast_f
  53                 Right $ (as,) $ EToken $ inj_token (Syntax "Map.foldrWithKey" [ast_f]) $
  54                         Token_Term_Map_foldrWithKey f
  55         tokenizeT _t _sy = Nothing
  56
  57 tests :: TestTree
  58 tests = testGroup "Map"
  59  [ Syntax "Map.fromList"
  60          [ Syntax "zipWith"
  61                  [ syLam "x" (sy @Int) $
  62                                 syLam "y" (sy @Text) $
  63                                         Syntax "(,)"
  64                                          [ syVar "x"
  65                                          , syVar "y"
  66                                          ]
  67                  , Syntax "list"
  68                          [ sy @Int
  69                          , syLit (1::Int)
  70                          , syLit (2::Int)
  71                          , syLit (3::Int)
  72                          ]
  73                  , Syntax "list"
  74                          [ sy @Text
  75                          , syLit ("a"::Text)
  76                          , syLit ("b"::Text)
  77                          , syLit ("c"::Text)
  78                          ]
  79                  ]
  80          ] ==> Right
  81          ( (ty @Map :$ ty @Int) :$ ty @Text
  82          , Map.fromList [(1, "a"), (2, "b"), (3, "c")]
  83          , "Map.fromList (((\\x0 -> (\\x1 -> zipWith (\\x2 -> (\\x3 -> (x2, x3))) x0 x1)) [1, 2, 3]) [\"a\", \"b\", \"c\"])" )
  84  , Syntax "Map.foldrWithKey"
  85          [ syLam "k" (sy @Int) $
  86                         syLam "v" (sy @Text) $
  87                                 syLam "a" (sy @(,) [sy @Int, sy @Text]) $
  88                                         sy @(,)
  89                                          [ Syntax "(+)"
  90                                                  [ syVar "k"
  91                                                  , Syntax "fst" [ syVar "a" ]
  92                                                  ]
  93                                          , Syntax "mappend"
  94                                                  [ syVar "v"
  95                                                  , Syntax "snd" [ syVar "a" ]
  96                                                  ]
  97                                          ]
  98          , sy @(,)
  99                  [ syLit (0::Int)
 100                  , syLit (""::Text)
 101                  ]
 102          , Syntax "Map.fromList"
 103                  [ Syntax "zipWith"
 104                          [ syLam "x" (sy @Int) $
 105                                         syLam "y" (sy @Text) $
 106                                                 sy @(,)
 107                                                  [ syVar "x"
 108                                                  , syVar "y"
 109                                                  ]
 110                          , Syntax "list"
 111                                  [ sy @Int
 112                                  , syLit (1::Int)
 113                                  , syLit (2::Int)
 114                                  , syLit (3::Int)
 115                                  ]
 116                          , Syntax "list"
 117                                  [ sy @Text
 118                                  , syLit ("a"::Text)
 119                                  , syLit ("b"::Text)
 120                                  , syLit ("c"::Text)
 121                                  ]
 122                          ]
 123                  ]
 124          ] ==> Right
 125          ( (ty @(,) :$ ty @Int) :$ ty @Text
 126          , (6, "abc")
 127          , "((\\x0 -> (\\x1 -> Map.foldrWithKey (\\x2 -> (\\x3 -> (\\x4 -> ((\\x5 -> x2 + x5) (fst x4), (\\x5 -> mappend x3 x5) (snd x4))))) x0 x1)) (0, \"\")) (Map.fromList (((\\x0 -> (\\x1 -> zipWith (\\x2 -> (\\x3 -> (x2, x3))) x0 x1)) [1, 2, 3]) [\"a\", \"b\", \"c\"]))" )
 128  ]