67 lines
3.0 KiB
Plaintext
67 lines
3.0 KiB
Plaintext
module Test.Main where
|
|
|
|
import Prelude
|
|
import Language.Bergamot.Syntax
|
|
import Control.Monad.Logic.Trans
|
|
import Control.Monad.Logic.Class
|
|
import Control.Monad.Unify.Trans
|
|
import Control.Monad.Unify.Class
|
|
import Data.List
|
|
import Data.Maybe
|
|
|
|
rules :: Array (Rule Metavariable)
|
|
rules =
|
|
[ MkRule { name: "TInt", head: tType tIntExpr tInt, tail: Nil }
|
|
, MkRule { name: "TString", head: tType tStringExpr tString, tail: Nil }
|
|
, MkRule { name: "TPlusInt", head: tType (tPlusExpr (Var "e1") (Var "e2")) tInt, tail: fromFoldable
|
|
[ tType (Var "e1") tInt
|
|
, tType (Var "e2") tInt
|
|
] }
|
|
, MkRule { name: "TPlusString", head: tType (tPlusExpr (Var "e1") (Var "e2")) tString, tail: fromFoldable
|
|
[ tType (Var "e1") tString
|
|
, tType (Var "e2") tString
|
|
] }
|
|
, MkRule { name: "TPair", head: tType (tProdExpr (Var "e1") (Var "e2")) (tProd (Var "t1") (Var "t2")), tail: fromFoldable
|
|
[ tType (Var "e1") (Var "t1")
|
|
, tType (Var "e2") (Var "t2")
|
|
] }
|
|
, MkRule { name: "TFst", head: tType (tFstExpr (Var "e")) (Var "t1"), tail: fromFoldable
|
|
[ tType (Var "e") (tProd (Var "t1") (Var "t2"))
|
|
] }
|
|
, MkRule { name: "TSnd", head: tType (tSndExpr (Var "e")) (Var "t2"), tail: fromFoldable
|
|
[ tType (Var "e") (tProd (Var "t1") (Var "t2"))
|
|
] }
|
|
]
|
|
|
|
tType et tt = Atom "type" $ et : tt : Nil
|
|
tInt = Atom "int" Nil
|
|
tString = Atom "string" Nil
|
|
tProd t1 t2 = Atom "prod" $ t1 : t2 : Nil
|
|
tIntExpr = Atom "n" Nil
|
|
tStringExpr = Atom "s" Nil
|
|
tPlusExpr et1 et2 = Atom "plus" $ et1 : et2 : Nil
|
|
tProdExpr et1 et2 = Atom "pair" $ et1 : et2 : Nil
|
|
tFstExpr et = Atom "fst" $ et : Nil
|
|
tSndExpr et = Atom "snd" $ et : Nil
|
|
|
|
toLatexExpr :: Expr IntVar -> String
|
|
toLatexExpr (Atom "type" (t1 : t2 : Nil)) = toLatexExpr t1 <> " : " <> toLatexExpr t2
|
|
toLatexExpr (Atom "int" Nil) = "\\text{int}"
|
|
toLatexExpr (Atom "string" Nil) = "\\text{string}"
|
|
toLatexExpr (Atom "prod" (t1 : t2 : Nil)) = toLatexExpr t1 <> "\\times" <> toLatexExpr t2
|
|
toLatexExpr (Atom "n" Nil) = "n"
|
|
toLatexExpr (Atom "s" Nil) = "s"
|
|
toLatexExpr (Atom "plus" (t1 : t2 : Nil)) = toLatexExpr t1 <> " + " <> toLatexExpr t2
|
|
toLatexExpr (Atom "pair" (t1 : t2 : Nil)) = "(" <> toLatexExpr t1 <> ", " <> toLatexExpr t2 <> ")"
|
|
toLatexExpr (Atom "fst" (t : Nil)) = "\\text{fst}\\ " <> toLatexExpr t
|
|
toLatexExpr (Atom "snd" (t : Nil)) = "\\text{snd}\\ " <> toLatexExpr t
|
|
toLatexExpr (Atom s xs) = "\\text{" <> s <> "}(" <> intercalate ", " (toLatexExpr <$> xs) <> ")"
|
|
toLatexExpr (Var _) = "?"
|
|
|
|
toLatexProofTree :: ProofTree IntVar -> String
|
|
toLatexProofTree (MkProofTree {claim, witnesses}) = "\\cfrac{" <> intercalate "\\quad" (toLatexProofTree <$> witnesses) <> "}{" <> toLatexExpr claim <> "}"
|
|
|
|
main :: Maybe String
|
|
main = map toLatexProofTree $ runUnifier rules $ query $ tType (Var "e") (tProd tInt (tProd tInt tString))
|
|
-- main = map toLatexProofTree $ runUnifier rules $ query $ tType (tSndExpr (tProdExpr tStringExpr (tPlusExpr tIntExpr tIntExpr))) (Var "T")
|