[Imp] start a parser combinator for Imp lang

haskell/Imp/AExpr.hs

@@ -0,0 +1,45 @@
+module AExpr where
+
+import qualified Parser as P
+
+data E
+  = Const Int
+  | Add E E
+  | Sub E E
+  | Mul E E
+  deriving Show
+
+eval :: E -> Int
+eval e = case e of
+  Const n -> n
+  Add e1 e2 -> (eval e1) + (eval e2)
+  Sub e1 e2 -> (eval e1) - (eval e2)
+  Mul e1 e2 -> (eval e1) * (eval e2)
+
+
+
+parser :: P.Parser E 
+parser = P.chainl cnst op
+ where
+  --cnst :: P.Parser E
+  cnst = do {
+    P.spaces
+  ; n <- P.nat
+  ; return $ (Const . read) n
+  }
+  --op :: P.Parser (E -> E -> E)
+  op = do {
+    P.spaces
+  ; sym <- P.choice $ map P.char "+-*"
+  ; return $ 
+      case sym of
+      '+' -> Add
+      '-' -> Sub
+      '*' -> Mul
+  }
+
+
+-- λ> P.parse AE.parser "2 * 3"
+-- Ok (Mul (Const 2) (Const 3)) ""
+-- λ> P.parse AE.parser "2 * 3 + 4"
+-- Ok (Add (Mul (Const 2) (Const 3)) (Const 4)) ""

haskell/Imp/BExpr.hs

@@ -0,0 +1,70 @@
+module BExpr where
+
+import Control.Applicative -- for `Alternative' typeclass
+
+import qualified AExpr as AE
+import qualified Parser as P
+
+data E
+  = Cnst Bool
+  | Eql AE.E AE.E
+  | NEq AE.E AE.E
+  | LEq AE.E AE.E
+  | Gt AE.E AE.E
+  | Not E
+  | And E E
+  deriving Show
+
+parser :: P.Parser E  
+parser = bconst
+  <|> notOp
+  <|> aOp
+  <|> aOp
+ where
+   bconst = do {
+   ; bval <- P.choice $ map P.string ["true", "false"]  
+   ; return $ (Cnst . strToBool) bval
+   }
+   notOp = do {
+     e <- notOpP
+   ; return $ Not e
+   }
+   aOp = do {
+     x <- AE.parser
+   ; P.spaces
+   ; opcode <- P.choice $ map P.string ["==", "!=", "<=", ">"]
+   ; P.spaces
+   ; y <- AE.parser
+   ; return $ case opcode of
+       "==" -> Eql x y 
+       "!=" -> NEq x y 
+       "<=" -> LEq x y 
+       ">" -> Gt x y 
+   }
+   andOp = do {
+     x <- parser
+   ; P.spaces
+   ; opcode <- P.string "&&"
+   ; P.spaces
+   ; y <- parser
+   ; return $ And x y
+   }
+   notOpP = P.string "~" *> P.spaces *> parser
+   strToBool s = if s == "true" then True else False
+
+eval :: E -> Bool
+eval e = case e of
+  Cnst b -> b
+  Eql e1 e2 -> (AE.eval e1) == (AE.eval e2)
+  NEq e1 e2 -> not $ (AE.eval e1) == (AE.eval e2)
+  LEq e1 e2 -> (AE.eval e1) <= (AE.eval e2)
+  Gt e1 e2 -> (AE.eval e1) > (AE.eval e2)
+  Not e -> not $ eval e
+  And e1 e2 -> (eval e1) && (eval e2)
+
+-- λ> P.parse parser "3 <= 2"
+-- Ok (LEq (Const 3) (Const 2)) ""
+-- λ> P.parse parser "3 <= 2"
+-- Ok (LEq (Const 3) (Const 2)) ""
+-- λ> P.parse parser "3 <= 2 && 2 > 4 && ~false"
+-- Ok (LEq (Const 3) (Const 2)) " && 2 > 4 && ~false"

haskell/Imp/Dict.hs

@@ -0,0 +1,17 @@
+module Dict where
+
+type Dict a = [(String, a)]
+
+set :: Dict a -> String -> a -> Dict a
+set d lbl val = case d of
+  [] -> [(lbl,val)]
+  (l,v):xs ->
+    if l==lbl then (l,val):xs
+    else (l,v):(set xs lbl val)
+
+get :: Dict a -> String -> Maybe a 
+get d lbl = case d of
+  [] -> Nothing
+  (l,v):xs ->
+    if l==lbl then Just v
+    else get xs lbl

haskell/Imp/Parser.hs

@@ -0,0 +1,123 @@
+module Parser where
+
+import Control.Applicative -- for `Alternative' typeclass
+import qualified Data.Char
+
+data Result a
+  = Ok a String
+  | Err
+  deriving Show
+  
+newtype Parser a = Parser {
+  -- | Run parser on some input
+  parse :: String -> Result a
+}
+
+instance Functor Result where
+  -- f :: a -> b
+  -- ra :: Result a
+  fmap f ra = case ra of
+    Ok a rem -> Ok (f a) rem
+    Err -> Err
+
+instance Functor Parser where
+  -- f :: a -> b
+  -- pa :: Parser a
+  fmap f pa = Parser $ \inp ->
+    -- resa :: Result a
+    let resa = parse pa inp in
+    f <$> resa
+
+instance Applicative Parser where
+  -- pab :: Parser (a -> b)
+  -- pa :: Parser a
+  (<*>) pab pa = Parser $ \inp ->
+    -- resf :: Result (a -> b)
+    let resf = parse pab inp in
+    case resf of
+      -- f :: a -> b
+      Ok f remf -> 
+        let resa = parse pa remf in
+        case resa of
+          -- resa :: Result a
+          Ok a rem -> Ok (f a) rem
+          Err -> Err
+      Err -> Err
+
+  -- pure :: a -> Parser a
+  pure a = Parser $ \inp -> Ok a inp
+
+instance Monad Parser where
+  -- pa :: Parser a
+  -- f :: a -> Parser b
+  (>>=) pa f = Parser $ \inp ->
+    let resa = parse pa inp in
+    case resa of
+      -- resa :: Result a
+      Ok a rem ->
+        let res = f a in
+        -- res :: Parser b
+        parse res rem
+      Err -> Err
+
+instance Alternative Parser where
+  -- empty is identity of (<|>)
+  empty = Parser $ \inp -> Err
+
+  (<|>) p1 p2 = Parser $ \inp ->
+    -- p1 p2 :: Parser a 
+    let res = parse p1 inp in
+    case res of
+      Ok _ _ -> res
+      Err -> parse p2 inp
+
+--------------------------------------------------
+
+{- Helper functions -}
+
+digitsToNat :: [Int] -> Int
+digitsToNat = foldl (\res x -> res*10 + x) 0
+
+satisfy :: (Char -> Bool) -> Parser Char
+satisfy f = Parser $ \inp ->
+  case inp of
+    a:rem -> if f a then Ok a rem
+             else Err
+    _ -> Err
+
+--------------------------------------------------
+
+{- Primitive combinators -}
+  
+char :: Char -> Parser Char
+char a = satisfy (==a)
+
+digit :: Parser Char
+digit = satisfy Data.Char.isDigit
+
+nat :: Parser String
+nat = some digit
+
+spaces :: Parser String
+spaces = many $ satisfy (==' ') 
+
+string :: String -> Parser String
+string str = traverse char str
+
+choice :: [Parser a] -> Parser a
+choice ps = case ps of
+  [] -> empty
+  p:ps -> p <|> (choice ps)
+
+-- For left-associative operations
+chainl :: Parser a -> Parser (a -> a -> a) -> Parser a
+chainl p op = do {
+    x <- p
+  ; rest x
+  }
+ where
+  rest x = do {
+    f <- op
+  ; y <- p
+  ; rest (f x y)
+  } <|> return x

haskell/Imp/Stmt.hs

@@ -0,0 +1,31 @@
+module Expr where
+
+import qualified AExpr as AE
+import qualified BExpr as BE
+import qualified Dict
+
+data Stmt
+  = Skip
+  | Assign String AE.E
+  | Seq Stmt Stmt
+  | If BE.E Stmt Stmt
+  | While BE.E Stmt
+
+type Env = [(String, Int)]  
+
+eval :: Env -> Stmt -> Env 
+eval env st = case st of
+  Skip -> env
+  Assign var e ->
+    Dict.set env var (AE.eval e)
+  Seq s1 s2 -> 
+    let env' = eval env s1 in
+    eval env' s2
+  If b s1 s2 -> 
+    if BE.eval b then eval env s1
+    else eval env s2
+  While b st -> 
+    if BE.eval b then
+      let env' = eval env st in
+      eval env' (While b st)
+    else env