Interpreter.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}

-- |

module JL.Interpreter where

import qualified Data.Text as T
import           JL.Printer
import           JL.Types

-- | Eval core.
eval :: Core -> Core
eval (ApplicationCore op arg) =
  case eval op of
    LambdaCore param expr ->
      case eval arg of
        a@VariableCore {} ->
          error (T.unpack (prettyCore a <> " is not in scope!"))
        a -> eval (subst param a expr)
    EvalCore f -> f (eval arg)
    _ -> error (T.unpack (prettyCore op <> " is not a function!"))
eval (IfCore c a b) =
  case eval c of
    ConstantCore (BoolConstant True) -> eval a
    ConstantCore (BoolConstant False) -> eval b
    _ -> error ("type error for if condition, should be bool")
eval (RecordCore hms) =
  RecordCore (fmap eval hms)
eval (ArrayCore hms) =
  ArrayCore (fmap eval hms)
eval e = e

-- | Substitute name in function body.
subst :: Variable -> Core -> Core -> Core
subst name val e@(VariableCore name')
  | name == name' = val
  | otherwise = e
subst name val (LambdaCore name' e)
  | name /= name' = LambdaCore name' (subst name val e)
subst name val (ApplicationCore f a) =
  ApplicationCore (subst name val f) (subst name val a)
subst name val (IfCore f a b) =
  IfCore (subst name val f) (subst name val a) (subst name val b)
subst name val (RecordCore hm) = RecordCore (fmap (subst name val) hm)
subst name val (ArrayCore hm) = ArrayCore (fmap (subst name val) hm)
subst _ _ e = e

-- | Remove syntactic sugar and convert into executable form.
desugar :: Expression -> Core
desugar =
  \case
    (InfixExpression a f b) ->
      ApplicationCore (ApplicationCore (VariableCore f) (desugar a)) (desugar b)
    VariableExpression v -> VariableCore v
    LambdaExpression v e -> LambdaCore v (desugar e)
    ApplicationExpression f a -> ApplicationCore (desugar f) (desugar a)
    IfExpression a b c -> IfCore (desugar a) (desugar b) (desugar c)
    RecordExpression pars -> RecordCore (fmap desugar pars)
    ArrayExpression as -> ArrayCore (fmap desugar as)
    ConstantExpression c -> ConstantCore c
    SubscriptExpression subscripted subscripts ->
      let index =
            \c k ->
              ApplicationCore
                (ApplicationCore
                   (VariableCore (Variable "get"))
                   (case k of
                      ExpressionSubscript e -> desugar e
                      PropertySubscript t -> ConstantCore (StringConstant t)))
                c
      in case subscripted of
           WildcardSubscripted ->
             LambdaCore
               (Variable "a'")
               (foldl index (VariableCore (Variable "a'")) subscripts)
           ExpressionSubscripted e -> foldl index (desugar e) subscripts