Skip to content

GitLab

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

Changes: 

* predef; replace *some* strings by macro's
* small changes
parent 3e8bb969
Hide whitespace changes
Inline Side-by-side
Showing with 231 additions and 136 deletions
frontend/convertDynamics.dcl
View file @ 85526f74
......@@ -15,7 +15,4 @@ convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !*{! Gr
-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
*/
instance toString GlobalTCType
instance toString BasicType
get_module_id_app :: !*PredefinedSymbols -> (App,Expression,!*PredefinedSymbols)
frontend/convertDynamics.icl
View file @ 85526f74
......@@ -11,10 +11,13 @@ extended_unify_and_coerce no yes :== no; // change also _unify and _coerce in St
//import pp;
APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES yes no :== yes
import type_io;
//import RWSDebug;
/*2.0
from type_io_common import toString;
0.2*/
:: *ConversionInfo =
{ ci_predef_symb :: !*PredefinedSymbols
, ci_var_heap :: !*VarHeap
......@@ -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] !*TypeHeaps -> (.Bool,.File,!*TypeHeaps)
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 :: !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 predefined_symbols
# (pre_mod, predefined_symbols) = predefined_symbols![PD_PredefinedModule]
# write_type_info_state2
= { WriteTypeInfoState |
wtis_type_heaps = type_heaps
, wtis_n_type_vars = 0
wtis_type_heaps = type_heaps
, wtis_n_type_vars = 0
, wtis_predefined_module_def = pre_mod.pds_def
};
# (j,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
= fwritei (size main_dcl_module.dcl_common.com_type_defs) tcl_file
#! 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
f write_type_info_state=:{wtis_type_heaps}
= (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);
/*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]
-> (!*{! 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
// TD ...
# (tcl_file,type_heaps)
# (tcl_file,type_heaps,predefined_symbols)
= case tcl_file of
No
-> (No,type_heaps)
-> (No,type_heaps,predefined_symbols)
/*2.0
_
# tcl_file = f tcl_file;
0.2*/
//1.3
(Yes tcl_file)
# (ok,tcl_file,type_heaps)
= write_tcl_file main_dcl_module_n dcl_mods icl_mod.icl_common tcl_file /* TD */ directly_imported_dcl_modules type_heaps
//3.1
# (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
-> abort "convertDynamicPatternsIntoUnifyAppls: error writing tcl file"
-> (Yes tcl_file,type_heaps)
-> (Yes tcl_file,type_heaps,predefined_symbols)
// ... TD
......@@ -1161,30 +1176,10 @@ addToBoundVars :: BoundVar AType BoundVariables -> BoundVariables
addToBoundVars var type bound_vars
= [ { tv_free_var = varToFreeVar var 0, tv_type = type } : bound_vars ]
get_constructor :: !{!GlobalTCType} Index -> Expression
get_constructor glob_type_inst index
= 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 case_info_ptr ci=:{ci_expr_heap}
# (EI_CaseType {ct_result_type}, ci_expr_heap) = readPtr case_info_ptr ci_expr_heap
......
frontend/main.icl
View file @ 85526f74
......@@ -7,6 +7,12 @@ import StdEnv
import frontend
// ... RWS
// MV ...
from type_io import openTclFile, closeTclFile
// ... MV
write_tcl_file yes no :== no;
Start world
# (std_io, world) = stdio world
(_, ms_out, world) = fopen "out" FWriteText world
......@@ -171,8 +177,12 @@ dummyModTime _ f
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}
// 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)
= 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}
= case optional_syntax_tree of
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}
{dcl_modules=dcl_modules,cached_macros=cached_cached_macros,predef_symbols=predef_symbols,hash_table=hash_table,heaps=heaps}, ms)
No
-> (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 module_n dcls used_module_numbers var_heap
......
frontend/overloading.icl
View file @ 85526f74
......@@ -3,7 +3,7 @@ implementation module overloading
import StdEnv
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
......
frontend/predef.icl
View file @ 85526f74
implementation module predef
import syntax, hashtable
import syntax, hashtable, type_io_common
cPredefinedModuleIndex :== 1
......@@ -206,14 +206,14 @@ GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2
cons_and_nil_idents :: {!Ident}
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 = "_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 },
......@@ -246,14 +246,14 @@ where
= build_variables 0 32 (build_tuples 2 32 tables)
<<= ("_predefined", PD_PredefinedModule)
<<= ("_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_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_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_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)
<<= ("_dummyForStrictAlias", PD_DummyForStrictAliasFun) // MW++
where
......@@ -317,10 +317,10 @@ where
<<- ("P_laceholder", IC_Expression, PD_variablePlaceholder)
<<- ("_unify", IC_Expression, PD_unify)
<<- ("_coerce", IC_Expression, PD_coerce) /* MV */
<<- ("_SystemDynamic", IC_Module, PD_StdDynamic)
<<- (UnderscoreSystemDynamicModule_String, IC_Module, PD_StdDynamic)
<<- ("_undo_indirections", IC_Expression, PD_undo_indirections)
// MV..
<<- ("DynamicTemp", IC_Type, PD_DynamicTemp)
<<- (DynamicRepresentation_String, IC_Type, PD_DynamicTemp)
<<- ("__Module", IC_Expression, PD_ModuleConsSymbol)
<<- ("T_ypeID", IC_Type, PD_TypeID)
<<- ("ModuleID", IC_Expression, PD_ModuleID)
......@@ -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_specials = SP_None, ft_type_ptr = nilPtr }
// ..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
frontend/type_io.dcl
View file @ 85526f74
......@@ -3,6 +3,15 @@
*/
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
// because the binary format for type-files is used by the dynamic run-time
// system.
......@@ -15,6 +24,7 @@ import StdEnv
= {
wtis_type_heaps :: !.TypeHeaps
, wtis_n_type_vars :: !Int
, wtis_predefined_module_def :: !Index
};
class WriteTypeInfo a
......@@ -29,5 +39,4 @@ instance WriteTypeInfo {#b} | Array {#} b & WriteTypeInfo b
//1.3
instance WriteTypeInfo {#b} | select_u, size_u, WriteTypeInfo b
//3.1
//3.1
\ No newline at end of file
frontend/type_io.icl
View file @ 85526f74
......@@ -27,8 +27,10 @@ F a b :== b;
:: WriteTypeInfoState
= {
wtis_type_heaps :: !.TypeHeaps
, wtis_n_type_vars :: !Int
wtis_type_heaps :: !.TypeHeaps
, wtis_n_type_vars :: !Int
, wtis_predefined_module_def :: !Index
};
class WriteTypeInfo a
......@@ -382,13 +384,17 @@ where
instance WriteTypeInfo TypeSymbIdent
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)
= write_type_info type_name tcl_file wtis
# (tcl_file,wtis)
= write_type_info type_arity tcl_file wtis
= (tcl_file,wtis)
// basic and structural write_type_info's
instance WriteTypeInfo Int
......@@ -439,3 +445,62 @@ where
# tcl_file
= fwritec c tcl_file;
= (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
frontend/type_io_common.dcl
View file @ 85526f74
......@@ -3,49 +3,66 @@
*/
definition module type_io_common
from StdChar import toChar
// common between compiler and static linker
import StdEnv
import syntax
import StdOverloaded
/*
// Priority
PrioCode :== toChar 0
NoPrioCode :== toChar 1
PrioCode :== toChar 0
NoPrioCode :== toChar 1
// Assoc
LeftAssocCode :== toChar 2
RightAssocCode :== toChar 3
NoAssocCode :== toChar 4
LeftAssocCode :== toChar 2
RightAssocCode :== toChar 3
NoAssocCode :== toChar 4
*/
// TypeRhs
AlgTypeCode :== (toChar 5)
SynTypeCode :== (toChar 6)
RecordTypeCode :== (toChar 7)
AbstractTypeCode :== (toChar 8)
AlgTypeCode :== (toChar 5)
SynTypeCode :== (toChar 6)
RecordTypeCode :== (toChar 7)
AbstractTypeCode :== (toChar 8)
// Type
TypeTACode :== (toChar 9) // TA
TypeArrowCode :== (toChar 10) // -->
TypeConsApplyCode :== (toChar 11) // :@:
TypeTBCode :== (toChar 12) // TB
TypeGTVCode :== (toChar 13) // GTV
TypeTVCode :== (toChar 14) // TV
TypeTQVCode :== (toChar 15) // TempTQV
TypeTECode :== (toChar 16) // TE
TypeTACode :== (toChar 9) // TA
TypeArrowCode :== (toChar 10) // -->
TypeConsApplyCode :== (toChar 11) // :@:
TypeTBCode :== (toChar 12) // TB
TypeGTVCode :== (toChar 13) // GTV
TypeTVCode :== (toChar 14) // TV
TypeTQVCode :== (toChar 15) // TempTQV
TypeTECode :== (toChar 16) // TE
// Type; TB
BT_IntCode :== (toChar 17)
BT_CharCode :== (toChar 18)
BT_RealCode :== (toChar 19)
BT_BoolCode :== (toChar 20)
BT_DynamicCode :== (toChar 21)
BT_FileCode :== (toChar 22)
BT_WorldCode :== (toChar 23)
BT_StringCode :== (toChar 24)
BT_IntCode :== (toChar 17)
BT_CharCode :== (toChar 18)
BT_RealCode :== (toChar 19)
BT_BoolCode :== (toChar 20)
BT_DynamicCode :== (toChar 21)
BT_FileCode :== (toChar 22)
BT_WorldCode :== (toChar 23)
BT_StringCode :== (toChar 24)
// ConsVariable
ConsVariableCVCode :== (toChar 25)
ConsVariableTempCVCode :== (toChar 26)
ConsVariableTempQCVCode :== (toChar 27)
ConsVariableCVCode :== (toChar 25)
ConsVariableTempCVCode :== (toChar 26)
ConsVariableTempQCVCode :== (toChar 27)
// used by {compiler,dynamic rts}
PredefinedModuleName :== "_predefined"
\ No newline at end of file
// TypeSymbIdent
TypeSymbIdentWithoutDefinition :== (toChar 28) // valid only for predefined in PD_PredefinedModule e.g. _String, _List
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
frontend/type_io_common.icl
View file @ 85526f74
......@@ -4,7 +4,11 @@
implementation module type_io_common
// common between compiler and static linker
from StdChar import toChar
import StdEnv
import syntax
import StdOverloaded
APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES yes no :== yes
/*
// Priority
......@@ -48,5 +52,32 @@ ConsVariableCVCode :== (toChar 25)
ConsVariableTempCVCode :== (toChar 26)
ConsVariableTempQCVCode :== (toChar 27)
// used by {compiler,dynamic rts}
PredefinedModuleName :== "_predefined"
\ No newline at end of file
// TypeSymbIdent
TypeSymbIdentWithoutDefinition :== (toChar 28) // valid only for predefined in PD_PredefinedModule e.g. _String, _List
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
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"
main/compile.icl
View file @ 85526f74
......@@ -10,6 +10,7 @@ import filesystem, CoclSystemDependent
import portToNewSyntax
import compilerSwitches
//import RWSDebug
from type_io import openTclFile, closeTclFile, baseName, directoryName, splitBy
:: CoclOptions =
......@@ -138,28 +139,6 @@ splitPaths :: {#Char} -> [{#Char}]
splitPaths paths
= [path +++ {DirectorySeparator} \\ path <- splitBy PathSeparator paths]
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
baseName :: {#Char} -> {#Char}
baseName path
= last (splitBy DirectorySeparator path)
directoryName :: {#Char} -> {#Char}
directoryName path
= foldr (\p ps -> p +++ {DirectorySeparator} +++ ps) "" (init (splitBy DirectorySeparator path))
compile_modules [module_:modules] n_compiles cocl_options args_without_modules cache files
# cocl_options = prependModulePath {cocl_options & pathName=stripExtension ".icl" (stripQuotes module_)}
with
......@@ -190,7 +169,7 @@ compileModule options backendArgs {dcl_modules,functions_and_macros,predef_symbo
| not opened
= abort ("couldn't open out file \"" +++ options.outPath +++ "\"\n")
# (tcl_file, files)
= openTclFile options options.pathName files
= openTclFile options.compile_for_dynamics options.pathName files
# (io, files)
= stdio files
# ({boxed_ident=moduleIdent}, hash_table) = putIdentInHashTable options.moduleName IC_Module hash_table
......@@ -258,33 +237,4 @@ compileModule options backendArgs {dcl_modules,functions_and_macros,predef_symbo
# cache={dcl_modules=dcl_modules,functions_and_macros=cached_functions_and_macros,predef_symbols=unique_copy_of_predef_symbols,hash_table=hash_table,heaps=heaps}
= (success,cache,files)
# cache={dcl_modules=cached_dcl_mods,functions_and_macros=cached_functions_and_macros,predef_symbols=unique_copy_of_predef_symbols,hash_table=hash_table,heaps=heaps}
= (success,cache,files)
// MV ...
openTclFile :: CoclOptions !String !*Files -> (Optional !.File, !*Files)
openTclFile options=:{compile_for_dynamics=False} icl_mod_pathname files
= (No,files)
openTclFile options 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)