symantic-lib 0.0.2.20170702 → 0.0.2.20170703

raw patch · 12 files changed

+85/−56 lines, 12 files

Files

Language/Symantic/Compiling/Test.hs +33/−25
Language/Symantic/Grammar/Megaparsec.hs +18/−10
Language/Symantic/Lib/Applicative/Test.hs +1/−1
Language/Symantic/Lib/Bool/Test.hs +1/−1
Language/Symantic/Lib/Foldable/Test.hs +1/−1
Language/Symantic/Lib/Functor/Test.hs +1/−1
Language/Symantic/Lib/Map/Test.hs +1/−1
Language/Symantic/Lib/MonoFunctor/Test.hs +1/−1
Language/Symantic/Lib/Num/Test.hs +1/−1
Language/Symantic/Lib/Tuple2/Test.hs +1/−1
Language/Symantic/Typing/Test.hs +25/−12
symantic-lib.cabal +1/−1

Language/Symantic/Compiling/Test.hs view

@@ -25,37 +25,47 @@  import Grammar.Megaparsec () -test_parseTerm ::+type G src ss =+ P.ParsecT P.Dec Text+           (SS.StateT (Imports NameTe, Modules src ss)+                      ((SS.StateT (Imports NameTy, ModulesTy src))+                                  Identity))++parseTe ::  forall ss src.+ ImportTypes ss =>+ ModulesTyInj ss =>  ModulesInj src ss =>- Gram_Term src ss (P.ParsecT P.Dec Text (SS.StateT (Imports NameTe, Modules src ss) Identity)) =>- Text ->- Either (P.ParseError Char P.Dec) (AST_Term src ss)-test_parseTerm inp =-	let mods :: Modules src ss = either (error . show) id modulesInj in-	let imps = [] `importModules` mods in+ Gram_Term src ss (G src ss) =>+ Text -> Either (P.ParseError Char P.Dec) (AST_Term src ss)+parseTe inp =+	let modsTe :: Modules src ss = either (error . show) id modulesInj in+	let impsTe = [] `importModules` modsTe in+	let modsTy = modulesTyInj @ss @src in+	let impsTy = importTypes @ss [] in 	runIdentity $-	MC.evalStateStrict (imps, mods) $+	MC.evalStateStrict (impsTy, modsTy) $+	MC.evalStateStrict (impsTe, modsTe) $ 	P.runParserT g "" inp 	where g = unCF $ g_term <* eoi -test_readTerm ::+readTe ::  forall src ss t.  ( Eq t- , Gram_Term src ss (P.ParsecT P.Dec Text (SS.StateT (Imports NameTe, Modules src ss) Identity))- , Show t- , Syms ss Eval- , Syms ss View- , Syms ss (BetaT View)- , ModulesInj src ss  , Eq src+ , Gram_Term src ss (G src ss)+ , ImportTypes ss+ , ModulesInj src ss+ , ModulesTyInj ss  , Show src- , SourceInj (TypeVT src) src- , SourceInj (TypeT src '[]) src- , SourceInj (KindK src) src+ , Show t  , SourceInj (AST_Type src) src- , ModulesTyInj ss- , ImportTypes ss+ , SourceInj (KindK src) src+ , SourceInj (TypeT src '[]) src+ , SourceInj (TypeVT src) src+ , Syms ss (BetaT View)+ , Syms ss Eval+ , Syms ss View  ) =>  Text ->  Either ( Type src '[] t@@ -63,14 +73,12 @@                  (Error_Term src) )         (Type src '[] t, t, Text) ->  TestTree-test_readTerm inp expected =+readTe inp expected = 	testCase (elide inp) $-	case reduceTeApp <$> test_parseTerm @ss inp of+	case reduceTeApp <$> parseTe @ss inp of 	 Left err -> Left (Left err) @?= snd `left` expected 	 Right ast ->-		let modsTy = modulesTyInj @ss in-		let imps = importTypes @ss [] in-		case readTerm imps modsTy CtxTyZ ast of+		case readTerm CtxTyZ ast of 		 Left err -> Left (Right err) @?= snd `left` expected 		 Right term -> 			case term of

Language/Symantic/Grammar/Megaparsec.hs view

@@ -25,6 +25,12 @@ import qualified Language.Symantic as Sym import Language.Symantic.Lib () +-- * Type 'ParsecC'+-- | Convenient alias for defining instances involving 'P.ParsecT'.+type ParsecC e s = (P.Token s ~ Char, P.Stream s, P.ErrorComponent e)+instance ParsecC e s => IsString (P.ParsecT e s m [Char]) where+	fromString = P.string+ -- -- Readers --@@ -88,12 +94,6 @@ 		MC.put s 		return a --- * Type 'ParsecC'--- | Convenient alias for defining instances involving 'P.ParsecT'.-type ParsecC e s = (P.Token s ~ Char, P.Stream s, P.ErrorComponent e)-instance ParsecC e s => IsString (P.ParsecT e s m [Char]) where-	fromString = P.string- -- -- Sym instances --@@ -143,17 +143,25 @@ instance ParsecC e s => Sym.Gram_Term_Name (P.ParsecT e s m) instance -- Sym.Gram_Type  ( ParsecC e s- , Gram_Source src      (P.ParsecT e s m)+ , Gram_Source src (P.ParsecT e s m)+ , Show src+ , MC.MonadState ( Sym.Imports Sym.NameTy+                 , Sym.ModulesTy src ) (P.ParsecT e s m)  ) => Sym.Gram_Type src (P.ParsecT e s m) instance -- Sym.Gram_Term_Type  ( ParsecC e s+ , Show src+ , MC.MonadState ( Sym.Imports Sym.NameTy+                 , Sym.ModulesTy src ) (P.ParsecT e s m)  , Gram_Source src           (P.ParsecT e s m)  ) => Sym.Gram_Term_Type src (P.ParsecT e s m) instance -- Sym.Gram_Term  ( ParsecC e s  , Show src+ , MC.MonadState ( Sym.Imports Sym.NameTy+                 , Sym.ModulesTy src )  (P.ParsecT e s m)  , MC.MonadState ( Sym.Imports Sym.NameTe                  , Sym.Modules src ss ) (P.ParsecT e s m)- , Sym.Gram_Source src                  (P.ParsecT e s m)- , Sym.Gram_Term_Atoms src ss           (P.ParsecT e s m)- ) => Sym.Gram_Term src ss              (P.ParsecT e s m)+ , Sym.Gram_Source src        (P.ParsecT e s m)+ , Sym.Gram_Term_Atoms src ss (P.ParsecT e s m)+ ) => Sym.Gram_Term src ss    (P.ParsecT e s m)

Language/Symantic/Lib/Applicative/Test.hs view

@@ -18,7 +18,7 @@  , Proxy Functor  , Proxy Applicative  ]-(==>) = test_readTerm @() @SS+(==>) = readTe @() @SS  tests :: TestTree tests = testGroup "Applicative"

Language/Symantic/Lib/Bool/Test.hs view

@@ -18,7 +18,7 @@  , Proxy []  , Proxy Char  ]-(==>) = test_readTerm @() @SS+(==>) = readTe @() @SS  tests :: TestTree tests = testGroup "Bool" $

Language/Symantic/Lib/Foldable/Test.hs view

@@ -18,7 +18,7 @@  , Proxy (,)  , Proxy Foldable  ]-(==>) = test_readTerm @() @SS+(==>) = readTe @() @SS  tests :: TestTree tests = testGroup "Foldable"

Language/Symantic/Lib/Functor/Test.hs view

@@ -17,7 +17,7 @@  , Proxy Integer  , Proxy Maybe  ]-(==>) = test_readTerm @() @SS+(==>) = readTe @() @SS  tests :: TestTree tests = testGroup "Functor"

Language/Symantic/Lib/Map/Test.hs view

@@ -23,7 +23,7 @@  , Proxy Num  , Proxy Monoid  ]-(==>) = test_readTerm @() @SS+(==>) = readTe @() @SS  tests :: TestTree tests = testGroup "Map"

Language/Symantic/Lib/MonoFunctor/Test.hs view

@@ -19,7 +19,7 @@  , Proxy MT.MonoFunctor  , Proxy Maybe  ]-(==>) = test_readTerm @() @SS+(==>) = readTe @() @SS  tests :: TestTree tests = testGroup "MonoFunctor"

Language/Symantic/Lib/Num/Test.hs view

@@ -24,7 +24,7 @@  , Proxy Traversable  , Proxy []  ]-(==>) = test_readTerm @() @SS+(==>) = readTe @() @SS  tests :: TestTree tests = testGroup "Num"

Language/Symantic/Lib/Tuple2/Test.hs view

@@ -15,7 +15,7 @@  , Proxy ()  , Proxy (,)  ]-(==>) = test_readTerm @() @SS+(==>) = readTe @() @SS  tests :: TestTree tests = testGroup "Tuple2"

Language/Symantic/Typing/Test.hs view

@@ -1,3 +1,4 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Typing.Test where@@ -7,21 +8,25 @@  import Control.Applicative (Applicative(..)) import Control.Arrow (left)+import Data.Functor.Identity (Identity(..))+import Data.List.NonEmpty (NonEmpty) import Data.Map.Strict (Map) import Data.Maybe (isJust) import Data.NonNull (NonNull) import Data.Proxy import Data.Ratio (Ratio) import Data.Text (Text)-import Data.List.NonEmpty (NonEmpty) import GHC.Exts (Constraint) import Prelude hiding (exp)+import qualified Control.Monad.Classes.Run as MC+import qualified Control.Monad.Trans.State.Strict as SS import qualified Data.Function as Fun import qualified Data.Map.Strict as Map import qualified Data.MonoTraversable as MT import qualified Data.Sequences as Seqs import qualified System.IO as IO import qualified Text.Megaparsec as P+import qualified Text.Megaparsec.Prim as P  import Language.Symantic.Grammar import Language.Symantic@@ -81,6 +86,19 @@ 		tyConstLen @(K Char) @Char len) $ 	modulesTyInj @SS +parseTy ::+ forall src g err inp.+ g ~ P.ParsecT err inp (SS.StateT (Imports NameTy, ModulesTy src) Identity) =>+ P.MonadParsec err inp (P.ParsecT err inp g) =>+ Gram_Type src g =>+ P.Token inp ~ Char =>+ inp -> Either (P.ParseError Char err) (AST_Type src)+parseTy inp =+	runIdentity $+	MC.evalStateStrict (impsTy, modsTy @src) $+	P.runParserT g "" inp+	where g = unCF $ g_type <* eoi+ tests :: TestTree tests = testGroup "Typing" $  [ testGroup "readType" $@@ -89,9 +107,8 @@ 		where 		got :: Either (P.ParseError Char P.Dec) 		              (Either (Error_Type SRC) (TypeVT SRC))-		got = readType impsTy modsTy <$> P.runParser (unCF g) "" inp-		g :: Gram_Type SRC g => CF g (AST_Type SRC)-		g = g_type <* eoi in+		got = readType <$> parseTy inp+		in 	let (==>) = run; infixr 0 ==> in 	 [ "Bool"                        ==> TypeT $ tyBool 	 , "(->) Bool"                   ==> TypeT $ tyFun `tyApp` tyBool@@ -134,23 +151,19 @@ 		let run inp = testCase inp $ got @?= Left () 			where 			got :: Either () (AST_Type SRC)-			got = left (\(_::P.ParseError (P.Token String) P.Dec) -> ()) $ P.runParser (unCF g) "" inp-			g :: Gram_Type SRC g => CF g (AST_Type SRC)-			g = g_type <* eoi in+			got = left (\(_::P.ParseError (P.Token String) P.Dec) -> ()) $ parseTy inp in 		run <$> 		 [ "Bool, Int" 		 , "(Bool -> Int) Char"+		 , "NonExistingType" 		 ] 	 , testGroup "Compiling errors" $ 		let run inp = testCase inp $ got @?= Right (Left ()) 			where 			got :: Either (P.ParseError Char P.Dec) (Either () (TypeVT SRC))-			got = left (Fun.const ()) . readType impsTy modsTy <$> P.runParser (unCF g) "" inp-			g :: Gram_Type SRC g => CF g (AST_Type SRC)-			g = g_type <* eoi in+			got = left (Fun.const ()) . readType <$> parseTy inp in 		run <$>-		 [ "NonExistingType"-		 , "Bool Int"+		 [ "Bool Int" 		 , "[IO]" 		 , "(->) IO" 		 , "(->) Bool Int Char"

symantic-lib.cabal view

@@ -19,7 +19,7 @@ -- PVP:  +-+------- breaking API changes --       | | +----- non-breaking API additions --       | | | +--- code changes with no API change-version: 0.0.2.20170702+version: 0.0.2.20170703  Source-Repository head   location: git://git.autogeree.net/symantic