Went back to Parsec, added pretty-printer

package.yaml

@@ -27,6 +27,9 @@ dependencies:
 - BNFC-meta
 - happy-meta
 - alex-meta
+- parsec
+- text
+- prettyprinter
 
 library:
   source-dirs: src

src/Check.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE
     FlexibleContexts
   , TemplateHaskell
-  , QuasiQuotes
+  , OverloadedStrings
 #-}
 
 module Check where
@@ -13,25 +13,32 @@ import Control.Monad.Writer
 import Control.Monad.RWS
 import Control.Lens
 
+import           Data.List((\\))
 import qualified Data.Map as M
 import           Data.Map(Map)
 import qualified Data.Set as S
 import           Data.Set(Set)
-import Data.List((\\))
--- import Data.Maybe(fromMaybe)
+import qualified Data.Text as T
+import qualified Data.Text.Prettyprint.Doc as P
 
 import Prelude hiding (lookup)
 
 import Environment
 import Error
-import Subst
 import Grammar
+import Subst
+import Print
+
 
 data Constraint
   = TyConstr Typ Typ
   | RoConstr Row Row
   deriving Show
 
+instance Pretty Constraint where
+  pretty (TyConstr a b) = pretty a P.<+> "~" P.<+> pretty b
+  pretty (RoConstr a b) = pretty a P.<+> "~" P.<+> pretty b
+
 type Constraints = [Constraint]
 
 instance Substitute Constraint where
@@ -74,11 +81,11 @@ instantiate (Scheme vs ty) = do
 lookupEnv :: Ident -> Check Typ
 lookupEnv v = lookup v >>= instantiate
 
-fresh :: (MonadState State m) => m TVar
+fresh :: (MonadState State m) => m TyVar
 fresh = do
   i <- gets _sNextVar
   modify (sNextVar %~ (+1))
-  return $ TVar ("'t" ++ show i)
+  return $ TV $ T.pack ("t" ++ show i)
 
 freshTyp :: (MonadState State m) => m Typ
 freshTyp = TyVar <$> fresh
@@ -95,8 +102,8 @@ constrRow a b = tell [RoConstr a b]
 infer :: Term -> Check (Typ, Row)
 infer (Var v)       = (,) <$> lookupEnv v <*> freshRow
 -- infer (Lit VBool{}) = (,) (TyLit "Bool")  <$> freshTyp
-infer (Lit VInt{})  = (,) (TyLit $ Ident "Int")  <$> freshRow
-infer (Lit VUnit{}) = (,) (TyLit $ Ident "Unit") <$> freshRow
+infer (Lit VInt{})  = (,) (TyLit $ TL "Int")  <$> freshRow
+infer (Lit VUnit{}) = (,) (TyLit $ TL "Unit") <$> freshRow
 infer (Abs v term) = do
   tv <- freshTyp
   (ty, row) <- inEnv v (Scheme [] tv) $ infer term

src/Environment.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE
     FlexibleContexts
+  , OverloadedStrings
   , TemplateHaskell
-  , QuasiQuotes
 #-}
 
 module Environment where
@@ -16,27 +16,27 @@ import           Data.Map (Map)
 import Error
 import Grammar
 
-data Scheme = Scheme [TVar] Typ
+data Scheme = Scheme [TyVar] Typ
   deriving Show
 
 data Environment = Env
   { _eTypeContext :: Map Ident Scheme
-  , _eOperations  :: Map Ident (Ident, Typ, Typ)
+  , _eOperations  :: Map Ident (TyLit, Typ, Typ)
   } deriving (Show)
 
 makeLenses ''Environment
 
-operations :: Map Ident (Ident, Typ, Typ)
+operations :: Map Ident (TyLit, Typ, Typ)
 operations = M.fromList
-  [ (Ident "put",   (Ident "ST", tv "Int",  tv "Unit"))
-  , (Ident "get",   (Ident "ST", tv "Unit", tv "Int" ))
-  , (Ident "print", (Ident "IO", tv "Int",  tv "Unit"))
+  [ (ID "put",   (TL "ST", tv "Int",  tv "Unit"))
+  , (ID "get",   (TL "ST", tv "Unit", tv "Int" ))
+  , (ID "print", (TL "IO", tv "Int",  tv "Unit"))
   ]
-  where tv = TyVar . TVar
+  where tv = TyVar . TV
 
 effects :: Map Ident Scheme
 effects = fmap (\(eff, a, b) -> 
-  let v = TVar "'a" in
+  let v = TV "'a" in
     Scheme [v] (TyArr a (Row [eff] (Just v)) b)) operations
 
 initEnv :: Environment
@@ -49,7 +49,7 @@ lookup v = do
     Just t -> return t
     Nothing -> throwError $ UnboundVariable (show v)
 
-lookupEff :: (MonadReader Environment m, MonadError Error m) => Ident -> m (Ident, Typ, Typ)
+lookupEff :: (MonadReader Environment m, MonadError Error m) => Ident -> m (TyLit, Typ, Typ)
 lookupEff v = do
   ml <- asks (\e -> e ^. eOperations . to (M.lookup v))
   case ml of

src/Grammar.hs

@@ -1,24 +1,57 @@
-{-# LANGUAGE
-    TemplateHaskell
-  , QuasiQuotes
-  , FlexibleContexts
-  , FlexibleInstances
-#-}
-
 module Grammar 
   ( Top(..)
   , Term(..) 
   , Handler(..)
+  , OpDef(..)
   , Val(..)
   , Typ(..)
   , Row(..)
-  , TVar(..)
+  , TyVar(..)
+  , TyLit(..)
   , Ident(..)
-  , pShow
   ) where
 
-import Control.Monad.Except
-import Language.LBNF.Runtime(printTree)
-import Language.LBNF.Compiletime
+import Data.Text
+
+newtype TyVar = TV Text deriving (Show, Eq, Ord)
+newtype TyLit = TL Text deriving (Show, Eq, Ord)
+newtype Ident = ID Text deriving (Show, Eq, Ord)
+
+data Top
+  = Def Ident Term
+  | Run Term
+  | EffDef TyLit [OpDef]
+  deriving Show
+
+data OpDef = OpDef Ident Typ Typ
+  deriving Show
+
+data Term
+  = App Term Term
+  | Let Ident Term Term
+  | Abs Ident Term
+  | Var Ident
+  | Lit Val
+  | Handle TyLit Term [Handler]
+  | Lift TyLit Term
+  | Bind Ident Term Term
+  deriving Show
+
+data Handler
+  = Op  Ident Ident Ident Term
+  | Ret Ident Term
+  deriving Show
+
+data Val
+  = VInt Integer
+  | VUnit
+  deriving Show
+
+data Typ
+  = TyArr Typ Row Typ
+  | TyVar TyVar
+  | TyLit TyLit
+  deriving Show
 
-import Grammar.Impl
+data Row = Row [TyLit] (Maybe TyVar)
+  deriving Show