diff options
Diffstat (limited to 'lambda-calcul/haskell/src')
| -rw-r--r-- | lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs | 12 |
1 files changed, 11 insertions, 1 deletions
diff --git a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs index f18ac74..28da47f 100644 --- a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs +++ b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs @@ -1,8 +1,12 @@ +{-# LANGUAGE LambdaCase #-} + module Minilang.Lambda.Parser where import Control.Applicative (Alternative (many), (<|>)) import Data.Bifunctor (first) -import Data.Text (Text, pack) +import qualified Data.List as List +import Data.Text (Text, intersperse, pack) +import qualified Data.Text as Text import Data.Void (Void) import Text.Megaparsec (Parsec, between, empty, errorBundlePretty, manyTill, notFollowedBy, optional, parse, try) import Text.Megaparsec.Char (alphaNumChar, char, letterChar, space1, string, symbolChar) @@ -16,6 +20,12 @@ data ParseError = ParseError Text data AST = Sym Text | Abs [Text] AST | App AST AST [AST] deriving (Eq, Show) +pretty :: AST -> Text +pretty = \case + Sym sym -> sym + Abs bound body -> "(lam (" <> Text.unwords bound <> ") " <> pretty body <> ")" + App x y rest -> "(" <> mconcat (List.intersperse " " (pretty <$> (x : y : rest))) <> ")" + parse :: Text -> Either ParseError AST parse = first (ParseError . pack . errorBundlePretty) . Text.Megaparsec.parse ast "" |