Skip to content
GitLab
Commit 0a880141 authored by Martijn Vervoort's avatar Martijn Vervoort
Browse files

- type files worden aangemaakt (buggy) 

- type namen worden gesuffixed met hun definierde module naam
parent 82fca2f5
Hide whitespace changes
Inline Side-by-side
frontend/convertDynamics.dcl
View file @ 0a880141
......@@ -3,8 +3,8 @@ definition module convertDynamics
import syntax, transform, convertcases
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !Int !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap
-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !Int !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap !*File {# DclModule} !IclModule
-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap, !*File)
/*
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !*{! Group} !*{#FunDef} !*PredefinedSymbols
......
frontend/convertDynamics.icl
View file @ 0a880141
......@@ -3,6 +3,7 @@ implementation module convertDynamics
import syntax, transform, utilities, convertcases
// Optional
USE_TUPLES tuple b :== b; // change also StdDynamic.icl and recompile all applications
import type_io;
:: *ConversionInfo =
{ ci_predef_symb :: !*PredefinedSymbols
......@@ -47,11 +48,73 @@ getSymbol index symb_kind arity ci=:{ci_predef_symb}
symbol = { symb_name = pds_ident, symb_kind = symb_kind { glob_module = pds_module, glob_object = pds_def}, symb_arity = arity }
= (symbol, ci)
*/
/*
// | True
// = abort (toString main_dcl_module.dcl_name.id_name)
| True
= abort (toString main_dcl_module_n);
// distinguish external/internal types
# dcl_conversions
= get_conversion_table (main_dcl_module.dcl_conversions)
# type_defs_conversions
= dcl_conversions.[cTypeDefs]
# s_type_defs_conversions
= size type_defs_conversions
# s_exported_com_type_defs
= size common_defs.com_type_defs
# exported_com_type_defs
= createArray s_exported_com_type_defs False
# exported_com_type_defs
= foldSt (\i exported_com_type_defs ->
{ exported_com_type_defs & [type_defs_conversions.[i]] = True }
) [0..dec s_type_defs_conversions] exported_com_type_defs;
# (s_exported_com_type_defs,exported_com_type_defs)
= usize exported_com_type_defs
| True
= abort (toString s_exported_com_type_defs);
*/
pl [] = ""
pl [x:xs] = x +++ " , " +++ (pl xs)
F :: !a .b -> .b
F a b = b
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !Int !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap
-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_module_n groups fun_defs predefined_symbols var_heap type_heaps expr_heap
write_tcl_file :: !Int {#DclModule} CommonDefs !*File -> (.Bool,.File)
write_tcl_file main_dcl_module_n dcl_mods=:{[main_dcl_module_n] = main_dcl_module} common_defs tcl_file
/*
#! tcl_file
= write_type_info dcl_mods tcl_file
*/
#! tcl_file
= write_type_info common_defs tcl_file
// #! (ok,common_defs,tcl_file)
// = read_type_info tcl_file
// | True
// = abort (toString (size common_defs.com_type_defs))
= (True,tcl_file)
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !Int !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap /* TD */!*File {# DclModule} !IclModule
-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap, /* TD */ !*File)
convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_module_n groups fun_defs predefined_symbols var_heap type_heaps expr_heap /* TD */ tcl_file dcl_mods icl_mod
// TD ...
/*
# (ok,tcl_file)
= write_tcl_file main_dcl_module_n dcl_mods icl_mod.icl_common tcl_file
| not ok
= abort "convertDynamicPatternsIntoUnifyAppls: error writing tcl file"
*/
// ... TD
# ({pds_module, pds_def} , predefined_symbols) = predefined_symbols![PD_StdDynamics]
#! (dynamic_temp_symb_ident,ci_sel_value_field,ci_sel_type_field,predefined_symbols)
= case (pds_module == (-1) || pds_def == (-1)) of
......@@ -151,7 +214,7 @@ convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_
ci_used_tcs = [],ci_symb_ident = dynamic_temp_symb_ident , ci_sel_type_field = ci_sel_type_field, ci_sel_value_field = ci_sel_value_field })
(groups, new_fun_defs, imported_types, imported_conses, type_heaps, ci_var_heap)
= addNewFunctionsToGroups common_defs ci_fun_heap ci_new_functions main_dcl_module_n groups imported_types [] type_heaps ci_var_heap
= (groups, { fundef \\ fundef <- [ fundef \\ fundef <-: fun_defs ] ++ new_fun_defs }, ci_predef_symb, imported_types, imported_conses, ci_var_heap, type_heaps, ci_expr_heap)
= (groups, { fundef \\ fundef <- [ fundef \\ fundef <-: fun_defs ] ++ new_fun_defs }, ci_predef_symb, imported_types, imported_conses, ci_var_heap, type_heaps, ci_expr_heap, tcl_file)
where
convert_groups group_nr groups global_type_instances fun_defs_and_ci
| group_nr == size groups
......@@ -980,9 +1043,9 @@ get_constructor glob_type_inst index
instance toString GlobalTCType
where
toString (GTT_Basic basic_type) = toString basic_type
toString GTT_Function = " -> "
toString (GTT_Constructor type_symb_indent) = type_symb_indent.type_name.id_name
toString (GTT_Basic basic_type) = toString basic_type
toString GTT_Function = " -> "
toString (GTT_Constructor type_symb_indent mod_name) = type_symb_indent.type_name.id_name +++ "'" +++ mod_name
instance toString BasicType
where
......
frontend/frontend.dcl
View file @ 0a880141
......@@ -22,5 +22,5 @@ import checksupport, transform, overloading
| FrontEndPhaseConvertModules
| FrontEndPhaseAll
frontEndInterface :: !FrontEndPhase !Ident !SearchPaths !{#DclModule} !{#FunDef} !(Optional Bool) !*PredefinedSymbols !*HashTable !*Files !*File !*File !*File !*Heaps
-> ( !Optional *FrontEndSyntaxTree,!.{# FunDef },!Int,!Int,!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File,!*Heaps)
frontEndInterface :: !FrontEndPhase !Ident !SearchPaths !{#DclModule} !{#FunDef} !(Optional Bool) !*PredefinedSymbols !*HashTable !*Files !*File !*File !*File !*File !*Heaps
-> ( !Optional *FrontEndSyntaxTree,!.{# FunDef },!Int,!Int,!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File, !*File, !*Heaps)
frontend/frontend.icl
View file @ 0a880141
......@@ -57,7 +57,7 @@ instance == FrontEndPhase where
(==) a b
= equal_constructor a b
frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions
frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions
global_fun_range heaps
:== (Yes {
fe_icl = {icl_mod & icl_functions=fun_defs }
......@@ -67,15 +67,18 @@ frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_module
, fe_iclDclConversions = build_optional_icl_dcl_conversions (size fun_defs) optional_dcl_icl_conversions
, fe_globalFunctions = global_fun_range
, fe_arrayInstances = array_instances
},cached_functions_and_macros,n_functions_and_macros_in_dcl_modules,main_dcl_module_n,predef_symbols,hash_table,files,error,io,out,heaps
},cached_functions_and_macros,n_functions_and_macros_in_dcl_modules,main_dcl_module_n,predef_symbols,hash_table,files,error,io,out,tcl_file,heaps
)
frontEndInterface :: !FrontEndPhase !Ident !SearchPaths !{#DclModule} !{#FunDef} !(Optional Bool) !*PredefinedSymbols !*HashTable !*Files !*File !*File !*File !*Heaps -> ( !Optional *FrontEndSyntaxTree,!.{# FunDef },!Int,!Int,!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File,!*Heaps)
frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_macros list_inferred_types predef_symbols hash_table files error io out heaps
//frontEndInterface :: !FrontEndPhase !Ident !SearchPaths !{#DclModule} !{#FunDef} !(Optional Bool) !*PredefinedSymbols !*HashTable !*Files !*File !*File !*File !*File !*Heaps -> ( !Optional *FrontEndSyntaxTree,!.{# FunDef },!Int,!Int,!*PredefinedSymbols, !*HashTable, !*Files, !*File !*File, !*File, !*File, !*Heaps)
frontEndInterface :: !FrontEndPhase !Ident !SearchPaths !{#DclModule} !{#FunDef} !(Optional Bool) !*PredefinedSymbols !*HashTable !*Files !*File !*File !*File !*File !*Heaps
-> ( !Optional *FrontEndSyntaxTree,!.{# FunDef },!Int,!Int,!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File, !*File, !*Heaps)
frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_macros list_inferred_types predef_symbols hash_table files error io out tcl_file heaps
# (ok, mod, hash_table, error, predef_symbols, files)
= wantModule cWantIclFile mod_ident NoPos (hash_table /* ---> ("Parsing:", mod_ident)*/) error search_paths predef_symbols files
| not ok
= (No,{},0,0,predef_symbols, hash_table, files, error, io, out,heaps)
= (No,{},0,0,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
# cached_module_idents = [dcl_mod.dcl_name \\ dcl_mod<-:dcl_modules]
# (ok, mod, global_fun_range, mod_functions, optional_dcl_mod, modules, dcl_module_n_in_cache,n_functions_and_macros_in_dcl_modules,hash_table, error, predef_symbols, files)
= scanModule (mod -*-> "Scanning") cached_module_idents (size functions_and_macros) hash_table error search_paths predef_symbols files
......@@ -84,14 +87,14 @@ frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_mac
# hash_table = remove_icl_symbols_from_hash_table hash_table
/**/
| not ok
= (No,{},0,0,predef_symbols, hash_table, files, error, io, out,heaps)
= (No,{},0,0,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
# symbol_table = hash_table.hte_symbol_heap
(ok, icl_mod, dcl_mods, components, optional_dcl_icl_conversions,cached_functions_and_macros,main_dcl_module_n,heaps, predef_symbols, symbol_table, error)
= checkModule mod global_fun_range mod_functions n_functions_and_macros_in_dcl_modules dcl_module_n_in_cache optional_dcl_mod modules dcl_modules functions_and_macros predef_symbols (symbol_table -*-> "Checking") error heaps
hash_table = { hash_table & hte_symbol_heap = symbol_table}
| not ok
= (No,{},0,main_dcl_module_n,predef_symbols, hash_table, files, error, io, out, heaps)
= (No,{},0,main_dcl_module_n,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
#! (icl_functions,icl_mod) = select_and_remove_icl_functions_from_record icl_mod
with
......@@ -116,13 +119,13 @@ frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_mac
array_instances = {ir_from=0, ir_to=0}
| upToPhase == FrontEndPhaseCheck
= frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps
= frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps
# (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 icl_functions icl_specials list_inferred_types icl_common [a\\a<-:icl_import] dcl_mods icl_used_module_numbers heaps predef_symbols error out
= typeProgram (components -*-> "Typing") main_dcl_module_n icl_functions icl_specials list_inferred_types icl_common [a\\a<-:icl_import] dcl_mods icl_used_module_numbers heaps predef_symbols error out dcl_mods
| not ok
= (No,{},0,main_dcl_module_n,predef_symbols, hash_table, files, error, io, out,heaps)
= (No,{},0,main_dcl_module_n,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
# (components, fun_defs) = partitionateFunctions (fun_defs -*-> "partitionateFunctions") [ global_fun_range, icl_instances, icl_specials]
// (components, fun_defs, error) = showTypes components 0 fun_defs error
......@@ -130,15 +133,17 @@ frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_mac
// (fun_defs, error) = showFunctions array_instances fun_defs error
| upToPhase == FrontEndPhaseTypeCheck
= frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps
= frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps
# (components, fun_defs, predef_symbols, dcl_types, used_conses_in_dynamics, var_heap, type_heaps, expression_heap)
# (components, fun_defs, predef_symbols, dcl_types, used_conses_in_dynamics, var_heap, type_heaps, expression_heap, tcl_file)
= convertDynamicPatternsIntoUnifyAppls type_code_instances common_defs main_dcl_module_n (components -*-> "convertDynamics") fun_defs predef_symbols
heaps.hp_var_heap heaps.hp_type_heaps heaps.hp_expression_heap
heaps.hp_var_heap heaps.hp_type_heaps heaps.hp_expression_heap tcl_file dcl_mods icl_mod
// # (components, fun_defs, error) = showComponents3 components 0 False fun_defs error
// (components, fun_defs, error) = showComponents components 0 True fun_defs error
| upToPhase == FrontEndPhaseConvertDynamics
# heaps = {hp_var_heap=var_heap, hp_type_heaps=type_heaps, hp_expression_heap=expression_heap}
= frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps
= frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps
// (components, fun_defs, error) = showComponents components 0 True fun_defs error
# (cleanup_info, acc_args, components, fun_defs, var_heap, expression_heap)
......@@ -149,7 +154,7 @@ frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_mac
| upToPhase == FrontEndPhaseTransformGroups
# heaps = {hp_var_heap=var_heap, hp_type_heaps=type_heaps, hp_expression_heap=expression_heap}
= frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps
= frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps
# (dcl_types, used_conses, var_heap, type_heaps) = convertIclModule main_dcl_module_n common_defs (dcl_types -*-> "Convert icl") used_conses var_heap type_heaps
# (dcl_types, used_conses, var_heap, type_heaps) = convertDclModule main_dcl_module_n dcl_mods common_defs (dcl_types -*-> "Convert dcl") used_conses var_heap type_heaps
......@@ -158,7 +163,7 @@ frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_mac
| upToPhase == FrontEndPhaseConvertModules
# heaps = {hp_var_heap=var_heap, hp_type_heaps=type_heaps, hp_expression_heap=expression_heap}
= frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps
= frontSyntaxTree cached_functions_and_macros n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps
// (components, fun_defs, out) = showComponents components 0 False fun_defs out
# (used_funs, components, fun_defs, dcl_types, used_conses, var_heap, type_heaps, expression_heap)
......@@ -181,7 +186,7 @@ frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_mac
, fe_iclDclConversions = build_optional_icl_dcl_conversions (size fun_defs) optional_dcl_icl_conversions
, fe_arrayInstances = array_instances,fe_globalFunctions=global_fun_range
}
= (Yes fe,cached_functions_and_macros,n_functions_and_macros_in_dcl_modules,main_dcl_module_n,predef_symbols,hash_table,files,error,io,out,heaps)
= (Yes fe,cached_functions_and_macros,n_functions_and_macros_in_dcl_modules,main_dcl_module_n,predef_symbols,hash_table,files,error,io,out,tcl_file,heaps)
where
build_optional_icl_dcl_conversions :: !Int !(Optional {# Index}) -> Optional {# Index}
build_optional_icl_dcl_conversions size No
......
frontend/overloading.dcl
View file @ 0a880141
......@@ -36,13 +36,16 @@ import syntax, check, typesupport
:: LocalTypePatternVariable
:: DictionaryTypes :== [(Index, [ExprInfoPtr])]
tryToSolveOverloading :: ![(Optional [TypeContext], [ExprInfoPtr], IdentPos, Index)] !Int !{# CommonDefs } !ClassInstanceInfo !*Coercions !*OverloadingState
tryToSolveOverloading :: ![(Optional [TypeContext], [ExprInfoPtr], IdentPos, Index)] !Int !{# CommonDefs } !ClassInstanceInfo !*Coercions !*OverloadingState !{# DclModule}
-> (![TypeContext], !*Coercions, ![LocalTypePatternVariable], DictionaryTypes, !*OverloadingState)
:: TypeCodeInfo =
{ tci_next_index :: !Index
, tci_instances :: ![GlobalTCInstance]
, tci_type_var_heap :: !.TypeVarHeap
// MV ...
, tci_dcl_modules :: !{# DclModule}
// ... MV
}
removeOverloadedFunctions :: ![Index] ![LocalTypePatternVariable] !Int !*{#FunDef} !*{! FunctionType} !*ExpressionHeap
......
frontend/overloading.icl
View file @ 0a880141
......@@ -83,7 +83,7 @@ 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
......@@ -134,16 +134,16 @@ FoundObject object :== object.glob_module <> NotFound
ObjectNotFound :== { glob_module = NotFound, glob_object = NotFound }
reduceContexts :: ![TypeContext] !Int !{# CommonDefs} !ClassInstanceInfo ![TypeContext] !*SpecialInstances ![LocalTypePatternVariable]
!(!*VarHeap, !*TypeHeaps) !*Coercions !*PredefinedSymbols !*ErrorAdmin
!(!*VarHeap, !*TypeHeaps) !*Coercions !*PredefinedSymbols !*ErrorAdmin !{# DclModule}
-> *(![ClassApplication], ![TypeContext], !*SpecialInstances, ![LocalTypePatternVariable],
!(!*VarHeap, !*TypeHeaps), !*Coercions, !*PredefinedSymbols, !*ErrorAdmin)
reduceContexts [] main_dcl_module_n defs instance_info new_contexts special_instances type_pattern_vars heaps coercion_env predef_symbols error
reduceContexts [] main_dcl_module_n defs instance_info new_contexts special_instances type_pattern_vars heaps coercion_env predef_symbols error dcl_modules
= ([], new_contexts, special_instances, type_pattern_vars, heaps, coercion_env, predef_symbols, error)
reduceContexts [tc : tcs] main_dcl_module_n defs instance_info new_contexts special_instances type_pattern_vars heaps coercion_env predef_symbols error
reduceContexts [tc : tcs] main_dcl_module_n defs instance_info new_contexts special_instances type_pattern_vars heaps coercion_env predef_symbols error dcl_modules
# (appl, new_contexts, special_instances, type_pattern_vars, heaps, coercion_env, predef_symbols, error)
= try_to_reduce_context tc defs instance_info new_contexts special_instances type_pattern_vars heaps coercion_env predef_symbols error
(appls, new_contexts, special_instances, type_pattern_vars, heaps, coercion_env, predef_symbols, error)
= reduceContexts tcs main_dcl_module_n defs instance_info new_contexts special_instances type_pattern_vars heaps coercion_env predef_symbols error
= reduceContexts tcs main_dcl_module_n defs instance_info new_contexts special_instances type_pattern_vars heaps coercion_env predef_symbols error dcl_modules
= ([appl : appls], new_contexts, special_instances, type_pattern_vars, heaps, coercion_env, predef_symbols, error)
where
......@@ -183,7 +183,7 @@ where
= ({ rcs_class_context = rcs_class_context, rcs_constraints_contexts = []}, new_contexts,
special_instances, type_pattern_vars, (var_heap, type_heaps), coercion_env, predef_symbols, error)
# (appls, new_contexts, special_instances, type_pattern_vars, heaps, coercion_env, predef_symbols, error)
= reduceContexts contexts main_dcl_module_n defs instance_info new_contexts special_instances type_pattern_vars (var_heap, type_heaps) coercion_env predef_symbols error
= reduceContexts contexts main_dcl_module_n defs instance_info new_contexts special_instances type_pattern_vars (var_heap, type_heaps) coercion_env predef_symbols error dcl_modules
(constraints, new_contexts, special_instances, type_pattern_vars, heaps, coercion_env, predef_symbols, error)
= reduce_contexts_in_constraints tc_types class_args class_context defs instance_info new_contexts special_instances type_pattern_vars
heaps coercion_env predef_symbols error
......@@ -416,9 +416,13 @@ 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 cons_args) (new_contexts, special_instances=:{si_next_TC_member_index, si_TC_instances}, type_pattern_vars, var_heap)
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)
// MV ...
# defining_module_name
= dcl_modules.[glob_module].dcl_name.id_name
// ... MV
# (inst_index, (si_next_TC_member_index, si_TC_instances))
= addGlobalTCInstance (GTT_Constructor cons_id) (si_next_TC_member_index, si_TC_instances)
= addGlobalTCInstance (GTT_Constructor cons_id defining_module_name) (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)
......@@ -582,9 +586,9 @@ where
:: DictionaryTypes :== [(Index, [ExprInfoPtr])]
tryToSolveOverloading :: ![(Optional [TypeContext], [ExprInfoPtr], IdentPos, Index)] !Int !{# CommonDefs } !ClassInstanceInfo !*Coercions !*OverloadingState
tryToSolveOverloading :: ![(Optional [TypeContext], [ExprInfoPtr], IdentPos, Index)] !Int !{# CommonDefs } !ClassInstanceInfo !*Coercions !*OverloadingState !{# DclModule}
-> (![TypeContext], !*Coercions, ![LocalTypePatternVariable], DictionaryTypes, !*OverloadingState)
tryToSolveOverloading ocs main_dcl_module_n defs instance_info coercion_env os
tryToSolveOverloading ocs main_dcl_module_n defs instance_info coercion_env os dcl_modules
# (reduced_contexts, contexts, coercion_env, type_pattern_vars, os) = foldSt (reduce_contexts defs instance_info) ocs ([], [], coercion_env, [], os)
| os.os_error.ea_ok
# (contexts, os_var_heap) = foldSt add_spec_contexts ocs (contexts, os.os_var_heap)
......@@ -623,7 +627,7 @@ where
# (class_applications, new_contexts, os_special_instances, type_pattern_vars,
(os_var_heap, os_type_heaps), coercion_env, os_predef_symbols, os_error)
= reduceContexts oc_context main_dcl_module_n defs instance_info new_contexts os_special_instances type_pattern_vars
(os_var_heap, os_type_heaps) coercion_env os_predef_symbols os_error
(os_var_heap, os_type_heaps) coercion_env os_predef_symbols os_error dcl_modules
= ([ (oc_symbol, fun_index, over_info_ptr, class_applications) : reduced_calls ], new_contexts, coercion_env, type_pattern_vars,
{ os & os_type_heaps = os_type_heaps, os_symbol_heap = os_symbol_heap, os_var_heap = os_var_heap,
os_special_instances = os_special_instances, os_error = os_error, os_predef_symbols = os_predef_symbols })
......@@ -1085,15 +1089,22 @@ retrieve_var symb_name var_info_ptr (free_vars, var_heap, rev_variables, error)
{ tci_next_index :: !Index
, tci_instances :: ![GlobalTCInstance]
, tci_type_var_heap :: !.TypeVarHeap
// MV ...
, tci_dcl_modules :: !{# DclModule}
// ... MV
}
class toTypeCodeExpression type :: !Ident ![Ptr VarInfo] type !(!*TypeCodeInfo,!*VarHeap,!*ErrorAdmin) -> (!TypeCodeExpression, !(!*TypeCodeInfo,!*VarHeap,!*ErrorAdmin))
instance toTypeCodeExpression Type
where
toTypeCodeExpression symb_name rev_variables (TA cons_id type_args) (tci=:{tci_next_index,tci_instances},var_heap,error)
toTypeCodeExpression symb_name rev_variables (TA cons_id=:{type_index={glob_module}} type_args) (tci=:{tci_next_index,tci_instances,tci_dcl_modules},var_heap,error)
// MV ...
# defining_module_name
= tci_dcl_modules.[glob_module].dcl_name.id_name
// ... MV
# (inst_index, (tci_next_index, tci_instances))
= addGlobalTCInstance (GTT_Constructor cons_id) (tci_next_index, tci_instances)
= addGlobalTCInstance (GTT_Constructor cons_id defining_module_name) (tci_next_index, tci_instances)
(type_code_args, tci) = mapSt (toTypeCodeExpression symb_name rev_variables) 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 rev_variables (TB basic_type) (tci=:{tci_next_index,tci_instances},var_heap,error)
......
frontend/syntax.dcl
View file @ 0a880141
......@@ -1118,7 +1118,7 @@ cIsNotStrict :== False
//:: TypeCodeExpression = TCE_Empty | TCE_Var !VarInfoPtr | TCE_Constructor !Index ![TypeCodeExpression] | TCE_Selector ![Selection] !VarInfoPtr
:: TypeCodeExpression = TCE_Empty | TCE_Var !VarInfoPtr /* MV */ | TCE_TypeTerm !VarInfoPtr | TCE_Constructor !Index ![TypeCodeExpression] | TCE_Selector ![Selection] !VarInfoPtr
:: GlobalTCType = GTT_Basic !BasicType | GTT_Constructor !TypeSymbIdent | GTT_Function
:: GlobalTCType = GTT_Basic !BasicType | GTT_Constructor !TypeSymbIdent !String | GTT_Function
/*
:: PatternExpression =
......
frontend/syntax.icl
View file @ 0a880141
......@@ -1041,7 +1041,7 @@ cIsNotStrict :== False
:: TypeCodeExpression = TCE_Empty | TCE_Var !VarInfoPtr /* MV */ | TCE_TypeTerm !VarInfoPtr | TCE_Constructor !Index ![TypeCodeExpression] | TCE_Selector ![Selection] !VarInfoPtr
:: GlobalTCType = GTT_Basic !BasicType | GTT_Constructor !TypeSymbIdent | GTT_Function
:: GlobalTCType = GTT_Basic !BasicType | GTT_Constructor !TypeSymbIdent !String | GTT_Function
:: FunctionPattern = FP_Basic !BasicValue !(Optional FreeVar)
| FP_Algebraic !(Global DefinedSymbol) ![FunctionPattern] !(Optional FreeVar)
......
frontend/type.dcl
View file @ 0a880141
......@@ -3,7 +3,7 @@ definition module type
import StdArray
import syntax, check
typeProgram ::!{! Group} !Int !*{# FunDef} !IndexRange !(Optional Bool) !CommonDefs ![Declaration] !{# DclModule} !NumberSet !*Heaps !*PredefinedSymbols !*File !*File
typeProgram ::!{! Group} !Int !*{# FunDef} !IndexRange !(Optional Bool) !CommonDefs ![Declaration] !{# DclModule} !NumberSet !*Heaps !*PredefinedSymbols !*File !*File !{# DclModule}
-> (!Bool, !*{# FunDef}, !IndexRange, {! GlobalTCType}, !{# CommonDefs}, !{# {# FunType} }, !.TypeDefInfos, !*Heaps, !*PredefinedSymbols, !*File, !*File)
addPropagationAttributesToAType :: {#CommonDefs} !AType !*PropState -> *(!AType,Int,!*PropState);
......
frontend/type.icl
View file @ 0a880141
......@@ -1848,9 +1848,9 @@ addLiftedArgumentsToSymbolType st=:{st_arity,st_args,st_vars,st_attr_vars,st_con
, fe_location :: !IdentPos
}
typeProgram ::!{! Group} !Int !*{# FunDef} !IndexRange !(Optional Bool) !CommonDefs ![Declaration] !{# DclModule} !NumberSet !*Heaps !*PredefinedSymbols !*File !*File
typeProgram ::!{! Group} !Int !*{# FunDef} !IndexRange !(Optional Bool) !CommonDefs ![Declaration] !{# DclModule} !NumberSet !*Heaps !*PredefinedSymbols !*File !*File !{# DclModule}
-> (!Bool, !*{# FunDef}, !IndexRange, {! GlobalTCType}, !{# CommonDefs}, !{# {# FunType} }, !.TypeDefInfos, !*Heaps, !*PredefinedSymbols, !*File, !*File)
typeProgram comps main_dcl_module_n fun_defs specials list_inferred_types icl_defs imports modules used_module_numbers heaps=:{hp_var_heap, hp_expression_heap, hp_type_heaps} predef_symbols file out
typeProgram comps main_dcl_module_n fun_defs specials list_inferred_types icl_defs imports modules used_module_numbers heaps=:{hp_var_heap, hp_expression_heap, hp_type_heaps} predef_symbols file out dcl_modules
#! fun_env_size = size fun_defs
# ts_error = {ea_file = file, ea_loc = [], ea_ok = True }
ti_common_defs = {{dcl_common \\ {dcl_common} <-: modules } & [main_dcl_module_n] = icl_defs }
......@@ -2009,7 +2009,7 @@ where
{ os_type_heaps, os_var_heap, os_symbol_heap, os_predef_symbols, os_special_instances, os_error })
= tryToSolveOverloading over_info main_dcl_module_n ti_common_defs class_instances coercion_env
{ os_type_heaps = {ts_type_heaps & th_vars = th_vars}, os_var_heap = ts_var_heap, os_symbol_heap = ts_expr_heap,
os_predef_symbols = predef_symbols, os_error = ts_error, os_special_instances = special_instances }
os_predef_symbols = predef_symbols, os_error = ts_error, os_special_instances = special_instances } modules
| not os_error.ea_ok
= (True, fun_defs, os_predef_symbols, os_special_instances, create_erroneous_function_types comp { ts & ts_type_heaps = os_type_heaps,
ts_error = { os_error & ea_ok = True }, ts_var_store = 0, ts_attr_store = FirstAttrVar,
......@@ -2031,7 +2031,7 @@ where
| isEmpty over_info
# ts_type_heaps = ts.ts_type_heaps
type_code_info = { tci_next_index = os_special_instances.si_next_TC_member_index, tci_instances = os_special_instances.si_TC_instances,
tci_type_var_heap = ts_type_heaps.th_vars }
tci_type_var_heap = ts_type_heaps.th_vars, tci_dcl_modules = dcl_modules }
(fun_defs, ts_fun_env, ts_expr_heap, {tci_next_index,tci_instances,tci_type_var_heap}, ts_var_heap, ts_error, os_predef_symbols)
= updateDynamics comp local_pattern_variables main_dcl_module_n fun_defs ts.ts_fun_env ts.ts_expr_heap type_code_info ts.ts_var_heap ts.ts_error os_predef_symbols
= ( type_error || not ts_error.ea_ok,
......@@ -2040,7 +2040,7 @@ where
ts_var_heap = ts_var_heap, ts_type_heaps = { ts_type_heaps & th_vars = tci_type_var_heap }, ts_fun_env = ts_fun_env})
# ts_type_heaps = ts.ts_type_heaps
type_code_info = { tci_next_index = os_special_instances.si_next_TC_member_index, tci_instances = os_special_instances.si_TC_instances,
tci_type_var_heap = ts_type_heaps.th_vars }
tci_type_var_heap = ts_type_heaps.th_vars, tci_dcl_modules = dcl_modules }
(fun_defs, ts_fun_env, ts_expr_heap, {tci_next_index,tci_instances,tci_type_var_heap}, ts_var_heap, ts_error, os_predef_symbols)
= removeOverloadedFunctions comp local_pattern_variables main_dcl_module_n fun_defs ts.ts_fun_env
ts.ts_expr_heap type_code_info ts.ts_var_heap ts.ts_error os_predef_symbols
......
frontend/type_io.dcl 0 → 100644
View file @ 0a880141
definition module type_io
import scanner, general, Heap, typeproperties, utilities, checksupport
import StdEnv
class WriteTypeInfo a
where
write_type_info :: a !*File -> !*File
instance WriteTypeInfo CommonDefs
//1.3
instance WriteTypeInfo {#b} | select_u, size_u, WriteTypeInfo b
//3.1
// read
// read
class ReadTypeInfo a
where
read_type_info :: !*File -> (!Bool,a,!*File)
instance ReadTypeInfo CommonDefs //,TypeDef TypeRhs, ConsDef
frontend/type_io.icl 0 → 100644
View file @ 0a880141
implementation module type_io
import DebugUtilities;
import StdEnv, compare_constructor // ,RWSDebug
import scanner, general, Heap, typeproperties, utilities, checksupport
class WriteTypeInfo a
where
write_type_info :: a !*File -> !*File
instance WriteTypeInfo CommonDefs
where
write_type_info {com_type_defs,com_cons_defs} tcl_file
# tcl_file
= write_type_info com_type_defs tcl_file
# tcl_file
= write_type_info com_cons_defs tcl_file
= tcl_file
instance WriteTypeInfo ConsDef
where
write_type_info {cons_symb,cons_arg_vars,cons_priority,cons_index,cons_type_index,cons_exi_vars} tcl_file
# tcl_file
= write_type_info cons_symb tcl_file
# tcl_file
= write_type_info cons_arg_vars tcl_file
# tcl_file
= write_type_info cons_priority tcl_file
# tcl_file
= write_type_info cons_index tcl_file
# tcl_file
= write_type_info cons_type_index tcl_file
# tcl_file
= write_type_info cons_exi_vars tcl_file
= tcl_file
PrioCode =: toChar 0
NoPrioCode =: toChar 1
instance WriteTypeInfo Priority
where
write_type_info (Prio assoc i) tcl_file
# tcl_file
= fwritec PrioCode tcl_file
# tcl_file
= write_type_info assoc tcl_file
# tcl_file
= write_type_info i tcl_file
= tcl_file
write_type_info NoPrio tcl_file
# tcl_file
= fwritec NoPrioCode tcl_file
= tcl_file
LeftAssocCode =: toChar 2
RightAssocCode =: toChar 3
NoAssocCode =: toChar 4
instance WriteTypeInfo Assoc
where
write_type_info LeftAssoc tcl_file
# tcl_file
= fwritec LeftAssocCode tcl_file
= tcl_file
write_type_info RightAssoc tcl_file
# tcl_file
= fwritec RightAssocCode tcl_file
= tcl_file
write_type_info NoAssoc tcl_file
# tcl_file
= fwritec NoAssocCode tcl_file
= tcl_file
instance WriteTypeInfo TypeDef TypeRhs
where
write_type_info {td_name,td_arity,td_args,td_rhs} tcl_file
#! tcl_file
= write_type_info td_name tcl_file
#! tcl_file
= write_type_info td_arity tcl_file
#! tcl_file
= write_type_info td_args tcl_file
#! tcl_file
= write_type_info td_rhs tcl_file
= tcl_file
instance WriteTypeInfo ATypeVar
where
write_type_info {atv_annotation,atv_variable} tcl_file
#! tcl_file
= write_type_info atv_annotation tcl_file
#! tcl_file
= write_type_info atv_variable tcl_file
= tcl_file
instance WriteTypeInfo Annotation
where
write_type_info AN_Strict tcl_file
= fwritec '!' tcl_file
write_type_info AN_None tcl_file
= fwritec ' ' tcl_file
instance WriteTypeInfo TypeVar
where
write_type_info {tv_name} tcl_file