add_line_info.hs

-- error message monad here
data E a = Success a | Error String
unitE a = Success a
errorE s = Error s
(Success a) `bindE` k = k a
(Error s) `bindE` k = Error s
showE (Success a) = "Success: " ++ showval a
showE (Error s) = "Error: " ++ s

showpos :: Position -> String
showpos i = "x: " ++ show i

-- add position monad combinator for position information
type Position = Int
type P a = Position -> E a
unitP a = \p -> unitE a
errorP s = \p -> errorE (showpos p ++ ":" ++ s)
m `bindP` k = \p-> m p `bindE` (\x -> k x p)

showP m = showE (m 0)
resetP :: Position -> P x -> P x
resetP q m = \p -> m q


-- define type name
type Name = String

-- define term data type
data Term = Var Name
           |Con Int
           |Add Term Term
           |Lam Name Term
           |App Term Term
           |At Position Term

-- define value type
data Value = Wrong
            |Num Int
            |Fun(Value -> P Value)

-- here is show function
showval :: Value -> String
showval Wrong = "<Wront>"
showval (Num i) = show i
showval (Fun f) = "<function>"

-- add function
add :: Value -> Value -> P Value
add (Num i) (Num j) = unitP (Num ( i + j ))
add a b = errorP("should be numbers: " ++ showval a ++ showval b)

-- env is just k-v pairs
type Environment = [(Name, Value)]

mylookup :: Name -> Environment -> P Value
mylookup x [] = errorP("cannot find in env: " ++ x)
mylookup x ((k,v):e) = if k == x then unitP v else (mylookup x e)

-- apply function
apply :: Value -> Value -> P Value
apply (Fun k) a = k a
apply f a = errorP("should be function: " ++ showval f)

-- interpret function
interp :: Term -> Environment -> P Value
interp (Var x) e = mylookup x e
interp (Con i) e = unitP (Num i)
interp (Add u v) e = interp u e `bindP` (\a ->
                     interp v e `bindP` (\b ->
                     add a b))
interp (Lam x v) e = unitP (Fun(\a -> interp v((x,a):e)) )
interp (App t u) e = interp t e `bindP` (\f ->
                     interp u e `bindP` (\a ->
                     apply f a))
interp (At p t) e = resetP p (interp t e)

--test function for my interpreter
test :: Term -> String
test t = showP (interp t [])

term0 = (App (Lam "x" (Add (Var "x") (Var "x")))
             (Add (Con 10) (Con 11)))

test1 = do
    test term0

test2 = do
    test (Add (Var "abc") (Con 11 ))

test3 = do  
    test (At 10 (Var "abc"))

error_monad.hs

-- error message monad here
data E a = Success a | Error String
unitE a = Success a
errorE s = Error s
(Success a) `bindE` k = k a
(Error s) `bindE` k = Error s
showE (Success a) = "Success: " ++ showval a
showE (Error s) = "Error: " ++ s


-- define type name
type Name = String

-- define term data type
data Term = Var Name
           |Con Int
           |Add Term Term
           |Lam Name Term
           |App Term Term

-- define value type
data Value = Wrong
            |Num Int
            |Fun(Value -> E Value)

-- here is show function
showval :: Value -> String
showval Wrong = "<Wront>"
showval (Num i) = show i
showval (Fun f) = "<function>"

-- add function
add :: Value -> Value -> E Value
add (Num i) (Num j) = unitE (Num ( i + j ))
add a b = errorE("should be numbers: " ++ showval a ++ showval b)

-- env is just k-v pairs
type Environment = [(Name, Value)]

mylookup :: Name -> Environment -> E Value
mylookup x [] = errorE("cannot find in env: " ++ x)
mylookup x ((k,v):e) = if k == x then unitE v else (mylookup x e)

-- apply function
apply :: Value -> Value -> E Value
apply (Fun k) a = k a
apply f a = errorE("should be function: " ++ showval f)

-- interpret function
interp :: Term -> Environment -> E Value
interp (Var x) e = mylookup x e
interp (Con i) e = unitE (Num i)
interp (Add u v) e = interp u e `bindE` (\a ->
                     interp v e `bindE` (\b ->
                     add a b))
interp (Lam x v) e = unitE (Fun(\a -> interp v((x,a):e)) )
interp (App t u) e = interp t e `bindE` (\f ->
                     interp u e `bindE` (\a ->
                     apply f a))

-- show function
showI a = showval a

-- test function for my interpreter
test :: Term -> String
test t = showE (interp t [])


term0 = (App (Lam "x" (Add (Var "x") (Var "x")))
             (Add (Con 10) (Con 11)))

test1 = do
    test term0
    
test2 = do 
    test (Add (Var "abc") (Con 11 ))

monad.hs

-- here is our simplest monad
type I a = a
unitI a = a
a `bindI` k = k a

-- define type name 
type Name = String

-- define term data type
data Term = Var Name
           |Con Int
           |Add Term Term
           |Lam Name Term
           |App Term Term

-- define value type           
data Value = Wrong
            |Num Int
            |Fun(Value -> I Value)

-- here is show function          
showval :: Value -> String
showval Wrong = "<Wront>"
showval (Num i) = show i
showval (Fun f) = "<function>"

-- add function 
add :: Value -> Value -> I Value
add (Num i) (Num j) = unitI (Num ( i + j ))
add _ _ = unitI Wrong

-- env is just k-v pairs
type Environment = [(Name, Value)]

mylookup :: Name -> Environment -> I Value
mylookup x [] = unitI Wrong
mylookup x ((k,v):e) = if k == x then unitI v else (mylookup x e)

-- apply function 
apply :: Value -> Value -> I Value
apply (Fun k) a = k a
apply f a = unitI Wrong

-- interpret function
interp :: Term -> Environment -> I Value
interp (Var x) e = mylookup x e
interp (Con i) e = unitI (Num i)
interp (Add u v) e = interp u e `bindI` (\a ->
                     interp v e `bindI` (\b ->
                     add a b))
interp (Lam x v) e = unitI Fun(\a -> interp v((x,a):e))
interp (App t u) e = interp t e `bindI` (\f ->
                     interp u e `bindI` (\a ->
                     apply f a))
                 
-- show function
showI a = showval a

-- test function for my interpreter
test :: Term -> String
test t = showI (interp t [])


term0 = (App (Lam "x" (Add (Var "x") (Var "x")))
             (Add (Con 10) (Con 11)))
             
mytest = do 
    test term0

state_monad.hs

-- add state monad for state count
type State = Int
type S a = State -> (a, State)
unitS a = \s0 -> (a, s0)
m `bindS` k = \s0 -> let (a, s1) = m s0
                         (b, s2) = k a s1
                     in (b, s2)
showS m = let (a, s1) = m 0
          in "Value:" ++ showval a ++ ";" ++ "Count:" ++ show s1
tickS :: S ()
tickS = \s -> ((), s + 1)


-- define type name
type Name = String

-- define term data type
data Term = Var Name
           |Con Int
           |Add Term Term
           |Lam Name Term
           |App Term Term

-- define value type
data Value = Wrong
            |Num Int
            |Fun(Value -> S Value)

-- here is show function
showval :: Value -> String
showval Wrong = "<Wrong>"
showval (Num i) = show i
showval (Fun f) = "<function>"

-- add function
add :: Value -> Value -> S Value
add (Num i) (Num j) = tickS `bindS` (\()-> unitS (Num ( i + j )))
add _ _ = unitS Wrong

-- env is just k-v pairs
type Environment = [(Name, Value)]

mylookup :: Name -> Environment -> S Value
mylookup x [] = unitS Wrong
mylookup x ((k,v):e) = if k == x then unitS v else (mylookup x e)

-- apply function
apply :: Value -> Value -> S Value
apply (Fun k) a = tickS `bindS` (\()-> k a)
apply f a = unitS Wrong

-- interpret function
interp :: Term -> Environment -> S Value
interp (Var x) e = mylookup x e
interp (Con i) e = unitS (Num i)
interp (Add u v) e = interp u e `bindS` (\a ->
                     interp v e `bindS` (\b ->
                     add a b))
interp (Lam x v) e = unitS (Fun(\a -> interp v((x,a):e)) )
interp (App t u) e = interp t e `bindS` (\f ->
                     interp u e `bindS` (\a ->
                     apply f a))

-- show function
showI a = showval a

--test function for my interpreter
test :: Term -> String
test t = showS (interp t [])

term0 = (App (Lam "x" (Add (Var "x") (Var "x")))
             (Add (Con 10) (Con 11)))

test1 = do
    test term0

test2 = do
    test (Add (Var "abc") (Con 11 ))