src/lem_interp/interp_lib.lem


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

open import Pervasives
open import Interp
open import Interp_ast
import Maybe_extra
open import Num
open import List

let compose f g x = f (V_tuple [g x]) ;;

let is_one (V_lit b) = V_lit (if b = L_one then L_true else L_false) ;;

let eq (V_tuple [x; y]) = V_lit (if x = y then L_true else L_false) ;;

let neg (V_tuple [V_lit arg]) = V_lit (match arg with
  | L_true -> L_false
  | L_false -> L_true end) ;;

let neq = compose neg eq ;;

let add (V_tuple [V_lit(L_num x); V_lit(L_num y)]) = V_lit(L_num (x+y)) ;;

let rec vec_concat (V_tuple args) = match args with
  | [V_vector n d l; V_vector n' d' l'] ->
      (* XXX d = d' ? droping n' ? *)
      V_vector n d (l ++ l')
  | [V_lit l; x] -> vec_concat (V_tuple [litV_to_vec l; x])
  | [x; V_lit l] -> vec_concat (V_tuple [x; litV_to_vec l])
  end ;;

let function_map = [
  ("add", add);
  ("add_infix", add);
  ("eq", eq);
  ("vec_concat", vec_concat);
  ("is_one", is_one);
] ;;

let eval_external name v = (Maybe_extra.fromJust (List.lookup name function_map)) v ;;