Add sections to the language syntax

Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
This commit is contained in:
Danila Fedorin 2023-12-21 13:31:53 -08:00
parent 18d524a0d2
commit fd301806c6
3 changed files with 54 additions and 11 deletions

View File

@ -1,11 +1,14 @@
module Bergamot.Parser exposing (..) module Bergamot.Parser exposing (..)
import Bergamot.Syntax exposing (Term(..), Metavariable(..)) import Bergamot.Syntax exposing (Term(..), Metavariable(..))
import Bergamot.Rules exposing (Rule, RuleEnv) import Bergamot.Rules exposing (Rule, Section, RuleEnv)
import Bergamot.Utils exposing (decodeStr) import Bergamot.Utils exposing (decodeStr)
import Parser exposing (Parser, Trailing(..), (|.), (|=)) import Parser exposing (Parser, Trailing(..), (|.), (|=))
import Set import Set exposing (Set)
reserved : Set String
reserved = Set.fromList ["section"]
intLit : Parser Int intLit : Parser Int
intLit = Parser.int intLit = Parser.int
@ -35,7 +38,7 @@ name : Parser String
name = Parser.variable name = Parser.variable
{ start = \c -> Char.isAlpha c || c == '_' { start = \c -> Char.isAlpha c || c == '_'
, inner = \c -> Char.isAlphaNum c || c == '_' , inner = \c -> Char.isAlphaNum c || c == '_'
, reserved = Set.empty , reserved = reserved
} }
variable : Parser Metavariable variable : Parser Metavariable
@ -44,7 +47,7 @@ variable =
|= Parser.variable |= Parser.variable
{ start = \c -> c == '?' { start = \c -> c == '?'
, inner = \c -> Char.isAlphaNum c || c == '_' , inner = \c -> Char.isAlphaNum c || c == '_'
, reserved = Set.empty , reserved = reserved
} }
term : Parser (Term Metavariable) term : Parser (Term Metavariable)
@ -97,16 +100,48 @@ rule =
, item = term , item = term
, trailing = Forbidden , trailing = Forbidden
} }
|. Parser.spaces |. Parser.symbol ";"
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 RuleEnv
program = program =
Parser.succeed (\rs -> { rules = rs }) Parser.succeed (\ss -> { sections = ss })
|= Parser.sequence |= Parser.sequence
{ start = "" { start = ""
, separator = ";" , separator = ""
, end = "" , end = ""
, spaces = Parser.spaces , spaces = Parser.spaces
, item = rule , item = Parser.oneOf [sectionExp, sectionImp]
, trailing = Mandatory , trailing = Mandatory
} }
|. Parser.end |. Parser.end

View File

@ -12,6 +12,11 @@ type alias Rule =
, premises : List (Term Metavariable) , premises : List (Term Metavariable)
} }
type alias Section =
{ name : String
, rules : List Rule
}
type ProofTree = MkProofTree type ProofTree = MkProofTree
{ name : String { name : String
, conclusion : Term UnificationVar , conclusion : Term UnificationVar
@ -19,7 +24,7 @@ type ProofTree = MkProofTree
} }
type alias RuleEnv = type alias RuleEnv =
{ rules : List Rule { sections : List Section
} }
type alias ProveState = type alias ProveState =
@ -71,6 +76,9 @@ yield p env ps = Search.yield (p env ps)
getEnv : Prover RuleEnv getEnv : Prover RuleEnv
getEnv env ps = Search.pure (env, ps) getEnv env ps = Search.pure (env, ps)
getRules : Prover (List Rule)
getRules env ps = Search.pure (List.concatMap (.rules) env.sections, ps)
getUnificationState : Prover UnificationState getUnificationState : Prover UnificationState
getUnificationState env ps = Search.pure (ps.unificationState, ps) getUnificationState env ps = Search.pure (ps.unificationState, ps)
@ -164,8 +172,8 @@ proveTerm t =
map (reify t) getUnificationState map (reify t) getUnificationState
|> andThen (\tp -> |> andThen (\tp ->
burn burn
|> andThen (\() -> getEnv) |> andThen (\() -> getRules)
|> andThen (\env -> List.foldl (\r -> interleave (yield (rule tp r))) (builtinRules tp) env.rules)) |> andThen (List.foldl (\r -> interleave (yield (rule tp r))) (builtinRules tp)))
prove : Term Metavariable -> Prover ProofTree prove : Term Metavariable -> Prover ProofTree
prove mt = prove mt =

View File

@ -87,7 +87,7 @@ viewRules : String -> String -> Html Msg
viewRules renderProgs progs = viewSection "Rendered Rules" <| viewRules renderProgs progs = viewSection "Rendered Rules" <|
Html.div [ class "bergamot-rule-list" ] <| Html.div [ class "bergamot-rule-list" ] <|
case (run program renderProgs, run program progs) of case (run program renderProgs, run program progs) of
(Just renderProg, Just prog) -> List.filterMap (viewRule renderProg) prog.rules (Just renderProg, Just prog) -> List.filterMap (viewRule renderProg) (List.concatMap .rules prog.sections)
_ -> [] _ -> []
proofGoal : EditMode -> String -> Maybe (Term Metavariable) proofGoal : EditMode -> String -> Maybe (Term Metavariable)