bergamot-elm/src/Bergamot/Parser.elm

module Bergamot.Parser exposing (..)

import Bergamot.Syntax exposing (Term(..), Metavariable(..))
import Bergamot.Rules exposing (Rule, RuleEnv)

import Parser exposing (Parser, Trailing(..), (|.), (|=))
import Set

intLit : Parser Int
intLit = Parser.int

decodeStr : String -> String
decodeStr str =
    let
        go l =
            case l of
                '\\' :: 'n' :: rest -> '\n' :: go rest
                '\\' :: '\\' :: rest -> '\\' :: go rest
                '\\' :: '"' :: rest -> '"' :: go rest
                '\\' :: c :: rest -> c :: go rest
                c :: rest -> c :: go rest
                [] -> []
        noQuotes = String.dropLeft 1 <| String.dropRight 1 <| str
    in
        String.fromList (go (String.toList str))

strLit : Parser String
strLit =
    let
        char = Parser.map decodeStr <| Parser.getChompedString <|
            Parser.oneOf
                [ Parser.backtrackable <|
                    Parser.chompIf (\c -> c == '\\')
                    |. Parser.chompIf (\c -> True)
                , Parser.backtrackable <| Parser.chompIf (\c -> c /= '"')
                ]
    in
        Parser.map (String.join "") <| Parser.sequence
            { start = "\""
            , separator = ""
            , end = "\""
            , spaces = Parser.succeed ()
            , item = char
            , trailing = Optional
            }


name : Parser String
name = Parser.variable
    { start = \c -> Char.isAlphaNum c || c == '_'
    , inner = \c -> Char.isAlphaNum c || c == '_'
    , reserved = Set.empty
    }

variable : Parser Metavariable
variable =
    Parser.succeed MkMetavariable
    |= Parser.variable
        { start = \c -> c == '?'
        , inner = \c -> Char.isAlphaNum c || c == '_'
        , reserved = Set.empty
        }

term : Parser (Term Metavariable)
term = Parser.lazy (\() -> Parser.oneOf
    [ Parser.backtrackable <|
      Parser.succeed Call
        |= name
        |= Parser.sequence
            { start = "("
            , separator = ","
            , end = ")"
            , spaces = Parser.spaces
            , item = term
            , trailing = Forbidden
            }
    , Parser.backtrackable
        <| Parser.map (List.foldr (\x xs -> Call "cons" [x, xs]) (Call "nil" []))
        <| Parser.sequence
            { start = "["
            , separator = ","
            , end = "]"
            , spaces = Parser.spaces
            , item = term
            , trailing = Forbidden
            }
    , Parser.backtrackable <|
      Parser.succeed (\n -> Call n [])
        |= name
    , Parser.backtrackable <|
      Parser.succeed Var |= variable
    , Parser.succeed IntLit |= intLit
    , Parser.succeed StringLit |= strLit
    ])

rule : Parser Rule
rule =
    let
        makeRule n c ps = { name = n, conclusion = c, premises = ps }
    in
        Parser.succeed makeRule
        |= name
        |. Parser.spaces |. Parser.symbol "@" |. Parser.spaces
        |= term
        |. Parser.spaces |. Parser.symbol "<-" |. Parser.spaces
        |= Parser.sequence
            { start = ""
            , separator = ","
            , end = ""
            , spaces = Parser.spaces
            , item = term
            , trailing = Forbidden
            }

program : Parser RuleEnv
program =
    Parser.succeed (\rs -> { rules = rs })
    |= Parser.sequence
        { start = ""
        , separator = ";"
        , end = ""
        , spaces = Parser.spaces
        , item = rule
        , trailing = Mandatory
        }
    |. Parser.end

run : Parser a -> String -> Maybe a
run prs s =
    case Parser.run prs s of
        Ok a -> Just a
        Err _ -> Nothing