Todo, Readme and one extra test file

README.md

@@ -3,40 +3,27 @@ An experimental language with algebraic effects
 
 ### Grammar
 
-    toplevel ::= def <identifier> { : <type> } = <value>
-               | <fixity> int
+    toplevel ::= let <identifier> = <value>
                | run <expression>
-
-    type ::= type-lit | <type> -> <row> <type>
-
-    type-lit ::= () | int | string | bool
-
-    row ::= '<' <row-contents> '>'
-          | row-var
-
-    row-var ::= <identifier>
+               | eff <type-lit> = <operations>
 
-    row-label ::= <identifier>
-
-    row-contents ::= <empty>
-                   | <row-label>
-                   | <row-label> '|' row-contents
-
-    fixity ::= infix{l|r} <identifier> int
-             | {pre|post}fix <identifier> int
+    operations ::= { <identifier> : type-lit -> type-lit ; }+
+
+    type-lit ::= Unit | Int
 
-    value ::= fun <identifier> => <expression>
+    value ::= fn <identifier> -> <expression>
             | <literal>
             | <variable>
 
-    literal ::= "string" | int | true | false | ()
+    literal ::= int | ()
 
     variable ::= <identifier>
 
     expression ::= <expression> <expressiom>
                  | <variable>
                  | <value>
-                 | handle <expression> with {<handlers>}*
+                 | handle <type-lit> in <expression> with {<handlers>}*
+                 | lift <type-lit> in ( expression )
 
-    handlers ::= { | <identifier> <identifier> <identifier> => expression }*
-               | { | return <identifier> => expression }?
+    handlers ::= { <identifier> <identifier> , <identifier> -> expression ;}*
+               | { return <identifier> -> expression ; }

TODO

@@ -1,7 +1,5 @@
-Fix pretty printing of types
-Add pretty printing of terms
-Add syntax and parsing for lifting and handling of effects
-Finish constraint generation and let polymorphism
+Add subsumption on types (simple one)
+Implement interpreter
 Define built in effects
 Add polymorphim of types, not only effects
 CLEAN UP

src/Check.hs

@@ -249,6 +249,9 @@ unifyT s (TyArr a1 r1 b1,  TyArr a2 r2 b2) =
     return (s, cs)
 unifyT s (t1, t2) = throw $ UnificationError $ pretty t1 <+> "and" <+> pretty t2
 
+
+-- TODO Add occurs check
+
 unifyR :: Solve m => Subst -> (Row, Row) -> m (Subst, Constraints)
 unifyR s (r1@(Row l1 v1), r2@(Row l2 v2)) = let
   extraInL1 = l1 \\ l2

src/Parse.hs

@@ -30,7 +30,9 @@ top =  Def <$> (res "let" >> ident) <*> (resOp "=" >> term)
    <|> Run <$> (res "run" >> term)
    <|> EffDef <$> (res "eff" >> tyLit) <*> (resOp "=" >> opDefs)
 
-opDefs = P.endBy (OpDef <$> ident <*> (resOp ":" >> typ) <*> (resOp "->" >> typ)) (resOp ";")
+opDefs = P.endBy 
+  (OpDef <$> ident <*> (resOp ":" >> (TyLit <$> tyLit)) <*> (resOp "->" >> (TyLit <$> tyLit)))
+  (resOp ";")
 
 term =  Let    <$> (res "let" *> ident) <*> (resOp "=" *>  term) <*> (res "in" *> term)
     <|> Abs    <$> (res "fn"  *> ident) <*> (resOp "->" *> term)
@@ -53,6 +55,7 @@ typ =  (P.try $ TyArr <$> typ1 <*> (resOp "->" *> row) <*> typ)
    <|> typ1
 
 typ1 = TyLit <$> tyLit
+   <|> parens typ
 
 row =  Row [] . Just <$> tyVar
    <|> Row <$> (str "[" *> P.many tyLit) <*> (optional (str "|" *> tyVar) <* str "]")

test/Spec.hs

@@ -6,8 +6,9 @@
 import           System.IO
 import qualified System.IO.Strict as S
 
-import qualified Data.Map  as M
-import qualified Data.Text as T
+import qualified Data.Map     as M
+import qualified Data.Text    as T
+import qualified Data.Text.IO as TIO
 import           Data.Text(Text)
 import           Data.Text.Prettyprint.Doc
 
@@ -39,6 +40,13 @@ test s = do
                         pretty t <+> "|" <+> pretty e <> line
 
 
+testFile :: (MonadError Error m, MonadIO m) => FilePath -> m ()
+testFile f = do
+  t <- liftIO $ TIO.readFile f
+  p <- parse program t
+  e <- run $ processProgram p
+  liftIO $ putDocW 80 $ pretty e
+
 run c = unEither =<< liftIO (evalCheck c)
 
 testTop :: (MonadError Error m, MonadIO m) => Text -> m ()
@@ -51,10 +59,9 @@ testTop s = do
     Run t -> do
       (t, e) <-run $ process t
       liftIO $ putDocW 80 $ pretty t <+> "|" <+> pretty e <> line
-    e@EffDef{} ->do
+    e@EffDef{} ->
       liftIO $ putDocW 80 $ pretty e <> line
 
-
 reportError :: (MonadIO m) => ExceptT Error m a -> m ()
 reportError x = do
   e <- runExceptT x
@@ -86,3 +93,6 @@ main = do
     , "eff Reader = \
       \ ask : Unit -> Int;"
     ]
+  mapM_ (\s -> reportError (testFile s) >> putStrLn "")
+    [ "/home/mbuszka/university/aleph/test/test-1.al"
+    ]

test/test-1.al

@@ -1,5 +1,20 @@
-def id: forall 'a. () -> 'a () = fun 'a. fun x: (). x
+eff RD =
+  ask : Unit -> Int;
 
-def f: forall 'a. Int -> 'a Int = fun 'a. fun x: Int. x
+let h = fn comp -> fn r -> 
+  (handle RD in comp () with
+    ask u, k -> k r;
+    return x -> x;)
 
-run let u1 = id in 42
+let x = h (fn u ->
+  a <- ask (),
+  a) 7
+
+let y = h (fn u ->
+  a <- h (fn u -> lift RD in (ask ())) 5,
+  b <- ask (),
+  a) 6
+
+let z = fn u -> lift RD in (ask ())
+
+let v = h (fn u -> lift RD in (ask ()))