split into submodules

src/Error.hs

@@ -10,17 +10,18 @@ import           Control.Monad.Except
 
 import           Data.Text.Prettyprint.Doc
 
-import Grammar
+import Syntax.Grammar
 import Print
 
 data Error
   = ParseError String
-  | UnboundVariable String
+  | UnboundVariable Ident
   | UnknownOperation Ident
   | UnknownEffect TyLit
   | TypeError (forall a. Doc a)
   | KindError (forall a. Doc a)
   | UnificationError (forall a. Doc a)
+  | RuntimeError (forall a. Doc a)
 
 instance Pretty Error where
   pretty (ParseError s) = "Parse error:" <+> pretty s
@@ -30,6 +31,7 @@ instance Pretty Error where
   pretty (TypeError s) = "Type error:" <+> s
   pretty (KindError s) = "Kind error" <+> s
   pretty (UnificationError s) = "Unification error:" <+> s
+  pretty (RuntimeError s) = "Runtime error:" <+> s
 
 throw :: MonadError Error m => Error -> m a
 throw = throwError

src/Environment.hs → src/Inference/Environment.hs

@@ -4,7 +4,7 @@
   , TemplateHaskell
 #-}
 
-module Environment where
+module Inference.Environment where
 
 import Control.Monad.Reader
 import Control.Monad.Except
@@ -15,7 +15,7 @@ import qualified Data.Map as M
 import           Data.Map (Map)
 
 import Error
-import Grammar
+import Syntax.Grammar
 import Print
 
 data Scheme = Scheme [TyVar] Typ
@@ -31,10 +31,11 @@ data Environment = Env
   } deriving (Show)
 
 instance Pretty Environment where
-  pretty (Env tc ops eff) = "Environment:" <> line 
-                         <> (align $ vsep 
-                              (map (\(k, s) -> pretty k <+> ":" <+> pretty s) $ M.assocs tc))
-                         <> line
+  pretty (Env tc ops eff) = 
+    "Environment:" <> line
+    <> align (vsep (map (\(k, s) -> pretty k <+> ":" <+> pretty s) $ M.assocs tc)) <> line
+    <> "Operations:" <> line
+    <> align (vsep (map (\(k, (tl, f, t)) -> pretty k <+> "->" <+> pretty tl) $ M.assocs ops)) <> line
 
 makeLenses ''Environment
 
@@ -47,13 +48,13 @@ operations = M.fromList
   where tl = TyLit . TL
 
 effToOps :: Map TyLit [Ident]
-effToOps = fmap sort . 
+effToOps = fmap sort .
            M.fromListWith (++) .
            map (\(id, l) -> (l, [id])) . M.toList .
            fmap (\(l, _, _) -> l) $ operations
 
 effects :: Map Ident Scheme
-effects = fmap (\(eff, a, b) -> 
+effects = fmap (\(eff, a, b) ->
   let v = TV "'a" in
     Scheme [v] (TyArr a (Row [eff] (Just v)) b)) operations
 
@@ -68,7 +69,7 @@ lookup v = do
   ms <- asks (\env -> env ^. eTypeContext . to (M.lookup v))
   case ms of
     Just t -> return t
-    Nothing -> throwError $ UnboundVariable (show v)
+    Nothing -> throwError $ UnboundVariable v
 
 lookupOp :: (MonadReader Environment m, MonadError Error m) => Ident -> m (TyLit, Typ, Typ)
 lookupOp v = do
@@ -91,5 +92,5 @@ extendEnv :: Ident -> Scheme -> Environment -> Environment
 extendEnv id s = eTypeContext %~ M.insert id s
 
 combine :: Environment -> Environment -> Environment
-combine (Env tcs1 ops1 eff1) (Env tcs2 ops2 eff2) = 
+combine (Env tcs1 ops1 eff1) (Env tcs2 ops2 eff2) =
   Env (M.union tcs1 tcs2) (M.union ops1 ops2) (M.union eff1 eff2)

src/Check.hs → src/Inference/Infer.hs

@@ -5,7 +5,7 @@
   , OverloadedStrings
 #-}
 
-module Check where
+module Inference.Infer where
 
 import Control.Monad.Except
 import Control.Monad.State hiding (State)
@@ -26,10 +26,11 @@ import qualified Data.Text.Prettyprint.Doc as P
 
 import Prelude hiding (lookup)
 
-import Environment
+import Inference.Environment
+import Inference.Subst
+import Syntax.Grammar
+
 import Error
-import Grammar
-import Subst
 import Print
 
 

src/Subst.hs → src/Inference/Subst.hs

@@ -4,7 +4,7 @@
   , OverloadedStrings
 #-}
 
-module Subst 
+module Inference.Subst 
   ( Subst(..)
   , Substitute(..)
   , FreeVars(..)
@@ -21,9 +21,9 @@ import           Data.Map (Map)
 import qualified Data.Set as S
 import           Data.Set (Set)
 
-import Environment
+import Inference.Environment
 import Error
-import Grammar
+import Syntax.Grammar
 import Print
 
 newtype Subst = Subst { unwrap :: Map TyVar (Either Typ Row) }

src/Print.hs

@@ -4,6 +4,7 @@
 
 module Print 
   ( Pretty(..)
+  , Doc
   , align
   , putDocW
   , (<+>)
@@ -19,7 +20,7 @@ import           Data.Text(Text)
 import           Data.Text.Prettyprint.Doc
 import           Data.Text.Prettyprint.Doc.Util(putDocW)
 
-import Grammar
+import Syntax.Grammar
 
 instance Pretty TyVar where
   pretty (TV v) = pretty v

src/Grammar.hs → src/Syntax/Grammar.hs

@@ -1,4 +1,4 @@
-module Grammar 
+module Syntax.Grammar 
   ( Top(..)
   , Term(..) 
   , Handler(..)

src/Lex.hs → src/Syntax/Lex.hs

@@ -2,7 +2,7 @@
     OverloadedStrings
 #-}
 
-module Lex 
+module Syntax.Lex 
   ( ident
   , parens
   , res
@@ -27,7 +27,7 @@ import qualified Text.Parsec       as P
 import qualified Text.Parsec.Token as P
 import qualified Text.Parsec.Char  as P
 
-import Grammar
+import Syntax.Grammar
 
 lexer :: P.GenTokenParser Text () Identity
 lexer = P.makeTokenParser $ P.LanguageDef

src/Parse.hs → src/Syntax/Parse.hs

@@ -2,7 +2,7 @@
   FlexibleContexts
 #-}
 
-module Parse where
+module Syntax.Parse where
 
 import Control.Applicative
 import Control.Monad.Except
@@ -14,8 +14,8 @@ import qualified Text.Parsec as P
 import           Text.Parsec(ParsecT)
 
 import Error
-import Grammar
-import Lex
+import Syntax.Grammar
+import Syntax.Lex
 
 type Parser a = ParsecT Text () Identity a