From 38c11c9095c44e48ad37d600d346d033f7d47b93 Mon Sep 17 00:00:00 2001 From: Adam Megacz Date: Mon, 9 May 2011 14:12:14 -0700 Subject: [PATCH] add support for hetmet_unflatten --- compiler/deSugar/Desugar.lhs | 13 +++++++++++-- compiler/hetmet | 2 +- compiler/prelude/PrelNames.lhs | 10 ++++++---- libraries/base | 2 +- 4 files changed, 19 insertions(+), 8 deletions(-) diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs index 4e67111..476ab2f 100644 --- a/compiler/deSugar/Desugar.lhs +++ b/compiler/deSugar/Desugar.lhs @@ -113,6 +113,7 @@ deSugar hsc_env , undefined , undefined , undefined + , undefined )) _ -> do (binds_cvr,ds_hpc_info, modBreaks) @@ -132,6 +133,7 @@ deSugar hsc_env ; hetmet_brak <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_brak_name else return undefined ; hetmet_esc <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_esc_name else return undefined ; hetmet_flatten <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_flatten_name else return undefined + ; hetmet_unflatten <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_unflatten_name else return undefined ; hetmet_flattened_id <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_flattened_id_name else return undefined ; hetmet_PGArrow <- if dopt Opt_F_coqpass dflags then dsLookupTyCon hetmet_PGArrow_name else return undefined ; hetmet_pga_id <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_id_name else return undefined @@ -158,7 +160,10 @@ deSugar hsc_env , foreign_prs `appOL` core_prs `appOL` spec_prs , spec_rules ++ ds_rules, ds_vects , ds_fords `appendStubC` hpc_init - , ds_hpc_info, modBreaks, hetmet_brak, hetmet_esc, hetmet_flatten, hetmet_flattened_id + , ds_hpc_info, modBreaks, hetmet_brak, hetmet_esc + , hetmet_flatten + , hetmet_unflatten + , hetmet_flattened_id , hetmet_PGArrow , hetmet_pga_id , hetmet_pga_comp @@ -182,7 +187,10 @@ deSugar hsc_env ; case mb_res of { Nothing -> return (msgs, Nothing) ; Just (ds_ev_binds, all_prs, all_rules, ds_vects, ds_fords,ds_hpc_info, modBreaks - , hetmet_brak, hetmet_esc, hetmet_flatten, hetmet_flattened_id + , hetmet_brak, hetmet_esc + , hetmet_flatten + , hetmet_unflatten + , hetmet_flattened_id , hetmet_PGArrow , hetmet_pga_id , hetmet_pga_comp @@ -231,6 +239,7 @@ deSugar hsc_env hetmet_brak hetmet_esc hetmet_flatten + hetmet_unflatten hetmet_flattened_id us ds_binds diff --git a/compiler/hetmet b/compiler/hetmet index dac68fd..35d3a59 160000 --- a/compiler/hetmet +++ b/compiler/hetmet @@ -1 +1 @@ -Subproject commit dac68fdf6d495ed60d3e4c5738c27ca7fffc1399 +Subproject commit 35d3a59796735e5341389fa6a145f62dcea9c3fc diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 8456996..3dccbfc 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -213,7 +213,7 @@ basicKnownKeyNames randomClassName, randomGenClassName, monadPlusClassName, -- Code types - hetmet_brak_name, hetmet_esc_name, hetmet_csp_name, hetmet_flatten_name, hetmet_flattened_id_name, + hetmet_brak_name, hetmet_esc_name, hetmet_csp_name, hetmet_flatten_name, hetmet_unflatten_name, hetmet_flattened_id_name, hetmet_guest_integer_literal_name, hetmet_guest_string_literal_name, hetmet_guest_char_literal_name, hetmet_PGArrow_name, @@ -803,12 +803,13 @@ emptyPName pkg = varQual (gHC_PARR pkg) (fsLit "emptyP") empty appPName pkg = varQual (gHC_PARR pkg) (fsLit "+:+") appPIdKey -- code type things -hetmet_brak_name, hetmet_esc_name, hetmet_csp_name, hetmet_flatten_name, hetmet_flattened_id_name :: Name +hetmet_brak_name, hetmet_esc_name, hetmet_csp_name, hetmet_flatten_name, hetmet_unflatten_name, hetmet_flattened_id_name :: Name hetmet_guest_integer_literal_name, hetmet_guest_string_literal_name, hetmet_guest_char_literal_name :: Name hetmet_brak_name = varQual gHC_HETMET_CODETYPES (fsLit "hetmet_brak") hetmet_brak_key hetmet_esc_name = varQual gHC_HETMET_CODETYPES (fsLit "hetmet_esc") hetmet_esc_key hetmet_csp_name = varQual gHC_HETMET_CODETYPES (fsLit "hetmet_csp") hetmet_csp_key hetmet_flatten_name = varQual gHC_HETMET_CODETYPES (fsLit "pga_flatten") hetmet_flatten_key +hetmet_unflatten_name = varQual gHC_HETMET_CODETYPES (fsLit "pga_unflatten") hetmet_unflatten_key hetmet_flattened_id_name = varQual gHC_HETMET_CODETYPES (fsLit "pga_flattened_id") hetmet_flattened_id_key hetmet_guest_integer_literal_name = varQual gHC_HETMET_CODETYPES (fsLit "guestIntegerLiteral") hetmet_guest_integer_literal_key hetmet_guest_string_literal_name = varQual gHC_HETMET_CODETYPES (fsLit "guestStringLiteral") hetmet_guest_string_literal_key @@ -1410,7 +1411,7 @@ toIntegerClassOpKey = mkPreludeMiscIdUnique 129 toRationalClassOpKey = mkPreludeMiscIdUnique 130 -- code types -hetmet_brak_key, hetmet_esc_key, hetmet_csp_key, hetmet_flatten_key, hetmet_flattened_id_key :: Unique +hetmet_brak_key, hetmet_esc_key, hetmet_csp_key, hetmet_flatten_key, hetmet_unflatten_key, hetmet_flattened_id_key :: Unique hetmet_brak_key = mkPreludeMiscIdUnique 131 hetmet_esc_key = mkPreludeMiscIdUnique 132 hetmet_csp_key = mkPreludeMiscIdUnique 133 @@ -1455,7 +1456,8 @@ hetmet_pga_curryl_key = mkPreludeMiscIdUnique 153 hetmet_pga_curryr_key :: Unique hetmet_pga_curryr_key = mkPreludeMiscIdUnique 154 hetmet_flatten_key = mkPreludeMiscIdUnique 155 -hetmet_flattened_id_key = mkPreludeMiscIdUnique 156 +hetmet_unflatten_key = mkPreludeMiscIdUnique 156 +hetmet_flattened_id_key = mkPreludeMiscIdUnique 157 diff --git a/libraries/base b/libraries/base index 0062aca..9bcc30e 160000 --- a/libraries/base +++ b/libraries/base @@ -1 +1 @@ -Subproject commit 0062aca5c18e35baea51593bd8b0812a16d5afd4 +Subproject commit 9bcc30e533d29ee316a7ba572254765b97b4b0d0 -- 1.7.10.4