{-# 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 -> 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
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
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