Commit 85526f74 authored by Martijn Vervoort's avatar Martijn Vervoort

Changes:

* predef; replace *some* strings by macro's
* small changes
parent 3e8bb969
...@@ -15,7 +15,4 @@ convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !*{! Gr ...@@ -15,7 +15,4 @@ convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !*{! Gr
-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap) -> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
*/ */
instance toString GlobalTCType
instance toString BasicType
get_module_id_app :: !*PredefinedSymbols -> (App,Expression,!*PredefinedSymbols) get_module_id_app :: !*PredefinedSymbols -> (App,Expression,!*PredefinedSymbols)
...@@ -11,10 +11,13 @@ extended_unify_and_coerce no yes :== no; // change also _unify and _coerce in St ...@@ -11,10 +11,13 @@ extended_unify_and_coerce no yes :== no; // change also _unify and _coerce in St
//import pp; //import pp;
APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES yes no :== yes
import type_io; import type_io;
//import RWSDebug; //import RWSDebug;
/*2.0
from type_io_common import toString;
0.2*/
:: *ConversionInfo = :: *ConversionInfo =
{ ci_predef_symb :: !*PredefinedSymbols { ci_predef_symb :: !*PredefinedSymbols
, ci_var_heap :: !*VarHeap , ci_var_heap :: !*VarHeap
...@@ -62,12 +65,14 @@ F a b = b ...@@ -62,12 +65,14 @@ F a b = b
//write_tcl_file :: !Int {#DclModule} CommonDefs !*File [String] -> (.Bool,.File) //write_tcl_file :: !Int {#DclModule} CommonDefs !*File [String] -> (.Bool,.File)
write_tcl_file :: !Int {#DclModule} CommonDefs !*File [String] !*TypeHeaps -> (.Bool,.File,!*TypeHeaps) write_tcl_file :: !Int {#DclModule} CommonDefs !*File [String] !*TypeHeaps !*PredefinedSymbols -> (.Bool,.File,!*TypeHeaps,!*PredefinedSymbols)
write_tcl_file main_dcl_module_n dcl_mods=:{[main_dcl_module_n] = main_dcl_module} common_defs tcl_file directly_imported_dcl_modules type_heaps write_tcl_file main_dcl_module_n dcl_mods=:{[main_dcl_module_n] = main_dcl_module} common_defs tcl_file directly_imported_dcl_modules type_heaps predefined_symbols
# (pre_mod, predefined_symbols) = predefined_symbols![PD_PredefinedModule]
# write_type_info_state2 # write_type_info_state2
= { WriteTypeInfoState | = { WriteTypeInfoState |
wtis_type_heaps = type_heaps wtis_type_heaps = type_heaps
, wtis_n_type_vars = 0 , wtis_n_type_vars = 0
, wtis_predefined_module_def = pre_mod.pds_def
}; };
# (j,tcl_file) # (j,tcl_file)
= fposition tcl_file = fposition tcl_file
...@@ -87,28 +92,38 @@ write_tcl_file main_dcl_module_n dcl_mods=:{[main_dcl_module_n] = main_dcl_modul ...@@ -87,28 +92,38 @@ write_tcl_file main_dcl_module_n dcl_mods=:{[main_dcl_module_n] = main_dcl_modul
= fwritei (size main_dcl_module.dcl_common.com_type_defs) tcl_file = fwritei (size main_dcl_module.dcl_common.com_type_defs) tcl_file
#! tcl_file #! tcl_file
= fwritei (size main_dcl_module.dcl_common.com_cons_defs) tcl_file = fwritei (size main_dcl_module.dcl_common.com_cons_defs) tcl_file
= (True,tcl_file,type_heaps) = (True,tcl_file,type_heaps,predefined_symbols)
where where
f write_type_info_state=:{wtis_type_heaps} f write_type_info_state=:{wtis_type_heaps}
= (wtis_type_heaps,{write_type_info_state & wtis_type_heaps = abort "convertDynamics.icl"}); = (wtis_type_heaps,{write_type_info_state & wtis_type_heaps = abort "convertDynamics.icl"});
//---> ("dcl",size main_dcl_module.dcl_common.com_type_defs, "icl", size common_defs.com_type_defs); //---> ("dcl",size main_dcl_module.dcl_common.com_type_defs, "icl", size common_defs.com_type_defs);
/*2.0
f (Yes tcl_file)
= tcl_file;
0.2*/
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !Int !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap /* TD */ (Optional !*File) {# DclModule} !IclModule /* TD */ [String] convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !Int !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap /* TD */ (Optional !*File) {# DclModule} !IclModule /* TD */ [String]
-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap, /* TD */ (Optional !*File)) -> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap, /* TD */ (Optional !*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 */ directly_imported_dcl_modules 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 */ directly_imported_dcl_modules
// TD ... // TD ...
# (tcl_file,type_heaps) # (tcl_file,type_heaps,predefined_symbols)
= case tcl_file of = case tcl_file of
No No
-> (No,type_heaps) -> (No,type_heaps,predefined_symbols)
/*2.0
_
# tcl_file = f tcl_file;
0.2*/
//1.3
(Yes tcl_file) (Yes tcl_file)
# (ok,tcl_file,type_heaps) //3.1
= write_tcl_file main_dcl_module_n dcl_mods icl_mod.icl_common tcl_file /* TD */ directly_imported_dcl_modules type_heaps # (ok,tcl_file,type_heaps,predefined_symbols)
= write_tcl_file main_dcl_module_n dcl_mods icl_mod.icl_common tcl_file /* TD */ directly_imported_dcl_modules type_heaps predefined_symbols
| not ok | not ok
-> abort "convertDynamicPatternsIntoUnifyAppls: error writing tcl file" -> abort "convertDynamicPatternsIntoUnifyAppls: error writing tcl file"
-> (Yes tcl_file,type_heaps) -> (Yes tcl_file,type_heaps,predefined_symbols)
// ... TD // ... TD
...@@ -1161,30 +1176,10 @@ addToBoundVars :: BoundVar AType BoundVariables -> BoundVariables ...@@ -1161,30 +1176,10 @@ addToBoundVars :: BoundVar AType BoundVariables -> BoundVariables
addToBoundVars var type bound_vars addToBoundVars var type bound_vars
= [ { tv_free_var = varToFreeVar var 0, tv_type = type } : bound_vars ] = [ { tv_free_var = varToFreeVar var 0, tv_type = type } : bound_vars ]
get_constructor :: !{!GlobalTCType} Index -> Expression get_constructor :: !{!GlobalTCType} Index -> Expression
get_constructor glob_type_inst index get_constructor glob_type_inst index
= BasicExpr (BVS ("\"" +++ toString glob_type_inst.[index] +++ "\"")) (BT_String TE) = BasicExpr (BVS ("\"" +++ toString glob_type_inst.[index] +++ "\"")) (BT_String TE)
instance toString GlobalTCType
where
toString (GTT_Basic basic_type) = toString basic_type +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ PredefinedModuleName ) "")
toString GTT_Function = " -> "
toString (GTT_Constructor type_symb_indent mod_name) = type_symb_indent.type_name.id_name +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ mod_name) "")
instance toString BasicType
where
toString BT_Int = "Int"
toString BT_Char = "Char"
toString BT_Real = "Real"
toString BT_Bool = "Bool"
toString BT_Dynamic = "Dynamic"
toString BT_File = "File"
toString BT_World = "World"
toString (BT_String _) = "String"
getResultType :: ExprInfoPtr !*ConversionInfo -> (!AType, !*ConversionInfo) getResultType :: ExprInfoPtr !*ConversionInfo -> (!AType, !*ConversionInfo)
getResultType case_info_ptr ci=:{ci_expr_heap} getResultType case_info_ptr ci=:{ci_expr_heap}
# (EI_CaseType {ct_result_type}, ci_expr_heap) = readPtr case_info_ptr ci_expr_heap # (EI_CaseType {ct_result_type}, ci_expr_heap) = readPtr case_info_ptr ci_expr_heap
......
...@@ -7,6 +7,12 @@ import StdEnv ...@@ -7,6 +7,12 @@ import StdEnv
import frontend import frontend
// ... RWS // ... RWS
// MV ...
from type_io import openTclFile, closeTclFile
// ... MV
write_tcl_file yes no :== no;
Start world Start world
# (std_io, world) = stdio world # (std_io, world) = stdio world
(_, ms_out, world) = fopen "out" FWriteText world (_, ms_out, world) = fopen "out" FWriteText world
...@@ -171,8 +177,12 @@ dummyModTime _ f ...@@ -171,8 +177,12 @@ dummyModTime _ f
loadModule :: Ident *DclCache *MainState -> *(!Optional InterMod,!*DclCache,!*MainState); loadModule :: Ident *DclCache *MainState -> *(!Optional InterMod,!*DclCache,!*MainState);
loadModule mod_ident {dcl_modules,cached_macros,predef_symbols,hash_table,heaps} ms=:{ms_files,ms_error,ms_io,ms_out,ms_paths} loadModule mod_ident {dcl_modules,cached_macros,predef_symbols,hash_table,heaps} ms=:{ms_files,ms_error,ms_io,ms_out,ms_paths}
// MV ...
# (tcl_file,ms=:{ms_files,ms_error,ms_io,ms_out,ms_paths})
= write_tcl_file (WrapopenTclFile ms) (No,ms);
// ... MV
# (optional_syntax_tree,cached_cached_macros,cached_dcl_mods,_,main_dcl_module_n,predef_symbols, hash_table, ms_files, ms_error, ms_io, ms_out,_,heaps) # (optional_syntax_tree,cached_cached_macros,cached_dcl_mods,_,main_dcl_module_n,predef_symbols, hash_table, ms_files, ms_error, ms_io, ms_out,_,heaps)
= frontEndInterface { feo_up_to_phase = FrontEndPhaseAll, feo_generics = False, feo_fusion = False} mod_ident {sp_locations = [], sp_paths = ms_paths} dcl_modules cached_macros No predef_symbols hash_table dummyModTime ms_files ms_error ms_io ms_out No heaps = frontEndInterface { feo_up_to_phase = FrontEndPhaseAll, feo_generics = False, feo_fusion = False} mod_ident {sp_locations = [], sp_paths = ms_paths} dcl_modules cached_macros No predef_symbols hash_table dummyModTime ms_files ms_error ms_io ms_out tcl_file heaps
# ms = {ms & ms_files=ms_files, ms_error=ms_error,ms_io=ms_io,ms_out=ms_out} # ms = {ms & ms_files=ms_files, ms_error=ms_error,ms_io=ms_io,ms_out=ms_out}
= case optional_syntax_tree of = case optional_syntax_tree of
Yes {fe_icl={/*icl_functions,*/icl_used_module_numbers}, fe_dcls} Yes {fe_icl={/*icl_functions,*/icl_used_module_numbers}, fe_dcls}
...@@ -183,6 +193,11 @@ loadModule mod_ident {dcl_modules,cached_macros,predef_symbols,hash_table,heaps} ...@@ -183,6 +193,11 @@ loadModule mod_ident {dcl_modules,cached_macros,predef_symbols,hash_table,heaps}
{dcl_modules=dcl_modules,cached_macros=cached_cached_macros,predef_symbols=predef_symbols,hash_table=hash_table,heaps=heaps}, ms) {dcl_modules=dcl_modules,cached_macros=cached_cached_macros,predef_symbols=predef_symbols,hash_table=hash_table,heaps=heaps}, ms)
No No
-> (No, {dcl_modules=dcl_modules,cached_macros=cached_cached_macros,predef_symbols=predef_symbols,hash_table=hash_table,heaps=heaps},ms) -> (No, {dcl_modules=dcl_modules,cached_macros=cached_cached_macros,predef_symbols=predef_symbols,hash_table=hash_table,heaps=heaps},ms)
where
WrapopenTclFile ms=:{ms_files}
# (tcl_file,ms_files)
= openTclFile True "test" ms_files
= (tcl_file,{ms & ms_files = ms_files});
remove_expanded_types_from_dcl_modules :: Int {#DclModule} NumberSet *VarHeap -> *VarHeap remove_expanded_types_from_dcl_modules :: Int {#DclModule} NumberSet *VarHeap -> *VarHeap
remove_expanded_types_from_dcl_modules module_n dcls used_module_numbers var_heap remove_expanded_types_from_dcl_modules module_n dcls used_module_numbers var_heap
......
...@@ -3,7 +3,7 @@ implementation module overloading ...@@ -3,7 +3,7 @@ implementation module overloading
import StdEnv import StdEnv
import syntax, check, type, typesupport, utilities, unitype, predef, checktypes, convertDynamics import syntax, check, type, typesupport, utilities, unitype, predef, checktypes, convertDynamics
import generics, compilerSwitches import generics, compilerSwitches, type_io_common
:: InstanceTree = IT_Node !(Global Index) !InstanceTree !InstanceTree | IT_Empty :: InstanceTree = IT_Node !(Global Index) !InstanceTree !InstanceTree | IT_Empty
......
implementation module predef implementation module predef
import syntax, hashtable import syntax, hashtable, type_io_common
cPredefinedModuleIndex :== 1 cPredefinedModuleIndex :== 1
...@@ -206,14 +206,14 @@ GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2 ...@@ -206,14 +206,14 @@ GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2
cons_and_nil_idents :: {!Ident} cons_and_nil_idents :: {!Ident}
cons_and_nil_idents =: { cons_and_nil_idents =: {
{ id_name = "_Cons", id_info = allocPtr }, { id_name = PD_ConsSymbol_String, id_info = allocPtr },
{ id_name = "_!Cons", id_info = allocPtr }, { id_name = "_!Cons", id_info = allocPtr },
{ id_name = "_#Cons", id_info = allocPtr }, { id_name = "_#Cons", id_info = allocPtr },
{ id_name = "_Cons!", id_info = allocPtr }, { id_name = "_Cons!", id_info = allocPtr },
{ id_name = "_!Cons!", id_info = allocPtr }, { id_name = "_!Cons!", id_info = allocPtr },
{ id_name = "_#Cons!", id_info = allocPtr }, { id_name = "_#Cons!", id_info = allocPtr },
{ id_name = "_|Cons", id_info = allocPtr }, { id_name = "_|Cons", id_info = allocPtr },
{ id_name = "_Nil", id_info = allocPtr }, { id_name = PD_NilSymbol_String, id_info = allocPtr },
{ id_name = "_!Nil", id_info = allocPtr }, { id_name = "_!Nil", id_info = allocPtr },
{ id_name = "_#Nil", id_info = allocPtr }, { id_name = "_#Nil", id_info = allocPtr },
{ id_name = "_Nil!", id_info = allocPtr }, { id_name = "_Nil!", id_info = allocPtr },
...@@ -246,14 +246,14 @@ where ...@@ -246,14 +246,14 @@ where
= build_variables 0 32 (build_tuples 2 32 tables) = build_variables 0 32 (build_tuples 2 32 tables)
<<= ("_predefined", PD_PredefinedModule) <<= ("_predefined", PD_PredefinedModule)
<<= ("_String", PD_StringType) <<= ("_String", PD_StringType)
<<= ("_List", PD_ListType) <<+ (local_cons_and_nil_idents, PD_ConsSymbol)<<+ (local_cons_and_nil_idents, PD_NilSymbol) <<= (PD_ListType_String, PD_ListType) <<+ (local_cons_and_nil_idents, PD_ConsSymbol)<<+ (local_cons_and_nil_idents, PD_NilSymbol)
<<= ("_!List", PD_StrictListType) <<+ (local_cons_and_nil_idents, PD_StrictConsSymbol) <<+ (local_cons_and_nil_idents, PD_StrictNilSymbol) <<= ("_!List", PD_StrictListType) <<+ (local_cons_and_nil_idents, PD_StrictConsSymbol) <<+ (local_cons_and_nil_idents, PD_StrictNilSymbol)
<<= ("_#List", PD_UnboxedListType) <<+ (local_cons_and_nil_idents, PD_UnboxedConsSymbol) <<+ (local_cons_and_nil_idents, PD_UnboxedNilSymbol) <<= ("_#List", PD_UnboxedListType) <<+ (local_cons_and_nil_idents, PD_UnboxedConsSymbol) <<+ (local_cons_and_nil_idents, PD_UnboxedNilSymbol)
<<= ("_List!", PD_TailStrictListType) <<+ (local_cons_and_nil_idents, PD_TailStrictConsSymbol) <<+ (local_cons_and_nil_idents, PD_TailStrictNilSymbol) <<= ("_List!", PD_TailStrictListType) <<+ (local_cons_and_nil_idents, PD_TailStrictConsSymbol) <<+ (local_cons_and_nil_idents, PD_TailStrictNilSymbol)
<<= ("_!List!", PD_StrictTailStrictListType) <<+ (local_cons_and_nil_idents, PD_StrictTailStrictConsSymbol) <<+ (local_cons_and_nil_idents, PD_StrictTailStrictNilSymbol) <<= ("_!List!", PD_StrictTailStrictListType) <<+ (local_cons_and_nil_idents, PD_StrictTailStrictConsSymbol) <<+ (local_cons_and_nil_idents, PD_StrictTailStrictNilSymbol)
<<= ("_#List!", PD_UnboxedTailStrictListType) <<+ (local_cons_and_nil_idents, PD_UnboxedTailStrictConsSymbol) <<+ (local_cons_and_nil_idents, PD_UnboxedTailStrictNilSymbol) <<= ("_#List!", PD_UnboxedTailStrictListType) <<+ (local_cons_and_nil_idents, PD_UnboxedTailStrictConsSymbol) <<+ (local_cons_and_nil_idents, PD_UnboxedTailStrictNilSymbol)
<<= ("_|List", PD_OverloadedListType) <<+ (local_cons_and_nil_idents, PD_OverloadedConsSymbol) <<+ (local_cons_and_nil_idents, PD_OverloadedNilSymbol) <<= ("_|List", PD_OverloadedListType) <<+ (local_cons_and_nil_idents, PD_OverloadedConsSymbol) <<+ (local_cons_and_nil_idents, PD_OverloadedNilSymbol)
<<= ("_Array", PD_LazyArrayType) <<= ("_!Array", PD_StrictArrayType) <<= ("_#Array", PD_UnboxedArrayType) <<= ("_Array", PD_LazyArrayType) <<= ("_!Array", PD_StrictArrayType) <<= (PD_UnboxedArray_String, PD_UnboxedArrayType)
<<= ("_type_code", PD_TypeCodeMember) <<= ("_type_code", PD_TypeCodeMember)
<<= ("_dummyForStrictAlias", PD_DummyForStrictAliasFun) // MW++ <<= ("_dummyForStrictAlias", PD_DummyForStrictAliasFun) // MW++
where where
...@@ -317,10 +317,10 @@ where ...@@ -317,10 +317,10 @@ where
<<- ("P_laceholder", IC_Expression, PD_variablePlaceholder) <<- ("P_laceholder", IC_Expression, PD_variablePlaceholder)
<<- ("_unify", IC_Expression, PD_unify) <<- ("_unify", IC_Expression, PD_unify)
<<- ("_coerce", IC_Expression, PD_coerce) /* MV */ <<- ("_coerce", IC_Expression, PD_coerce) /* MV */
<<- ("_SystemDynamic", IC_Module, PD_StdDynamic) <<- (UnderscoreSystemDynamicModule_String, IC_Module, PD_StdDynamic)
<<- ("_undo_indirections", IC_Expression, PD_undo_indirections) <<- ("_undo_indirections", IC_Expression, PD_undo_indirections)
// MV.. // MV..
<<- ("DynamicTemp", IC_Type, PD_DynamicTemp) <<- (DynamicRepresentation_String, IC_Type, PD_DynamicTemp)
<<- ("__Module", IC_Expression, PD_ModuleConsSymbol) <<- ("__Module", IC_Expression, PD_ModuleConsSymbol)
<<- ("T_ypeID", IC_Type, PD_TypeID) <<- ("T_ypeID", IC_Type, PD_TypeID)
<<- ("ModuleID", IC_Expression, PD_ModuleID) <<- ("ModuleID", IC_Expression, PD_ModuleID)
...@@ -499,3 +499,19 @@ where ...@@ -499,3 +499,19 @@ where
= { ft_symb = alias_dummy_id, ft_arity = 1, ft_priority = NoPrio, ft_type = id_symbol_type, ft_pos = NoPos, = { ft_symb = alias_dummy_id, ft_arity = 1, ft_priority = NoPrio, ft_type = id_symbol_type, ft_pos = NoPos,
ft_specials = SP_None, ft_type_ptr = nilPtr } ft_specials = SP_None, ft_type_ptr = nilPtr }
// ..MW // ..MW
// MV ...
// changes requires recompile of {static,dynamic}-linker plus all dynamics ever made
UnderscoreSystemDynamicModule_String :== "_SystemDynamic"
DynamicRepresentation_String :== "DynamicTemp"
// List-type
PD_ListType_String :== "_List"
PD_ConsSymbol_String :== "_Cons"
PD_NilSymbol_String :== "_Nil"
// Array-type
PD_UnboxedArray_String :== "_#Array"
// ... MV
...@@ -3,6 +3,15 @@ ...@@ -3,6 +3,15 @@
*/ */
definition module type_io definition module type_io
openTclFile :: !Bool !String !*Files -> (Optional !.File, !*Files)
closeTclFile :: !*(Optional *File) *Files -> *(!Bool,*Files)
baseName :: {#Char} -> {#Char}
directoryName :: {#Char} -> {#Char}
splitBy :: Char {#Char} -> [{#Char}]
// WARNING: It is essential to report changes in this module to martijnv@cs.kun.nl // WARNING: It is essential to report changes in this module to martijnv@cs.kun.nl
// because the binary format for type-files is used by the dynamic run-time // because the binary format for type-files is used by the dynamic run-time
// system. // system.
...@@ -15,6 +24,7 @@ import StdEnv ...@@ -15,6 +24,7 @@ import StdEnv
= { = {
wtis_type_heaps :: !.TypeHeaps wtis_type_heaps :: !.TypeHeaps
, wtis_n_type_vars :: !Int , wtis_n_type_vars :: !Int
, wtis_predefined_module_def :: !Index
}; };
class WriteTypeInfo a class WriteTypeInfo a
...@@ -29,5 +39,4 @@ instance WriteTypeInfo {#b} | Array {#} b & WriteTypeInfo b ...@@ -29,5 +39,4 @@ instance WriteTypeInfo {#b} | Array {#} b & WriteTypeInfo b
//1.3 //1.3
instance WriteTypeInfo {#b} | select_u, size_u, WriteTypeInfo b instance WriteTypeInfo {#b} | select_u, size_u, WriteTypeInfo b
//3.1 //3.1
\ No newline at end of file
...@@ -27,8 +27,10 @@ F a b :== b; ...@@ -27,8 +27,10 @@ F a b :== b;
:: WriteTypeInfoState :: WriteTypeInfoState
= { = {
wtis_type_heaps :: !.TypeHeaps wtis_type_heaps :: !.TypeHeaps
, wtis_n_type_vars :: !Int , wtis_n_type_vars :: !Int
, wtis_predefined_module_def :: !Index
}; };
class WriteTypeInfo a class WriteTypeInfo a
...@@ -382,13 +384,17 @@ where ...@@ -382,13 +384,17 @@ where
instance WriteTypeInfo TypeSymbIdent instance WriteTypeInfo TypeSymbIdent
where where
write_type_info {type_name,type_arity} tcl_file wtis write_type_info {type_name,type_arity,type_index={glob_module}} tcl_file wtis=:{wtis_predefined_module_def}
# is_type_without_definition
= glob_module == wtis_predefined_module_def
# tcl_file
= fwritec (if is_type_without_definition TypeSymbIdentWithoutDefinition TypeSymbIdentWithDefinition) tcl_file
# (tcl_file,wtis) # (tcl_file,wtis)
= write_type_info type_name tcl_file wtis = write_type_info type_name tcl_file wtis
# (tcl_file,wtis) # (tcl_file,wtis)
= write_type_info type_arity tcl_file wtis = write_type_info type_arity tcl_file wtis
= (tcl_file,wtis) = (tcl_file,wtis)
// basic and structural write_type_info's // basic and structural write_type_info's
instance WriteTypeInfo Int instance WriteTypeInfo Int
...@@ -439,3 +445,62 @@ where ...@@ -439,3 +445,62 @@ where
# tcl_file # tcl_file
= fwritec c tcl_file; = fwritec c tcl_file;
= (tcl_file,wtis); = (tcl_file,wtis);
// MV ...
from CoclSystemDependent import DirectorySeparator, ensureCleanSystemFilesExists
openTclFile :: !Bool !String !*Files -> (Optional !.File, !*Files)
openTclFile False icl_mod_pathname files
= (No,files)
openTclFile compile_for_dynamics icl_mod_pathname files
# csf_path
= directoryName icl_mod_pathname +++ "Clean System Files"
# tcl_path
= csf_path +++ {DirectorySeparator} +++ baseName icl_mod_pathname +++ ".tcl"
# (opened, tcl_file, files)
= fopen tcl_path FWriteData files
| opened
= (Yes tcl_file, files)
// try again after creating Clean System Files folder
# (ok, files)
= ensureCleanSystemFilesExists csf_path files
| not ok
= abort ("can't create folder \"" +++ csf_path +++"\"\n")
# (opened, tcl_file, files)
= fopen tcl_path FWriteData files
| opened
=(Yes tcl_file, files)
= abort ("couldn't open file \"" +++ tcl_path +++ "\"\n")
closeTclFile :: !*(Optional *File) *Files -> *(!Bool,*Files)
closeTclFile (Yes tcl_file) files
= fclose tcl_file files
closeTclFile _ files
= (True,files);
// copy from compile.icl ...
baseName :: {#Char} -> {#Char}
baseName path
= last (splitBy DirectorySeparator path)
directoryName :: {#Char} -> {#Char}
directoryName path
= foldr (\p ps -> p +++ {DirectorySeparator} +++ ps) "" (init (splitBy DirectorySeparator path))
splitBy :: Char {#Char} -> [{#Char}]
splitBy char string
= splitBy` 0 0
where
splitBy` frm to
| to >= stringSize
= [string % (frm, to-1)]
| string.[to] == char
= [string % (frm, to-1) : splitBy` (to+1) (to+1)]
// otherwise
= splitBy` frm (to+1)
stringSize
= size string
// ... copy from compile.icl
// ... MV
...@@ -3,49 +3,66 @@ ...@@ -3,49 +3,66 @@
*/ */
definition module type_io_common definition module type_io_common
from StdChar import toChar // common between compiler and static linker
import StdEnv
import syntax
import StdOverloaded
/* /*
// Priority // Priority
PrioCode :== toChar 0 PrioCode :== toChar 0
NoPrioCode :== toChar 1 NoPrioCode :== toChar 1
// Assoc // Assoc
LeftAssocCode :== toChar 2 LeftAssocCode :== toChar 2
RightAssocCode :== toChar 3 RightAssocCode :== toChar 3
NoAssocCode :== toChar 4 NoAssocCode :== toChar 4
*/ */
// TypeRhs // TypeRhs
AlgTypeCode :== (toChar 5) AlgTypeCode :== (toChar 5)
SynTypeCode :== (toChar 6) SynTypeCode :== (toChar 6)
RecordTypeCode :== (toChar 7) RecordTypeCode :== (toChar 7)
AbstractTypeCode :== (toChar 8) AbstractTypeCode :== (toChar 8)
// Type // Type
TypeTACode :== (toChar 9) // TA TypeTACode :== (toChar 9) // TA
TypeArrowCode :== (toChar 10) // --> TypeArrowCode :== (toChar 10) // -->
TypeConsApplyCode :== (toChar 11) // :@: TypeConsApplyCode :== (toChar 11) // :@:
TypeTBCode :== (toChar 12) // TB TypeTBCode :== (toChar 12) // TB
TypeGTVCode :== (toChar 13) // GTV TypeGTVCode :== (toChar 13) // GTV
TypeTVCode :== (toChar 14) // TV TypeTVCode :== (toChar 14) // TV
TypeTQVCode :== (toChar 15) // TempTQV TypeTQVCode :== (toChar 15) // TempTQV
TypeTECode :== (toChar 16) // TE TypeTECode :== (toChar 16) // TE
// Type; TB // Type; TB
BT_IntCode :== (toChar 17) BT_IntCode :== (toChar 17)
BT_CharCode :== (toChar 18) BT_CharCode :== (toChar 18)
BT_RealCode :== (toChar 19) BT_RealCode :== (toChar 19)
BT_BoolCode :== (toChar 20) BT_BoolCode :== (toChar 20)
BT_DynamicCode :== (toChar 21) BT_DynamicCode :== (toChar 21)
BT_FileCode :== (toChar 22) BT_FileCode :== (toChar 22)
BT_WorldCode :== (toChar 23) BT_WorldCode :== (toChar 23)
BT_StringCode :== (toChar 24) BT_StringCode :== (toChar 24)
// ConsVariable // ConsVariable
ConsVariableCVCode :== (toChar 25) ConsVariableCVCode :== (toChar 25)
ConsVariableTempCVCode :== (toChar 26) ConsVariableTempCVCode :== (toChar 26)
ConsVariableTempQCVCode :== (toChar 27) ConsVariableTempQCVCode :== (toChar 27)
// used by {compiler,dynamic rts} // TypeSymbIdent
PredefinedModuleName :== "_predefined" TypeSymbIdentWithoutDefinition :== (toChar 28) // valid only for predefined in PD_PredefinedModule e.g. _String, _List
\ No newline at end of file TypeSymbIdentWithDefinition :== (toChar 29) // for all types which have definitions in some .icl-module
// Maybe
MaybeNothingCode :== (toChar 30)
MaybeJustCode :== (toChar 31)
// used by {compiler,dynamic rts} to make String representation of types
PredefinedModuleName :== "_predefined"
UnderscoreSystemModule :== "_system" // implements the predefined module
instance toString GlobalTCType
instance toString BasicType
...@@ -4,7 +4,11 @@ ...@@ -4,7 +4,11 @@
implementation module type_io_common implementation module type_io_common
// common between compiler and static linker // common between compiler and static linker
from StdChar import toChar import StdEnv
import syntax
import StdOverloaded