154 lines
4.1 KiB
Elm
154 lines
4.1 KiB
Elm
module Bergamot.Parser exposing (..)
|
|
|
|
import Bergamot.Syntax exposing (Term(..), Metavariable(..))
|
|
import Bergamot.Rules exposing (Rule, Section, RuleEnv)
|
|
import Bergamot.Utils exposing (decodeStr)
|
|
|
|
import Parser exposing (Parser, Trailing(..), (|.), (|=))
|
|
import Set exposing (Set)
|
|
|
|
reserved : Set String
|
|
reserved = Set.fromList ["section"]
|
|
|
|
intLit : Parser Int
|
|
intLit = Parser.int
|
|
|
|
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.isAlpha c || c == '_'
|
|
, inner = \c -> Char.isAlphaNum c || c == '_'
|
|
, reserved = reserved
|
|
}
|
|
|
|
variable : Parser Metavariable
|
|
variable =
|
|
Parser.succeed MkMetavariable
|
|
|= Parser.variable
|
|
{ start = \c -> c == '?'
|
|
, inner = \c -> Char.isAlphaNum c || c == '_'
|
|
, reserved = reserved
|
|
}
|
|
|
|
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
|
|
}
|
|
|. Parser.spaces |. Parser.symbol ";" |. Parser.spaces
|
|
|
|
rules : Parser (List Rule)
|
|
rules = Parser.sequence
|
|
{ start = ""
|
|
, separator = ""
|
|
, end = ""
|
|
, spaces = Parser.spaces
|
|
, item = rule
|
|
, trailing = Optional
|
|
}
|
|
|
|
sectionExp : Parser Section
|
|
sectionExp =
|
|
Parser.succeed (\n rs -> { name = n, rules = rs })
|
|
|. Parser.symbol "section" |. Parser.spaces
|
|
|= strLit |. Parser.spaces
|
|
|. Parser.symbol "{" |. Parser.spaces
|
|
|= rules
|
|
|. Parser.symbol "}" |. Parser.spaces
|
|
|
|
sectionImp : Parser Section
|
|
sectionImp =
|
|
(\rs ->
|
|
Parser.oneOf
|
|
[ rule |> Parser.map (\r -> Parser.Loop <| r :: rs)
|
|
, case rs of
|
|
[] -> Parser.problem "empty implicit sections not allowed."
|
|
_ -> Parser.succeed (Parser.Done <| List.reverse rs)
|
|
])
|
|
|> Parser.loop []
|
|
|> Parser.map (\rs -> { name = "", rules = rs })
|
|
|
|
program : Parser RuleEnv
|
|
program =
|
|
Parser.succeed (\ss -> { sections = ss })
|
|
|= Parser.sequence
|
|
{ start = ""
|
|
, separator = ""
|
|
, end = ""
|
|
, spaces = Parser.spaces
|
|
, item = Parser.oneOf [sectionExp, sectionImp]
|
|
, 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
|