From: Adam Megacz Date: Mon, 9 May 2011 08:19:23 +0000 (-0700) Subject: add support for hetmet_flatten casting variable X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=4c1f0681d85da48deaf706c0f05d971deb48261f add support for hetmet_flatten casting variable --- diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs index 4276414..4e67111 100644 --- a/compiler/deSugar/Desugar.lhs +++ b/compiler/deSugar/Desugar.lhs @@ -111,6 +111,8 @@ deSugar hsc_env , undefined , undefined , undefined + , undefined + , undefined )) _ -> do (binds_cvr,ds_hpc_info, modBreaks) @@ -129,6 +131,8 @@ deSugar hsc_env ; ds_vects <- mapM dsVect vects ; 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_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 ; hetmet_pga_comp <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_comp_name else return undefined @@ -154,7 +158,7 @@ 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 + , ds_hpc_info, modBreaks, hetmet_brak, hetmet_esc, hetmet_flatten, hetmet_flattened_id , hetmet_PGArrow , hetmet_pga_id , hetmet_pga_comp @@ -177,7 +181,8 @@ 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 + 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_PGArrow , hetmet_pga_id , hetmet_pga_comp @@ -225,6 +230,8 @@ deSugar hsc_env ; return (coqPassCoreToCore hetmet_brak hetmet_esc + hetmet_flatten + hetmet_flattened_id us ds_binds hetmet_PGArrow diff --git a/compiler/hetmet b/compiler/hetmet index 4ad68fe..dac68fd 160000 --- a/compiler/hetmet +++ b/compiler/hetmet @@ -1 +1 @@ -Subproject commit 4ad68fe2894b35c21f2feb7b176d2b0f146ff6d3 +Subproject commit dac68fdf6d495ed60d3e4c5738c27ca7fffc1399 diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 69eb8e9..8456996 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_brak_name, hetmet_esc_name, hetmet_csp_name, hetmet_flatten_name, hetmet_flattened_id_name, hetmet_guest_integer_literal_name, hetmet_guest_string_literal_name, hetmet_guest_char_literal_name, hetmet_PGArrow_name, @@ -803,11 +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 :: Name +hetmet_brak_name, hetmet_esc_name, hetmet_csp_name, hetmet_flatten_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_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 hetmet_guest_char_literal_name = varQual gHC_HETMET_CODETYPES (fsLit "guestCharLiteral") hetmet_guest_char_literal_key @@ -1408,7 +1410,7 @@ toIntegerClassOpKey = mkPreludeMiscIdUnique 129 toRationalClassOpKey = mkPreludeMiscIdUnique 130 -- code types -hetmet_brak_key, hetmet_esc_key, hetmet_csp_key :: Unique +hetmet_brak_key, hetmet_esc_key, hetmet_csp_key, hetmet_flatten_key, hetmet_flattened_id_key :: Unique hetmet_brak_key = mkPreludeMiscIdUnique 131 hetmet_esc_key = mkPreludeMiscIdUnique 132 hetmet_csp_key = mkPreludeMiscIdUnique 133 @@ -1452,6 +1454,8 @@ hetmet_pga_curryl_key :: Unique 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 diff --git a/libraries/base b/libraries/base index 5fb5033..0062aca 160000 --- a/libraries/base +++ b/libraries/base @@ -1 +1 @@ -Subproject commit 5fb503378b4f2110ef044404092fdf21be48117e +Subproject commit 0062aca5c18e35baea51593bd8b0812a16d5afd4