remove look_up

This commit is contained in:
Pierre-Emmanuel Wulfman 2020-03-16 18:09:12 +01:00
parent 3cbd8f0113
commit c5d9c9ffa3
17 changed files with 5 additions and 66 deletions

View File

@ -378,9 +378,6 @@ and eval : Ast_typed.expression -> env -> value result
) )
| E_recursive {fun_name; fun_type=_; lambda} -> | E_recursive {fun_name; fun_type=_; lambda} ->
ok @@ V_Func_rec (fun_name, lambda.binder, lambda.result, env) ok @@ V_Func_rec (fun_name, lambda.binder, lambda.result, env)
| E_look_up _ ->
let serr = Format.asprintf "Unsupported construct :\n %a\n" Ast_typed.PP.expression term in
simple_fail serr
let dummy : Ast_typed.program -> string result = let dummy : Ast_typed.program -> string result =
fun prg -> fun prg ->

View File

@ -234,7 +234,6 @@ and tree_of_sum : AST.type_expression -> (AST.constructor' * AST.type_expression
and transpile_annotated_expression (ae:AST.expression) : expression result = and transpile_annotated_expression (ae:AST.expression) : expression result =
let%bind tv = transpile_type ae.type_expression in let%bind tv = transpile_type ae.type_expression in
let return ?(tv = tv) expr = ok @@ Combinators.Expression.make_tpl (expr, tv) in let return ?(tv = tv) expr = ok @@ Combinators.Expression.make_tpl (expr, tv) in
let f = transpile_annotated_expression in
let info = let info =
let title () = "translating expression" in let title () = "translating expression" in
let content () = Format.asprintf "%a" Location.pp ae.location in let content () = Format.asprintf "%a" Location.pp ae.location in
@ -439,10 +438,6 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
let init = return @@ E_make_empty_big_map (src, dst) in let init = return @@ E_make_empty_big_map (src, dst) in
List.fold_left aux init m List.fold_left aux init m
) )
| E_look_up dsi -> (
let%bind (ds', i') = bind_map_pair f dsi in
return @@ E_constant {cons_name=C_MAP_FIND_OPT;arguments=[i' ; ds']}
)
| E_matching {matchee=expr; cases=m} -> ( | E_matching {matchee=expr; cases=m} -> (
let%bind expr' = transpile_annotated_expression expr in let%bind expr' = transpile_annotated_expression expr in
match m with match m with

View File

@ -127,8 +127,8 @@ let rec compile_expression : I.expression -> O.expression result =
let%bind set = bind_map_list compile_expression set in let%bind set = bind_map_list compile_expression set in
return @@ O.E_set set return @@ O.E_set set
| I.E_look_up look_up -> | I.E_look_up look_up ->
let%bind look_up = bind_map_pair compile_expression look_up in let%bind (path, index) = bind_map_pair compile_expression look_up in
return @@ O.E_look_up look_up return @@ O.E_constant {cons_name=C_MAP_FIND_OPT;arguments=[index;path]}
| I.E_ascription {anno_expr; type_annotation} -> | I.E_ascription {anno_expr; type_annotation} ->
let%bind anno_expr = compile_expression anno_expr in let%bind anno_expr = compile_expression anno_expr in
let%bind type_annotation = idle_type_expression type_annotation in let%bind type_annotation = idle_type_expression type_annotation in

View File

@ -685,17 +685,6 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_expression -
let wrapped = Wrap.application f'.type_expression args.type_expression in let wrapped = Wrap.application f'.type_expression args.type_expression in
return_wrapped (E_application {lamb=f';args}) state'' wrapped return_wrapped (E_application {lamb=f';args}) state'' wrapped
(* | E_look_up dsi ->
* let%bind (ds, ind) = bind_map_pair (type_expression e) dsi in
* let%bind (src, dst) = bind_map_or (get_t_map , get_t_big_map) ds.type_annotation in
* let%bind _ = O.assert_type_value_eq (ind.type_annotation, src) in
* return (E_look_up (ds , ind)) (t_option dst ()) *)
| E_look_up dsi ->
let aux' state' elt = type_expression e state' elt >>? swap in
let%bind (state'' , (ds , ind)) = bind_fold_map_pair aux' state dsi in
let wrapped = Wrap.look_up ds.type_expression ind.type_expression in
return_wrapped (E_look_up (ds , ind)) state'' wrapped
(* Advanced *) (* Advanced *)
(* | E_matching (ex, m) -> ( (* | E_matching (ex, m) -> (
@ -1076,9 +1065,6 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
| E_set lst -> | E_set lst ->
let%bind lst' = bind_map_list untype_expression lst in let%bind lst' = bind_map_list untype_expression lst in
return (e_set lst') return (e_set lst')
| E_look_up dsi ->
let%bind (a , b) = bind_map_pair untype_expression dsi in
return (e_look_up a b)
| E_matching {matchee;cases} -> | E_matching {matchee;cases} ->
let%bind ae' = untype_expression matchee in let%bind ae' = untype_expression matchee in
let%bind m' = untype_matching untype_expression cases in let%bind m' = untype_matching untype_expression cases in

View File

@ -703,11 +703,6 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
lamb'.location lamb'.location
in in
return (E_application {lamb=lamb'; args=args'}) tv return (E_application {lamb=lamb'; args=args'}) tv
| E_look_up dsi ->
let%bind (ds, ind) = bind_map_pair (type_expression' e) dsi in
let%bind (src, dst) = bind_map_or (get_t_map , get_t_big_map) ds.type_expression in
let%bind _ = O.assert_type_expression_eq (ind.type_expression, src) in
return (E_look_up (ds , ind)) (t_option dst ())
(* Advanced *) (* Advanced *)
| E_matching {matchee;cases} -> ( | E_matching {matchee;cases} -> (
let%bind ex' = type_expression' e matchee in let%bind ex' = type_expression' e matchee in
@ -882,9 +877,6 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
| E_set lst -> | E_set lst ->
let%bind lst' = bind_map_list untype_expression lst in let%bind lst' = bind_map_list untype_expression lst in
return (e_set lst') return (e_set lst')
| E_look_up dsi ->
let%bind (a , b) = bind_map_pair untype_expression dsi in
return (e_look_up a b)
| E_matching {matchee;cases} -> | E_matching {matchee;cases} ->
let%bind ae' = untype_expression matchee in let%bind ae' = untype_expression matchee in
let%bind m' = untype_matching untype_expression cases in let%bind m' = untype_matching untype_expression cases in

View File

@ -16,9 +16,6 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
let%bind res = bind_fold_list (bind_fold_pair self) init' lst in let%bind res = bind_fold_list (bind_fold_pair self) init' lst in
ok res ok res
) )
| E_look_up ab ->
let%bind res = bind_fold_pair self init' ab in
ok res
| E_application {lamb; args} -> ( | E_application {lamb; args} -> (
let ab = (lamb, args) in let ab = (lamb, args) in
let%bind res = bind_fold_pair self init' ab in let%bind res = bind_fold_pair self init' ab in
@ -109,10 +106,6 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
let%bind lst' = bind_map_list (bind_map_pair self) lst in let%bind lst' = bind_map_list (bind_map_pair self) lst in
return @@ E_big_map lst' return @@ E_big_map lst'
) )
| E_look_up ab -> (
let%bind ab' = bind_map_pair self ab in
return @@ E_look_up ab'
)
| E_matching {matchee=e;cases} -> ( | E_matching {matchee=e;cases} -> (
let%bind e' = self e in let%bind e' = self e in
let%bind cases' = map_cases f cases in let%bind cases' = map_cases f cases in
@ -224,10 +217,6 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
let%bind (res, lst') = bind_fold_map_list (bind_fold_map_pair self) init' lst in let%bind (res, lst') = bind_fold_map_list (bind_fold_map_pair self) init' lst in
ok (res, return @@ E_big_map lst') ok (res, return @@ E_big_map lst')
) )
| E_look_up ab -> (
let%bind (res, ab') = bind_fold_map_pair self init' ab in
ok (res, return @@ E_look_up ab')
)
| E_matching {matchee=e;cases} -> ( | E_matching {matchee=e;cases} -> (
let%bind (res, e') = self init' e in let%bind (res, e') = self init' e in
let%bind (res,cases') = fold_map_cases f res cases in let%bind (res,cases') = fold_map_cases f res cases in

View File

@ -67,10 +67,6 @@ let rec check_recursive_call : expression_variable -> bool -> expression -> unit
| E_list el | E_set el -> | E_list el | E_set el ->
let%bind _ = bind_map_list (check_recursive_call n false) el in let%bind _ = bind_map_list (check_recursive_call n false) el in
ok () ok ()
| E_look_up (e1,e2) ->
let%bind _ = check_recursive_call n false e1 in
let%bind _ = check_recursive_call n false e2 in
ok ()
and check_recursive_call_in_matching = fun n final_path c -> and check_recursive_call_in_matching = fun n final_path c ->
match c with match c with

View File

@ -39,8 +39,6 @@ and expression_content ppf (ec : expression_content) =
fprintf ppf "list[%a]" (list_sep_d expression) lst fprintf ppf "list[%a]" (list_sep_d expression) lst
| E_set lst -> | E_set lst ->
fprintf ppf "set[%a]" (list_sep_d expression) lst fprintf ppf "set[%a]" (list_sep_d expression) lst
| E_look_up (ds, ind) ->
fprintf ppf "(%a)[%a]" expression ds expression ind
| E_lambda {binder; input_type; output_type; result} -> | E_lambda {binder; input_type; output_type; result} ->
fprintf ppf "lambda (%a:%a) : %a return %a" fprintf ppf "lambda (%a:%a) : %a return %a"
expression_variable binder expression_variable binder

View File

@ -127,7 +127,6 @@ let e_annotation ?loc anno_expr ty = make_expr ?loc @@ E_ascription {anno_expr;
let e_application ?loc a b = make_expr ?loc @@ E_application {lamb=a ; args=b} let e_application ?loc a b = make_expr ?loc @@ E_application {lamb=a ; args=b}
let e_binop ?loc name a b = make_expr ?loc @@ E_constant {cons_name = name ; arguments = [a ; b]} let e_binop ?loc name a b = make_expr ?loc @@ E_constant {cons_name = name ; arguments = [a ; b]}
let e_constant ?loc name lst = make_expr ?loc @@ E_constant {cons_name=name ; arguments = lst} let e_constant ?loc name lst = make_expr ?loc @@ E_constant {cons_name=name ; arguments = lst}
let e_look_up ?loc x y = make_expr ?loc @@ E_look_up (x , y)
let e_cond ?loc expr match_true match_false = e_matching expr ?loc (Match_bool {match_true; match_false}) let e_cond ?loc expr match_true match_false = e_matching expr ?loc (Match_bool {match_true; match_false})
(* (*
let e_assign ?loc a b c = location_wrap ?loc @@ E_assign (Var.of_name a , b , c) (* TODO handlethat*) let e_assign ?loc a b c = location_wrap ?loc @@ E_assign (Var.of_name a , b , c) (* TODO handlethat*)

View File

@ -89,7 +89,6 @@ val e_annotation : ?loc:Location.t -> expression -> type_expression -> expressio
val e_application : ?loc:Location.t -> expression -> expression -> expression val e_application : ?loc:Location.t -> expression -> expression -> expression
val e_binop : ?loc:Location.t -> constant' -> expression -> expression -> expression val e_binop : ?loc:Location.t -> constant' -> expression -> expression -> expression
val e_constant : ?loc:Location.t -> constant' -> expression list -> expression val e_constant : ?loc:Location.t -> constant' -> expression list -> expression
val e_look_up : ?loc:Location.t -> expression -> expression -> expression
val ez_match_variant : ((string * string ) * 'a ) list -> ('a,unit) matching_content val ez_match_variant : ((string * string ) * 'a ) list -> ('a,unit) matching_content
val e_matching_variant : ?loc:Location.t -> expression -> ((string * string) * expression) list -> expression val e_matching_variant : ?loc:Location.t -> expression -> ((string * string) * expression) list -> expression

View File

@ -183,8 +183,8 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
| (E_variable _, _) | (E_lambda _, _) | (E_variable _, _) | (E_lambda _, _)
| (E_application _, _) | (E_let_in _, _) | (E_application _, _) | (E_let_in _, _)
| (E_recursive _,_) | (E_record_accessor _, _) | (E_recursive _,_) | (E_record_accessor _, _)
| (E_look_up _, _) | (E_matching _, _) | (E_matching _, _)
-> simple_fail "comparing not a value" -> simple_fail "comparing not a value"
let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b) let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b)

View File

@ -49,7 +49,6 @@ and expression_content =
| E_big_map of (expression * expression) list (*move to operator *) | E_big_map of (expression * expression) list (*move to operator *)
| E_list of expression list | E_list of expression list
| E_set of expression list | E_set of expression list
| E_look_up of (expression * expression)
(* Advanced *) (* Advanced *)
| E_ascription of ascription | E_ascription of ascription

View File

@ -40,8 +40,6 @@ and expression_content ppf (ec: expression_content) =
fprintf ppf "list[%a]" (list_sep_d expression) lst fprintf ppf "list[%a]" (list_sep_d expression) lst
| E_set lst -> | E_set lst ->
fprintf ppf "set[%a]" (list_sep_d expression) lst fprintf ppf "set[%a]" (list_sep_d expression) lst
| E_look_up (ds, ind) ->
fprintf ppf "(%a)[%a]" expression ds expression ind
| E_lambda {binder; result} -> | E_lambda {binder; result} ->
fprintf ppf "lambda (%a) return %a" expression_variable binder fprintf ppf "lambda (%a) return %a" expression_variable binder
expression result expression result

View File

@ -214,7 +214,6 @@ module Free_variables = struct
| E_list lst -> unions @@ List.map self lst | E_list lst -> unions @@ List.map self lst
| E_set lst -> unions @@ List.map self lst | E_set lst -> unions @@ List.map self lst
| (E_map m | E_big_map m) -> unions @@ List.map self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m | (E_map m | E_big_map m) -> unions @@ List.map self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m
| E_look_up (a , b) -> unions @@ List.map self [ a ; b ]
| E_matching {matchee; cases;_} -> union (self matchee) (matching_expression b cases) | E_matching {matchee; cases;_} -> union (self matchee) (matching_expression b cases)
| E_let_in { let_binder; rhs; let_result; _} -> | E_let_in { let_binder; rhs; let_result; _} ->
let b' = union (singleton let_binder) b in let b' = union (singleton let_binder) b in
@ -534,7 +533,7 @@ let rec assert_value_eq (a, b: (expression*expression)) : unit result =
| (E_literal _, _) | (E_variable _, _) | (E_application _, _) | (E_literal _, _) | (E_variable _, _) | (E_application _, _)
| (E_lambda _, _) | (E_let_in _, _) | (E_recursive _, _) | (E_lambda _, _) | (E_let_in _, _) | (E_recursive _, _)
| (E_record_accessor _, _) | (E_record_update _,_) | (E_record_accessor _, _) | (E_record_update _,_)
| (E_look_up _, _) | (E_matching _, _) | (E_matching _, _)
-> fail @@ error_uncomparable_values "can't compare sequences nor loops" a b -> fail @@ error_uncomparable_values "can't compare sequences nor loops" a b
let merge_annotation (a:type_expression option) (b:type_expression option) err : type_expression result = let merge_annotation (a:type_expression option) (b:type_expression option) err : type_expression result =

View File

@ -84,9 +84,6 @@ module Captured_variables = struct
| (E_map m | E_big_map m) -> | (E_map m | E_big_map m) ->
let%bind lst' = bind_map_list self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m in let%bind lst' = bind_map_list self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m in
ok @@ unions lst' ok @@ unions lst'
| E_look_up (a , b) ->
let%bind lst' = bind_map_list self [ a ; b ] in
ok @@ unions lst'
| E_matching {matchee;cases;_} -> | E_matching {matchee;cases;_} ->
let%bind a' = self matchee in let%bind a' = self matchee in
let%bind cs' = matching_expression b cases in let%bind cs' = matching_expression b cases in

View File

@ -55,7 +55,6 @@ and expression_content =
| E_big_map of (expression * expression) list (*move to operator *) | E_big_map of (expression * expression) list (*move to operator *)
| E_list of expression list | E_list of expression list
| E_set of expression list | E_set of expression list
| E_look_up of (expression * expression)
and constant = and constant =
{ cons_name: constant' { cons_name: constant'

View File

@ -210,10 +210,6 @@ module Substitution = struct
| T.E_set vals -> | T.E_set vals ->
let%bind vals = bind_map_list (s_expression ~substs) vals in let%bind vals = bind_map_list (s_expression ~substs) vals in
ok @@ T.E_set vals ok @@ T.E_set vals
| T.E_look_up (val1, val2) ->
let%bind val1 = s_expression ~substs val1 in
let%bind val2 = s_expression ~substs val2 in
ok @@ T.E_look_up (val1 , val2)
| T.E_matching {matchee;cases} -> | T.E_matching {matchee;cases} ->
let%bind matchee = s_expression ~substs matchee in let%bind matchee = s_expression ~substs matchee in
let%bind cases = s_matching_expr ~substs cases in let%bind cases = s_matching_expr ~substs cases in