balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Replace OCaml tuples with record in ast_typed

Browse Source
This commit is contained in:
Suzanne Dupéron 2020-02-17 18:09:35 +01:00
parent ea74ed8a2c
commit 4f36ff3bcb
5 changed files with 52 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/passes/6-transpiler/transpiler.ml
View File

@ -338,7 +338,7 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
trace_option (corner_case ~loc:__LOC__ "missing var") @@
AST.Environment.get_opt v f.environment in
match elt.definition with
| ED_declaration (f , _) -> (
| ED_declaration { expr = f ; free_variables = _ } -> (
match f.expression_content with
| E_lambda l -> lambda_to_iterator_body f l
| _ -> fail @@ unsupported_iterator f.location

42
src/stages/ast_typed/environment.ml
View File

@ -6,24 +6,28 @@ let make_element : type_expression -> full_environment -> environment_element_de
fun type_value source_environment definition -> {type_value ; source_environment ; definition}
let make_element_binder = fun t s -> make_element t s ED_binder
let make_element_declaration = fun s (ae : expression) ->
let free_variables = Misc.Free_variables.(expression empty ae) in
make_element (get_type_expression ae) s (ED_declaration (ae , free_variables))
let make_element_declaration = fun s (expr : expression) ->
let free_variables = Misc.Free_variables.(expression empty expr) in
make_element (get_type_expression expr) s (ED_declaration {expr ; free_variables})
module Small = struct
type t = small_environment
let empty : t = ([] , [])
let empty : t = { expression_environment = [] ; type_environment = [] }
let get_environment : t -> environment = fst
let get_type_environment : t -> type_environment = snd
let map_environment : _ -> t -> t = fun f (a , b) -> (f a , b)
let map_type_environment : _ -> t -> t = fun f (a , b) -> (a , f b)
(* TODO: generate *)
let get_environment : t -> environment = fun { expression_environment ; type_environment=_ } -> expression_environment
(* TODO: generate *)
let get_type_environment : t -> type_environment = fun { expression_environment=_ ; type_environment } -> type_environment
(* TODO: generate *)
let map_environment : _ -> t -> t = fun f { expression_environment ; type_environment } -> { expression_environment = f expression_environment ; type_environment }
let map_type_environment : _ -> t -> t = fun f { expression_environment ; type_environment } -> { expression_environment ; type_environment = f type_environment }
let add : expression_variable -> element -> t -> t = fun k v -> map_environment (fun x -> (k , v) :: x)
let add_type : type_variable -> type_expression -> t -> t = fun k v -> map_type_environment (fun x -> (k , v) :: x)
let get_opt : expression_variable -> t -> element option = fun k x -> List.assoc_opt k (get_environment x)
let get_type_opt : type_variable -> t -> type_expression option = fun k x -> List.assoc_opt k (get_type_environment x)
let add : expression_variable -> element -> t -> t = fun expr_var env_elt -> map_environment (fun x -> {expr_var ; env_elt} :: x)
let add_type : type_variable -> type_expression -> t -> t = fun type_variable type_ -> map_type_environment (fun x -> { type_variable ; type_ } :: x)
(* TODO: generate : these are now messy, clean them up. *)
let get_opt : expression_variable -> t -> element option = fun k x -> Option.bind (fun {expr_var=_ ; env_elt} -> Some env_elt) @@ List.find_opt (fun {expr_var ; env_elt=_} -> Var.equal expr_var k) (get_environment x)
let get_type_opt : type_variable -> t -> type_expression option = fun k x -> Option.bind (fun {type_variable=_ ; type_} -> Some type_) @@ List.find_opt (fun {type_variable ; type_=_} -> Var.equal type_variable k) (get_type_environment x)
end
type t = full_environment
@ -41,11 +45,11 @@ let get_type_opt : type_variable -> t -> type_expression option = fun k x -> Lis
let get_constructor : constructor' -> t -> (type_expression * type_expression) option = fun k x -> (* Left is the constructor, right is the sum type *)
let aux = fun x ->
let aux = fun (_type_name , x) ->
match x.type_content with
let aux = fun {type_variable=_ ; type_} ->
match type_.type_content with
| T_sum m ->
(match CMap.find_opt k m with
Some km -> Some (km , x)
Some km -> Some (km , type_)
| None -> None)
| _ -> None
in
@ -60,11 +64,11 @@ module PP = struct
let list_sep_scope x = list_sep x (const " | ")
let environment_element = fun ppf (k , (ele : environment_element)) ->
fprintf ppf "%a -> %a" PP.expression_variable k PP.type_expression ele.type_value
let environment_element = fun ppf {expr_var ; env_elt} ->
fprintf ppf "%a -> %a" PP.expression_variable expr_var PP.type_expression env_elt.type_value
let type_environment_element = fun ppf (k , tv) ->
fprintf ppf "%a -> %a" PP.type_variable k PP.type_expression tv
let type_environment_element = fun ppf {type_variable ; type_} ->
fprintf ppf "%a -> %a" PP.type_variable type_variable PP.type_expression type_
let environment : _ -> environment -> unit = fun ppf lst ->
fprintf ppf "E[%a]" (list_sep environment_element (const " , ")) lst

2
src/stages/ast_typed/misc_smart.ml
View File

@ -59,7 +59,7 @@ module Captured_variables = struct
Environment.get_opt name ae.environment in
match env_element.definition with
| ED_binder -> ok empty
| ED_declaration (_ , _) -> simple_fail "todo"
| ED_declaration {expr=_ ; free_variables=_} -> simple_fail "todo"
)
| E_application {expr1;expr2} ->
let%bind lst' = bind_map_list self [ expr1 ; expr2 ] in

24
src/stages/ast_typed/types.ml
View File

@ -117,8 +117,10 @@ and environment_element_definition =
| ED_binder
| ED_declaration of environment_element_definition_declaration
and environment_element_definition_declaration =
(expression * free_variables)
and environment_element_definition_declaration = {
expr: expression ;
free_variables: free_variables ;
}
and free_variables = expression_variable list
@ -130,17 +132,23 @@ and environment_element = {
and environment = environment_binding list
and environment_binding =
(expression_variable * environment_element)
and environment_binding = {
expr_var: expression_variable ;
env_elt: environment_element ;
}
and type_environment = type_environment_binding list
and type_environment_binding =
(type_variable * type_expression)
and type_environment_binding = {
type_variable: type_variable ;
type_: type_expression ;
}
(* SUBST ??? *)
and small_environment =
(environment * type_environment)
and small_environment = {
expression_environment: environment ;
type_environment: type_environment ;
}
and full_environment = small_environment List.Ne.t

22
src/stages/typesystem/misc.ml
View File

@ -17,25 +17,25 @@ module Substitution = struct
let rec rec_yes = true
and s_environment_element_definition ~substs = function
| T.ED_binder -> ok @@ T.ED_binder
| T.ED_declaration (val_, free_variables) ->
let%bind val_ = s_expression ~substs val_ in
| T.ED_declaration T.{expr ; free_variables} ->
let%bind expr = s_expression ~substs expr in
let%bind free_variables = bind_map_list (s_variable ~substs) free_variables in
ok @@ T.ED_declaration (val_, free_variables)
ok @@ T.ED_declaration {expr ; free_variables}
and s_environment : T.environment w = fun ~substs env ->
bind_map_list (fun (variable, T.{ type_value; source_environment; definition }) ->
bind_map_list (fun T.{expr_var=variable ; env_elt={ type_value; source_environment; definition }} ->
let%bind type_value = s_type_expression ~substs type_value in
let%bind source_environment = s_full_environment ~substs source_environment in
let%bind definition = s_environment_element_definition ~substs definition in
ok @@ (variable, T.{ type_value; source_environment; definition })) env
ok @@ T.{expr_var=variable ; env_elt={ type_value; source_environment; definition }}) env
and s_type_environment : T.type_environment w = fun ~substs tenv ->
bind_map_list (fun (type_variable , type_value) ->
bind_map_list (fun T.{type_variable ; type_} ->
let%bind type_variable = s_type_variable ~substs type_variable in
let%bind type_value = s_type_expression ~substs type_value in
ok @@ (type_variable , type_value)) tenv
and s_small_environment : T.small_environment w = fun ~substs (environment, type_environment) ->
let%bind environment = s_environment ~substs environment in
let%bind type_ = s_type_expression ~substs type_ in
ok @@ T.{type_variable ; type_}) tenv
and s_small_environment : T.small_environment w = fun ~substs T.{expression_environment ; type_environment} ->
let%bind expression_environment = s_environment ~substs expression_environment in
let%bind type_environment = s_type_environment ~substs type_environment in
ok @@ (environment, type_environment)
ok @@ T.{ expression_environment ; type_environment }
and s_full_environment : T.full_environment w = fun ~substs (a , b) ->
let%bind a = s_small_environment ~substs a in
let%bind b = bind_map_list (s_small_environment ~substs) b in