44 lines
713 B
Haskell
44 lines
713 B
Haskell
![]() |
{-# 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)
|