Inital commit

prover.hs

@@ -0,0 +1,78 @@
+{-# LANGUAGE LambdaCase #-}
+
+import Data.Char
+
+---------------- Parser declerations ---------------------------
+
+
+newtype Parser a = P (String -> [(a,String)])
+
+apply :: Parser a -> String -> [(a,String)]
+apply (P p) = p
+
+instance Functor Parser where
+  -- fmap :: (a -> b) -> Parser a -> Parser b
+  fmap g p = P (\s -> case apply p s of
+                        []        -> []
+                        [(v,out)] -> [(g v, out)])
+
+
+instance Applicative Parser where
+  -- pure :: a -> Parser a
+  pure v = P (\inp -> [(v,inp)])
+
+  -- <*> :: Parser (a -> b) -> Parser a -> Parser b
+  pg <*> px = P (\inp -> case apply pg inp of
+                           []        -> []
+                           [(g,out)] -> apply (fmap g px) out)
+
+instance Monad Parser where
+  -- (>>=) :: Parser a -> (a -> Parser b) -> Parser b
+  p >>= f = P (\s -> case apply p s of
+                       [] -> []
+                       [(g, left)] -> apply (f g) left)
+
+(<|>) :: Parser a -> Parser a -> Parser a
+p <|> q = P (\s -> let ps = apply p s in
+                     if null ps
+                       then apply q s
+                       else ps)
+
+item :: Parser Char
+item = P (\case
+            []     -> []
+            (x:xs) -> [(x,xs)])
+
+
+none :: Parser [a]
+none = return []
+
+sat :: (Char -> Bool) -> Parser Char
+sat p = do x <- item
+           if p x then return x else parse_fail
+
+parse_fail :: Parser a
+parse_fail = P (const [])
+
+some :: Parser a -> Parser [a]
+-- some p = do x <- p
+            -- xs <- some p
+            -- return (x:xs)
+
+some p = p >>= (\x -> some p >>= (\xs -> return (x : xs)))
+
+optional :: Parser [a] -> Parser [a]
+optional = (<|> none)
+
+many :: Parser a -> Parser [a]
+many = optional . some
+
+----------------- Calculator -----------------------------------
+
+newtype Expr = Compose [Atom] deriving Eq
+data Atom = Var VarName | Con ConName [Expr]
+  deriving Eq
+
+type VarName = String
+type ConName = String
+