From f8555e3c1ecfc9667795c19975067b37ba5c617f Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 31 Aug 2023 17:08:08 +0200 Subject: Update TranslateCore and factor out some definitions in PrintPure --- compiler/TranslateCore.ml | 46 ++++++++++++++++++++++++++++++---------------- 1 file changed, 30 insertions(+), 16 deletions(-) (limited to 'compiler/TranslateCore.ml') diff --git a/compiler/TranslateCore.ml b/compiler/TranslateCore.ml index ba5e237b..1b1572d6 100644 --- a/compiler/TranslateCore.ml +++ b/compiler/TranslateCore.ml @@ -18,25 +18,37 @@ type fun_context = { } [@@deriving show] +type trait_decls_context = C.trait_decls_context [@@deriving show] +type trait_impls_context = C.trait_impls_context [@@deriving show] type global_context = C.global_context [@@deriving show] type trans_ctx = { type_context : type_context; fun_context : fun_context; global_context : global_context; + trait_decls_context : trait_decls_context; + trait_impls_context : trait_impls_context; } type fun_and_loops = Pure.fun_decl * Pure.fun_decl list type pure_fun_translation_no_loops = Pure.fun_decl * Pure.fun_decl list type pure_fun_translation = fun_and_loops * fun_and_loops list -let type_decl_to_string (ctx : trans_ctx) (def : Pure.type_decl) : string = - let type_params = def.type_params in - let cg_params = def.const_generic_params in +let trans_ctx_to_type_formatter (ctx : trans_ctx) + (type_params : Pure.type_var list) + (const_generic_params : Pure.const_generic_var list) : + PrintPure.type_formatter = let type_decls = ctx.type_context.type_decls in let global_decls = ctx.global_context.global_decls in + let trait_decls = ctx.trait_decls_context.trait_decls in + let trait_impls = ctx.trait_impls_context.trait_impls in + PrintPure.mk_type_formatter type_decls global_decls trait_decls trait_impls + type_params const_generic_params + +let type_decl_to_string (ctx : trans_ctx) (def : Pure.type_decl) : string = + let generics = def.generics in let fmt = - PrintPure.mk_type_formatter type_decls global_decls type_params cg_params + trans_ctx_to_type_formatter ctx generics.types generics.const_generics in PrintPure.type_decl_to_string fmt def @@ -44,27 +56,29 @@ let type_id_to_string (ctx : trans_ctx) (id : Pure.TypeDeclId.id) : string = Print.fun_name_to_string (Pure.TypeDeclId.Map.find id ctx.type_context.type_decls).name -let fun_sig_to_string (ctx : trans_ctx) (sg : Pure.fun_sig) : string = - let type_params = sg.type_params in - let cg_params = sg.const_generic_params in +let trans_ctx_to_ast_formatter (ctx : trans_ctx) + (type_params : Pure.type_var list) + (const_generic_params : Pure.const_generic_var list) : + PrintPure.ast_formatter = let type_decls = ctx.type_context.type_decls in let fun_decls = ctx.fun_context.fun_decls in let global_decls = ctx.global_context.global_decls in + let trait_decls = ctx.trait_decls_context.trait_decls in + let trait_impls = ctx.trait_impls_context.trait_impls in + PrintPure.mk_ast_formatter type_decls fun_decls global_decls trait_decls + trait_impls type_params const_generic_params + +let fun_sig_to_string (ctx : trans_ctx) (sg : Pure.fun_sig) : string = + let generics = sg.generics in let fmt = - PrintPure.mk_ast_formatter type_decls fun_decls global_decls type_params - cg_params + trans_ctx_to_ast_formatter ctx generics.types generics.const_generics in PrintPure.fun_sig_to_string fmt sg let fun_decl_to_string (ctx : trans_ctx) (def : Pure.fun_decl) : string = - let type_params = def.signature.type_params in - let cg_params = def.signature.const_generic_params in - let type_decls = ctx.type_context.type_decls in - let fun_decls = ctx.fun_context.fun_decls in - let global_decls = ctx.global_context.global_decls in + let generics = def.signature.generics in let fmt = - PrintPure.mk_ast_formatter type_decls fun_decls global_decls type_params - cg_params + trans_ctx_to_ast_formatter ctx generics.types generics.const_generics in PrintPure.fun_decl_to_string fmt def -- cgit v1.2.3 From b42c0a8fa4708d6bf8424d63b6a7fe4964ba0e3d Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sun, 3 Sep 2023 15:18:36 +0200 Subject: Make progress on the extraction --- compiler/TranslateCore.ml | 1 + 1 file changed, 1 insertion(+) (limited to 'compiler/TranslateCore.ml') diff --git a/compiler/TranslateCore.ml b/compiler/TranslateCore.ml index 1b1572d6..34a6434f 100644 --- a/compiler/TranslateCore.ml +++ b/compiler/TranslateCore.ml @@ -22,6 +22,7 @@ type trait_decls_context = C.trait_decls_context [@@deriving show] type trait_impls_context = C.trait_impls_context [@@deriving show] type global_context = C.global_context [@@deriving show] +(* TODO: we should use Contexts.decls_ctx *) type trans_ctx = { type_context : type_context; fun_context : fun_context; -- cgit v1.2.3 From 9fb4886f9003f75e8d3aafaf51586ab5f9001744 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sun, 3 Sep 2023 19:18:25 +0200 Subject: Update the type TranslateCore.fun_and_loops --- compiler/TranslateCore.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'compiler/TranslateCore.ml') diff --git a/compiler/TranslateCore.ml b/compiler/TranslateCore.ml index 34a6434f..9694c95e 100644 --- a/compiler/TranslateCore.ml +++ b/compiler/TranslateCore.ml @@ -31,7 +31,7 @@ type trans_ctx = { trait_impls_context : trait_impls_context; } -type fun_and_loops = Pure.fun_decl * Pure.fun_decl list +type fun_and_loops = { f : Pure.fun_decl; loops : Pure.fun_decl list } type pure_fun_translation_no_loops = Pure.fun_decl * Pure.fun_decl list type pure_fun_translation = fun_and_loops * fun_and_loops list -- cgit v1.2.3 From cce09bb0fb64b07b07613d7db59857651e040c20 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sun, 3 Sep 2023 19:29:11 +0200 Subject: Update TranslateCore.pure_fun_translation --- compiler/TranslateCore.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'compiler/TranslateCore.ml') diff --git a/compiler/TranslateCore.ml b/compiler/TranslateCore.ml index 9694c95e..9fd27c59 100644 --- a/compiler/TranslateCore.ml +++ b/compiler/TranslateCore.ml @@ -33,7 +33,7 @@ type trans_ctx = { type fun_and_loops = { f : Pure.fun_decl; loops : Pure.fun_decl list } type pure_fun_translation_no_loops = Pure.fun_decl * Pure.fun_decl list -type pure_fun_translation = fun_and_loops * fun_and_loops list +type pure_fun_translation = { fwd : fun_and_loops; backs : fun_and_loops list } let trans_ctx_to_type_formatter (ctx : trans_ctx) (type_params : Pure.type_var list) -- cgit v1.2.3 From dfcbfab4030be2f03b159a4b298ed75ac2f236ae Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sun, 3 Sep 2023 19:41:03 +0200 Subject: Add the keep_fwd field in TranslateCore.pure_fun_translation --- compiler/TranslateCore.ml | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) (limited to 'compiler/TranslateCore.ml') diff --git a/compiler/TranslateCore.ml b/compiler/TranslateCore.ml index 9fd27c59..f31dc458 100644 --- a/compiler/TranslateCore.ml +++ b/compiler/TranslateCore.ml @@ -33,7 +33,18 @@ type trans_ctx = { type fun_and_loops = { f : Pure.fun_decl; loops : Pure.fun_decl list } type pure_fun_translation_no_loops = Pure.fun_decl * Pure.fun_decl list -type pure_fun_translation = { fwd : fun_and_loops; backs : fun_and_loops list } + +type pure_fun_translation = { + keep_fwd : bool; + (** Should we extract the forward function? + + If the forward function returns `()` and there is exactly one + backward function, we may merge the forward into the backward + function and thus don't extract the forward function)? + *) + fwd : fun_and_loops; + backs : fun_and_loops list; +} let trans_ctx_to_type_formatter (ctx : trans_ctx) (type_params : Pure.type_var list) -- cgit v1.2.3 From 47bc2ba74c90c1a29a081b8950022f74408f037e Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sun, 17 Sep 2023 05:15:18 +0200 Subject: Merge trans_ctx and decls_ctx --- compiler/TranslateCore.ml | 45 ++++++++++++--------------------------------- 1 file changed, 12 insertions(+), 33 deletions(-) (limited to 'compiler/TranslateCore.ml') diff --git a/compiler/TranslateCore.ml b/compiler/TranslateCore.ml index f31dc458..3427fd43 100644 --- a/compiler/TranslateCore.ml +++ b/compiler/TranslateCore.ml @@ -10,27 +10,7 @@ module FA = FunsAnalysis (** The local logger *) let log = L.translate_log -type type_context = C.type_context [@@deriving show] - -type fun_context = { - fun_decls : A.fun_decl A.FunDeclId.Map.t; - fun_infos : FA.fun_info A.FunDeclId.Map.t; -} -[@@deriving show] - -type trait_decls_context = C.trait_decls_context [@@deriving show] -type trait_impls_context = C.trait_impls_context [@@deriving show] -type global_context = C.global_context [@@deriving show] - -(* TODO: we should use Contexts.decls_ctx *) -type trans_ctx = { - type_context : type_context; - fun_context : fun_context; - global_context : global_context; - trait_decls_context : trait_decls_context; - trait_impls_context : trait_impls_context; -} - +type trans_ctx = C.decls_ctx [@@deriving show] type fun_and_loops = { f : Pure.fun_decl; loops : Pure.fun_decl list } type pure_fun_translation_no_loops = Pure.fun_decl * Pure.fun_decl list @@ -50,10 +30,10 @@ let trans_ctx_to_type_formatter (ctx : trans_ctx) (type_params : Pure.type_var list) (const_generic_params : Pure.const_generic_var list) : PrintPure.type_formatter = - let type_decls = ctx.type_context.type_decls in - let global_decls = ctx.global_context.global_decls in - let trait_decls = ctx.trait_decls_context.trait_decls in - let trait_impls = ctx.trait_impls_context.trait_impls in + let type_decls = ctx.type_ctx.type_decls in + let global_decls = ctx.global_ctx.global_decls in + let trait_decls = ctx.trait_decls_ctx.trait_decls in + let trait_impls = ctx.trait_impls_ctx.trait_impls in PrintPure.mk_type_formatter type_decls global_decls trait_decls trait_impls type_params const_generic_params @@ -66,17 +46,17 @@ let type_decl_to_string (ctx : trans_ctx) (def : Pure.type_decl) : string = let type_id_to_string (ctx : trans_ctx) (id : Pure.TypeDeclId.id) : string = Print.fun_name_to_string - (Pure.TypeDeclId.Map.find id ctx.type_context.type_decls).name + (Pure.TypeDeclId.Map.find id ctx.type_ctx.type_decls).name let trans_ctx_to_ast_formatter (ctx : trans_ctx) (type_params : Pure.type_var list) (const_generic_params : Pure.const_generic_var list) : PrintPure.ast_formatter = - let type_decls = ctx.type_context.type_decls in - let fun_decls = ctx.fun_context.fun_decls in - let global_decls = ctx.global_context.global_decls in - let trait_decls = ctx.trait_decls_context.trait_decls in - let trait_impls = ctx.trait_impls_context.trait_impls in + let type_decls = ctx.type_ctx.type_decls in + let fun_decls = ctx.fun_ctx.fun_decls in + let global_decls = ctx.global_ctx.global_decls in + let trait_decls = ctx.trait_decls_ctx.trait_decls in + let trait_impls = ctx.trait_impls_ctx.trait_impls in PrintPure.mk_ast_formatter type_decls fun_decls global_decls trait_decls trait_impls type_params const_generic_params @@ -95,5 +75,4 @@ let fun_decl_to_string (ctx : trans_ctx) (def : Pure.fun_decl) : string = PrintPure.fun_decl_to_string fmt def let fun_decl_id_to_string (ctx : trans_ctx) (id : A.FunDeclId.id) : string = - Print.fun_name_to_string - (A.FunDeclId.Map.find id ctx.fun_context.fun_decls).name + Print.fun_name_to_string (A.FunDeclId.Map.find id ctx.fun_ctx.fun_decls).name -- cgit v1.2.3