Skip to content
GitLab
Commit 5867c988 authored by Ronny Wichers Schreur's avatar Ronny Wichers Schreur 🏘
Browse files

new type code and type code constructor representation 

clean-up and renamed functions from StdDynamic
parent bced17b9
Expand all Hide whitespace changes
Inline Side-by-side
frontend/check.icl
View file @ 5867c988
......@@ -2490,11 +2490,6 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo
(dcls_import_list, dcl_modules, cs)
= addImportedSymbolsToSymbolTable nr_of_modules (Yes dcl_macros) modules_in_component_set imports_ikh dcl_modules cs
(x_main_dcl_module,cs) = cs!cs_x.x_main_dcl_module_n
cs = cs
<=< adjustPredefSymbol PD_ModuleConsSymbol x_main_dcl_module STE_Constructor
(dcl_modules, icl_functions,macro_defs,hp_expression_heap, cs)
= checkExplicitImportCompleteness imports.si_explicit dcl_modules icl_functions macro_defs heaps.hp_expression_heap cs
......@@ -3443,15 +3438,34 @@ where
<=< adjustPredefSymbol PD_Dyn_DynamicTemp mod_index STE_Type
<=< adjustPredefSymbol PD_Dyn_Type mod_index STE_Type
<=< adjustPredefSymbol PD_Dyn_TypeScheme mod_index STE_Constructor
<=< adjustPredefSymbol PD_Dyn_TypeCons mod_index STE_Constructor
<=< adjustPredefSymbol PD_Dyn_TypeApp mod_index STE_Constructor
<=< adjustPredefSymbol PD_Dyn_TypeVar mod_index STE_Constructor
<=< adjustPredefSymbol PD_Dyn_TypePatternVar mod_index STE_Constructor
<=< adjustPredefSymbol PD_Dyn_ModuleID mod_index STE_Constructor
<=< adjustPredefSymbol PD_Dyn_Unifier mod_index STE_Type
<=< adjustPredefSymbol PD_Dyn_UnificationEnvironment mod_index STE_Type
<=< adjustPredefSymbol PD_Dyn_initial_unification_environment mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_bind_global_type_pattern_var mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_unify mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_initial_unifier mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_normalise mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_bind_global_type_pattern_var mod_index STE_DclFunction)
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructorInt mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructorChar mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructorReal mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructorBool mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructorDynamic mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructorFile mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructorWorld mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructor_Arrow mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructor_List mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructor_StrictList mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructor_UnboxedList mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructor_TailStrictList mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructor_StrictTailStrictList mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructor_UnboxedTailStrictList mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructor_Tuple mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructor_LazyArray mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructor_StrictArray mod_index STE_DclFunction
<=< adjustPredefSymbol PD_Dyn_TypeCodeConstructor_UnboxedArray mod_index STE_DclFunction)
# (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdGeneric]
# type_bimap = predefined_idents.[PD_TypeBimap]
......
frontend/convertDynamics.icl
View file @ 5867c988
This diff is collapsed.
frontend/overloading.icl
View file @ 5867c988
......@@ -87,12 +87,11 @@ where
where
compare_types (GTT_Basic bt1) (GTT_Basic bt2)
= bt1 =< bt2
compare_types (GTT_Constructor cons1 _ _) (GTT_Constructor cons2 _ _)
compare_types (GTT_Constructor cons1 _) (GTT_Constructor cons2 _)
= cons1 =< cons2
compare_types _ _
= Equal
instanceError symbol types err
# err = errorHeading "Overloading error" err
format = { form_properties = cNoProperties, form_attr_position = No }
......@@ -120,6 +119,12 @@ overloadingError op_symb err
-> str+++" [line "+++toString line_nr+++"]"
= { err & ea_file = err.ea_file <<< " internal overloading of \"" <<< str <<< "\" could not be solved\n" }
typeCodeInDynamicError err=:{ea_ok}
# err = errorHeading "Overloading error (warning for now)" err
err = {err & ea_ok=ea_ok}
= { err & ea_file = err.ea_file <<< "TC context not allowed in dynamic" <<< '\n' }
/*
As soon as all overloaded variables in an type context are instantiated, context reduction is carried out.
This reduction yields a type class instance (here represented by a an index) and a list of
......@@ -532,19 +537,17 @@ where
reduce_TC_context type_code_class tc_type new_contexts special_instances type_pattern_vars var_heap
= reduce_tc_context type_code_class tc_type (new_contexts, special_instances, type_pattern_vars, var_heap)
where
reduce_tc_context type_code_class (TA cons_id=:{type_index={glob_module}} cons_args) (new_contexts, special_instances=:{si_next_TC_member_index, si_TC_instances}, type_pattern_vars, var_heap)
# defining_module_name
= dcl_modules.[glob_module].dcl_name.id_name
reduce_tc_context type_code_class (TA cons_id=:{type_index} cons_args) (new_contexts, special_instances=:{si_next_TC_member_index, si_TC_instances}, type_pattern_vars, var_heap)
# type_constructor = toTypeCodeConstructor type_index defs
# (inst_index, (si_next_TC_member_index, si_TC_instances))
= addGlobalTCInstance (GTT_Constructor cons_id defining_module_name False) (si_next_TC_member_index, si_TC_instances)
= addGlobalTCInstance type_constructor (si_next_TC_member_index, si_TC_instances)
(rc_red_contexts, instances) = reduce_TC_contexts type_code_class cons_args
(new_contexts, { special_instances & si_next_TC_member_index = si_next_TC_member_index, si_TC_instances = si_TC_instances }, type_pattern_vars, var_heap)
= (CA_GlobalTypeCode { tci_index = inst_index, tci_contexts = rc_red_contexts }, instances)
reduce_tc_context type_code_class (TAS cons_id=:{type_index={glob_module}} cons_args _) (new_contexts, special_instances=:{si_next_TC_member_index, si_TC_instances}, type_pattern_vars, var_heap)
# defining_module_name
= dcl_modules.[glob_module].dcl_name.id_name
reduce_tc_context type_code_class (TAS cons_id=:{type_index} cons_args _) (new_contexts, special_instances=:{si_next_TC_member_index, si_TC_instances}, type_pattern_vars, var_heap)
# type_constructor = toTypeCodeConstructor type_index defs
# (inst_index, (si_next_TC_member_index, si_TC_instances))
= addGlobalTCInstance (GTT_Constructor cons_id defining_module_name False) (si_next_TC_member_index, si_TC_instances)
= addGlobalTCInstance type_constructor (si_next_TC_member_index, si_TC_instances)
(rc_red_contexts, instances) = reduce_TC_contexts type_code_class cons_args
(new_contexts, { special_instances & si_next_TC_member_index = si_next_TC_member_index, si_TC_instances = si_TC_instances }, type_pattern_vars, var_heap)
= (CA_GlobalTypeCode { tci_index = inst_index, tci_contexts = rc_red_contexts }, instances)
......@@ -1294,13 +1297,39 @@ getTCDictionary symb_name var_info_ptr (var_heap, error)
, tci_type_constructors_in_patterns :: ![Index]
}
toTypeCodeConstructor type=:{glob_object=type_index, glob_module=module_index} common_defs
| module_index == cPredefinedModuleIndex
= GTT_PredefTypeConstructor type
// otherwise
# tc_type_index
= type_index + 1
# types
= common_defs.[module_index].com_type_defs
// sanity check ...
# type_name
= types.[type_index].td_name.id_name
# tc_type_name
= types.[tc_type_index].td_name.id_name
| "TC;" +++ type_name <> tc_type_name
= fatal "toTypeCodeConstructor" ("name mismatch (" +++ type_name +++ ", " +++ tc_type_name +++ ")")
// ... sanity check
# ({td_rhs=AlgType [{ds_ident, ds_index}:_]})
= types.[tc_type_index]
# type_constructor
= { symb_name = ds_ident
, symb_kind = SK_Constructor {glob_module = module_index, glob_object = ds_index}
}
= GTT_Constructor type_constructor False
fatal :: {#Char} {#Char} -> .a
fatal function_name message
= abort ("overloading, " +++ function_name +++ ": " +++ message)
class toTypeCodeExpression type :: !Ident type !(!*TypeCodeInfo,!*VarHeap,!*ErrorAdmin) -> (!TypeCodeExpression, !(!*TypeCodeInfo,!*VarHeap,!*ErrorAdmin))
instance toTypeCodeExpression Type
where
toTypeCodeExpression symb_name type=:(TA cons_id=:{type_index={glob_module}} type_args) (tci=:{tci_next_index,tci_instances,tci_dcl_modules,tci_common_defs},var_heap,error)
# defining_module_name
= tci_dcl_modules.[glob_module].dcl_name.id_name
instance toTypeCodeExpression Type where
toTypeCodeExpression symb_name type=:(TA cons_id=:{type_index} type_args) (tci=:{tci_next_index,tci_instances,tci_dcl_modules,tci_common_defs},var_heap,error)
// RWS ...
# type_heaps
= {th_vars = tci.tci_type_var_heap, th_attrs = tci.tci_attr_var_heap}
......@@ -1311,9 +1340,12 @@ where
| expanded
= toTypeCodeExpression symb_name type (tci,var_heap,error)
// ... RWS
# type_constructor
= toTypeCodeConstructor type_index tci_common_defs
# (inst_index, (tci_next_index, tci_instances))
= addGlobalTCInstance (GTT_Constructor cons_id defining_module_name False) (tci_next_index, tci_instances)
(type_code_args, tci) = mapSt (toTypeCodeExpression symb_name) type_args ({ tci & tci_next_index = tci_next_index, tci_instances = tci_instances },var_heap,error)
= addGlobalTCInstance type_constructor (tci_next_index, tci_instances)
(type_code_args, tci)
= mapSt (toTypeCodeExpression symb_name) type_args ({ tci & tci_next_index = tci_next_index, tci_instances = tci_instances },var_heap,error)
= (TCE_Constructor inst_index type_code_args, tci)
toTypeCodeExpression symb_name (TAS cons_id type_args _) state
= toTypeCodeExpression symb_name (TA cons_id type_args) state
......@@ -1326,18 +1358,30 @@ where
= addGlobalTCInstance GTT_Function (tci_next_index, tci_instances)
(type_code_args, tci) = mapSt (toTypeCodeExpression symb_name) [arg_type, result_type] ({ tci & tci_next_index = tci_next_index, tci_instances = tci_instances },var_heap,error)
= (TCE_Constructor inst_index type_code_args, tci)
toTypeCodeExpression symb_name (TV {tv_name,tv_info_ptr}) (tci=:{tci_type_var_heap}, var_heap, error)
toTypeCodeExpression symb_name (TV var) st
= toTypeCodeExpression symb_name var st
toTypeCodeExpression symb_name (TFA vars type) (tci=:{tci_type_var_heap}, var_heap, error)
# (new_vars, (tci_type_var_heap, var_heap)) = newTypeVariables vars (tci_type_var_heap, var_heap)
(type_code, tci) = toTypeCodeExpression symb_name type ({tci & tci_type_var_heap = tci_type_var_heap}, var_heap, error)
= (TCE_UniType new_vars type_code, tci)
toTypeCodeExpression symb_name (CV var :@: args) st
# (type_code_var, st)
= toTypeCodeExpression symb_name var st
(type_code_args, st)
= mapSt (toTypeCodeExpression symb_name) args st
= (foldl TCE_App type_code_var type_code_args, st)
instance toTypeCodeExpression TypeVar where
toTypeCodeExpression symb_name {tv_name,tv_info_ptr} (tci=:{tci_type_var_heap}, var_heap, error)
# (type_info, tci_type_var_heap) = readPtr tv_info_ptr tci_type_var_heap
tci = { tci & tci_type_var_heap = tci_type_var_heap }
= case type_info of
TVI_TypeCode type_code
-> (type_code, (tci,var_heap,error))
_
-> abort ("toTypeCodeExpression (TV)" ---> ((ptrToInt tv_info_ptr, tv_name)))
toTypeCodeExpression symb_name (TFA vars type) (tci=:{tci_type_var_heap}, var_heap, error)
# (new_vars, (tci_type_var_heap, var_heap)) = newTypeVariables vars (tci_type_var_heap, var_heap)
(type_code, tci) = toTypeCodeExpression symb_name type ({tci & tci_type_var_heap = tci_type_var_heap}, var_heap, error)
= (TCE_UniType new_vars type_code, tci)
-> abort ("toTypeCodeExpression (TypeVar)" ---> ((ptrToInt tv_info_ptr, tv_name)))
instance toTypeCodeExpression AType
where
toTypeCodeExpression symb_ident {at_type} tci_and_var_heap_and_error = toTypeCodeExpression symb_ident at_type tci_and_var_heap_and_error
......@@ -1501,8 +1545,17 @@ where
# (expression, ui) = updateExpression group_index expression ui
(expressions, ui) = updateExpression group_index expressions ui
= (RecordUpdate cons_symbol expression expressions, ui)
updateExpression group_index (DynamicExpr dyn=:{dyn_expr,dyn_info_ptr}) ui
# (dyn_expr, ui) = updateExpression group_index dyn_expr ui
updateExpression group_index (DynamicExpr dyn=:{dyn_expr,dyn_info_ptr}) ui=:{ui_has_type_codes}
# (dyn_expr, ui) = updateExpression group_index dyn_expr {ui & ui_has_type_codes = False}
# ui = check_type_codes_in_dynamic ui
with
check_type_codes_in_dynamic ui=:{ui_has_type_codes, ui_error}
| ui_has_type_codes
# ui_error = typeCodeInDynamicError ui_error
= {ui & ui_error = ui_error}
// otherwise
= ui
# ui = {ui & ui_has_type_codes=ui_has_type_codes}
(EI_TypeOfDynamic uni_vars type_code, ui_symbol_heap) = readPtr dyn_info_ptr ui.ui_symbol_heap
ui = { ui & ui_symbol_heap = ui_symbol_heap }
= (DynamicExpr { dyn & dyn_expr = dyn_expr, dyn_type_code = type_code }, ui)
......@@ -1615,25 +1668,31 @@ where
adjustClassExpression symb_name (Selection opt_type expr selectors) ui
# (expr, ui) = adjustClassExpression symb_name expr ui
= (Selection opt_type expr selectors, ui)
adjustClassExpression symb_name tce=:(TypeCodeExpression type_code_expression) ui
# ui = check_type_code type_code_expression ui
= (tce, {ui & ui_has_type_codes = True})
adjustClassExpression symb_name tce=:(TypeCodeExpression type_code) ui
# (type_code, ui) = adjust_type_code type_code ui
= (TypeCodeExpression type_code, {ui & ui_has_type_codes = True})
where
check_type_code (TCE_TypeTerm var_info_ptr) ui=:{ui_var_heap,ui_error}
# (_, (ui_var_heap,ui_error))
adjust_type_code (TCE_TypeTerm var_info_ptr) ui=:{ui_var_heap,ui_error}
# (var_info_ptr, (ui_var_heap,ui_error))
= getTCDictionary symb_name var_info_ptr (ui_var_heap, ui_error)
= { ui & ui_var_heap = ui_var_heap, ui_error = ui_error}
check_type_code (TCE_Constructor index typecode_exprs)
# ui
= { ui & ui_var_heap = ui_var_heap, ui_error = ui_error}
= (TCE_TypeTerm var_info_ptr, ui)
adjust_type_code (TCE_Constructor index typecode_exprs)
ui=:{ui_x={x_type_code_info={tci_type_constructors_in_patterns} }}
# ui
= { ui & ui_x.x_type_code_info.tci_type_constructors_in_patterns =
[index:tci_type_constructors_in_patterns] }
= foldSt check_type_code typecode_exprs ui
check_type_code (TCE_UniType uni_vars type_code) ui
= check_type_code type_code ui
check_type_code _ ui
= ui
# (typecode_exprs, ui)
= mapSt adjust_type_code typecode_exprs ui
= (TCE_Constructor index typecode_exprs, ui)
adjust_type_code (TCE_UniType uni_vars type_code) ui
# (type_code, ui)
= adjust_type_code type_code ui
= (TCE_UniType uni_vars type_code, ui)
adjust_type_code type_code ui
= (type_code, ui)
adjustClassExpression symb_name (Let this_let=:{let_strict_binds, let_lazy_binds, let_expr }) ui
# (let_strict_binds, ui) = adjust_let_binds symb_name let_strict_binds ui
(let_lazy_binds, ui) = adjust_let_binds symb_name let_lazy_binds ui
......
frontend/parse.icl
View file @ 5867c988
......@@ -306,9 +306,6 @@ where
(mod_ident, pState) = stringToIdent mod_name IC_Module pState
pState = check_layout_rule pState
(defs, pState) = want_definitions (SetGlobalContext iclmodule) pState
// MV ...
# (defs, pState) = add_module_id mod_name defs pState;
// ... MV
{ps_scanState,ps_hash_table,ps_error}
= pState
defs = if (ParseOnly && id_name <> "StdOverloaded" && id_name <> "StdArray" && id_name <> "StdEnum" && id_name <> "StdBool" && id_name <> "StdDynamics" && id_name <> "StdGeneric")
......@@ -325,37 +322,6 @@ where
mod = { mod_name = file_id, mod_modification_time = modification_time, mod_type = mod_type, mod_imports = [], mod_imported_objects = [], mod_defs = [] }
= (False, mod, hash_table, error <<< "Error [" <<< file_name <<< ',' <<< fp_line <<< "]: incorrect module header",
closeScanner scanState files)
where
// MV...
add_module_id mod_name defs pState
| not iclmodule
= (defs,pState);
// It is essential that the type name denoted by ident is an unique type name within the application. Otherwise
// the static linker will choose one implementation (because the type names are equal) and map the other to the
// chosen implementation.
// The zero arity of the _Module constructor makes the code generator, pre-allocate _Module in .data section of
// the final executable. The module name needed by the dynamic run-time system can then be determined by looking
// at the descriptor. If however all implementations were mapped to a single one, the dynamic rts could not use
// the module name anymore because they are all the same.
# (ident, pState) = stringToIdent ("_" +++ mod_name +++ "_Module") IC_Type pState
# td = MakeTypeDef ident [] (ConsList []) TA_None [] NoPos
# (pc_cons_name, pState) = stringToIdent "__Module" IC_Expression pState
# cons
= {
pc_cons_name = pc_cons_name
, pc_arg_types = []
, pc_args_strictness = NotStrict
, pc_cons_arity = 0
, pc_cons_prio = NoPrio
, pc_exi_vars = []
, pc_cons_pos = NoPos
}
# td
= { td & td_rhs = ConsList [cons] }
= ([PD_Type td:defs],pState)
// ...MV
try_module_header :: !Bool !ScanState -> (!Bool,!ModuleKind,!String,!ScanState)
try_module_header is_icl_mod scanState
......
frontend/postparse.icl
View file @ 5867c988
......@@ -1058,7 +1058,7 @@ where
scan_dcl_module :: ParsedModule [ScannedModule] !SearchPaths (ModTimeFunction *Files) *Files *CollectAdmin -> (Bool, [ScannedModule],*Files, *CollectAdmin)
scan_dcl_module mod=:{mod_defs = pdefs} parsed_modules searchPaths modtimefunction files ca
# (_, defs, imports, imported_objects, ca)
= reorganiseDefinitions False pdefs 0 0 0 0 ca
= reorganiseDefinitionsAndAddTypes False pdefs 0 0 0 0 ca
(def_macros, ca) = collectFunctions defs.def_macros False {ca & ca_fun_count=0,ca_rev_fun_defs=[]}
(range, ca) = addFunctionsRange def_macros ca
(rev_fun_defs,ca) = ca!ca_rev_fun_defs
......@@ -1079,7 +1079,7 @@ scanModule mod=:{mod_name,mod_type,mod_defs = pdefs} cached_modules support_gene
, ca_rev_fun_defs = []
, ca_hash_table = hash_table
}
(fun_defs, defs, imports, imported_objects, ca) = reorganiseDefinitions True pdefs 0 0 0 0 ca
(fun_defs, defs, imports, imported_objects, ca) = reorganiseDefinitionsAndAddTypes True pdefs 0 0 0 0 ca
(reorganise_icl_ok, ca) = ca!ca_error.pea_ok
......@@ -1146,7 +1146,7 @@ where
| not parse_ok
= (False, No,NoIndex, [],cached_modules, files, ca)
# pdefs = mod.mod_defs
# (_, defs, imports, imported_objects, ca) = reorganiseDefinitions False pdefs 0 0 0 0 ca
# (_, defs, imports, imported_objects, ca) = reorganiseDefinitionsAndAddTypes False pdefs 0 0 0 0 ca
# mod = { mod & mod_imports = imports, mod_imported_objects = imported_objects, mod_defs = defs}
# cached_modules = [mod.mod_name:cached_modules]
# (import_ok, parsed_modules,files, ca) = scanModules imports [] cached_modules searchPaths support_generics modtimefunction files ca
......@@ -1452,6 +1452,54 @@ reorganiseDefinitions icl_module [] _ _ _ _ ca
def_instances = [], def_funtypes = [],
def_generics = [], def_generic_cases = []}, [], [], ca)
reorganiseDefinitionsAndAddTypes icl_module defs cons_count sel_count mem_count type_count ca
# (rev_defs, ca)
= addTypeConstructors defs [] ca
= reorganiseDefinitions icl_module (reverse rev_defs) cons_count sel_count mem_count type_count ca
where
addTypeConstructors [] rev_defs ca
= (rev_defs, ca)
addTypeConstructors [PD_Type type_def : defs] rev_defs ca
# (type_def, tc_def, ca)
= addTypeConstructor type_def ca
= addTypeConstructors defs [PD_Type tc_def, PD_Type type_def : rev_defs] ca
addTypeConstructors [def : defs] rev_defs ca
= addTypeConstructors defs [def : rev_defs] ca
addTypeConstructor def=:{td_name, td_attribute, td_attrs, td_args, td_arity, td_pos} ca=:{ca_hash_table}
# tc_name = "TC;" +++ td_name.id_name
# ({boxed_ident=tc_cons_ident}, ca_hash_table) = putIdentInHashTable tc_name IC_Expression ca_hash_table
# ({boxed_ident=tc_type_ident}, ca_hash_table) = putIdentInHashTable tc_name IC_Type ca_hash_table
= (def, type_tc_def tc_type_ident tc_cons_ident td_name td_attribute td_attrs td_args
td_arity td_pos, { ca & ca_hash_table = ca_hash_table })
where
type_tc_def type_ident cons_ident type_name attr attrs args arity position
= { td_name = type_ident
, td_index = NoIndex
, td_arity = arity
, td_args = args
, td_attrs = attrs
, td_context = []
, td_rhs = ConsList [type_tc_cons cons_ident type_name args arity position]
, td_attribute = attr
, td_pos = position
, td_used_types = []
}
type_tc_cons cons_ident type_name args arity position
= { pc_cons_name = cons_ident
, pc_cons_arity = 1
, pc_exi_vars = []
, pc_arg_types = [type type_name args arity]
, pc_args_strictness = NotStrict
, pc_cons_prio = NoPrio
, pc_cons_pos = position
}
type type_name args arity
= { at_attribute = TA_None
, at_type = TA (MakeNewTypeSymbIdent type_name arity)
[{at_attribute = TA_None, at_type = TV arg.atv_variable} \\ arg <- args]
}
belongsToTypeSpec name prio new_name is_infix :==
name == new_name && sameFixity prio is_infix
......
frontend/predef.dcl
View file @ 5867c988
......@@ -66,146 +66,161 @@ PD_Arity32TupleSymbol :== 87
PD_TypeVar_a0 :== 88
PD_TypeVar_a31 :== 119
/* Dynamics */
PD_TypeCodeMember :== 120
PD_TypeCodeClass :== 121
PD_Dyn_bind_global_type_pattern_var
:== 122
PD_Dyn_ModuleID :== 123
/* identifiers present in the hashtable */
PD_StdArray :== 124
PD_StdEnum :== 125
PD_StdBool :== 126
PD_StdArray :== 120
PD_StdEnum :== 121
PD_StdBool :== 122
PD_AndOp :== 127
PD_OrOp :== 128
PD_AndOp :== 123
PD_OrOp :== 124
/* Array functions */
PD_ArrayClass :== 129
PD_ArrayClass :== 125
PD_CreateArrayFun :== 130
PD__CreateArrayFun :== 131
PD_ArraySelectFun :== 132
PD_UnqArraySelectFun :== 133
PD_ArrayUpdateFun :== 134
PD_ArrayReplaceFun :== 135
PD_ArraySizeFun :== 136
PD_UnqArraySizeFun :== 137
PD_CreateArrayFun :== 126
PD__CreateArrayFun :== 127
PD_ArraySelectFun :== 128
PD_UnqArraySelectFun :== 129
PD_ArrayUpdateFun :== 130
PD_ArrayReplaceFun :== 131
PD_ArraySizeFun :== 132
PD_UnqArraySizeFun :== 133
/* Enum/Comprehension functions */
PD_SmallerFun :== 138
PD_LessOrEqualFun :== 139
PD_IncFun :== 140
PD_SubFun:== 141
PD_From :== 142
PD_FromThen :== 143
PD_FromTo :== 144
PD_FromThenTo :== 145
PD_SmallerFun :== 134
PD_LessOrEqualFun :== 135
PD_IncFun :== 136
PD_SubFun :== 137
PD_From :== 138
PD_FromThen :== 139
PD_FromTo :== 140
PD_FromThenTo :== 141
/* StdMisc */
PD_StdMisc :== 146
PD_abort :== 147
PD_undef :== 148
PD_StdMisc :== 142
PD_abort :== 143
PD_undef :== 144
PD_Start :== 149
PD_Start :== 145
PD_DummyForStrictAliasFun :== 150
PD_DummyForStrictAliasFun :== 146
PD_StdStrictLists:==151
PD_StdStrictLists:==147
PD_cons:==152
PD_decons:==153
PD_cons:==148
PD_decons:==149
PD_cons_u:==154
PD_decons_u:==155
PD_cons_u:==150
PD_decons_u:==151
PD_cons_uts:==156
PD_decons_uts:==157
PD_cons_uts:==152
PD_decons_uts:==153
PD_nil:==158
PD_nil_u:==159
PD_nil_uts:==160
PD_nil:==154
PD_nil_u:==155
PD_nil_uts:==156
PD_ListClass :== 161
PD_UListClass :== 162
PD_UTSListClass :== 163
PD_ListClass :== 157
PD_UListClass :== 158
PD_UTSListClass :== 159
/* Dynamics */
PD_StdDynamic :== 164
PD_Dyn_DynamicTemp :== 165
PD_Dyn_Type :== 166
PD_Dyn_TypeScheme :== 167
PD_Dyn_TypeApp :== 168
PD_Dyn_TypeVar :== 169
PD_Dyn_TypePatternVar :== 170
PD_Dyn_TypeCons :== 171
PD_Dyn_tc_name :== 172
PD_Dyn_Unifier :== 173
PD_Dyn_unify :== 174
PD_Dyn_initial_unifier :== 175
PD_Dyn_normalise :== 176
// TC class
PD_TypeCodeMember :== 160
PD_TypeCodeClass :== 161
// dynamic module
PD_StdDynamic :== 162
// dynamic type
PD_Dyn_DynamicTemp :== 163
// type code
PD_Dyn_Type :== 164
PD_Dyn_TypeScheme :== 165
PD_Dyn_TypeApp :== 166
PD_Dyn_TypeVar :== 167
PD_Dyn_TypePatternVar :== 168
PD_Dyn_TypeCons :== 169
// unification
PD_Dyn_UnificationEnvironment :== 170
PD_Dyn_initial_unification_environment :== 171
PD_Dyn_bind_global_type_pattern_var :== 172
PD_Dyn_unify :== 173
PD_Dyn_normalise :== 174
// predefined type code constructor
PD_Dyn_TypeCodeConstructorInt :== 175
PD_Dyn_TypeCodeConstructorChar :== 176
PD_Dyn_TypeCodeConstructorReal :== 177
PD_Dyn_TypeCodeConstructorBool :== 178
PD_Dyn_TypeCodeConstructorDynamic :== 179
PD_Dyn_TypeCodeConstructorFile :== 180
PD_Dyn_TypeCodeConstructorWorld :== 181
PD_Dyn_TypeCodeConstructor_Arrow :== 182
PD_Dyn_TypeCodeConstructor_List :== 183
PD_Dyn_TypeCodeConstructor_StrictList :== 184
PD_Dyn_TypeCodeConstructor_UnboxedList :== 185
PD_Dyn_TypeCodeConstructor_TailStrictList :== 186
PD_Dyn_TypeCodeConstructor_StrictTailStrictList :== 187
PD_Dyn_TypeCodeConstructor_UnboxedTailStrictList :== 188
PD_Dyn_TypeCodeConstructor_Tuple :== 189
PD_Dyn_TypeCodeConstructor_LazyArray :== 190
PD_Dyn_TypeCodeConstructor_StrictArray :== 191
PD_Dyn_TypeCodeConstructor_UnboxedArray :== 192
/* Generics */
PD_StdGeneric :== 177
PD_TypeBimap :== 178
PD_ConsBimap :== 179
PD_map_to :== 180
PD_map_from :== 181
PD_TypeUNIT :== 182
PD_ConsUNIT :== 183
PD_TypeEITHER :== 184
PD_ConsLEFT :== 185
PD_ConsRIGHT :== 186
PD_TypePAIR :== 187
PD_ConsPAIR :== 188
PD_StdGeneric :== 193