From 38098c81804942ff27f3c47e5d7920ad8655e517 Mon Sep 17 00:00:00 2001
From: johnvg
Date: Fri, 2 Jul 2010 14:25:22 +0000
Subject: pass Ident name instead of Ident to functions to create generic
idents in genericsupport
git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@1790 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
---
frontend/check.icl | 4 ++--
frontend/checktypes.icl | 4 ++--
frontend/generics1.icl | 26 +++++++++++++-------------
frontend/genericsupport.dcl | 8 ++++----
frontend/genericsupport.icl | 22 +++++++++++-----------
frontend/postparse.icl | 2 +-
6 files changed, 33 insertions(+), 33 deletions(-)
(limited to 'frontend')
diff --git a/frontend/check.icl b/frontend/check.icl
index 53a1c84..937422a 100644
--- a/frontend/check.icl
+++ b/frontend/check.icl
@@ -2419,7 +2419,7 @@ check_module1 cdefs icl_global_function_range fun_defs optional_dcl_mod optional
convert_generic_instances [gc=:{gc_ident,gc_pos, gc_type_cons, gc_body=GCB_None} : gcs] next_fun_index
# (fun_defs, gcs) = convert_generic_instances gcs (inc next_fun_index)
# fun_def =
- { fun_ident = genericIdentToFunIdent gc_ident gc_type_cons
+ { fun_ident = genericIdentToFunIdent gc_ident.id_name gc_type_cons
, fun_arity = 0
, fun_priority = NoPrio
, fun_body = GeneratedBody
@@ -3333,7 +3333,7 @@ checkInstancesOfDclModule mod_index (nr_of_dcl_functions_and_instances, nr_of_dc
# gencase_def = { gencase_def & gc_body = GCB_FunIndex fun_index }
# gencase_defs = {gencase_defs & [gc_index] = gencase_def}
- #! fun_ident = genericIdentToFunIdent gc_ident gc_type_cons
+ #! fun_ident = genericIdentToFunIdent gc_ident.id_name gc_type_cons
#! (var_info_ptr, hp_var_heap) = newPtr VI_Empty hp_var_heap
#! fun =
{ ft_ident = fun_ident
diff --git a/frontend/checktypes.icl b/frontend/checktypes.icl
index bc0ca57..8256eaa 100644
--- a/frontend/checktypes.icl
+++ b/frontend/checktypes.icl
@@ -1003,7 +1003,7 @@ where
# clazz =
{ glob_module = -1
, glob_object =
- { ds_ident = genericIdentToClassIdent gen_ident gtc_kind
+ { ds_ident = genericIdentToClassIdent gen_ident.id_name gtc_kind
, ds_arity = 1
, ds_index = -1
}
@@ -1605,7 +1605,7 @@ where
// FIXME: We do not know the type before the generic phase.
// The generic phase currently does not update the type.
# field_type = makeAttributedType TA_Multi TE
- # class_ident = genericIdentToClassIdent gtc_generic.glob_object.ds_ident gtc_kind
+ # class_ident = genericIdentToClassIdent gtc_generic.glob_object.ds_ident.id_name gtc_kind
# (field, var_heap, symbol_table) = build_field field_nr class_ident.id_name rec_type_index rec_type field_type next_selector_index var_heap symbol_table
= build_context_fields mod_index (inc field_nr) tcs rec_type rec_type_index (inc next_selector_index) [ field : rev_fields ]
[field_type : rev_field_types] class_defs modules var_heap symbol_table
diff --git a/frontend/generics1.icl b/frontend/generics1.icl
index dcd44b3..3e686a0 100644
--- a/frontend/generics1.icl
+++ b/frontend/generics1.icl
@@ -1517,8 +1517,8 @@ buildClassAndMember
//---> ("buildClassAndMember", gen_def.gen_ident, kind)
where
- class_ident = genericIdentToClassIdent gen_def.gen_ident kind
- member_ident = genericIdentToMemberIdent gen_def.gen_ident kind
+ class_ident = genericIdentToClassIdent gen_def.gen_ident.id_name kind
+ member_ident = genericIdentToMemberIdent gen_def.gen_ident.id_name kind
class_ds = {ds_index = class_index, ds_ident = class_ident, ds_arity = 1}
build_class_member class_var gs=:{gs_varh}
@@ -1773,7 +1773,7 @@ where
{ tc_class = TCClass
{ glob_module=gci_module // the same as icl module
, glob_object =
- { ds_ident = genericIdentToClassIdent gc_ident gci_kind
+ { ds_ident = genericIdentToClassIdent gc_ident.id_name gci_kind
, ds_index = gci_class
, ds_arity = 1
}
@@ -1789,7 +1789,7 @@ where
#! (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty heaps.hp_expression_heap
#! heaps = {heaps & hp_expression_heap = hp_expression_heap}
- #! fun_name = genericIdentToMemberIdent gc_ident this_kind
+ #! fun_name = genericIdentToMemberIdent gc_ident.id_name this_kind
# (gen_exprs, heaps) = mapSt (build_generic_app gc_generic gc_ident) class_infos heaps
@@ -1821,7 +1821,7 @@ where
# {gc_pos, gc_ident, gc_kind} = gencase
- #! class_ident = genericIdentToClassIdent gc_ident this_kind
+ #! class_ident = genericIdentToClassIdent gc_ident.id_name this_kind
#! class_ds = {ds_index = class_index, ds_arity=1, ds_ident=class_ident}
#! ins =
{ ins_class = {glob_module=gs_main_module, glob_object=class_ds}
@@ -1864,7 +1864,7 @@ where
| fun_index < size dcl_functions
#! (symbol_type, heaps) = fresh_symbol_type symbol_type heaps
#! (fun, dcl_functions) = dcl_functions ! [fun_index]
- #! fun = { fun & ft_ident = genericIdentToFunIdent gc_ident gc_type_cons
+ #! fun = { fun & ft_ident = genericIdentToFunIdent gc_ident.id_name gc_type_cons
, ft_type = symbol_type
, ft_arity = symbol_type.st_arity }
#! dcl_functions = { dcl_functions & [fun_index] = fun}
@@ -1887,7 +1887,7 @@ where
update_icl_function fun_index gencase=:{gc_ident, gc_type_cons, gc_pos} st funs_and_groups fun_defs td_infos modules heaps error
#! (st, heaps) = fresh_symbol_type st heaps
#! (fun=:{fun_body, fun_arity}, fun_defs) = fun_defs ! [fun_index]
- #! fun_ident = genericIdentToFunIdent gc_ident gc_type_cons
+ #! fun_ident = genericIdentToFunIdent gc_ident.id_name gc_type_cons
= case fun_body of
TransformedBody tb // user defined case
| fun_arity <> st.st_arity
@@ -1928,7 +1928,7 @@ where
#! (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty heaps.hp_expression_heap
#! heaps = {heaps & hp_expression_heap = hp_expression_heap}
- #! fun_name = genericIdentToFunIdent gc_ident gc_type_cons
+ #! fun_name = genericIdentToFunIdent gc_ident.id_name gc_type_cons
#! expr = App
{ app_symb =
{ symb_ident=fun_name
@@ -1940,7 +1940,7 @@ where
#! (st, heaps) = fresh_symbol_type st heaps
- #! memfun_name = genericIdentToMemberIdent gc_ident gc_kind
+ #! memfun_name = genericIdentToMemberIdent gc_ident.id_name gc_kind
#! (fun_ds, fun_info)
= buildFunAndGroup memfun_name arg_vars expr (Yes st) gs_main_module gc_pos fun_info
= (fun_ds, fun_info, heaps)
@@ -1949,7 +1949,7 @@ where
# {gc_pos, gc_ident, gc_kind} = gencase
- #! class_ident = genericIdentToClassIdent gc_ident gc_kind
+ #! class_ident = genericIdentToClassIdent gc_ident.id_name gc_kind
#! class_ds = {ds_index = class_index, ds_arity=1, ds_ident=class_ident}
#! ins =
{ ins_class = {glob_module=gs_main_module, glob_object=class_ds}
@@ -2269,7 +2269,7 @@ where
# clazz =
{ glob_module = class_info.gci_module
, glob_object =
- { ds_ident = genericIdentToClassIdent gtc_generic.glob_object.ds_ident gtc_kind
+ { ds_ident = genericIdentToClassIdent gtc_generic.glob_object.ds_ident.id_name gtc_kind
, ds_arity = 1
, ds_index = class_info.gci_class
}
@@ -3151,11 +3151,11 @@ where
// generic type var is replaced with a fresh one
subst_gtv {tv_info_ptr, tv_ident} th_vars
- # (tv, th_vars) = freshTypeVar (postfixIdent tv_ident postfix) th_vars
+ # (tv, th_vars) = freshTypeVar (postfixIdent tv_ident.id_name postfix) th_vars
= (tv, writePtr tv_info_ptr (TVI_Type (TV tv)) th_vars)
subst_attr (TA_Var {av_ident, av_info_ptr}) th_attrs
- # (av, th_attrs) = freshAttrVar (postfixIdent av_ident postfix) th_attrs
+ # (av, th_attrs) = freshAttrVar (postfixIdent av_ident.id_name postfix) th_attrs
= (TA_Var av, writePtr av_info_ptr (AVI_Attr (TA_Var av)) th_attrs)
//---> ("(2) writePtr av_info_ptr", ptrToInt av_info_ptr, av)
subst_attr TA_Multi th = (TA_Multi, th)
diff --git a/frontend/genericsupport.dcl b/frontend/genericsupport.dcl
index 95aa35c..303f695 100644
--- a/frontend/genericsupport.dcl
+++ b/frontend/genericsupport.dcl
@@ -46,7 +46,7 @@ getGenericClass ::
// Ident Helpers
//****************************************************************************************
makeIdent :: !String -> Ident
-postfixIdent :: !Ident !String -> Ident
-genericIdentToClassIdent :: !Ident !TypeKind -> Ident
-genericIdentToMemberIdent :: !Ident !TypeKind -> Ident
-genericIdentToFunIdent :: !Ident !TypeCons -> Ident
+postfixIdent :: !String !String -> Ident
+genericIdentToClassIdent :: !String !TypeKind -> Ident
+genericIdentToMemberIdent :: !String !TypeKind -> Ident
+genericIdentToFunIdent :: !String !TypeCons -> Ident
diff --git a/frontend/genericsupport.icl b/frontend/genericsupport.icl
index 8b62503..637bcff 100644
--- a/frontend/genericsupport.icl
+++ b/frontend/genericsupport.icl
@@ -79,12 +79,12 @@ addGenericClassInfo class_info=:{gci_kind} class_infos
makeIdent :: !String -> Ident
makeIdent str = {id_name = str, id_info = nilPtr}
-postfixIdent :: !Ident !String -> Ident
-postfixIdent {id_name} postfix = makeIdent (id_name +++ postfix)
+postfixIdent :: !String !String -> Ident
+postfixIdent id_name postfix = makeIdent (id_name +++ postfix)
-genericIdentToClassIdent :: !Ident !TypeKind -> Ident
-genericIdentToClassIdent gen_ident kind
- = postfixIdent gen_ident ("_" +++ kind_to_str kind)
+genericIdentToClassIdent :: !String !TypeKind -> Ident
+genericIdentToClassIdent id_name kind
+ = postfixIdent id_name ("_" +++ kind_to_str kind)
where
kind_to_str KindConst = "s"
kind_to_str (KindArrow kinds)
@@ -93,13 +93,13 @@ where
kinds_to_str [KindConst:ks] = "s" +++ kinds_to_str ks
kinds_to_str [k:ks] = "o" +++ (kind_to_str k) +++ "c" +++ kinds_to_str ks
-genericIdentToMemberIdent :: !Ident !TypeKind -> Ident
-genericIdentToMemberIdent gen_ident kind
- = genericIdentToClassIdent gen_ident kind
+genericIdentToMemberIdent :: !String !TypeKind -> Ident
+genericIdentToMemberIdent id_name kind
+ = genericIdentToClassIdent id_name kind
-genericIdentToFunIdent :: !Ident !TypeCons -> Ident
-genericIdentToFunIdent gen_ident type_cons
- = postfixIdent gen_ident ("_" +++ type_cons_to_str type_cons)
+genericIdentToFunIdent :: !String !TypeCons -> Ident
+genericIdentToFunIdent id_name type_cons
+ = postfixIdent id_name ("_" +++ type_cons_to_str type_cons)
where
type_cons_to_str (TypeConsSymb {type_ident}) = toString type_ident
type_cons_to_str (TypeConsBasic bt) = toString bt
diff --git a/frontend/postparse.icl b/frontend/postparse.icl
index 4eb6a1d..29b3a03 100644
--- a/frontend/postparse.icl
+++ b/frontend/postparse.icl
@@ -1440,7 +1440,7 @@ reorganiseDefinitions icl_module [PD_GenericCase gc : defs] cons_count sel_count
, pb_position = gc.gc_pos
}
#! bodies = [body : bodies ]
- #! fun_name = genericIdentToFunIdent gc.gc_ident gc.gc_type_cons
+ #! fun_name = genericIdentToFunIdent gc.gc_ident.id_name gc.gc_type_cons
#! fun = MakeNewImpOrDefFunction fun_name gc.gc_arity bodies (FK_Function cNameNotLocationDependent) NoPrio No gc.gc_pos
#! inst = { gc & gc_body = GCB_FunDef fun }
#! c_defs = {c_defs & def_generic_cases = [inst : c_defs.def_generic_cases]}
--
cgit v1.2.3