159 lines
4.3 KiB
Elm
159 lines
4.3 KiB
Elm
module Bergamot.ObjectLanguage exposing (..)
|
|
|
|
import Bergamot.Syntax as Syntax exposing (Metavariable)
|
|
import Bergamot.Parser exposing (strLit)
|
|
|
|
import Parser exposing (Parser, Trailing(..), (|.), (|=))
|
|
import Set
|
|
|
|
type Type
|
|
= TInt
|
|
| TStr
|
|
| TPair Type Type
|
|
| TArr Type Type
|
|
|
|
type Expr
|
|
= IntLit Int
|
|
| FloatLit Float
|
|
| StrLit String
|
|
| Plus Expr Expr
|
|
| Pair Expr Expr
|
|
| Fst Expr
|
|
| Snd Expr
|
|
| Abs String Type Expr
|
|
| App Expr Expr
|
|
| Ref String
|
|
|
|
parenthed : Parser a -> Parser a
|
|
parenthed val = Parser.succeed (\x -> x)
|
|
|. Parser.symbol "("
|
|
|. Parser.spaces
|
|
|= val
|
|
|. Parser.spaces
|
|
|. Parser.symbol ")"
|
|
|
|
pair : Parser a -> Parser (a, a)
|
|
pair elem = parenthed <|
|
|
Parser.succeed Tuple.pair
|
|
|= elem
|
|
|. Parser.spaces
|
|
|. Parser.symbol ","
|
|
|. Parser.spaces
|
|
|= elem
|
|
|
|
type_ : Parser Type
|
|
type_ = Parser.lazy <| \() -> Parser.oneOf
|
|
[ Parser.backtrackable <| Parser.succeed TArr
|
|
|= typeBasic
|
|
|. Parser.spaces
|
|
|. Parser.symbol "->"
|
|
|. Parser.spaces
|
|
|= type_
|
|
, typeBasic
|
|
]
|
|
|
|
typeBasic : Parser Type
|
|
typeBasic = Parser.lazy <| \() -> Parser.oneOf
|
|
[ Parser.succeed TInt |. Parser.keyword "number"
|
|
, Parser.succeed TStr |. Parser.keyword "string"
|
|
, Parser.backtrackable <| Parser.map (\(a, b) -> TPair a b) <| pair type_
|
|
, parenthed type_
|
|
]
|
|
|
|
variable : Parser String
|
|
variable = Parser.variable
|
|
{ start = Char.isAlphaNum
|
|
, inner = Char.isAlphaNum
|
|
, reserved = Set.fromList ["fst", "snd", "let", "in"]
|
|
}
|
|
|
|
expr : Parser Expr
|
|
expr = Parser.lazy <| \() -> Parser.oneOf
|
|
[ Parser.backtrackable <| Parser.succeed Plus
|
|
|= exprBasic
|
|
|. Parser.spaces
|
|
|. Parser.symbol "+"
|
|
|. Parser.spaces
|
|
|= expr
|
|
, exprApps
|
|
]
|
|
|
|
topLevelExpr : Parser Expr
|
|
topLevelExpr = expr |. Parser.end
|
|
|
|
exprApps : Parser Expr
|
|
exprApps =
|
|
let
|
|
handle l =
|
|
case l of
|
|
[] -> Parser.problem "no applications found"
|
|
x :: xs -> Parser.succeed <| List.foldl (\a b -> App b a) x xs
|
|
in
|
|
Parser.sequence
|
|
{ start = ""
|
|
, separator = " "
|
|
, end = ""
|
|
, spaces = Parser.succeed ()
|
|
, item = exprBasic
|
|
, trailing = Optional
|
|
}
|
|
|> Parser.andThen handle
|
|
|
|
exprBasic : Parser Expr
|
|
exprBasic = Parser.lazy <| \() -> Parser.oneOf
|
|
[ Parser.backtrackable <|
|
|
Parser.number
|
|
{ int = Just IntLit
|
|
, hex = Nothing
|
|
, octal = Nothing
|
|
, binary = Nothing
|
|
, float = Just FloatLit
|
|
}
|
|
, Parser.backtrackable (Parser.succeed StrLit |= strLit)
|
|
, Parser.backtrackable <| Parser.map (\(a, b) -> Pair a b) <| pair expr
|
|
, Parser.succeed Fst
|
|
|. Parser.keyword "fst"
|
|
|. Parser.spaces
|
|
|= parenthed expr
|
|
, Parser.succeed Snd
|
|
|. Parser.keyword "snd"
|
|
|. Parser.spaces
|
|
|= parenthed expr
|
|
, Parser.succeed Abs
|
|
|. Parser.symbol "\\"
|
|
|. Parser.spaces
|
|
|= variable
|
|
|. Parser.spaces
|
|
|. Parser.symbol ":"
|
|
|. Parser.spaces
|
|
|= type_
|
|
|. Parser.spaces
|
|
|. Parser.symbol "."
|
|
|. Parser.spaces
|
|
|= expr
|
|
, Parser.succeed Ref |= variable
|
|
, parenthed expr
|
|
]
|
|
|
|
typeToTerm : Type -> Syntax.Term Metavariable
|
|
typeToTerm t =
|
|
case t of
|
|
TInt -> Syntax.Call "number" []
|
|
TStr -> Syntax.Call "string" []
|
|
TPair t1 t2 -> Syntax.Call "tpair" [ typeToTerm t1, typeToTerm t2 ]
|
|
TArr t1 t2 -> Syntax.Call "tarr" [ typeToTerm t1, typeToTerm t2 ]
|
|
|
|
exprToTerm : Expr -> Syntax.Term Metavariable
|
|
exprToTerm e =
|
|
case e of
|
|
IntLit i -> Syntax.Call "lit" [Syntax.IntLit i]
|
|
FloatLit f -> Syntax.Call "lit" [Syntax.FloatLit f]
|
|
StrLit s -> Syntax.Call "lit" [Syntax.StringLit s]
|
|
Plus e1 e2 -> Syntax.Call "plus" [exprToTerm e1, exprToTerm e2]
|
|
Pair e1 e2 -> Syntax.Call "pair" [exprToTerm e1, exprToTerm e2]
|
|
Fst ep -> Syntax.Call "fst" [exprToTerm ep]
|
|
Snd ep -> Syntax.Call "snd" [exprToTerm ep]
|
|
Abs s t ep -> Syntax.Call "abs" [Syntax.Call s [], typeToTerm t, exprToTerm ep]
|
|
App e1 e2 -> Syntax.Call "app" [exprToTerm e1, exprToTerm e2]
|
|
Ref x -> Syntax.Call "var" [Syntax.Call x []]
|