bergamot-elm/src/Bergamot/ObjectLanguage.elm

module Bergamot.ObjectLanguage exposing (..)

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

type Type
    = TInt
    | TStr
    | TPair Type Type
    | TArr Type Type

type Expr
    = IntLit Int
    | StrLit String
    | Plus Expr Expr
    | Pair Expr Expr
    | Fst Expr
    | Snd Expr
    | Abs String Type Expr
    | App Expr Expr
    | Ref String

parseParenthed : Parser a -> Parser a
parseParenthed val = Parser.succeed (\x -> x)
    |. Parser.symbol "("
    |. Parser.spaces
    |= val
    |. Parser.spaces
    |. Parser.symbol ")"

parsePair : Parser a -> Parser (a, a)
parsePair elem = parseParenthed <|
    Parser.succeed Tuple.pair
    |= elem
    |. Parser.spaces
    |. Parser.symbol ","
    |. Parser.spaces
    |= elem

parseType : Parser Type
parseType = Parser.lazy <| \() -> Parser.oneOf
    [ Parser.backtrackable <| Parser.succeed TArr
        |= parseTypeBasic
        |. Parser.spaces
        |. Parser.symbol "->"
        |. Parser.spaces
        |= parseType
    , parseTypeBasic
    ]

parseTypeBasic : Parser Type
parseTypeBasic = Parser.lazy <| \() -> Parser.oneOf
    [ Parser.succeed TInt |. Parser.keyword "tint"
    , Parser.succeed TStr |. Parser.keyword "tstr"
    , Parser.backtrackable <| Parser.map (\(a, b) -> TPair a b) <| parsePair parseType
    , parseParenthed parseType
    ]

parseVariable : Parser String
parseVariable = Parser.variable
    { start = Char.isAlphaNum
    , inner = Char.isAlphaNum
    , reserved = Set.fromList ["fst", "snd", "let", "in"]
    }

parseExpr : Parser Expr
parseExpr = Parser.lazy <| \() -> Parser.oneOf
    [ Parser.backtrackable <| Parser.succeed Plus
        |= parseExprBasic
        |. Parser.spaces
        |. Parser.symbol "+"
        |. Parser.spaces
        |= parseExpr
    , parseExprApps
    ]

parseExprApps : Parser Expr
parseExprApps =
    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 = parseExprBasic
            , trailing = Optional
            }
        |> Parser.andThen handle

parseExprBasic : Parser Expr
parseExprBasic = Parser.lazy <| \() -> Parser.oneOf
    [ Parser.backtrackable (Parser.succeed IntLit |= Parser.int)
    , Parser.backtrackable <| Parser.map (\(a, b) -> Pair a b) <| parsePair parseExpr
    , Parser.succeed Fst
        |. Parser.keyword "fst"
        |. Parser.spaces
        |= parseParenthed parseExpr
    , Parser.succeed Snd
        |. Parser.keyword "snd"
        |. Parser.spaces
        |= parseParenthed parseExpr
    , Parser.succeed Abs
        |. Parser.symbol "\\"
        |. Parser.spaces
        |= parseVariable
        |. Parser.spaces
        |. Parser.symbol ":"
        |. Parser.spaces
        |= parseType
        |. Parser.spaces
        |. Parser.symbol "."
        |. Parser.spaces
        |= parseExpr
    , Parser.succeed Ref |= parseVariable
    , parseParenthed parseExpr
    ]