{-# 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 :: Core -> Core
eval (ApplicationCore Core
op Core
arg) =
  case Core -> Core
eval Core
op of
    LambdaCore Variable
param Core
expr ->
      case Core -> Core
eval Core
arg of
        a :: Core
a@VariableCore {} ->
          [Char] -> Core
forall a. HasCallStack => [Char] -> a
error (Text -> [Char]
T.unpack (Core -> Text
prettyCore Core
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not in scope!"))
        Core
a -> Core -> Core
eval (Variable -> Core -> Core -> Core
subst Variable
param Core
a Core
expr)
    EvalCore Core -> Core
f -> Core -> Core
f (Core -> Core
eval Core
arg)
    Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error (Text -> [Char]
T.unpack (Core -> Text
prettyCore Core
op Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a function!"))
eval (IfCore Core
c Core
a Core
b) =
  case Core -> Core
eval Core
c of
    ConstantCore (BoolConstant Bool
True) -> Core -> Core
eval Core
a
    ConstantCore (BoolConstant Bool
False) -> Core -> Core
eval Core
b
    Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error ([Char]
"type error for if condition, should be bool")
eval (RecordCore HashMap Text Core
hms) =
  HashMap Text Core -> Core
RecordCore ((Core -> Core) -> HashMap Text Core -> HashMap Text Core
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Core -> Core
eval HashMap Text Core
hms)
eval (ArrayCore Vector Core
hms) =
  Vector Core -> Core
ArrayCore ((Core -> Core) -> Vector Core -> Vector Core
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Core -> Core
eval Vector Core
hms)
eval Core
e = Core
e

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

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