DynEditorExample.icl 12 KB
Newer Older
1 2
module DynEditorExample

Steffen Michels's avatar
Steffen Michels committed
3
import StdEnv
Tim Steenvoorden's avatar
Tim Steenvoorden committed
4 5
import Data.Func
import Data.Functor
6
import Text
Tim Steenvoorden's avatar
Tim Steenvoorden committed
7 8
import iTasks
import iTasks.Extensions.Editors.DynamicEditor
9

Tim Steenvoorden's avatar
Tim Steenvoorden committed
10 11 12

// Synonyms ////////////////////////////////////////////////////////////////////

Tim Steenvoorden's avatar
Tim Steenvoorden committed
13
:: List a :== [a]
Tim Steenvoorden's avatar
Tim Steenvoorden committed
14

Tim Steenvoorden's avatar
Tim Steenvoorden committed
15 16 17

// Main ////////////////////////////////////////////////////////////////////////

18 19
Start world = doTasks editTask world

Tim Steenvoorden's avatar
Tim Steenvoorden committed
20 21
editTask =
  forever
Tim Steenvoorden's avatar
Tim Steenvoorden committed
22
    ( enterInformation ("Contruct a task", info1) [EnterUsing id $ dynamicEditor taskEditor]
Tim Steenvoorden's avatar
Tim Steenvoorden committed
23
      >>= \v ->
Tim Steenvoorden's avatar
Tim Steenvoorden committed
24
          viewInformation ("Evaluate the task", info2) [] ()
Tim Steenvoorden's avatar
Tim Steenvoorden committed
25
            ||- (evalTaskConstExpr (toValue taskEditor v) <<@ ApplyLayout frameCompact)
Tim Steenvoorden's avatar
Tim Steenvoorden committed
26
            >>= viewInformation ("Done!", info3) []
Tim Steenvoorden's avatar
Tim Steenvoorden committed
27
            >>= return
Tim Steenvoorden's avatar
Tim Steenvoorden committed
28 29
    )
where
Tim Steenvoorden's avatar
Tim Steenvoorden committed
30
  info1 :: String
Tim Steenvoorden's avatar
Tim Steenvoorden committed
31
  info1 = "Select the editors and combinators you'd like to use. When you're ready, push the 'Continue' button below to run your program."
Tim Steenvoorden's avatar
Tim Steenvoorden committed
32
  info2 :: String
Tim Steenvoorden's avatar
Tim Steenvoorden committed
33
  info2 = "Now step through the task you just created to test it."
Tim Steenvoorden's avatar
Tim Steenvoorden committed
34
  info3 :: String
Tim Steenvoorden's avatar
Tim Steenvoorden committed
35
  info3 = "The program is done, the result is given below."
36 37


Tim Steenvoorden's avatar
Tim Steenvoorden committed
38 39
// Data ////////////////////////////////////////////////////////////////////////

Tim Steenvoorden's avatar
Tim Steenvoorden committed
40
:: TaskExpr
Tim Steenvoorden's avatar
Tim Steenvoorden committed
41 42
  = Done Expr
  // | Apply TaskFuncExpr Expr
Tim Steenvoorden's avatar
Tim Steenvoorden committed
43
  | EnterInfo String Ty
Tim Steenvoorden's avatar
Tim Steenvoorden committed
44 45 46 47
  | Then TaskExpr TaskFuncExpr
  | Or TaskExpr TaskExpr
  | And TaskExpr TaskExpr
  | When TaskExpr (List TaskContExpr)
48

Tim Steenvoorden's avatar
Tim Steenvoorden committed
49
:: TaskFuncExpr
Tim Steenvoorden's avatar
Tim Steenvoorden committed
50 51
  = ViewInfo String
  | UpdateInfo String
52

Tim Steenvoorden's avatar
Tim Steenvoorden committed
53 54 55
:: TaskContExpr
  = { name :: String, pred :: FuncExpr, cont :: TaskFuncExpr}

Tim Steenvoorden's avatar
Tim Steenvoorden committed
56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
:: Expr
  = Int Int
  | Bool Bool
  | String String
  | Tuple Expr Expr
  | Fst Expr
  | Snd Expr
  | Eq Expr Expr

:: Value
  = VInt Int
  | VBool Bool
  | VString String
  | VTuple Value Value

Tim Steenvoorden's avatar
Tim Steenvoorden committed
71
:: FuncExpr
Tim Steenvoorden's avatar
Tim Steenvoorden committed
72 73 74 75 76 77 78 79 80
  = EqV Value
  | GrtV Value
  | LessV Value

:: Ty
  = E.a: Ty (a -> Value) & iTask a

:: Typed a b
  =: Typed a
81

Tim Steenvoorden's avatar
Tim Steenvoorden committed
82
derive class iTask TaskExpr, TaskFuncExpr, TaskContExpr, Expr, FuncExpr, Value, Typed
83

Tim Steenvoorden's avatar
Tim Steenvoorden committed
84 85
// These instances cannot be auto derived because of the existential quantifier.
// However, they will be never used, so we make them undefined.
Tim Steenvoorden's avatar
Tim Steenvoorden committed
86 87 88 89 90 91 92
gDefault{|Ty|} = undef
gEq{|Ty|} _ _ = undef
JSONEncode{|Ty|} _ _ = undef
JSONDecode{|Ty|} _ _ = undef
gText{|Ty|} _ _ = undef
gEditor{|Ty|} = undef

93

Tim Steenvoorden's avatar
Tim Steenvoorden committed
94 95
// Editor //////////////////////////////////////////////////////////////////////

Tim Steenvoorden's avatar
Tim Steenvoorden committed
96
taskEditor :: DynamicEditor TaskExpr
97 98
taskEditor = DynamicEditor conses
where
Tim Steenvoorden's avatar
Tim Steenvoorden committed
99
  conses =
Tim Steenvoorden's avatar
Tim Steenvoorden committed
100
    [ // This cons is used to provide untyped `TaskExpr` values.
Tim Steenvoorden's avatar
Tim Steenvoorden committed
101
      DynamicCons
Tim Steenvoorden's avatar
Tim Steenvoorden committed
102
        $ functionConsDyn "TaskExpr" "(enter task)" (dynamic \(Typed taskExpr) -> taskExpr ::  A.a: (Typed TaskExpr a) -> TaskExpr)
Tim Steenvoorden's avatar
Tim Steenvoorden committed
103
        <<@@@ HideIfOnlyChoice
Tim Steenvoorden's avatar
Tim Steenvoorden committed
104
    , DynamicConsGroup "Combinators"
Tim Steenvoorden's avatar
Tim Steenvoorden committed
105 106 107 108 109 110 111 112
        [ functionConsDyn "Done" "done"
            ( dynamic \(Typed expr) -> Typed (Done expr) ::
                A.a:
                (Typed Expr a)
                -> Typed TaskExpr (Task a)
            )
        , functionConsDyn "Then" "sequence"
            ( dynamic \(Typed task) (Typed taskFunc) -> Typed (Then task taskFunc) ::
Tim Steenvoorden's avatar
Tim Steenvoorden committed
113
                A.a b:
Tim Steenvoorden's avatar
Tim Steenvoorden committed
114 115
                (Typed TaskExpr (Task a)) (Typed TaskFuncExpr (a -> Task b))
                -> Typed TaskExpr (Task b)
Tim Steenvoorden's avatar
Tim Steenvoorden committed
116
            )
Tim Steenvoorden's avatar
Tim Steenvoorden committed
117
        , functionConsDyn "When" "guarded sequence"
Tim Steenvoorden's avatar
Tim Steenvoorden committed
118
            ( dynamic \(Typed task1) (Typed steps) -> Typed (When task1 steps) ::
119
              // Typed (When task1 [(expr, pred, tfExpr) \\ (Typed expr, pred, Typed tfExpr) <- steps]) ::
Tim Steenvoorden's avatar
Tim Steenvoorden committed
120
                A.a b:
Tim Steenvoorden's avatar
Tim Steenvoorden committed
121 122 123 124
                (Typed TaskExpr (Task a))
                (Typed (List TaskContExpr) (a -> Task b))
                // (Typed (List (Typed FuncExpr (a -> Bool), String, Typed TaskFuncExpr (a -> Task a))) (a -> Task b))
                -> Typed TaskExpr (Task b)
Tim Steenvoorden's avatar
Tim Steenvoorden committed
125
            )
Tim Steenvoorden's avatar
Tim Steenvoorden committed
126 127
            <<@@@ applyHorizontalClasses
        , functionConsDyn "Or" "or"
Tim Steenvoorden's avatar
Tim Steenvoorden committed
128
            ( dynamic \(Typed task1) (Typed task2) -> Typed (Or task1 task2) ::
Tim Steenvoorden's avatar
Tim Steenvoorden committed
129
                A.a b:
130 131
                (Typed TaskExpr (Task a))
                (Typed TaskExpr (Task a))
Tim Steenvoorden's avatar
Tim Steenvoorden committed
132
                -> Typed TaskExpr (Task a)
Tim Steenvoorden's avatar
Tim Steenvoorden committed
133
            )
134
            <<@@@ applyHorizontalClasses
Tim Steenvoorden's avatar
Tim Steenvoorden committed
135
        , functionConsDyn "And" "and"
Tim Steenvoorden's avatar
Tim Steenvoorden committed
136
            ( dynamic \(Typed task1) (Typed task2) -> Typed (And task1 task2) ::
Tim Steenvoorden's avatar
Tim Steenvoorden committed
137
                A.a b:
138 139
                (Typed TaskExpr (Task a))
                (Typed TaskExpr (Task b))
Tim Steenvoorden's avatar
Tim Steenvoorden committed
140
                -> Typed TaskExpr (Task (a, b))
Tim Steenvoorden's avatar
Tim Steenvoorden committed
141
            )
142
            <<@@@ applyHorizontalClasses
Tim Steenvoorden's avatar
Tim Steenvoorden committed
143
        , listConsDyn "List TaskContExpr" "continuations"
Tim Steenvoorden's avatar
Tim Steenvoorden committed
144
            ( dynamic \typedSteps -> Typed ((\(Typed expr) -> expr) <$> typedSteps) ::
Tim Steenvoorden's avatar
Tim Steenvoorden committed
145
                A.a b:
146
                (List (Typed TaskContExpr (a -> Task b)))
Tim Steenvoorden's avatar
Tim Steenvoorden committed
147
                -> Typed (List TaskContExpr) (a -> Task b)
Tim Steenvoorden's avatar
Tim Steenvoorden committed
148 149
            )
            <<@@@ HideIfOnlyChoice
Tim Steenvoorden's avatar
Tim Steenvoorden committed
150
        , functionConsDyn "TaskContExpr" "continuation"
Tim Steenvoorden's avatar
Tim Steenvoorden committed
151
            ( dynamic \s (Typed func) (Typed taskFunc) -> Typed {name = s, pred = func, cont = taskFunc} ::
Tim Steenvoorden's avatar
Tim Steenvoorden committed
152
                A.a b:
Tim Steenvoorden's avatar
Tim Steenvoorden committed
153
                String
Tim Steenvoorden's avatar
Tim Steenvoorden committed
154
                (Typed FuncExpr a)
Tim Steenvoorden's avatar
Tim Steenvoorden committed
155
                (Typed TaskFuncExpr (a -> Task b))
Tim Steenvoorden's avatar
Tim Steenvoorden committed
156
                -> Typed TaskContExpr (a -> Task b)
Tim Steenvoorden's avatar
Tim Steenvoorden committed
157 158
            )
            <<@@@ HideIfOnlyChoice
Tim Steenvoorden's avatar
Tim Steenvoorden committed
159
            <<@@@ AddLabels [Just "name", Just "predicate", Just "continuation"]
Tim Steenvoorden's avatar
Tim Steenvoorden committed
160
        ]
Tim Steenvoorden's avatar
Tim Steenvoorden committed
161
    , DynamicConsGroup "Editors"
Tim Steenvoorden's avatar
Tim Steenvoorden committed
162 163 164 165 166 167 168 169 170 171
        // [ functionConsDyn "Apply" "apply"
        //     ( dynamic \(Typed taskFunc) (Typed expr) ->
        //       Typed (Apply taskFunc expr) ::
        //         A.a b:
        //         (Typed TaskFuncExpr (a -> Task b))
        //         (Typed Expr a)
        //         -> Typed TaskExpr (Task b)
        //     )
        [ functionConsDyn "EnterInfo" "enter information"
            ( dynamic \s (Typed ty) -> Typed (EnterInfo s ty) ::
Tim Steenvoorden's avatar
Tim Steenvoorden committed
172
                A.a:
Tim Steenvoorden's avatar
Tim Steenvoorden committed
173
                String (Typed Ty a)
Tim Steenvoorden's avatar
Tim Steenvoorden committed
174
                -> Typed TaskExpr (Task a)
Tim Steenvoorden's avatar
Tim Steenvoorden committed
175 176
            )
            <<@@@ applyHorizontalClasses
Tim Steenvoorden's avatar
Tim Steenvoorden committed
177
        , functionConsDyn "ViewInfo" "view information"
Tim Steenvoorden's avatar
Tim Steenvoorden committed
178
            ( dynamic \s -> Typed (ViewInfo s) ::
Tim Steenvoorden's avatar
Tim Steenvoorden committed
179
                A.a:
Tim Steenvoorden's avatar
Tim Steenvoorden committed
180 181
                String
                -> Typed TaskFuncExpr (a -> Task a)
Tim Steenvoorden's avatar
Tim Steenvoorden committed
182 183
            )
            <<@@@ applyHorizontalClasses
Tim Steenvoorden's avatar
Tim Steenvoorden committed
184
        , functionConsDyn "UpdateInfo" "update information"
Tim Steenvoorden's avatar
Tim Steenvoorden committed
185
            ( dynamic \s -> Typed (UpdateInfo s) ::
Tim Steenvoorden's avatar
Tim Steenvoorden committed
186
                A.a:
Tim Steenvoorden's avatar
Tim Steenvoorden committed
187 188
                String
                -> Typed TaskFuncExpr (a -> Task a)
Tim Steenvoorden's avatar
Tim Steenvoorden committed
189 190 191
            )
            <<@@@ applyHorizontalClasses
        ]
Tim Steenvoorden's avatar
Tim Steenvoorden committed
192
    // ordinary (non-task) expressions
Tim Steenvoorden's avatar
Tim Steenvoorden committed
193
    , DynamicCons
Tim Steenvoorden's avatar
Tim Steenvoorden committed
194
        $ functionConsDyn "EqV" "equal" (dynamic \i -> Typed (EqV (VInt i)) :: Int -> Typed FuncExpr Int)
Tim Steenvoorden's avatar
Tim Steenvoorden committed
195 196
        <<@@@ applyHorizontalClasses
    , DynamicCons
Tim Steenvoorden's avatar
Tim Steenvoorden committed
197
        $ functionConsDyn "GrtV" "greater" (dynamic \i -> Typed (GrtV (VInt i)) :: Int -> Typed FuncExpr Int)
Tim Steenvoorden's avatar
Tim Steenvoorden committed
198 199
        <<@@@ applyHorizontalClasses
    , DynamicCons
Tim Steenvoorden's avatar
Tim Steenvoorden committed
200
        $ functionConsDyn "LessV" "less" (dynamic \i -> Typed (LessV (VInt i)) :: Int -> Typed FuncExpr Int)
Tim Steenvoorden's avatar
Tim Steenvoorden committed
201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231
        <<@@@ applyHorizontalClasses
    , DynamicCons
        $ functionConsDyn "int" "enter an integer:" (dynamic \i -> Typed (Int i) :: Int -> Typed Expr Int)
    , DynamicCons
        $ functionConsDyn "bool" "enter a boolean:" (dynamic \b -> Typed (Bool b) :: Bool -> Typed Expr Bool)
    , DynamicCons
        $ functionConsDyn "string" "enter a string:" (dynamic \s -> Typed (String s) :: String -> Typed Expr String)
    , DynamicCons
        $ functionConsDyn "tuple" "enter tuple:"
            ( dynamic \(Typed a) (Typed b) ->
              Typed (Tuple a b) ::
                A.a b:
                  (Typed Expr a) (Typed Expr b) -> Typed Expr (a, b)
            )
    , DynamicCons
        $ functionConsDyn "fst" "fst" (dynamic \(Typed (Tuple a _)) -> Typed a ::  A.a b: (Typed Expr (a, b)) -> Typed Expr a)
        <<@@@ applyHorizontalClasses
    , DynamicCons
        $ functionConsDyn "snd" "snd" (dynamic \(Typed (Tuple _ b)) -> Typed b ::  A.a b: (Typed Expr (a, b)) -> Typed Expr b)
        <<@@@ applyHorizontalClasses
    , DynamicCons
        $ functionConsDyn "==" "=="
            ( dynamic \(Typed a) (Typed b) ->
              Typed (Eq a b) ::
                A.a:
                  (Typed Expr a) (Typed Expr a) -> Typed Expr Bool
            )
        <<@@@ applyHorizontalClasses
    , DynamicCons $ customEditorCons "Int" "(enter integer)" intEditor <<@@@ HideIfOnlyChoice
    , DynamicCons $ customEditorCons "Bool" "(enter boolean)" boolEditor <<@@@ HideIfOnlyChoice
    , DynamicCons $ customEditorCons "String" "(enter string )" stringEditor <<@@@ HideIfOnlyChoice
Tim Steenvoorden's avatar
Tim Steenvoorden committed
232
    // type specifications for enterInformation
Tim Steenvoorden's avatar
Tim Steenvoorden committed
233 234 235 236 237 238 239 240 241 242 243
    , DynamicCons $ functionConsDyn "Ty.Int" "Int" (dynamic Typed (Ty VInt) :: Typed Ty Int)
    , DynamicCons $ functionConsDyn "Ty.Bool" "Bool" (dynamic Typed (Ty VBool) :: Typed Ty Bool)
    , DynamicCons $ functionConsDyn "Ty.String" "String" (dynamic Typed (Ty VString) :: Typed Ty String)
    , DynamicCons
        $ functionConsDyn "Ty.Tuple" "Tuple"
            ( dynamic \(Typed (Ty toValue1)) (Typed (Ty toValue2)) ->
              Typed (Ty \(x, y) -> VTuple (toValue1 x) (toValue2 y)) ::
                A.a b:
                  (Typed Ty a) (Typed Ty b) -> Typed Ty (a, b)
            )
        <<@@@ applyHorizontalClasses
Tim Steenvoorden's avatar
Tim Steenvoorden committed
244 245 246
    ]


Tim Steenvoorden's avatar
Tim Steenvoorden committed
247 248
// Helpers //

Tim Steenvoorden's avatar
Tim Steenvoorden committed
249 250 251 252 253 254
derivedType :: Typed Ty a | iTask a
derivedType = case dynToValue of
  (toValue :: a^ -> Value | iTask a^) = Typed (Ty toValue)
where
  dynToValue = dynamic ()

Tim Steenvoorden's avatar
Tim Steenvoorden committed
255

Tim Steenvoorden's avatar
Tim Steenvoorden committed
256 257
intEditor :: Editor Int
intEditor = gEditor{|*|}
Tim Steenvoorden's avatar
Tim Steenvoorden committed
258

Tim Steenvoorden's avatar
Tim Steenvoorden committed
259 260
boolEditor :: Editor Bool
boolEditor = gEditor{|*|}
261

Tim Steenvoorden's avatar
Tim Steenvoorden committed
262 263
stringEditor :: Editor String
stringEditor = gEditor{|*|}
264

265 266
applyHorizontalClasses = ApplyCssClasses ["itasks-horizontal", "itasks-wrap-width", "itasks-panel"]

Tim Steenvoorden's avatar
Tim Steenvoorden committed
267

Tim Steenvoorden's avatar
Tim Steenvoorden committed
268 269
// Evaluation //////////////////////////////////////////////////////////////////

Tim Steenvoorden's avatar
Tim Steenvoorden committed
270
evalTaskConstExpr :: TaskExpr -> Task Value
Tim Steenvoorden's avatar
Tim Steenvoorden committed
271
evalTaskConstExpr (Done expr) = return $ evalExpr expr
Tim Steenvoorden's avatar
Tim Steenvoorden committed
272
evalTaskConstExpr (EnterInfo msg (Ty toValue)) = enterInformation msg [] @ toValue
Tim Steenvoorden's avatar
Tim Steenvoorden committed
273
// evalTaskConstExpr (Apply taskFunc expr) = evalTaskFuncExpr taskFunc $ evalExpr expr
Tim Steenvoorden's avatar
Tim Steenvoorden committed
274
evalTaskConstExpr (Then task taskFunc) = evalTaskConstExpr task >>= evalTaskFuncExpr taskFunc
275 276
evalTaskConstExpr (Or task1 task2) = (evalTaskConstExpr task1 -||- evalTaskConstExpr task2 <<@ ApplyLayout arrangeHorizontal)
evalTaskConstExpr (And task1 task2) = (evalTaskConstExpr task1 -&&- evalTaskConstExpr task2 <<@ ApplyLayout arrangeHorizontal) @ \(a, b) -> VTuple a b
Tim Steenvoorden's avatar
Tim Steenvoorden committed
277
evalTaskConstExpr (When task1 options) = evalTaskConstExpr task1
Tim Steenvoorden's avatar
Tim Steenvoorden committed
278 279 280
  >>* [ OnAction (Action name) (ifValue (test pred) (evalTaskFuncExpr cont))
      \\ {name, pred, cont} <- options
      ]
Steffen Michels's avatar
Steffen Michels committed
281
where
Tim Steenvoorden's avatar
Tim Steenvoorden committed
282
  test pred (VInt i) = case pred of
Tim Steenvoorden's avatar
Tim Steenvoorden committed
283 284 285 286
    LessV (VInt j) -> i < j
    GrtV (VInt j) -> i > j
    EqV (VInt j) -> i == j

Tim Steenvoorden's avatar
Tim Steenvoorden committed
287
  test pred (VBool i) = case pred of
Tim Steenvoorden's avatar
Tim Steenvoorden committed
288 289 290 291
    EqV (VBool j) -> i == j
    LessV (VBool j) -> False
    GrtV (VBool j) -> False

292 293

evalTaskFuncExpr :: TaskFuncExpr Value -> Task Value
Tim Steenvoorden's avatar
Tim Steenvoorden committed
294 295 296 297
evalTaskFuncExpr (ViewInfo p) (VInt i) = (viewInformation p [] i @ VInt) <<@ ApplyLayout arrangeHorizontal
evalTaskFuncExpr (ViewInfo p) (VBool b) = (viewInformation p [] b @ VBool) <<@ ApplyLayout arrangeHorizontal
evalTaskFuncExpr (ViewInfo p) (VString s) = (viewInformation p [] s @ VString) <<@ ApplyLayout arrangeHorizontal
evalTaskFuncExpr (ViewInfo p) (VTuple a b) =
Tim Steenvoorden's avatar
Tim Steenvoorden committed
298
  ( viewInformation p [] ()
Tim Steenvoorden's avatar
Tim Steenvoorden committed
299 300
    ||- evalTaskFuncExpr (ViewInfo "") a
    -&&- evalTaskFuncExpr (ViewInfo "") b
Tim Steenvoorden's avatar
Tim Steenvoorden committed
301 302 303
    @ \(a, b) -> VTuple a b
  )
    <<@ ApplyLayout arrangeHorizontal
Tim Steenvoorden's avatar
Tim Steenvoorden committed
304 305 306 307
evalTaskFuncExpr (UpdateInfo p) (VInt i) = (updateInformation p [] i @ VInt) <<@ ApplyLayout arrangeHorizontal
evalTaskFuncExpr (UpdateInfo p) (VBool b) = (updateInformation p [] b @ VBool) <<@ ApplyLayout arrangeHorizontal
evalTaskFuncExpr (UpdateInfo p) (VString s) = (updateInformation p [] s @ VString) <<@ ApplyLayout arrangeHorizontal
evalTaskFuncExpr (UpdateInfo p) (VTuple a b) =
Tim Steenvoorden's avatar
Tim Steenvoorden committed
308
  ( viewInformation p [] ()
Tim Steenvoorden's avatar
Tim Steenvoorden committed
309 310
    ||- evalTaskFuncExpr (UpdateInfo "") a
    -&&- evalTaskFuncExpr (UpdateInfo "") b
Tim Steenvoorden's avatar
Tim Steenvoorden committed
311 312 313 314
    @ \(a, b) -> VTuple a b
  )
    <<@ ApplyLayout arrangeHorizontal

315
evalExpr :: Expr -> Value
Tim Steenvoorden's avatar
Tim Steenvoorden committed
316 317 318
evalExpr (Int i) = VInt i
evalExpr (Bool b) = VBool b
evalExpr (String s) = VString s
319
evalExpr (Tuple fstExpr sndExpr) = VTuple (evalExpr fstExpr) (evalExpr sndExpr)
Tim Steenvoorden's avatar
Tim Steenvoorden committed
320
evalExpr (Fst expr) = fst
321
where
Tim Steenvoorden's avatar
Tim Steenvoorden committed
322
  (VTuple fst _) = evalExpr expr
Tim Steenvoorden's avatar
Tim Steenvoorden committed
323
evalExpr (Snd expr) = snd
324
where
Tim Steenvoorden's avatar
Tim Steenvoorden committed
325
  (VTuple _ snd) = evalExpr expr
Tim Steenvoorden's avatar
Tim Steenvoorden committed
326
evalExpr (Eq expr1 expr2) = VBool $ evalExpr expr1 === evalExpr expr2