Commit 233238c9 authored by John van Groningen's avatar John van Groningen

use type index macros for list, array, maybe and unit types

parent 40642beb
......@@ -1055,22 +1055,21 @@ transform_pattern (AP_Algebraic cons_symbol global_type_index args opt_var) patt
# alg_patterns = alg_patterns_of_OverloadedListPatterns_or_NoPattern patterns
# (pattern,cs) = replace_overloaded_symbol_in_pattern pattern PD_UnboxedTailStrictConsSymbol PD_UnboxedTailStrictNilSymbol cs
-> (OverloadedListPatterns unboxed_tail_strict_list decons_expr [pattern : alg_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
AlgebraicPatterns alg_type _
| alg_type.gi_module==cPredefinedModuleIndex
# index=alg_type.gi_index+FirstTypePredefinedSymbolIndex
| index==PD_ListType
AlgebraicPatterns alg_type=:{gi_module,gi_index} _
| gi_module==cPredefinedModuleIndex
| gi_index==PD_ListTypeIndex
# alg_patterns = alg_patterns_of_AlgebraicPatterns_or_NoPattern patterns
# (pattern,cs) = replace_overloaded_symbol_in_pattern pattern PD_ConsSymbol PD_NilSymbol cs
-> (AlgebraicPatterns alg_type [pattern : alg_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
| index==PD_StrictListType
| gi_index==PD_StrictListTypeIndex
# alg_patterns = alg_patterns_of_AlgebraicPatterns_or_NoPattern patterns
# (pattern,cs) = replace_overloaded_symbol_in_pattern pattern PD_StrictConsSymbol PD_StrictNilSymbol cs
-> (AlgebraicPatterns alg_type [pattern : alg_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
| index==PD_TailStrictListType
| gi_index==PD_TailStrictListTypeIndex
# alg_patterns = alg_patterns_of_AlgebraicPatterns_or_NoPattern patterns
# (pattern,cs) = replace_overloaded_symbol_in_pattern pattern PD_TailStrictConsSymbol PD_TailStrictNilSymbol cs
-> (AlgebraicPatterns alg_type [pattern : alg_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
| index==PD_StrictTailStrictListType
| gi_index==PD_StrictTailStrictListTypeIndex
# alg_patterns = alg_patterns_of_AlgebraicPatterns_or_NoPattern patterns
# (pattern,cs) = replace_overloaded_symbol_in_pattern pattern PD_StrictTailStrictConsSymbol PD_StrictTailStrictNilSymbol cs
-> (AlgebraicPatterns alg_type [pattern : alg_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
......@@ -1106,14 +1105,13 @@ transform_pattern (AP_Algebraic cons_symbol global_type_index args opt_var) patt
# alg_patterns = alg_patterns_of_OverloadedListPatterns_or_NoPattern patterns
# (pattern,cs) = replace_overloaded_maybe_symbol_in_pattern pattern PD_UnboxedJustSymbol PD_UnboxedNothingSymbol cs
-> (OverloadedListPatterns unboxed_list from_just_expr [pattern : alg_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
AlgebraicPatterns alg_type _
| alg_type.gi_module==cPredefinedModuleIndex
# index=alg_type.gi_index+FirstTypePredefinedSymbolIndex
| index==PD_MaybeType
AlgebraicPatterns alg_type=:{gi_module,gi_index} _
| gi_module==cPredefinedModuleIndex
| gi_index==PD_MaybeTypeIndex
# alg_patterns = alg_patterns_of_AlgebraicPatterns_or_NoPattern patterns
# (pattern,cs) = replace_overloaded_maybe_symbol_in_pattern pattern PD_JustSymbol PD_NothingSymbol cs
-> (AlgebraicPatterns alg_type [pattern : alg_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
| index==PD_StrictMaybeType
| gi_index==PD_StrictMaybeTypeIndex
# alg_patterns = alg_patterns_of_AlgebraicPatterns_or_NoPattern patterns
# (pattern,cs) = replace_overloaded_maybe_symbol_in_pattern pattern PD_StrictJustSymbol PD_StrictNothingSymbol cs
-> (AlgebraicPatterns alg_type [pattern : alg_patterns], pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
......@@ -1133,20 +1131,19 @@ transform_pattern (AP_Algebraic cons_symbol global_type_index args opt_var) patt
-> (patterns, pattern_scheme, pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
OverloadedListPatterns (OverloadedList _ _ _) _ _
| global_type_index.gi_module==cPredefinedModuleIndex
# index=global_type_index.gi_index+FirstTypePredefinedSymbolIndex
| index==PD_ListType
| global_type_index.gi_index==PD_ListTypeIndex
# alg_patterns = alg_patterns_of_OverloadedListPatterns_or_NoPattern patterns
# (alg_patterns,cs) = replace_overloaded_symbols_in_patterns alg_patterns PD_ConsSymbol PD_NilSymbol cs
-> (AlgebraicPatterns global_type_index [pattern:alg_patterns], AlgebraicPatterns global_type_index [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
| index==PD_StrictListType
| global_type_index.gi_index==PD_StrictListTypeIndex
# alg_patterns = alg_patterns_of_OverloadedListPatterns_or_NoPattern patterns
# (alg_patterns,cs) = replace_overloaded_symbols_in_patterns alg_patterns PD_StrictConsSymbol PD_StrictNilSymbol cs
-> (AlgebraicPatterns global_type_index [pattern:alg_patterns], AlgebraicPatterns global_type_index [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
| index==PD_TailStrictListType
| global_type_index.gi_index==PD_TailStrictListTypeIndex
# alg_patterns = alg_patterns_of_OverloadedListPatterns_or_NoPattern patterns
# (alg_patterns,cs) = replace_overloaded_symbols_in_patterns alg_patterns PD_TailStrictConsSymbol PD_TailStrictNilSymbol cs
-> (AlgebraicPatterns global_type_index [pattern:alg_patterns], AlgebraicPatterns global_type_index [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
| index==PD_StrictTailStrictListType
| global_type_index.gi_index==PD_StrictTailStrictListTypeIndex
# alg_patterns = alg_patterns_of_OverloadedListPatterns_or_NoPattern patterns
# (alg_patterns,cs) = replace_overloaded_symbols_in_patterns alg_patterns PD_StrictTailStrictConsSymbol PD_StrictTailStrictNilSymbol cs
-> (AlgebraicPatterns global_type_index [pattern:alg_patterns], AlgebraicPatterns global_type_index [], pattern_variables, defaul, var_store, expr_heap, opt_dynamics, cs)
......
......@@ -572,33 +572,32 @@ where
| PD_Arity2TupleTypeIndex <= type_index && type_index <= PD_Arity32TupleTypeIndex
= type_code_constructor_expression (type_index + (PD_TC__Tuple2 - PD_Arity2TupleTypeIndex)) ci
// otherwise
# predef_type_index = type_index + FirstTypePredefinedSymbolIndex
= case predef_type_index of
PD_ListType
= case type_index of
PD_ListTypeIndex
-> type_code_constructor_expression PD_TC__List ci
PD_StrictListType
PD_StrictListTypeIndex
-> type_code_constructor_expression PD_TC__StrictList ci
PD_UnboxedListType
PD_UnboxedListTypeIndex
-> type_code_constructor_expression PD_TC__UnboxedList ci
PD_TailStrictListType
PD_TailStrictListTypeIndex
-> type_code_constructor_expression PD_TC__TailStrictList ci
PD_StrictTailStrictListType
PD_StrictTailStrictListTypeIndex
-> type_code_constructor_expression PD_TC__StrictTailStrictList ci
PD_UnboxedTailStrictListType
PD_UnboxedTailStrictListTypeIndex
-> type_code_constructor_expression PD_TC__UnboxedTailStrictList ci
PD_LazyArrayType
PD_LazyArrayTypeIndex
-> type_code_constructor_expression PD_TC__LazyArray ci
PD_StrictArrayType
PD_StrictArrayTypeIndex
-> type_code_constructor_expression PD_TC__StrictArray ci
PD_UnboxedArrayType
PD_UnboxedArrayTypeIndex
-> type_code_constructor_expression PD_TC__UnboxedArray ci
PD_PackedArrayType
PD_PackedArrayTypeIndex
-> type_code_constructor_expression PD_TC__PackedArray ci
PD_MaybeType
PD_MaybeTypeIndex
-> type_code_constructor_expression PD_TC__Maybe ci
PD_StrictMaybeType
PD_StrictMaybeTypeIndex
-> type_code_constructor_expression PD_TC__StrictMaybe ci
PD_UnitType
PD_UnitTypeIndex
-> type_code_constructor_expression PD_TC__Unit ci
typeConstructor (GTT_Constructor fun_ident _) ci
# type_fun
......
......@@ -1315,13 +1315,13 @@ where
build_expr_for_conses type_def_mod type_def_index cons_def_syms arg_expr heaps error
# (case_alts, heaps, error)
= build_exprs_for_conses 0 (length cons_def_syms) type_def_mod cons_def_syms heaps error
| type_def_mod==cPredefinedModuleIndex && type_def_index+FirstTypePredefinedSymbolIndex==PD_UnboxedListType
| type_def_mod==cPredefinedModuleIndex && type_def_index==PD_UnboxedListTypeIndex
# (unboxed_list,decons_expr,expression_heap) = make_unboxed_list heaps.hp_expression_heap predefs.psd_predefs_a
heaps & hp_expression_heap=expression_heap
case_patterns = OverloadedListPatterns unboxed_list decons_expr case_alts
(case_expr, heaps) = buildCaseExpr arg_expr case_patterns heaps
= (case_expr, heaps, error)
| type_def_mod==cPredefinedModuleIndex && type_def_index+FirstTypePredefinedSymbolIndex==PD_UnboxedTailStrictListType
| type_def_mod==cPredefinedModuleIndex && type_def_index==PD_UnboxedTailStrictListTypeIndex
# (unboxed_list,decons_expr,expression_heap) = make_unboxed_tail_strict_list heaps.hp_expression_heap predefs.psd_predefs_a
heaps & hp_expression_heap=expression_heap
case_patterns = OverloadedListPatterns unboxed_list decons_expr case_alts
......
......@@ -300,54 +300,52 @@ where
merge_guards guards=:(DynamicPatterns patterns1) (DynamicPatterns patterns2) var_heap symbol_heap error
# (merged_patterns, var_heap, symbol_heap, error) = merge_dynamic_patterns patterns1 patterns2 var_heap symbol_heap error
= (DynamicPatterns merged_patterns, var_heap, symbol_heap, error)
merge_guards guards=:(AlgebraicPatterns type1 patterns1) (OverloadedListPatterns type2 decons_expr2 patterns2) var_heap symbol_heap error
| type1.gi_module==cPredefinedModuleIndex
# index=type1.gi_index+FirstTypePredefinedSymbolIndex
merge_guards guards=:(AlgebraicPatterns type1=:{gi_module,gi_index} patterns1) (OverloadedListPatterns type2 decons_expr2 patterns2) var_heap symbol_heap error
| gi_module==cPredefinedModuleIndex
| type2=:OverloadedList _ _ _
| index==PD_ListType
| gi_index==PD_ListTypeIndex
# patterns2=replace_overloaded_symbols_in_patterns patterns2 PD_ConsSymbol PD_NilSymbol
= merge_algebraic_patterns type1 patterns1 patterns2 var_heap symbol_heap error
| index==PD_StrictListType
| gi_index==PD_StrictListTypeIndex
# patterns2=replace_overloaded_symbols_in_patterns patterns2 PD_StrictConsSymbol PD_StrictNilSymbol
= merge_algebraic_patterns type1 patterns1 patterns2 var_heap symbol_heap error
| index==PD_TailStrictListType
| gi_index==PD_TailStrictListTypeIndex
# patterns2=replace_overloaded_symbols_in_patterns patterns2 PD_TailStrictConsSymbol PD_TailStrictNilSymbol
= merge_algebraic_patterns type1 patterns1 patterns2 var_heap symbol_heap error
| index==PD_StrictTailStrictListType
| gi_index==PD_StrictTailStrictListTypeIndex
# patterns2=replace_overloaded_symbols_in_patterns patterns2 PD_StrictTailStrictConsSymbol PD_StrictTailStrictNilSymbol
= merge_algebraic_patterns type1 patterns1 patterns2 var_heap symbol_heap error
= (guards, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
| type2=:OverloadedMaybe _ _ _
| index==PD_MaybeType
| gi_index==PD_MaybeTypeIndex
# patterns2=replace_overloaded_maybe_symbols_in_patterns patterns2 PD_JustSymbol PD_NothingSymbol
= merge_algebraic_patterns type1 patterns1 patterns2 var_heap symbol_heap error
| index==PD_StrictMaybeType
| gi_index==PD_StrictMaybeTypeIndex
# patterns2=replace_overloaded_maybe_symbols_in_patterns patterns2 PD_StrictJustSymbol PD_StrictNothingSymbol
= merge_algebraic_patterns type1 patterns1 patterns2 var_heap symbol_heap error
= (guards, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
= (guards, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
merge_guards guards=:(OverloadedListPatterns type1 decons_expr1 patterns1) (AlgebraicPatterns type2 patterns2) var_heap symbol_heap error
| type2.gi_module==cPredefinedModuleIndex
# index=type2.gi_index+FirstTypePredefinedSymbolIndex
merge_guards guards=:(OverloadedListPatterns type1 decons_expr1 patterns1) (AlgebraicPatterns type2=:{gi_module,gi_index} patterns2) var_heap symbol_heap error
| gi_module==cPredefinedModuleIndex
| type1=:OverloadedList _ _ _
| index==PD_ListType
| gi_index==PD_ListTypeIndex
# patterns1=replace_overloaded_symbols_in_patterns patterns1 PD_ConsSymbol PD_NilSymbol
= merge_algebraic_patterns type2 patterns1 patterns2 var_heap symbol_heap error
| index==PD_StrictListType
| gi_index==PD_StrictListTypeIndex
# patterns1=replace_overloaded_symbols_in_patterns patterns1 PD_StrictConsSymbol PD_StrictNilSymbol
= merge_algebraic_patterns type2 patterns1 patterns2 var_heap symbol_heap error
| index==PD_TailStrictListType
| gi_index==PD_TailStrictListTypeIndex
# patterns1=replace_overloaded_symbols_in_patterns patterns1 PD_TailStrictConsSymbol PD_TailStrictNilSymbol
= merge_algebraic_patterns type2 patterns1 patterns2 var_heap symbol_heap error
| index==PD_StrictTailStrictListType
| gi_index==PD_StrictTailStrictListTypeIndex
# patterns1=replace_overloaded_symbols_in_patterns patterns1 PD_StrictTailStrictConsSymbol PD_StrictTailStrictNilSymbol
= merge_algebraic_patterns type2 patterns1 patterns2 var_heap symbol_heap error
= (guards, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
| type1=:OverloadedMaybe _ _ _
| index==PD_MaybeType
| gi_index==PD_MaybeTypeIndex
# patterns1=replace_overloaded_maybe_symbols_in_patterns patterns1 PD_JustSymbol PD_NothingSymbol
= merge_algebraic_patterns type2 patterns1 patterns2 var_heap symbol_heap error
| index==PD_StrictMaybeType
| gi_index==PD_StrictMaybeTypeIndex
# patterns1=replace_overloaded_maybe_symbols_in_patterns patterns1 PD_StrictJustSymbol PD_StrictNothingSymbol
= merge_algebraic_patterns type2 patterns1 patterns2 var_heap symbol_heap error
= (guards, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
......
......@@ -1423,36 +1423,35 @@ where
= abort ("<:: (Type) (typesupport.icl)" ---> type)
writeTypeTA :: !*File !(Optional TypeVarBeautifulizer) !Format !TypeSymbIdent !a -> (!*File, !Optional TypeVarBeautifulizer) | writeType a
writeTypeTA file opt_beautifulizer form {type_ident,type_index,type_arity} types
| type_index.glob_module == cPredefinedModuleIndex
# predef_index = type_index.glob_object+FirstTypePredefinedSymbolIndex
writeTypeTA file opt_beautifulizer form {type_ident,type_index={glob_module,glob_object},type_arity} types
| glob_module == cPredefinedModuleIndex
| type_arity == 0
| predef_index==PD_StringType
| glob_object==PD_StringTypeIndex
= (file <<< "String", opt_beautifulizer)
| predef_index==PD_UnitType
| glob_object==PD_UnitTypeIndex
= (file <<< "()", opt_beautifulizer)
= (file <<< type_ident, opt_beautifulizer)
| predef_index==PD_ListType
| glob_object==PD_ListTypeIndex
= writeWithinBrackets "[" "]" file opt_beautifulizer (setProperty form cCommaSeparator, types)
| predef_index==PD_StrictListType
| glob_object==PD_StrictListTypeIndex
= writeWithinBrackets "[!" "]" file opt_beautifulizer (setProperty form cCommaSeparator, types)
| predef_index==PD_UnboxedListType
| glob_object==PD_UnboxedListTypeIndex
= writeWithinBrackets "[#" "]" file opt_beautifulizer (setProperty form cCommaSeparator, types)
| predef_index==PD_TailStrictListType
| glob_object==PD_TailStrictListTypeIndex
= writeWithinBrackets "[" "!]" file opt_beautifulizer (setProperty form cCommaSeparator, types)
| predef_index==PD_StrictTailStrictListType
| glob_object==PD_StrictTailStrictListTypeIndex
= writeWithinBrackets "[!" "!]" file opt_beautifulizer (setProperty form cCommaSeparator, types)
| predef_index==PD_UnboxedTailStrictListType
| glob_object==PD_UnboxedTailStrictListTypeIndex
= writeWithinBrackets "[#" "!]" file opt_beautifulizer (setProperty form cCommaSeparator, types)
| predef_index==PD_LazyArrayType
| glob_object==PD_LazyArrayTypeIndex
= writeWithinBrackets "{" "}" file opt_beautifulizer (setProperty form cCommaSeparator, types)
| predef_index==PD_StrictArrayType
| glob_object==PD_StrictArrayTypeIndex
= writeWithinBrackets "{!" "}" file opt_beautifulizer (setProperty form cCommaSeparator, types)
| predef_index==PD_UnboxedArrayType
| glob_object==PD_UnboxedArrayTypeIndex
= writeWithinBrackets "{#" "}" file opt_beautifulizer (setProperty form cCommaSeparator, types)
| predef_index==PD_PackedArrayType
| glob_object==PD_PackedArrayTypeIndex
= writeWithinBrackets "{32#" "}" file opt_beautifulizer (setProperty form cCommaSeparator, types)
| predef_index>=PD_Arity2TupleType && predef_index<=PD_Arity32TupleType
| glob_object>=PD_Arity2TupleTypeIndex && glob_object<=PD_Arity32TupleTypeIndex
= writeWithinBrackets "(" ")" file opt_beautifulizer (setProperty form cCommaSeparator, types)
| checkProperty form cBrackets
# (file, opt_beautifulizer)
......
Markdown is supported
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