files written on presentation

Langdsl.hs

@@ -0,0 +1,43 @@
+{-# LANGUAGE DeriveFunctor #-}
+
+module Langdsl where
+
+import Control.Monad
+import Parser
+
+data Toy a next = Output a next | Bell next | Done
+  deriving Functor
+
+newtype Fix f = Fix (f (Fix f))
+
+type Toy2 a = Fix (Toy a)
+
+data Free f r = Free (f (Free f r)) | Pure r
+  deriving Functor
+
+instance Functor f => Monad (Free f) where
+  return = Pure
+  (Pure r) >>= f = f r
+  (Free a) >>= f = Free $ (fmap (>>= f) a)
+
+instance Functor f => Applicative (Free f) where
+  pure = Pure
+  (<*>) = ap
+
+liftF x = Free (fmap Pure x)
+
+output x = liftF (Output x ())
+bell = liftF (Bell ())
+done = liftF Done
+
+sub :: Free (Toy Char) ()
+sub = do
+  output 'x'
+  bell
+
+prog = do
+  sub
+  output 'A'
+  done
+
+toyParser :: Parser (Toy c)

Parser.hs

@@ -0,0 +1,37 @@
+module Parser where
+
+import Data.Char
+import Control.Arrow
+import Control.Applicative
+import Control.Monad
+
+newtype Parser a = Parser { parse :: String -> [(a,String)] }
+
+instance Functor Parser where
+  fmap f (Parser a) = Parser $ \s -> first f <$> a s
+
+instance Applicative Parser where
+  pure x = Parser $ \s -> pure (x,s)
+  (Parser pab) <*> (Parser pa) = Parser $ \s -> do
+    (ab, s1) <- pab s
+    (a, s2) <- pa s1
+    pure (ab a, s2)
+
+instance Monad Parser where
+  return = pure
+  (Parser a) >>= f = Parser $ \s -> (\(x,s1) -> parse (f x) s1) =<< a s
+
+instance Alternative Parser where
+  empty = Parser $ \s -> []
+  (Parser p) <|> (Parser q) = Parser $ \s -> p s <|> q s
+
+token :: Parser Char
+token = Parser $ \s -> case s of
+  (x:xs) -> [(x,xs)]
+  _ -> []
+
+satisfy :: (Char -> Bool) -> Parser Char
+satisfy p = do
+  x <- token
+  guard (p x)
+  pure x