Build with stack

1 files changed, 0 insertions, 240 deletions

diff --git a/parser.hs b/parser.hs
deleted file mode 100644
index 636c04f..0000000
--- a/parser.hs
+++ /dev/null
@@ -1,240 +0,0 @@
-module Parser (parseExpression) where
-
-import Control.Applicative
-import Control.Monad
-import Data.Char
-import Data.Maybe
-
-import AST
-import Utility
-
-
-parseExpression :: String -> Either String AST
-parseExpression s = case parse pexpression s of
-    ((node,rest):_) -> case rest of
-        "" -> Right node
-        s -> Left $ "Cannot parse from '" ++ take 10 rest ++ "'"
-    _ -> Left "No valid parse"
-
-
-newtype Parser a = Parser (String -> [(a,String)])
-
-parse :: Parser a -> String -> [(a,String)]
-parse (Parser p) = p
-
-instance Functor Parser where
-    fmap f p = Parser (\cs -> map (\(a,s) -> (f a,s)) $ parse p cs)
-
-instance Applicative Parser where
-    pure x = Parser (\cs -> [(x,cs)])
-    (<*>) f p = Parser (\cs -> concat $
-        map (\(a,s) -> parse (fmap a p) s) $ parse f cs)
-
-instance Monad Parser where
-    p >>= f = Parser (\cs -> concat $
-        map (\(a,s) -> parse (f a) s) $ parse p cs)
-
-instance Alternative Parser where
-    empty = Parser (\_ -> [])
-    (<|>) p q = Parser (\cs -> parse p cs ++ parse q cs)
-
-instance MonadPlus Parser
-
-
---The deterministic choice operator: choose the first possibile parse (if
---available at all) from the results given by the two parsers.
---mplus is the non-deterministic choice operator; it would give all results.
-mplus1 :: Parser a -> Parser a -> Parser a
-mplus1 p q = Parser $ \cs -> case parse (mplus p q) cs of
-    [] -> []
-    (x:_) -> [x]
-
---(++) = mplus
-(+++) = mplus1
-
-
-pitem :: Parser Char
-pitem = Parser $ \s -> case s of
-    "" -> []
-    (c:cs) -> [(c,cs)]
-
-psat :: (Char -> Bool) -> Parser Char
-psat f = do
-    c <- pitem
-    if f c then return c else mzero
-
---checks that the next char satisfies the predicate; does NOT consume characters
-passert :: (Char -> Bool) -> Parser ()
-passert p = Parser $ \s -> case s of
-    "" -> []
-    (c:_) -> if p c then [((),s)] else []
-
-pchar :: Char -> Parser Char
-pchar c = psat (==c)
-
-pstring :: String -> Parser String
-pstring "" = return ""
-pstring (c:cs) = do
-    pchar c
-    pstring cs
-    return (c:cs)
-
-pmany :: Parser a -> Parser [a]
-pmany p = pmany1 p +++ return []
-
-pmany1 :: Parser a -> Parser [a]
-pmany1 p = do
-    a <- p
-    as <- pmany p
-    return (a:as)
-
-pinteger :: Parser Int
-pinteger = do
-    s <- pmany $ psat isDigit
-    return $ read s
-
-pdouble :: Parser Double
-pdouble = Parser reads
-
-pquotstring :: Parser String
-pquotstring = Parser reads
-
-poptws :: Parser String
-poptws = Parser $ pure . span isSpace
-
-pws :: Parser String
-pws = Parser $ \s -> case span isSpace s of
-    ("",_) -> []
-    tup@(_,_) -> [tup]
-
-pword :: Parser String
-pword = do
-    c <- psat $ options [isAlpha,(=='_')]
-    cs <- pmany $ psat $ options [isAlpha,isDigit,(=='_')]
-    return (c:cs)
-
-
-pnumber :: Parser AST
-pnumber = liftM Number pdouble
-
-pvariable :: Parser AST
-pvariable = liftM Variable $ pstring "PI" +++ (liftM pure (psat isAlpha))
-
-pinfixoperator :: (Char,Char)  -- +/- symbols
-               -> Parser AST  -- term parser
-               -> ([AST] -> AST)  -- Sum constructor
-               -> (AST -> AST)  -- Negative constructor
-               -> Bool  -- whether the plus sign is optional
-               -> Bool  -- whether a negative sign cannot follow after a term
-               -> Parser AST  -- Resulting parser
-pinfixoperator (plus,minus) pterm sumconstr negconstr plusopt noneg = do
-    term <- pterm
-    pmoreterms term +++ return (sumconstr [term])
-    where
-        pmoreterms term = if plusopt
-            then pmoretermsplus term +++ pmoretermsminus term +++ pmoretermsnothing term
-            else pmoretermsplus term +++ pmoretermsminus term
-
-        pmoretermsplus term = do
-            poptws
-            pchar plus
-            poptws
-            nextterm <- pterm
-            let thissum = sumconstr [term,nextterm]
-            pmoreterms thissum +++ return thissum
-        pmoretermsminus term = do
-            poptws
-            pchar minus
-            poptws
-            nextterm <- pterm
-            let thissum = sumconstr [term,negconstr nextterm]
-            pmoreterms thissum +++ return thissum
-        pmoretermsnothing term = do
-            poptws
-            if noneg then passert (/='-') else return ()
-            nextterm <- pterm
-            let thissum = sumconstr [term,nextterm]
-            pmoreterms thissum +++ return thissum
-
-psum :: Parser AST
-psum = do
-    poptws
-    res <- pinfixoperator ('+','-') pproduct Sum Negative False False
-    poptws
-    return res
-
-pproduct :: Parser AST
-pproduct = pinfixoperator ('*','/') pfactor Product Reciprocal True True
-
-pfactor :: Parser AST
-pfactor = pnegative +++ pfactornoneg +++ pcapture +++ pcaptureterm
-
-pnegative :: Parser AST
-pnegative = do {pchar '-'; poptws; f <- pfactor; return $ Negative f} +++ pfactornoneg
-
-pfactornoneg :: Parser AST
-pfactornoneg = do
-    fact <- pnumber +++ pparenthetical +++ pfunctioncall +++ pvariable
-    ppower fact +++ pfactorial fact +++ return fact
-    where
-        ppower fact = do
-            poptws
-            pchar '^'
-            poptws
-            fact2 <- pfactornoneg
-            return $ Apply "pow" [fact,fact2]
-        pfactorial fact = do
-            poptws
-            pchar '!'
-            return $ Apply "fact" [fact]
-
-
-pparenthetical :: Parser AST
-pparenthetical = do
-    pchar '('
-    poptws
-    sum <- psum
-    poptws
-    pchar ')'
-    return sum
-
-pfunctioncall :: Parser AST
-pfunctioncall = do
-    name <- pword
-    poptws
-    pchar '('
-    poptws
-    args <- parglist
-    poptws
-    pchar ')'
-    return $ Apply name args
-    where
-        parglist = do
-            arg <- parg
-            poptws
-            pmoreargs arg +++ return [arg]
-        pmoreargs arg = do
-            pchar ','
-            poptws
-            args <- parglist
-            return (arg:args)
-        parg = pexpression
-
-pcapture :: Parser AST
-pcapture = do
-    pchar '['
-    name <- pmany1 $ psat (/=']')
-    pchar ']'
-    return $ Capture name
-
-pcaptureterm :: Parser AST
-pcaptureterm = do
-    pchar '['
-    pchar '['
-    name <- pmany1 $ psat (/=']')
-    pchar ']'
-    pchar ']'
-    return $ CaptureTerm name
-
-pexpression :: Parser AST
-pexpression = psum