Skip to content
GitLab
Commit 6ecd8b4a authored by Artem Alimarine's avatar Artem Alimarine
Browse files

minor changes in generics

parent 52873d20
Hide whitespace changes
Inline Side-by-side
frontend/check.icl
View file @ 6ecd8b4a
......@@ -3472,6 +3472,8 @@ where
<=< adjustPredefSymbol PD_ConsCONS mod_index STE_Constructor
<=< adjustPredefSymbol PD_TypeFIELD mod_index STE_Type
<=< adjustPredefSymbol PD_ConsFIELD mod_index STE_Constructor
<=< adjustPredefSymbol PD_TypeREC mod_index STE_Type
<=< adjustPredefSymbol PD_ConsREC mod_index STE_Constructor
<=< adjustPredefSymbol PD_GenericInfo mod_index STE_Type
<=< adjustPredefSymbol PD_NoGenericInfo mod_index STE_Constructor
<=< adjustPredefSymbol PD_GenericConsInfo mod_index STE_Constructor
......
frontend/frontend.icl
View file @ 6ecd8b4a
......@@ -139,7 +139,7 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an
# error = error_admin.ea_file
/*
# (_,genout,files) = fopen "c:\\Generics\\genout.icl" FWriteText files
# (_,genout,files) = fopen "c:\\Clean\\Generics\\genout.icl" FWriteText files
# (fun_defs, genout) = printFunDefs fun_defs genout
# (ok,files) = fclose genout files
| not ok = abort "could not write genout.icl"
......@@ -149,6 +149,15 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an
| not ok
= (No,{},{},0,main_dcl_module_n,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
/*
# (components, fun_defs) = partitionateFunctions (fun_defs -*-> "partitionateFunctions") (icl_global_functions++icl_instances ++ [icl_specials] ++ icl_gencases ++ generic_ranges)
# (_,f,files) = fopen "components" FWriteText files
(components, fun_defs, f) = showComponents {x\\x<-:components} 0 True fun_defs f
(ok,files) = fclose f files
| ok<>ok
= abort "";
*/
# (ok, fun_defs, array_instances, type_code_instances, common_defs, imported_funs, type_def_infos, heaps, predef_symbols, error,out)
= typeProgram (components -*-> "Typing") main_dcl_module_n fun_defs/*icl_functions*/ icl_specials list_inferred_types icl_common [a\\a<-:icl_import] dcl_mods icl_used_module_numbers td_infos heaps predef_symbols error out dcl_mods
......
frontend/generics1.icl
View file @ 6ecd8b4a
......@@ -564,8 +564,8 @@ buildTypeDefInfo1 td_module {td_name, td_pos, td_arity} alts fields main_module_
# (field_dsc_funs, (modules, heaps)) = zipWithSt (build_field_dsc group_index (hd cons_dsc_dss)) field_dsc_dss fields (modules, heaps)
// NOTE: reverse order
# new_funs = field_dsc_funs ++ cons_dsc_funs ++ [type_def_dsc_fun] ++ funs
// NOTE: reverse order (new functions are added at the head)
# new_funs = (reverse field_dsc_funs) ++ (reverse cons_dsc_funs) ++ [type_def_dsc_fun] ++ funs
# funs_and_groups = (new_fun_index, new_group_index, new_funs, new_groups)
......@@ -576,7 +576,7 @@ buildTypeDefInfo1 td_module {td_name, td_pos, td_arity} alts fields main_module_
= mapSt build_field_info field_dsc_dss (funs_and_groups, heaps)
# cons_infos = case (cons_info_dss, field_info_dss) of
([cons_info_ds], field_infos) -> [{ci_cons_info = cons_info_ds, ci_field_infos = reverse field_infos}]
([cons_info_ds], field_infos) -> [{ci_cons_info = cons_info_ds, ci_field_infos = field_infos}]
(cons_info_dss, []) -> [{ci_cons_info=x,ci_field_infos=[]}\\x<-cons_info_dss]
_ -> abort "generics.icl sanity check: fields in non-record type\n"
......@@ -586,18 +586,24 @@ where
build_type_def_dsc group_index cons_info_dss {ds_index, ds_ident} heaps
# td_name_expr = makeStringExpr td_name.id_name
# td_arity_expr = makeIntExpr td_arity
# num_conses_expr = makeIntExpr (length alts)
# (cons_info_exprs, heaps) = mapSt (\x st->buildFunApp main_module_index x [] st) cons_info_dss heaps
# (td_conses_expr, heaps) = makeListExpr cons_info_exprs predefs heaps
# (body_expr, heaps) = buildPredefConsApp PD_CGenericTypeDefDescriptor
[td_name_expr, td_arity_expr, td_conses_expr]
[ td_name_expr
, td_arity_expr
, num_conses_expr
, td_conses_expr
]
predefs heaps
# fun = makeFunction ds_ident ds_index group_index [] body_expr No main_module_index td_pos
= (fun, heaps)
build_cons_dsc group_index type_def_info_ds field_dsc_dss cons_info_ds cons_ds (modules, heaps)
# ({cons_symb, cons_type, cons_priority}, modules) = modules! [td_module].com_cons_defs.[cons_ds.ds_index]
# ({cons_symb, cons_type, cons_priority,cons_index}, modules)
= modules! [td_module].com_cons_defs.[cons_ds.ds_index]
# name_expr = makeStringExpr cons_symb.id_name
# arity_expr = makeIntExpr cons_type.st_arity
# (prio_expr, heaps) = make_prio_expr cons_priority heaps
......@@ -605,6 +611,7 @@ where
# (type_expr, heaps) = make_type_expr cons_type heaps
# (field_exprs, heaps) = mapSt (\x st->buildFunApp main_module_index x [] st) field_dsc_dss heaps
# (fields_expr, heaps) = makeListExpr field_exprs predefs heaps
# cons_index_expr = makeIntExpr cons_index
# (body_expr, heaps)
= buildPredefConsApp PD_CGenericConsDescriptor
[ name_expr
......@@ -613,6 +620,7 @@ where
, type_def_expr
, type_expr
, fields_expr
, cons_index_expr
]
predefs heaps
......@@ -1066,6 +1074,12 @@ where
# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pat]
= build_case_expr case_patterns heaps
// REC case
build_case_field var body_expr heaps
# pat = buildPredefConsPattern PD_ConsREC [var] body_expr predefs
# {pds_module, pds_def} = predefs.[PD_TypeREC]
# case_patterns = AlgebraicPatterns {glob_module = pds_module, glob_object = pds_def} [pat]
= build_case_expr case_patterns heaps
// case with a variable as the selector expression
build_case_expr case_patterns heaps
......@@ -3162,8 +3176,8 @@ makeFunction ident fun_index group_index arg_vars body_expr opt_sym_type main_dc
, fi_dynamics = []
, fi_properties = 0
}
}
//---> ("makeFunction", ident, fun_index)
}
//---> ("makeFunction", ident, fun_index, collectCalls main_dcl_module_n body_expr)
// build function and
buildFunAndGroup ::
......
frontend/predef.dcl
View file @ 6ecd8b4a
......@@ -173,38 +173,39 @@ PD_TypeCONS :== 189
PD_ConsCONS :== 190
PD_TypeFIELD :== 191
PD_ConsFIELD :== 192
PD_GenericInfo :== 193
PD_NoGenericInfo :== 194
PD_GenericConsInfo :== 195
PD_GenericFieldInfo :== 196
PD_TGenericConsDescriptor :== 197
PD_CGenericConsDescriptor :== 198
PD_TGenericFieldDescriptor :== 199
PD_CGenericFieldDescriptor :== 200
PD_TGenericTypeDefDescriptor :== 201
PD_CGenericTypeDefDescriptor :== 202
PD_TGenConsPrio :== 203
PD_CGenConsNoPrio :== 204
PD_CGenConsPrio :== 205
PD_TGenConsAssoc :== 206
PD_CGenConsAssocNone :== 207
PD_CGenConsAssocLeft :== 208
PD_CGenConsAssocRight :== 209
PD_TGenType :== 210
PD_CGenTypeCons :== 211
PD_CGenTypeVar :== 212
PD_CGenTypeArrow :== 213
PD_CGenTypeApp :== 214
PD_GenericBimap :== 215
PD_bimapId :== 216
PD_TypeGenericDict :== 217
PD_ModuleConsSymbol :== 218
PD_NrOfPredefSymbols :== 219
PD_TypeREC :== 193
PD_ConsREC :== 194
PD_GenericInfo :== 195
PD_NoGenericInfo :== 196
PD_GenericConsInfo :== 197
PD_GenericFieldInfo :== 198
PD_TGenericConsDescriptor :== 199
PD_CGenericConsDescriptor :== 200
PD_TGenericFieldDescriptor :== 201
PD_CGenericFieldDescriptor :== 202
PD_TGenericTypeDefDescriptor :== 203
PD_CGenericTypeDefDescriptor :== 204
PD_TGenConsPrio :== 205
PD_CGenConsNoPrio :== 206
PD_CGenConsPrio :== 207
PD_TGenConsAssoc :== 208
PD_CGenConsAssocNone :== 209
PD_CGenConsAssocLeft :== 210
PD_CGenConsAssocRight :== 211
PD_TGenType :== 212
PD_CGenTypeCons :== 213
PD_CGenTypeVar :== 214
PD_CGenTypeArrow :== 215
PD_CGenTypeApp :== 216
PD_GenericBimap :== 217
PD_bimapId :== 218
PD_TypeGenericDict :== 219
PD_ModuleConsSymbol :== 220
PD_NrOfPredefSymbols :== 221
GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2
GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2
......
frontend/predef.icl
View file @ 6ecd8b4a
......@@ -2,6 +2,7 @@ implementation module predef
import syntax, hashtable, type_io_common
(<<=) infixl
(<<=) symbol_table val
:== let (predefined_idents, index) = val
......@@ -135,6 +136,8 @@ predefined_idents
[PD_ConsCONS] = i "CONS",
[PD_TypeFIELD] = i "FIELD",
[PD_ConsFIELD] = i "FIELD",
[PD_TypeREC] = i "REC",
[PD_ConsREC] = i "REC",
[PD_GenericInfo] = i "GenericInfo",
[PD_NoGenericInfo] = i "NoGenericInfo",
[PD_GenericConsInfo] = i "GenericConsInfo",
......@@ -317,7 +320,9 @@ where
<<- (local_predefined_idents, IC_Type, PD_TypeCONS)
<<- (local_predefined_idents, IC_Expression, PD_ConsCONS)
<<- (local_predefined_idents, IC_Type, PD_TypeFIELD)
<<- (local_predefined_idents, IC_Expression, PD_ConsFIELD)
<<- (local_predefined_idents, IC_Expression, PD_ConsREC)
<<- (local_predefined_idents, IC_Type, PD_TypeREC)
<<- (local_predefined_idents, IC_Expression, PD_ConsFIELD)
<<- (local_predefined_idents, IC_Type, PD_GenericInfo)
<<- (local_predefined_idents, IC_Expression, PD_NoGenericInfo)
<<- (local_predefined_idents, IC_Expression, PD_GenericConsInfo)
......
frontend/syntax.dcl
View file @ 6ecd8b4a
......@@ -465,6 +465,7 @@ NoGlobalIndex :== {gi_module=NoIndex,gi_index=NoIndex}
| GTSVar TypeVar
| GTSCons DefinedSymbol GenTypeStruct
| GTSField DefinedSymbol GenTypeStruct
| GTSRec GenTypeStruct
| GTSE
:: GenericTypeRep =
......
frontend/trans.icl
View file @ 6ecd8b4a
......@@ -2594,6 +2594,18 @@ where
# (expr, st) = map_expr_st expr st
= f (Selection a expr b) st
// AA:
map_expr_st expr=:(BasicExpr _) st
= f expr st
map_expr_st (expr @ exprs) st
= abort "trans.icl: map_expr_st (expr @ exprs) not implemented\n"
map_expr_st (TupleSelect ds n expr) st
= abort "trans.icl: map_expr_st (TupleSelect ds n expr) not implemented\n"
map_expr_st (DynamicExpr dyn_expr) st
= abort "trans.icl: map_expr_st (DynamicExpr dyn_expr) not implemented\n"
map_expr_st _ st = abort "trans.icl: map_expr_st does not match !!!!!!!!!!!!\n"
foldrExprSt f expr st :== foldr_expr_st expr st
where
foldr_expr_st expr=:(Var _) st
......@@ -2610,6 +2622,10 @@ foldrExprSt f expr st :== foldr_expr_st expr st
= f lad st
foldr_expr_st sel=:(Selection a expr b) st
= f sel (foldr_expr_st expr st)
// AA:
foldr_expr_st expr=:(BasicExpr _) st
= f expr st
add_let_binds :: [FreeVar] [Expression] [LetBind] -> [LetBind]
add_let_binds free_vars rhss original_binds
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment