-----------------------------------------------------------------------
--
--  Haskell: The Craft of Functional Programming
--  Simon Thompson
--  (c) Addison-Wesley, 1996-2011.
--
--  CalcParse.hs
--
--  Parsing expressions and commands
--
-----------------------------------------------------------------------

module CalcParse where

import Data.Char

import CalcTypes
import CalcParseLib

-- A parser for expressions                 
--  
--  
-- The parser has three components, corresponding to the three  
-- clauses in the definition of the syntactic type.     
--  
parseExpr :: Parse Char Expr
parseExpr :: Parse Char Expr
parseExpr = (Parse Char Expr
litParse Parse Char Expr -> Parse Char Expr -> Parse Char Expr
forall a b. Parse a b -> Parse a b -> Parse a b
`alt` Parse Char Expr
varParse) Parse Char Expr -> Parse Char Expr -> Parse Char Expr
forall a b. Parse a b -> Parse a b -> Parse a b
`alt` Parse Char Expr
opExpParse
--  
-- Spotting variables.                      
--  
varParse :: Parse Char Expr
varParse :: Parse Char Expr
varParse = (Char -> Bool) -> Parse Char Char
forall a. (a -> Bool) -> Parse a a
spot Char -> Bool
isVar Parse Char Char -> (Char -> Expr) -> Parse Char Expr
forall a b c. Parse a b -> (b -> c) -> Parse a c
`build` Char -> Expr
Var

isVar :: Char -> Bool
isVar :: Char -> Bool
isVar Char
x = (Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z')
--  
-- Parsing (fully bracketed) operator applications.     
--  
opExpParse :: Parse Char Expr
opExpParse 
  = (Char -> Parse Char Char
forall a. Eq a => a -> Parse a a
token Char
'(' Parse Char Char
-> Parse Char (Expr, (Char, (Expr, Char)))
-> Parse Char (Char, (Expr, (Char, (Expr, Char))))
forall a b c. Parse a b -> Parse a c -> Parse a (b, c)
>*>
     Parse Char Expr
parseExpr Parse Char Expr
-> Parse Char (Char, (Expr, Char))
-> Parse Char (Expr, (Char, (Expr, Char)))
forall a b c. Parse a b -> Parse a c -> Parse a (b, c)
>*>
     (Char -> Bool) -> Parse Char Char
forall a. (a -> Bool) -> Parse a a
spot Char -> Bool
isOp Parse Char Char
-> Parse Char (Expr, Char) -> Parse Char (Char, (Expr, Char))
forall a b c. Parse a b -> Parse a c -> Parse a (b, c)
>*>
     Parse Char Expr
parseExpr Parse Char Expr -> Parse Char Char -> Parse Char (Expr, Char)
forall a b c. Parse a b -> Parse a c -> Parse a (b, c)
>*>
     Char -> Parse Char Char
forall a. Eq a => a -> Parse a a
token Char
')') 
     Parse Char (Char, (Expr, (Char, (Expr, Char))))
-> ((Char, (Expr, (Char, (Expr, Char)))) -> Expr)
-> Parse Char Expr
forall a b c. Parse a b -> (b -> c) -> Parse a c
`build` (Char, (Expr, (Char, (Expr, Char)))) -> Expr
forall {a} {b}. (a, (Expr, (Char, (Expr, b)))) -> Expr
makeExpr

makeExpr :: (a, (Expr, (Char, (Expr, b)))) -> Expr
makeExpr (a
_,(Expr
e1,(Char
bop,(Expr
e2,b
_)))) = Ops -> Expr -> Expr -> Expr
Op (Char -> Ops
charToOp Char
bop) Expr
e1 Expr
e2

isOp :: Char -> Bool
isOp :: Char -> Bool
isOp Char
ch = Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
ch [Char]
"+-*/%"

charToOp :: Char -> Ops
charToOp :: Char -> Ops
charToOp Char
ch 
  = case Char
ch of
      Char
'+' -> Ops
Add
      Char
'-' -> Ops
Sub
      Char
'*' -> Ops
Mul
      Char
'/' -> Ops
Div
      Char
'%' -> Ops
Mod

--  
-- A number is a list of digits with an optional ~ at the front. 
--  
litParse :: Parse Char Expr
litParse 
  = ((Parse Char Char -> Parse Char [Char]
forall a b. Parse a b -> Parse a [b]
optional (Char -> Parse Char Char
forall a. Eq a => a -> Parse a a
token Char
'~')) Parse Char [Char]
-> Parse Char [Char] -> Parse Char ([Char], [Char])
forall a b c. Parse a b -> Parse a c -> Parse a (b, c)
>*>
     (Parse Char Char -> Parse Char [Char]
forall a b. Parse a b -> Parse a [b]
neList ((Char -> Bool) -> Parse Char Char
forall a. (a -> Bool) -> Parse a a
spot Char -> Bool
isDigit)))
     Parse Char ([Char], [Char])
-> (([Char], [Char]) -> Expr) -> Parse Char Expr
forall a b c. Parse a b -> (b -> c) -> Parse a c
`build` ([Char] -> Expr
charListToExpr([Char] -> Expr)
-> (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Char], [Char]) -> [Char]
forall {a}. ([a], [a]) -> [a]
join) 
     where
     join :: ([a], [a]) -> [a]
join = ([a] -> [a] -> [a]) -> ([a], [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)

-- Converting strings representing numbers into numbers
--  
charListToExpr :: [Char] -> Expr
charListToExpr :: [Char] -> Expr
charListToExpr = Integer -> Expr
Lit (Integer -> Expr) -> ([Char] -> Integer) -> [Char] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Integer
charListToInt 

charListToInt :: [Char] -> Integer
charListToInt :: [Char] -> Integer
charListToInt (Char
'~':[Char]
rest) = - ([Char] -> Integer
charListToNat [Char]
rest)
charListToInt [Char]
other = [Char] -> Integer
charListToNat [Char]
other

charListToNat :: [Char] -> Integer
charListToNat :: [Char] -> Integer
charListToNat [] = Integer
0
charListToNat (Char
ch:[Char]
rest) 
  = Char -> Integer
charToNat Char
ch Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
rest) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ [Char] -> Integer
charListToNat [Char]
rest

charToNat :: Char -> Integer
charToNat :: Char -> Integer
charToNat Char
ch =
    Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$
              if Int
nch Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10 
                 then Int
nch Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n0
                 else Int
n0
              where
                nch :: Int
nch = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
ch 
                n0 :: Int
n0  = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'0'                      

--  
-- The top-level parser                     
--  
-- the b value is the result to be returned if there's no successful parse
-- otherwise return the result of the first successful parse

topLevel :: Parse a b -> b -> [a] -> b
topLevel :: forall a b. Parse a b -> b -> [a] -> b
topLevel Parse a b
p b
defaultVal [a]
inp
  = case [b]
results of
      [] -> b
defaultVal
      [b]
_  -> [b] -> b
forall a. HasCallStack => [a] -> a
head [b]
results
    where
    results :: [b]
results = [ b
found | (b
found,[]) <- Parse a b
p [a]
inp ]

-- A parse for the type of commands.                        
--  

parseCommand :: Parse Char Command
parseCommand :: Parse Char Command
parseCommand 
  = ((Parse Char Expr
parseExpr Parse Char Expr -> (Expr -> Command) -> Parse Char Command
forall a b c. Parse a b -> (b -> c) -> Parse a c
`build` Expr -> Command
Eval)
    Parse Char Command -> Parse Char Command -> Parse Char Command
forall a b. Parse a b -> Parse a b -> Parse a b
`alt`
    ((((Char -> Bool) -> Parse Char Char
forall a. (a -> Bool) -> Parse a a
spot Char -> Bool
isVar) Parse Char Char
-> Parse Char (Char, Expr) -> Parse Char (Char, (Char, Expr))
forall a b c. Parse a b -> Parse a c -> Parse a (b, c)
>*> 
     (Char -> Parse Char Char
forall a. Eq a => a -> Parse a a
token Char
':') Parse Char Char -> Parse Char Expr -> Parse Char (Char, Expr)
forall a b c. Parse a b -> Parse a c -> Parse a (b, c)
>*> 
     Parse Char Expr
parseExpr) Parse Char (Char, (Char, Expr))
-> ((Char, (Char, Expr)) -> Command) -> Parse Char Command
forall a b c. Parse a b -> (b -> c) -> Parse a c
`build` (Char, (Char, Expr)) -> Command
forall {a}. (Char, (a, Expr)) -> Command
makeComm))
     Parse Char Command -> Parse Char Command -> Parse Char Command
forall a b. Parse a b -> Parse a b -> Parse a b
`alt`
     Command -> Parse Char Command
forall b a. b -> Parse a b
endOfInput Command
Null

makeComm :: (Char, (a, Expr)) -> Command
makeComm (Char
v,(a
_,Expr
e)) = Char -> Expr -> Command
Assign Char
v Expr
e

-- This is the function which gets used in a top-level interaction.....

calcLine :: String -> Command

calcLine :: [Char] -> Command
calcLine = Parse Char Command -> Command -> [Char] -> Command
forall a b. Parse a b -> b -> [a] -> b
topLevel Parse Char Command
parseCommand Command
Null
--  

opExpParseM :: SParse Char Expr

opExpParseM :: SParse Char Expr
opExpParseM =
    do
      Char -> SParse Char Char
tokenM Char
'('
      Expr
e1 <- SParse Char Expr
parseExprM 
      Char
bop <- (Char -> Bool) -> SParse Char Char
forall {b}. (b -> Bool) -> SParse b b
spotM Char -> Bool
isOp
      Expr
e2 <- SParse Char Expr
parseExprM
      Char -> SParse Char Char
tokenM Char
')'
      Expr -> SParse Char Expr
forall a. a -> SParse Char a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ops -> Expr -> Expr -> Expr
Op (Char -> Ops
charToOp Char
bop) Expr
e1 Expr
e2)

tokenM :: Char -> SParse Char Char
tokenM = Parse Char Char -> SParse Char Char
forall a b. Parse a b -> SParse a b
SParse (Parse Char Char -> SParse Char Char)
-> (Char -> Parse Char Char) -> Char -> SParse Char Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Parse Char Char
forall a. Eq a => a -> Parse a a
token
spotM :: (b -> Bool) -> SParse b b
spotM  = Parse b b -> SParse b b
forall a b. Parse a b -> SParse a b
SParse (Parse b b -> SParse b b)
-> ((b -> Bool) -> Parse b b) -> (b -> Bool) -> SParse b b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Bool) -> Parse b b
forall a. (a -> Bool) -> Parse a a
spot
parseExprM :: SParse Char Expr
parseExprM = Parse Char Expr -> SParse Char Expr
forall a b. Parse a b -> SParse a b
SParse Parse Char Expr
parseExpr