hw11/SExpr.hs

   1 {- CIS 194 HW 11
   2    due Monday, 8 April
   3 -}
   4
   5 module SExpr where
   6
   7 import AParser
   8 import Control.Applicative
   9 import Data.Char(isSpace, isAlpha, isAlphaNum)
  10
  11 ------------------------------------------------------------
  12 --  1. Parsing repetitions
  13 ------------------------------------------------------------
  14 sequenceA  :: Applicative f => [f a] -> f [a]
  15 sequenceA [] = pure []
  16 sequenceA (x:xs) = (:) <$> x <*> sequenceA xs
  17 -- sequenceA (x:xs) = liftA2 (:) x (sequenceA xs)
  18
  19 replicateA :: Applicative f => Int -> f a -> f [a]
  20 replicateA n x = sequenceA (replicate n x)
  21
  22 zeroOrMore :: Parser a -> Parser [a]
  23 zeroOrMore p = oneOrMore p <|> pure []
  24
  25 oneOrMore :: Parser a -> Parser [a]
  26 oneOrMore p = liftA2 (:) p (zeroOrMore p)
  27
  28 ------------------------------------------------------------
  29 --  2. Utilities
  30 ------------------------------------------------------------
  31
  32 spaces :: Parser String
  33 spaces = zeroOrMore (satisfy isSpace)
  34
  35 ident :: Parser String
  36 ident = liftA2 (:) (satisfy isAlpha) (zeroOrMore (satisfy isAlphaNum))
  37
  38 ------------------------------------------------------------
  39 --  3. Parsing S-expressions
  40 ------------------------------------------------------------
  41
  42 -- An "identifier" is represented as just a String; however, only
  43 -- those Strings consisting of a letter followed by any number of
  44 -- letters and digits are valid identifiers.
  45 type Ident = String
  46
  47 -- An "atom" is either an integer value or an identifier.
  48 data Atom = N Integer | I Ident
  49   deriving Show
  50
  51 -- An S-expression is either an atom, or a list of S-expressions.
  52 data SExpr = A Atom
  53            | Comb [SExpr]
  54   deriving Show
  55
  56 parseAtom :: Parser Atom
  57 parseAtom = spaces *> (N <$> posInt <|>
  58                        I <$> ident) <* spaces
  59
  60 parseSExpr :: Parser SExpr
  61 parseSExpr = A <$> parseAtom <|>
  62              Comb <$> parseComb
  63   where
  64     parseComb =  spaces *> char '(' *> oneOrMore parseSExpr <* spaces <* char ')' <* spaces