aboutsummaryrefslogtreecommitdiff
path: root/frontend
diff options
context:
space:
mode:
Diffstat (limited to 'frontend')
-rw-r--r--frontend/type_io.icl71
1 files changed, 24 insertions, 47 deletions
diff --git a/frontend/type_io.icl b/frontend/type_io.icl
index 2fba866..fc393e0 100644
--- a/frontend/type_io.icl
+++ b/frontend/type_io.icl
@@ -42,13 +42,11 @@ where
instance WriteTypeInfo ConsDef
where
- write_type_info {cons_ident,cons_type,cons_type_index,cons_exi_vars} tcl_file wtis=:{wtis_n_type_vars}
+ write_type_info {cons_ident,cons_type,cons_type_index,cons_exi_vars} tcl_file wtis=:{wtis_n_type_vars,wtis_type_heaps}
// normalize ...
- # (th_vars,wtis)
- = sel_type_var_heap wtis
- # (_,(_,th_vars))
- = mapSt normalize_atype_var cons_exi_vars (wtis_n_type_vars,th_vars)
- # wtis = { wtis & wtis_type_heaps.th_vars = th_vars }
+ # (_,th_vars)
+ = foldSt normalize_atype_var cons_exi_vars (wtis_n_type_vars,wtis_type_heaps.th_vars)
+ # wtis & wtis_type_heaps = {wtis_type_heaps & th_vars = th_vars}
// ... normalize
# (tcl_file,wtis)
= write_type_info cons_ident tcl_file wtis
@@ -62,13 +60,11 @@ where
instance WriteTypeInfo (TypeDef TypeRhs)
where
- write_type_info {td_ident,td_arity,td_args,td_rhs,td_fun_index} tcl_file wtis
+ write_type_info {td_ident,td_arity,td_args,td_rhs,td_fun_index} tcl_file wtis=:{wtis_type_heaps}
// normalize ...
- # (th_vars,wtis)
- = sel_type_var_heap wtis
- # (_,(n_type_vars,th_vars))
- = mapSt normalize_atype_var td_args (0,th_vars)
- # wtis = { wtis & wtis_type_heaps.th_vars = th_vars, wtis_n_type_vars = n_type_vars }
+ # (n_type_vars,th_vars)
+ = foldSt normalize_atype_var td_args (0,wtis_type_heaps.th_vars)
+ # wtis & wtis_n_type_vars = n_type_vars, wtis_type_heaps = {wtis_type_heaps & th_vars = th_vars}
// ... normalize
# (tcl_file,wtis)
= write_type_info td_ident tcl_file wtis
@@ -84,24 +80,15 @@ where
(tcl_file,wtis) = write_type_info rt_constructor tcl_file wtis
= write_type_info rt_fields tcl_file wtis
-normalize_atype_var :: !ATypeVar (!Int,!*TypeVarHeap) -> (!Int,(!Int,!*TypeVarHeap))
+normalize_atype_var :: !ATypeVar (!Int,!*TypeVarHeap) -> (!Int,!*TypeVarHeap)
normalize_atype_var td_arg=:{atv_variable={tv_info_ptr}} (id,th_vars)
# th_vars = writePtr tv_info_ptr (TVI_Normalized id) th_vars
- = (id,(inc id,th_vars));
+ = (inc id,th_vars)
-normalize_type_var :: !TypeVar (!Int,!*TypeVarHeap) -> (!Int,(!Int,!*TypeVarHeap))
+normalize_type_var :: !TypeVar (!Int,!*TypeVarHeap) -> (!Int,!*TypeVarHeap)
normalize_type_var {tv_info_ptr} (id,th_vars)
# th_vars = writePtr tv_info_ptr (TVI_Normalized id) th_vars
- = (id,(inc id,th_vars));
-
-sel_type_var_heap :: !*WriteTypeInfoState -> (!*TypeVarHeap,!*WriteTypeInfoState)
-sel_type_var_heap wtis=:{wtis_type_heaps}
- # (th_vars,wtis_type_heaps)
- = sel wtis_type_heaps
- = (th_vars,{ wtis & wtis_type_heaps = wtis_type_heaps} )
-where
- sel wtis_type_heaps=:{th_vars}
- = (th_vars,{ wtis_type_heaps & th_vars = newHeap } )
+ = (inc id,th_vars)
instance WriteTypeInfo ATypeVar
where
@@ -112,15 +99,13 @@ where
instance WriteTypeInfo TypeVar
where
- write_type_info {tv_info_ptr} tcl_file wtis
- # (th_vars,wtis)
- = sel_type_var_heap wtis
- # ( v,th_vars)
- = readPtr tv_info_ptr th_vars
+ write_type_info {tv_info_ptr} tcl_file wtis=:{wtis_type_heaps}
+ # (v,th_vars)
+ = readPtr tv_info_ptr wtis_type_heaps.th_vars
# tcl_file
= fwritei (get_type_var_nf_number v) tcl_file
- # wtis = { wtis & wtis_type_heaps.th_vars = th_vars }
+ # wtis & wtis_type_heaps = {wtis_type_heaps & th_vars = th_vars}
= (tcl_file,wtis)
where
get_type_var_nf_number (TVI_Normalized i) = i
@@ -317,16 +302,10 @@ where
// FIXME: the universally quantifier and type vars are ignored here
// this is really just a hack to prevent the compiler from crashing
// on rank>1 types
- write_type_info (TFA uni_vars type) tcl_file wtis
- # (th_vars,wtis)
- = sel_type_var_heap wtis
- # (_,(_,th_vars))
- = mapSt normalize_atype_var uni_vars (0,th_vars)
- # wtis
- = { wtis & wtis_type_heaps.th_vars = th_vars }
- # (tcl_file,wtis)
- = write_type_info type tcl_file wtis
- = (tcl_file,wtis)
+ write_type_info (TFA uni_vars type) tcl_file wtis=:{wtis_type_heaps}
+ # (_,th_vars) = foldSt normalize_atype_var uni_vars (0,wtis_type_heaps.th_vars)
+ # wtis & wtis_type_heaps = {wtis_type_heaps & th_vars = th_vars}
+ = write_type_info type tcl_file wtis
write_type_info TE tcl_file wtis
# tcl_file
@@ -339,8 +318,8 @@ where
wtis!wtis_icl_generic_defs.[ds_index]
wtis!wtis_common_defs.[glob_module].com_generic_defs.[ds_index]
{wtis_type_heaps,wtis_n_type_vars} = wtis
- (_,(n_type_vars,th_vars))
- = mapSt normalize_type_var gen_type.st_vars (0,wtis_type_heaps.th_vars)
+ (n_type_vars,th_vars)
+ = foldSt normalize_type_var gen_type.st_vars (0,wtis_type_heaps.th_vars)
wtis = {wtis & wtis_type_heaps={wtis_type_heaps & th_vars = th_vars}, wtis_n_type_vars = n_type_vars}
tcl_file = fwritec GenericFunctionTypeCode tcl_file
kind_string = kind_to_short_string type_kind;
@@ -357,15 +336,13 @@ where
= fwritec ConsVariableCVCode tcl_file
# (tcl_file,wtis)
= write_type_info type_var tcl_file wtis
- = (tcl_file,wtis)
-
+ = (tcl_file,wtis)
write_type_info (TempCV temp_var_id) tcl_file wtis
# tcl_file
= fwritec ConsVariableTempCVCode tcl_file
# (tcl_file,wtis)
= write_type_info temp_var_id tcl_file wtis
- = (tcl_file,wtis)
-
+ = (tcl_file,wtis)
write_type_info (TempQCV temp_var_id) tcl_file wtis
# tcl_file
= fwritec ConsVariableTempQCVCode tcl_file