Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-compiler-and-rts
compiler
Commits
85526f74
Commit
85526f74
authored
Nov 19, 2001
by
Martijn Vervoort
Browse files
Changes:
* predef; replace *some* strings by macro's * small changes
parent
3e8bb969
Changes
10
Hide whitespace changes
Inline
Side-by-side
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
_Cons
Symbol_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
_Nil
Symbol_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
_List
Type_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
)
<<-
(
Underscore
SystemDynamic
Module_String
,
IC_Module
,
PD_StdDynamic
)
<<-
(
"_undo_indirections"
,
IC_Expression
,
PD_undo_indirections
)
// MV..
<<-
(
"
Dynamic
Temp"
,
IC_Type
,
PD_DynamicTemp
)
<<-
(
Dynamic
Representation_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
)
=
fopen
tcl_path
FWriteData
files
|
opened
=(
Yes
tcl_file
,
files
)