files written on presentation
This commit is contained in:
commit
265005f8c6
43
Langdsl.hs
Normal file
43
Langdsl.hs
Normal file
@ -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)
|
37
Parser.hs
Normal file
37
Parser.hs
Normal file
@ -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
|
Loading…
Reference in New Issue
Block a user