diff options
Diffstat (limited to 'src/lem_interp')
| -rw-r--r-- | src/lem_interp/interp.lem | 14 | ||||
| -rw-r--r-- | src/lem_interp/interp_lib.lem | 20 |
2 files changed, 28 insertions, 6 deletions
diff --git a/src/lem_interp/interp.lem b/src/lem_interp/interp.lem index f0770d4e..2960f048 100644 --- a/src/lem_interp/interp.lem +++ b/src/lem_interp/interp.lem @@ -986,6 +986,20 @@ and interp_main mode t_level l_env l_mem (E_aux exp (l,annot)) = update_stack a (add_to_top_frame (fun i2 -> E_aux (E_vector_update_subrange vec (to_exp vi1) i2 exp) (l,annot)))) | _ -> (Error l "vector update requires number",lm,le) end) (fun a -> update_stack a (add_to_top_frame (fun i1 -> E_aux (E_vector_update_subrange vec i1 i2 exp) (l,annot)))) + | E_vector_append e1 e2 -> + resolve_outcome (interp_main mode t_level l_env l_mem e1) + (fun v1 lm le -> + match v1 with + | V_vector m inc vals1 -> + (resolve_outcome (interp_main mode t_level l_env lm e2) + (fun v2 lm le -> + match v2 with + | V_vector _ _ vals2 -> (Value (V_vector m inc (vals1++vals2)) Tag_empty,lm,l_env) + | _ -> (Error l "vector concat requires vector",lm,le) end) + (fun a -> update_stack a (add_to_top_frame + (fun e -> E_aux (E_vector_append (to_exp v1) e) (l,annot))))) + | _ -> (Error l "vector concat requires vector",lm,le) end) + (fun a -> update_stack a (add_to_top_frame (fun e -> E_aux (E_vector_append e e2) (l,annot)))) | E_tuple(exps) -> exp_list mode t_level (fun exps -> E_aux (E_tuple exps) (l,annot)) V_tuple l_env l_mem [] exps | E_vector(exps) -> diff --git a/src/lem_interp/interp_lib.lem b/src/lem_interp/interp_lib.lem index 753de883..e994fdfe 100644 --- a/src/lem_interp/interp_lib.lem +++ b/src/lem_interp/interp_lib.lem @@ -39,6 +39,11 @@ let bitwise_not (V_vector idx inc v) = let apply x = bool_to_bit(not (bit_to_bool x)) in V_vector idx inc (List.map apply v) +let bitwise_not_bit (V_lit (L_aux l loc)) = match l with + | L_zero -> (V_lit (L_aux L_one loc)) + | L_one -> (V_lit (L_aux L_zero loc)) +end;; + let bitwise_binop op (V_tuple [V_vector idx inc v; V_vector idx' inc' v']) = (* typechecker ensures inc = inc', idx = idx' and length v = length v' *) let apply (x, y) = bool_to_bit(op (bit_to_bool x) (bit_to_bool y)) in @@ -74,14 +79,16 @@ let arith_op_vec op (V_tuple args) = match args with else to_vec_dec (List.length cs) n end ;; let arith_op_range_vec op (V_tuple args) = match args with - | [l1; (V_vector _ _ _ as l2)] -> - let l2 = (to_num true l2) in - arith_op op (V_tuple [l1;l2]) + | [n; (V_vector _ ord cs as l2)] -> + if ord + then arith_op_vec op (V_tuple [(to_vec_inc (List.length cs) n);l2]) + else arith_op_vec op (V_tuple [(to_vec_dec (List.length cs) n);l2]) end ;; let arith_op_vec_range op (V_tuple args) = match args with - | [(V_vector _ _ _ as l1);l2] -> - let l1 = (to_num true l1) in - arith_op op (V_tuple [l1;l2]) + | [(V_vector _ ord cs as l1);n] -> + if ord + then arith_op_vec op (V_tuple [l1;(to_vec_inc (List.length cs) n)]) + else arith_op_vec op (V_tuple [l1;(to_vec_dec (List.length cs) n)]) end ;; let compare_op op (V_tuple args) = match args with @@ -123,6 +130,7 @@ let function_map = [ ("to_vec_inc", to_vec_inc 64); ("to_vec_dec", to_vec_dec 64); ("bitwise_not", bitwise_not); + ("bitwise_not_bit", bitwise_not_bit); ("bitwise_and", bitwise_binop (&&)); ("bitwise_or", bitwise_binop (||)); ("bitwise_xor", bitwise_binop xor); |