Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
compiler
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
16
Issues
16
List
Boards
Labels
Service Desk
Milestones
Operations
Operations
Incidents
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
clean-compiler-and-rts
compiler
Commits
85526f74
Commit
85526f74
authored
Nov 19, 2001
by
Martijn Vervoort
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Changes:
* predef; replace *some* strings by macro's * small changes
parent
3e8bb969
Changes
10
Hide whitespace changes
Inline
Side-by-side
Showing
10 changed files
with
231 additions
and
136 deletions
+231
-136
frontend/convertDynamics.dcl
frontend/convertDynamics.dcl
+0
-3
frontend/convertDynamics.icl
frontend/convertDynamics.icl
+26
-31
frontend/main.icl
frontend/main.icl
+16
-1
frontend/overloading.icl
frontend/overloading.icl
+1
-1
frontend/predef.icl
frontend/predef.icl
+23
-7
frontend/type_io.dcl
frontend/type_io.dcl
+11
-2
frontend/type_io.icl
frontend/type_io.icl
+69
-4
frontend/type_io_common.dcl
frontend/type_io_common.dcl
+48
-31
frontend/type_io_common.icl
frontend/type_io_common.icl
+34
-3
main/compile.icl
main/compile.icl
+3
-53
No files found.
frontend/convertDynamics.dcl
View file @
85526f74
...
@@ -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
)
frontend/convertDynamics.icl
View file @
85526f74
...
@@ -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
...
...
frontend/main.icl
View file @
85526f74
...
@@ -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
...
...
frontend/overloading.icl
View file @
85526f74
...
@@ -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
...
...
frontend/predef.icl
View file @
85526f74
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
frontend/type_io.dcl
View file @
85526f74
...
@@ -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
frontend/type_io.icl
View file @
85526f74
...
@@ -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
frontend/type_io_common.dcl
View file @
85526f74
...
@@ -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
frontend/type_io_common.icl
View file @
85526f74
...
@@ -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