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
7ae1e52d
Commit
7ae1e52d
authored
Dec 05, 2001
by
John van Groningen
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
removed type from BasicExpr
added BVInt removed symb_arity from SymbIdent
parent
a2eee0c0
Changes
19
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
19 changed files
with
405 additions
and
368 deletions
+405
-368
backend/backendconvert.icl
backend/backendconvert.icl
+4
-2
frontend/StdCompare.icl
frontend/StdCompare.icl
+4
-1
frontend/check.icl
frontend/check.icl
+15
-3
frontend/checkFunctionBodies.icl
frontend/checkFunctionBodies.icl
+19
-18
frontend/comparedefimp.icl
frontend/comparedefimp.icl
+2
-4
frontend/convertDynamics.icl
frontend/convertDynamics.icl
+8
-9
frontend/convertcases.icl
frontend/convertcases.icl
+5
-5
frontend/explicitimports.icl
frontend/explicitimports.icl
+1
-1
frontend/generics.icl
frontend/generics.icl
+11
-13
frontend/overloading.icl
frontend/overloading.icl
+25
-29
frontend/parse.icl
frontend/parse.icl
+32
-2
frontend/postparse.icl
frontend/postparse.icl
+119
-119
frontend/predef.dcl
frontend/predef.dcl
+2
-0
frontend/predef.icl
frontend/predef.icl
+2
-0
frontend/syntax.dcl
frontend/syntax.dcl
+6
-11
frontend/syntax.icl
frontend/syntax.icl
+11
-19
frontend/trans.icl
frontend/trans.icl
+79
-83
frontend/transform.icl
frontend/transform.icl
+16
-20
frontend/type.icl
frontend/type.icl
+44
-29
No files found.
backend/backendconvert.icl
View file @
7ae1e52d
...
...
@@ -374,7 +374,7 @@ beDynamicTempTypeSymbol
notYetImplementedExpr
::
Expression
notYetImplementedExpr
=
(
BasicExpr
(
BVS
"
\"
error in compiler (something was not implemented by lazy Ronny)
\"
"
)
BT_Int
)
=
(
BasicExpr
(
BVS
"
\"
error in compiler (something was not implemented by lazy Ronny)
\"
"
))
backEndConvertModules
::
PredefinedSymbols
FrontEndSyntaxTree
!
Int
*
VarHeap
*
AttrVarHeap
*
BackEnd
->
(!*
VarHeap
,
*
AttrVarHeap
,
!*
BackEnd
)
/*
...
...
@@ -1751,6 +1751,8 @@ convertRhsStrictNodeIds expression
convertLiteralSymbol
::
BasicValue
->
BEMonad
BESymbolP
convertLiteralSymbol
(
BVI
intString
)
=
beLiteralSymbol
BEIntDenot
intString
convertLiteralSymbol
(
BVInt
int
)
=
beLiteralSymbol
BEIntDenot
(
toString
int
)
convertLiteralSymbol
(
BVB
bool
)
=
beBoolSymbol
bool
convertLiteralSymbol
(
BVC
charString
)
...
...
@@ -1769,7 +1771,7 @@ convertExpr expr main_dcl_module_n
=
convertExpr
expr
where
convertExpr
::
Expression
->
BEMonad
BENodeP
convertExpr
(
BasicExpr
value
_
)
convertExpr
(
BasicExpr
value
)
=
beNormalNode
(
convertLiteralSymbol
value
)
beNoArgs
convertExpr
(
App
{
app_symb
,
app_args
})
=
beNormalNode
(
convertSymbol
app_symb
)
(
convertArgs
app_args
)
...
...
frontend/StdCompare.icl
View file @
7ae1e52d
...
...
@@ -54,7 +54,10 @@ where
instance
==
BasicValue
where
(==)
(
BVI
int1
)
(
BVI
int2
)
=
int1
==
int2
(==)
(
BVI
int1
)
(
BVI
int2
)
=
int1
==
int2
(==)
(
BVI
int1
)
(
BVInt
int2
)
=
int1
==
toString
int2
(==)
(
BVInt
int1
)
(
BVI
int2
)
=
toString
int1
==
int2
(==)
(
BVInt
int1
)
(
BVInt
int2
)
=
int1
==
int2
(==)
(
BVC
char1
)
(
BVC
char2
)
=
char1
==
char2
(==)
(
BVB
bool1
)
(
BVB
bool2
)
=
bool1
==
bool2
(==)
(
BVR
real1
)
(
BVR
real2
)
=
real1
==
real2
...
...
frontend/check.icl
View file @
7ae1e52d
...
...
@@ -2158,12 +2158,12 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo
=
(
icl_functions
,
heaps
)
=
(
icl_functions
,
heaps
)
build_function
new_fun_index
fun_def
=:{
fun_symb
,
fun_
arity
,
fun_
body
=
CheckedBody
{
cb_args
},
fun_info
}
fun_index
fun_type
build_function
new_fun_index
fun_def
=:{
fun_symb
,
fun_body
=
CheckedBody
{
cb_args
},
fun_info
}
fun_index
fun_type
(
var_heap
,
type_var_heap
,
expr_heap
)
#
(
tb_args
,
var_heap
)
=
mapSt
new_free_var
cb_args
var_heap
(
app_args
,
expr_heap
)
=
mapSt
new_bound_var
tb_args
expr_heap
(
app_info_ptr
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
tb_rhs
=
App
{
app_symb
=
{
symb_name
=
fun_symb
,
symb_arity
=
fun_arity
,
tb_rhs
=
App
{
app_symb
=
{
symb_name
=
fun_symb
,
symb_kind
=
SK_Function
{
glob_module
=
main_dcl_module_n
,
glob_object
=
fun_index
}},
app_args
=
app_args
,
app_info_ptr
=
app_info_ptr
}
...
...
@@ -2849,7 +2849,7 @@ where
#
(
pre_mod
,
cs_predef_symbols
)
=
cs_predef_symbols
![
PD_PredefinedModule
]
|
pre_mod
.
pds_def
==
mod_index
=
(
class_members
,
class_instances
,
fun_types
,
{
cs
&
cs_predef_symbols
=
cs_predef_symbols
}
<=<
adjustPredefSymbol
PD_StringType
mod_i
ndex
STE_Type
<=<
adjustPredefSymbol
AndCheckIndex
PD_StringType
mod_index
PD_StringTypeI
ndex
STE_Type
<=<
adjust_predef_symbols
PD_ListType
PD_UnboxedArrayType
mod_index
STE_Type
<=<
adjust_predef_symbols
PD_ConsSymbol
PD_Arity32TupleSymbol
mod_index
STE_Constructor
<=<
adjustPredefSymbol
PD_TypeCodeClass
mod_index
STE_Class
...
...
@@ -2953,6 +2953,18 @@ where
=
ste_index
=
NoIndex
adjustPredefSymbolAndCheckIndex
predef_index
mod_index
symbol_index
symb_kind
cs
=:{
cs_symbol_table
,
cs_error
}
#
pre_id
=
predefined_idents
.[
predef_index
]
#!
pre_index
=
determine_index_of_symbol
(
sreadPtr
pre_id
.
id_info
cs_symbol_table
)
symb_kind
|
pre_index
==
symbol_index
=
{
cs
&
cs_predef_symbols
.[
predef_index
]
=
{
pds_def
=
pre_index
,
pds_module
=
mod_index
}}
=
{
cs
&
cs_error
=
checkError
pre_id
" function not defined or wrong index in predef"
cs_error
}
where
determine_index_of_symbol
{
ste_kind
,
ste_index
}
symb_kind
|
ste_kind
==
symb_kind
=
ste_index
=
NoIndex
NewEntry
symbol_table
symb_ptr
def_kind
def_index
level
previous
:==
symbol_table
<:=
(
symb_ptr
,{
ste_kind
=
def_kind
,
ste_index
=
def_index
,
ste_def_level
=
level
,
ste_previous
=
previous
})
...
...
frontend/checkFunctionBodies.icl
View file @
7ae1e52d
...
...
@@ -68,7 +68,7 @@ make_unboxed_list type_symbol expr_heap cs
#
(
stdStrictLists_index
,
cons_u_index
,
decons_u_index
,
nil_u_index
,
decons_u_ident
,
cs
)
=
get_unboxed_list_indices_and_decons_u_ident
cs
#
unboxed_list
=
UnboxedList
type_symbol
stdStrictLists_index
decons_u_index
nil_u_index
#
(
new_info_ptr
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
#
decons_expr
=
App
{
app_symb
={
symb_name
=
decons_u_ident
,
symb_
arity
=
0
,
symb_
kind
=
SK_OverloadedFunction
{
glob_object
=
decons_u_index
,
glob_module
=
stdStrictLists_index
}},
app_args
=[],
app_info_ptr
=
new_info_ptr
}
#
decons_expr
=
App
{
app_symb
={
symb_name
=
decons_u_ident
,
symb_kind
=
SK_OverloadedFunction
{
glob_object
=
decons_u_index
,
glob_module
=
stdStrictLists_index
}},
app_args
=[],
app_info_ptr
=
new_info_ptr
}
=
(
unboxed_list
,
decons_expr
,
expr_heap
,
cs
)
get_unboxed_tail_strict_list_indices_and_decons_u_ident
::
*
CheckState
->
(!
Index
,!
Index
,!
Index
,!
Index
,!
Ident
,!*
CheckState
);
...
...
@@ -85,7 +85,7 @@ make_unboxed_tail_strict_list type_symbol expr_heap cs
#
(
stdStrictLists_index
,
cons_uts_index
,
decons_uts_index
,
nil_uts_index
,
decons_uts_ident
,
cs
)
=
get_unboxed_tail_strict_list_indices_and_decons_u_ident
cs
#
unboxed_list
=
UnboxedTailStrictList
type_symbol
stdStrictLists_index
decons_uts_index
nil_uts_index
#
(
new_info_ptr
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
#
decons_expr
=
App
{
app_symb
={
symb_name
=
decons_uts_ident
,
symb_
arity
=
0
,
symb_
kind
=
SK_OverloadedFunction
{
glob_object
=
decons_uts_index
,
glob_module
=
stdStrictLists_index
}},
app_args
=[],
app_info_ptr
=
new_info_ptr
}
#
decons_expr
=
App
{
app_symb
={
symb_name
=
decons_uts_ident
,
symb_kind
=
SK_OverloadedFunction
{
glob_object
=
decons_uts_index
,
glob_module
=
stdStrictLists_index
}},
app_args
=[],
app_info_ptr
=
new_info_ptr
}
=
(
unboxed_list
,
decons_expr
,
expr_heap
,
cs
)
get_overloaded_list_indices_and_decons_ident
::
*
CheckState
->
(!
Index
,!
Index
,!
Index
,!
Index
,!
Ident
,!*
CheckState
);
...
...
@@ -102,7 +102,7 @@ make_overloaded_list type_symbol expr_heap cs
#
(
stdStrictLists_index
,
cons_index
,
decons_index
,
nil_index
,
decons_ident
,
cs
)
=
get_overloaded_list_indices_and_decons_ident
cs
#
overloaded_list
=
OverloadedList
type_symbol
stdStrictLists_index
decons_index
nil_index
#
(
new_info_ptr
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
#
decons_expr
=
App
{
app_symb
={
symb_name
=
decons_ident
,
symb_
arity
=
0
,
symb_
kind
=
SK_OverloadedFunction
{
glob_object
=
decons_index
,
glob_module
=
stdStrictLists_index
}},
app_args
=[],
app_info_ptr
=
new_info_ptr
}
#
decons_expr
=
App
{
app_symb
={
symb_name
=
decons_ident
,
symb_kind
=
SK_OverloadedFunction
{
glob_object
=
decons_index
,
glob_module
=
stdStrictLists_index
}},
app_args
=[],
app_info_ptr
=
new_info_ptr
}
=
(
overloaded_list
,
decons_expr
,
expr_heap
,
cs
)
make_case_guards
cons_symbol
type_symbol
alg_patterns
expr_heap
cs
...
...
@@ -1036,10 +1036,9 @@ checkExpression free_vars (PE_Update expr1 selectors expr2) e_input e_state e_in
=
(
Update
expr1
selectors
expr2
,
free_vars
,
e_state
,
e_info
,
cs
)
checkExpression
free_vars
(
PE_Tuple
exprs
)
e_input
e_state
e_info
cs
#
(
exprs
,
arity
,
free_vars
,
e_state
,
e_info
,
cs
)
=
check_expression_list
free_vars
exprs
e_input
e_state
e_info
cs
({
glob_object
={
ds_ident
,
ds_index
,
ds_arity
},
glob_module
},
cs
)
({
glob_object
={
ds_ident
,
ds_index
},
glob_module
},
cs
)
=
getPredefinedGlobalSymbol
(
GetTupleConsIndex
arity
)
PD_PredefinedModule
STE_Constructor
arity
cs
=
(
App
{
app_symb
=
{
symb_name
=
ds_ident
,
symb_arity
=
ds_arity
,
symb_kind
=
SK_Constructor
{
glob_object
=
ds_index
,
glob_module
=
glob_module
}},
=
(
App
{
app_symb
=
{
symb_name
=
ds_ident
,
symb_kind
=
SK_Constructor
{
glob_object
=
ds_index
,
glob_module
=
glob_module
}},
app_args
=
exprs
,
app_info_ptr
=
nilPtr
},
free_vars
,
e_state
,
e_info
,
cs
)
where
check_expression_list
free_vars
[]
e_input
e_state
e_info
cs
...
...
@@ -1053,8 +1052,8 @@ checkExpression free_vars rec=:(PE_Record record opt_type fields) e_input=:{ei_e
#
(
opt_record_and_fields
,
e_info
,
cs
)
=
checkFields
ei_mod_index
fields
opt_type
e_info
cs
=
case
opt_record_and_fields
of
Yes
(
cons
=:{
glob_module
,
glob_object
},
_,
new_fields
)
#
{
ds_ident
,
ds_index
,
ds_arity
}
=
glob_object
rec_cons
=
{
symb_name
=
ds_ident
,
symb_kind
=
SK_Constructor
{
glob_object
=
ds_index
,
glob_module
=
glob_module
}
,
symb_arity
=
ds_arity
}
#
{
ds_ident
,
ds_index
}
=
glob_object
rec_cons
=
{
symb_name
=
ds_ident
,
symb_kind
=
SK_Constructor
{
glob_object
=
ds_index
,
glob_module
=
glob_module
}
}
->
case
record
of
PE_Empty
#
(
exprs
,
free_vars
,
e_state
,
e_info
,
cs
)
=
check_field_exprs
free_vars
new_fields
0
RK_Constructor
e_input
e_state
e_info
cs
...
...
@@ -1135,8 +1134,7 @@ checkExpression free_vars (PE_Dynamic expr opt_type) e_input e_state=:{es_expr_h
// ... MV
checkExpression
free_vars
(
PE_Basic
basic_value
)
e_input
e_state
e_info
cs
#
(
basic_type
,
cs
)
=
typeOfBasicValue
basic_value
cs
=
(
BasicExpr
basic_value
basic_type
,
free_vars
,
e_state
,
e_info
,
cs
)
=
(
BasicExpr
basic_value
,
free_vars
,
e_state
,
e_info
,
cs
)
checkExpression
free_vars
(
PE_ABC_Code
code_sequence
do_inline
)
e_input
e_state
e_info
cs
=
(
ABCCodeExpr
code_sequence
do_inline
,
free_vars
,
e_state
,
e_info
,
cs
)
...
...
@@ -1216,7 +1214,7 @@ checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_stat
check_it
free_vars
mod_index
gen_index
id
kind
e_input
e_state
=:{
es_expr_heap
}
e_info
cs
#!
symb_kind
=
SK_Generic
{
glob_object
=
gen_index
,
glob_module
=
mod_index
}
kind
#!
symbol
=
{
symb_name
=
id
,
symb_kind
=
symb_kind
,
symb_arity
=
0
}
#!
symbol
=
{
symb_name
=
id
,
symb_kind
=
symb_kind
}
#!
(
new_info_ptr
,
es_expr_heap
)
=
newPtr
EI_Empty
es_expr_heap
#!
app
=
{
app_symb
=
symbol
,
app_args
=
[],
app_info_ptr
=
new_info_ptr
}
#!
e_state
=
{
e_state
&
es_expr_heap
=
es_expr_heap
}
...
...
@@ -1286,7 +1284,7 @@ where
{
cs
&
cs_error
=
checkError
id
"generic: missing kind argument"
cs_error
})
check_id_expression
entry
is_expr_list
free_vars
id
=:{
id_info
}
e_input
e_state
e_info
cs
#
(
symb_kind
,
arity
,
priority
,
is_a_function
,
e_state
,
e_info
,
cs
)
=
determine_info_of_symbol
entry
id_info
e_input
e_state
e_info
cs
symbol
=
{
symb_name
=
id
,
symb_kind
=
symb_kind
,
symb_arity
=
0
}
symbol
=
{
symb_name
=
id
,
symb_kind
=
symb_kind
}
|
is_expr_list
=
(
Constant
symbol
arity
priority
is_a_function
,
free_vars
,
e_state
,
e_info
,
cs
)
#
(
app_expr
,
e_state
,
cs_error
)
=
buildApplication
symbol
arity
0
is_a_function
[]
e_state
cs
.
cs_error
...
...
@@ -1592,6 +1590,8 @@ checkPattern (PE_ArrayPattern selections) opt_var p_input (var_env, array_patter
// further with next alternative
check_index_expr
(
PE_Basic
(
BVI
_))
states
=
states
check_index_expr
(
PE_Basic
(
BVInt
_))
states
=
states
check_index_expr
_
(
var_env
,
ap_selections
,
var_heap
,
cs
)
=
(
var_env
,
ap_selections
,
var_heap
,
{
cs
&
cs_error
=
checkError
"variable or integer constant expected as index expression"
""
cs
.
cs_error
})
...
...
@@ -1907,10 +1907,10 @@ where
unfold_pattern_macro
mod_index
macro_ident
opt_var
extra_args
(
App
{
app_symb
,
app_args
})
ums
=
unfold_application
mod_index
macro_ident
opt_var
extra_args
app_symb
app_args
ums
where
unfold_application
mod_index
macro_ident
opt_var
extra_args
{
symb_kind
=
SK_Constructor
{
glob_module
,
glob_object
},
symb_name
,
symb_arity
}
app_args
unfold_application
mod_index
macro_ident
opt_var
extra_args
{
symb_kind
=
SK_Constructor
{
glob_module
,
glob_object
},
symb_name
}
app_args
ums
=:{
ums_cons_defs
,
ums_modules
,
ums_error
}
#
(
cons_def
,
cons_index
,
ums_cons_defs
,
ums_modules
)
=
get_cons_def
mod_index
glob_module
glob_object
ums_cons_defs
ums_modules
|
cons_def
.
cons_type
.
st_arity
==
symb_arity
+
length
extra_args
|
cons_def
.
cons_type
.
st_arity
==
length
app_args
+
length
extra_args
#
(
patterns
,
ums
)
=
mapSt
(
unfold_pattern_macro
mod_index
macro_ident
No
[])
app_args
{
ums
&
ums_cons_defs
=
ums_cons_defs
,
ums_modules
=
ums_modules
}
cons_symbol
=
{
glob_object
=
MakeDefinedSymbol
symb_name
cons_index
cons_def
.
cons_type
.
st_arity
,
glob_module
=
glob_module
}
=
(
AP_Algebraic
cons_symbol
cons_def
.
cons_type_index
(
patterns
++
extra_args
)
opt_var
,
ums
)
...
...
@@ -1925,7 +1925,7 @@ where
cons_def
=
dcl_common
.
com_cons_defs
.[
cons_index
]
=
(
cons_def
,
cons_index
,
cons_defs
,
modules
)
unfold_pattern_macro
mod_index
macro_ident
opt_var
extra_args
(
BasicExpr
bv
bt
)
ums
=:{
ums_error
}
unfold_pattern_macro
mod_index
macro_ident
opt_var
extra_args
(
BasicExpr
bv
)
ums
=:{
ums_error
}
|
not
(
isEmpty
extra_args
)
=
(
AP_Empty
macro_ident
,
{
ums
&
ums_error
=
checkError
macro_ident
"too much arguments for pattern macro"
ums_error
})
=
(
AP_Basic
bv
opt_var
,
ums
)
...
...
@@ -2233,11 +2233,11 @@ buildApplication symbol form_arity act_arity is_fun args e_state=:{es_expr_heap}
|
is_fun
#
(
new_info_ptr
,
es_expr_heap
)
=
newPtr
EI_Empty
es_expr_heap
|
form_arity
<
act_arity
#
app
=
{
app_symb
=
{
symbol
&
symb_arity
=
form_arity
}
,
app_args
=
take
form_arity
args
,
app_info_ptr
=
new_info_ptr
}
#
app
=
{
app_symb
=
symbol
,
app_args
=
take
form_arity
args
,
app_info_ptr
=
new_info_ptr
}
=
(
App
app
@
drop
form_arity
args
,
{
e_state
&
es_expr_heap
=
es_expr_heap
},
error
)
#
app
=
{
app_symb
=
{
symbol
&
symb_arity
=
act_arity
}
,
app_args
=
take
form_arity
args
,
app_info_ptr
=
new_info_ptr
}
#
app
=
{
app_symb
=
symbol
,
app_args
=
take
form_arity
args
,
app_info_ptr
=
new_info_ptr
}
=
(
App
app
,
{
e_state
&
es_expr_heap
=
es_expr_heap
},
error
)
#
app
=
App
{
app_symb
=
{
symbol
&
symb_arity
=
act_arity
}
,
app_args
=
args
,
app_info_ptr
=
nilPtr
}
#
app
=
App
{
app_symb
=
symbol
,
app_args
=
args
,
app_info_ptr
=
nilPtr
}
|
form_arity
<
act_arity
=
(
app
,
e_state
,
checkError
symbol
.
symb_name
"used with too many arguments"
error
)
=
(
app
,
e_state
,
error
)
...
...
@@ -2284,6 +2284,7 @@ where
typeOfBasicValue
::
!
BasicValue
!*
CheckState
->
(!
BasicType
,
!*
CheckState
)
typeOfBasicValue
(
BVI
_)
cs
=
(
BT_Int
,
cs
)
typeOfBasicValue
(
BVInt
_)
cs
=
(
BT_Int
,
cs
)
typeOfBasicValue
(
BVC
_)
cs
=
(
BT_Char
,
cs
)
typeOfBasicValue
(
BVB
_)
cs
=
(
BT_Bool
,
cs
)
typeOfBasicValue
(
BVR
_)
cs
=
(
BT_Real
,
cs
)
...
...
frontend/comparedefimp.icl
View file @
7ae1e52d
...
...
@@ -677,7 +677,6 @@ instance t_corresponds (TypeDef TypeRhs) where
tc_state
=
init_atype_vars
iclDef
.
td_args
tc_state
=
t_corresponds
(
dclDef
.
td_args
,
(
dclDef
.
td_rhs
,
(
dclDef
.
td_context
,
dclDef
.
td_attribute
)))
(
iclDef
.
td_args
,
(
iclDef
.
td_rhs
,
(
iclDef
.
td_context
,
iclDef
.
td_attribute
)))
tc_state
instance
t_corresponds
TypeContext
where
t_corresponds
dclDef
iclDef
=
t_corresponds
dclDef
.
tc_class
iclDef
.
tc_class
...
...
@@ -938,9 +937,8 @@ instance e_corresponds Expression where
=
e_corresponds
dcl_ds
icl_ds
o`
equal2
dcl_field_nr
icl_field_nr
o`
e_corresponds
dcl_expr
icl_expr
e_corresponds
(
BasicExpr
dcl_value
dcl_type
)
(
BasicExpr
icl_value
icl_typ
e
)
e_corresponds
(
BasicExpr
dcl_value
)
(
BasicExpr
icl_valu
e
)
=
equal2
dcl_value
icl_value
o`
equal2
dcl_type
icl_type
e_corresponds
(
AnyCodeExpr
dcl_ins
dcl_outs
dcl_code_sequence
)
(
AnyCodeExpr
icl_ins
icl_outs
icl_code_sequence
)
=
e_corresponds
dcl_ins
icl_ins
o`
e_corresponds
dcl_outs
icl_outs
...
...
@@ -1075,7 +1073,7 @@ instance e_corresponds {#Char} where
instance
e_corresponds
BoundVar
where
e_corresponds
dcl
icl
=
e_corresponds_VarInfoPtr
icl
.
var_name
dcl
.
var_info_ptr
icl
.
var_info_ptr
instance
e_corresponds
FieldSymbol
where
e_corresponds
dclField
iclField
=
equal2
dclField
.
fs_name
iclField
.
fs_name
...
...
frontend/convertDynamics.icl
View file @
7ae1e52d
...
...
@@ -140,7 +140,7 @@ convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_
// get tuple arity 2 constructor
#
({
pds_module
,
pds_def
},
predefined_symbols
)
=
predefined_symbols
![
GetTupleConsIndex
arity
]
#
pds_ident
=
predefined_idents
.[
GetTupleConsIndex
arity
]
#
twoTuple_symb
=
{
symb_name
=
pds_ident
,
symb_kind
=
SK_Constructor
{
glob_module
=
pds_module
,
glob_object
=
pds_def
}
,
symb_arity
=
arity
}
#
twoTuple_symb
=
{
symb_name
=
pds_ident
,
symb_kind
=
SK_Constructor
{
glob_module
=
pds_module
,
glob_object
=
pds_def
}
}
// get tuple, type and value selectors
#
({
pds_def
},
predefined_symbols
)
=
predefined_symbols
![
GetTupleConsIndex
arity
]
...
...
@@ -159,7 +159,6 @@ convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_
=
{
SymbIdent
|
symb_name
=
rt_constructor
.
ds_ident
,
symb_kind
=
SK_Constructor
{
glob_module
=
pds_module1
,
glob_object
=
rt_constructor
.
ds_index
}
,
symb_arity
=
rt_constructor
.
ds_arity
}
// type field
...
...
@@ -407,8 +406,8 @@ where
convertDynamics
cinp
bound_vars
default_expr
(
TupleSelect
definedSymbol
int
expression
)
ci
#
(
expression
,
ci
)
=
convertDynamics
cinp
bound_vars
default_expr
expression
ci
=
(
TupleSelect
definedSymbol
int
expression
,
ci
)
convertDynamics
_
_
_
(
BasicExpr
basicValue
basicTyp
e
)
ci
=
(
BasicExpr
basicValue
basicTyp
e
,
ci
)
convertDynamics
_
_
_
be
=:(
BasicExpr
basicValu
e
)
ci
=
(
b
e
,
ci
)
convertDynamics
_
_
_
(
AnyCodeExpr
codeBinding1
codeBinding2
strings
)
ci
=
(
AnyCodeExpr
codeBinding1
codeBinding2
strings
,
ci
)
convertDynamics
_
_
_
(
ABCCodeExpr
strings
bool
)
ci
...
...
@@ -937,7 +936,7 @@ where
= ci;
# ({pds_module, pds_def}, ci_predef_symb) = ci_predef_symb![PD_ModuleConsSymbol]
# pds_ident = predefined_idents.[PD_ModuleConsSymbol]
# module_symb1 = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def}
, symb_arity = 0
}
# module_symb1 = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def} }
# ci
= { ci & ci_predef_symb = ci_predef_symb };
...
...
@@ -1181,7 +1180,7 @@ addToBoundVars var type bound_vars
get_constructor
::
!{!
GlobalTCType
}
Index
->
Expression
get_constructor
glob_type_inst
index
=
BasicExpr
(
BVS
(
"
\"
"
+++
toString
glob_type_inst
.[
index
]
+++
"
\"
"
))
(
BT_String
TE
)
=
BasicExpr
(
BVS
(
"
\"
"
+++
toString
glob_type_inst
.[
index
]
+++
"
\"
"
))
getResultType
::
ExprInfoPtr
!*
ConversionInfo
->
(!
AType
,
!*
ConversionInfo
)
getResultType
case_info_ptr
ci
=:{
ci_expr_heap
}
...
...
@@ -1193,7 +1192,7 @@ getSymbol index symb_kind arity ci=:{ci_predef_symb}
#
({
pds_module
,
pds_def
},
ci_predef_symb
)
=
ci_predef_symb
![
index
]
#
pds_ident
=
predefined_idents
.[
index
]
ci
=
{
ci
&
ci_predef_symb
=
ci_predef_symb
}
symbol
=
{
symb_name
=
pds_ident
,
symb_kind
=
symb_kind
{
glob_module
=
pds_module
,
glob_object
=
pds_def
}
,
symb_arity
=
arity
}
symbol
=
{
symb_name
=
pds_ident
,
symb_kind
=
symb_kind
{
glob_module
=
pds_module
,
glob_object
=
pds_def
}
}
=
(
symbol
,
ci
)
getTupleSymbol
arity
ci
=:{
ci_predef_symb
}
...
...
@@ -1283,7 +1282,7 @@ get_module_id_app predef_symbols
#
({
pds_module
,
pds_def
},
predef_symbols
)
=
predef_symbols
![
PD_ModuleConsSymbol
]
#
pds_ident
=
predefined_idents
.[
PD_ModuleConsSymbol
]
#
module_symb
=
{
app_symb
=
{
symb_name
=
pds_ident
,
symb_kind
=
SK_Constructor
{
glob_module
=
pds_module
,
glob_object
=
pds_def
}
,
symb_arity
=
0
}
{
app_symb
=
{
symb_name
=
pds_ident
,
symb_kind
=
SK_Constructor
{
glob_module
=
pds_module
,
glob_object
=
pds_def
}
}
,
app_args
=
[]
,
app_info_ptr
=
nilPtr
}
...
...
@@ -1291,7 +1290,7 @@ get_module_id_app predef_symbols
#
({
pds_module
,
pds_def
},
predef_symbols
)
=
predef_symbols
![
PD_ModuleID
]
#
pds_ident
=
predefined_idents
.[
PD_ModuleID
]
#
module_id_symb
=
{
app_symb
=
{
symb_name
=
pds_ident
,
symb_kind
=
SK_Constructor
{
glob_module
=
pds_module
,
glob_object
=
pds_def
}
,
symb_arity
=
1
}
{
app_symb
=
{
symb_name
=
pds_ident
,
symb_kind
=
SK_Constructor
{
glob_module
=
pds_module
,
glob_object
=
pds_def
}
}
,
app_args
=
[
App
module_symb
]
,
app_info_ptr
=
nilPtr
}
...
...
frontend/convertcases.icl
View file @
7ae1e52d
...
...
@@ -209,7 +209,7 @@ where
weightedRefCount
rci
(
Case
case_expr
)
rs
=:{
rcs_expr_heap
}
#
(
case_info
,
rcs_expr_heap
)
=
readPtr
case_expr
.
case_info_ptr
rcs_expr_heap
=
weightedRefCountOfCase
rci
case_expr
case_info
{
rs
&
rcs_expr_heap
=
rcs_expr_heap
}
weightedRefCount
rci
expr
=:(
BasicExpr
_
_
)
rs
weightedRefCount
rci
expr
=:(
BasicExpr
_)
rs
=
rs
weightedRefCount
rci
(
MatchExpr
_
constructor
expr
)
rs
=
weightedRefCount
rci
expr
rs
...
...
@@ -454,7 +454,7 @@ where
#
(
fun_expr
,
ds
)
=
distributeLets
depth
fun_expr
ds
(
exprs
,
ds
)
=
distributeLets
depth
exprs
ds
=
(
fun_expr
@
exprs
,
ds
)
distributeLets
depth
expr
=:(
BasicExpr
_
_
)
ds
distributeLets
depth
expr
=:(
BasicExpr
_)
ds
=
(
expr
,
ds
)
distributeLets
depth
(
MatchExpr
opt_tuple
constructor
expr
)
ds
#
(
expr
,
ds
)
=
distributeLets
depth
expr
ds
...
...
@@ -734,7 +734,7 @@ newFunctionWithType opt_id fun_bodies local_vars fun_type group_index (cs_next_f
,
fun_lifted
=
0
,
fun_info
=
{
EmptyFunInfo
&
fi_group_index
=
group_index
,
fi_local_vars
=
local_vars
}
}
=
({
symb_name
=
fun_id
,
symb_kind
=
SK_GeneratedFunction
fun_def_ptr
cs_next_fun_nr
,
symb_arity
=
arity
},
=
({
symb_name
=
fun_id
,
symb_kind
=
SK_GeneratedFunction
fun_def_ptr
cs_next_fun_nr
},
(
inc
cs_next_fun_nr
,
[
fun_def_ptr
:
cs_new_functions
],
cs_fun_heap
<:=
(
fun_def_ptr
,
FI_Function
{
gf_fun_def
=
fun_def
,
gf_instance_info
=
II_Empty
,
gf_fun_index
=
cs_next_fun_nr
,
gf_cons_args
=
{
cc_size
=
0
,
cc_args
=
[],
cc_linear_bits
=
[],
cc_producer
=
False
}
})))
...
...
@@ -910,7 +910,7 @@ instance convertRootCases Expression where
build_conditional
false
guard
then_expr
(
Yes
else_expr
)
=
Conditional
{
if_cond
=
guard
,
if_then
=
else_expr
,
if_else
=
Yes
then_expr
}
build_conditional
false
guard
then_expr
No
=
Conditional
{
if_cond
=
Conditional
{
if_cond
=
guard
,
if_then
=
BasicExpr
(
BVB
False
)
BT_Bool
,
if_else
=
Yes
(
BasicExpr
(
BVB
True
)
BT_Bool
)
},
=
Conditional
{
if_cond
=
Conditional
{
if_cond
=
guard
,
if_then
=
BasicExpr
(
BVB
False
)
,
if_else
=
Yes
(
BasicExpr
(
BVB
True
)
)
},
if_then
=
then_expr
,
if_else
=
No
}
convert_to_else_part
ci
sign_of_then_part
[
alt
=:{
bp_value
=
BVB
sign_of_else_part
,
bp_expr
}
:
alts
]
case_default
cs
...
...
@@ -1234,7 +1234,7 @@ where
copy
(
Conditional
cond
)
cp_info
#
(
cond
,
cp_info
)
=
copy
cond
cp_info
=
(
Conditional
cond
,
cp_info
)
copy
expr
=:(
BasicExpr
_
_
)
cp_info
copy
expr
=:(
BasicExpr
_)
cp_info
=
(
expr
,
cp_info
)
copy
(
MatchExpr
opt_tuple
constructor
expr
)
cp_info
#
(
expr
,
cp_info
)
=
copy
expr
cp_info
...
...
frontend/explicitimports.icl
View file @
7ae1e52d
...
...
@@ -654,7 +654,7 @@ instance check_completeness Expression where
(
check_completeness
selections
cci
ccs
)
check_completeness
(
TupleSelect
_
_
expression
)
cci
ccs
=
check_completeness
expression
cci
ccs
check_completeness
(
BasicExpr
_
_
)
_
ccs
check_completeness
(
BasicExpr
_)
_
ccs
=
ccs
check_completeness
(
AnyCodeExpr
_
_
_)
_
ccs
=
ccs
...
...
frontend/generics.icl
View file @
7ae1e52d
...
...
@@ -3749,8 +3749,8 @@ buildConsApp cons_mod {ds_ident, ds_index, ds_arity} arg_exprs heaps=:{hp_expres
#
expr
=
App
{
app_symb
=
{
symb_name
=
ds_ident
,
symb_kind
=
SK_Constructor
cons_glob
,
symb_arity
=
ds_arity
},
symb_kind
=
SK_Constructor
cons_glob
},
app_args
=
arg_exprs
,
app_info_ptr
=
expr_info_ptr
}
#
heaps
=
{
heaps
&
hp_expression_heap
=
hp_expression_heap
}
...
...
@@ -3764,8 +3764,8 @@ buildFunApp fun_mod {ds_ident, ds_index, ds_arity} arg_exprs heaps=:{hp_expressi
#
expr
=
App
{
app_symb
=
{
symb_name
=
ds_ident
,
symb_kind
=
SK_Function
fun_glob
,
symb_arity
=
length
arg_exprs
},
symb_kind
=
SK_Function
fun_glob
},
app_args
=
arg_exprs
,
app_info_ptr
=
expr_info_ptr
}
#
heaps
=
{
heaps
&
hp_expression_heap
=
hp_expression_heap
}
...
...
@@ -3779,8 +3779,8 @@ buildGenericApp module_index {ds_ident, ds_index} kind arg_exprs heaps=:{hp_expr
#
expr
=
App
{
app_symb
=
{
symb_name
=
ds_ident
,
symb_kind
=
SK_Generic
glob_index
kind
,
symb_arity
=
length
arg_exprs
},
symb_kind
=
SK_Generic
glob_index
kind
},
app_args
=
arg_exprs
,
app_info_ptr
=
expr_info_ptr
}
#
heaps
=
{
heaps
&
hp_expression_heap
=
hp_expression_heap
}
...
...
@@ -3847,8 +3847,7 @@ buildPredefConsApp predef_index args predefs heaps=:{hp_expression_heap}
#
global_index
=
{
glob_module
=
pds_module
,
glob_object
=
pds_def
}
#
symb_ident
=
{
symb_name
=
pds_ident
,
symb_kind
=
SK_Constructor
global_index
,
symb_arity
=
length
args
symb_kind
=
SK_Constructor
global_index
}
#
(
expr_info_ptr
,
hp_expression_heap
)
=
newPtr
EI_Empty
hp_expression_heap
#
app
=
App
{
app_symb
=
symb_ident
,
app_args
=
args
,
app_info_ptr
=
expr_info_ptr
}
...
...
@@ -3869,9 +3868,8 @@ buildPredefFunApp predef_index args predefs heaps=:{hp_expression_heap}
#
pds_ident
=
predefined_idents
.[
predef_index
]
#
global_index
=
{
glob_module
=
pds_module
,
glob_object
=
pds_def
}
#
symb_ident
=
{
symb_name
=
pds_ident
,
symb_kind
=
SK_Function
global_index
,
symb_arity
=
length
args
symb_name
=
pds_ident
,
symb_kind
=
SK_Function
global_index
}
#
(
expr_info_ptr
,
hp_expression_heap
)
=
newPtr
EI_Empty
hp_expression_heap
#
app
=
App
{
app_symb
=
symb_ident
,
app_args
=
args
,
app_info_ptr
=
expr_info_ptr
}
...
...
@@ -4179,14 +4177,14 @@ makeIdent :: String -> Ident
makeIdent
str
=
{
id_name
=
str
,
id_info
=
nilPtr
}
makeIntExpr
::
Int
->
Expression
makeIntExpr
value
=
BasicExpr
(
BVI
(
toString
value
))
BT_Int
makeIntExpr
value
=
BasicExpr
(
BVI
(
toString
value
))
makeStringExpr
::
String
!
PredefinedSymbols
->
Expression
makeStringExpr
str
predefs
#!
{
pds_module
,
pds_def
}
=
predefs
.[
PD_StringType
]
#!
pds_ident
=
predefined_idents
.[
PD_StringType
]
#!
type_symb
=
MakeTypeSymbIdent
{
glob_module
=
pds_module
,
glob_object
=
pds_def
}
pds_ident
0
=
BasicExpr
(
BVS
str
)
(
BT_String
(
TA
type_symb
[]))
=
BasicExpr
(
BVS
str
)
makeListExpr
::
[
Expression
]
!
PredefinedSymbols
!*
Heaps
->
(
Expression
,
!*
Heaps
)
makeListExpr
[]
predefs
heaps
...
...
frontend/overloading.icl
View file @
7ae1e52d
...
...
@@ -789,29 +789,28 @@ getDictionaryTypeAndConstructor {glob_module, glob_object = {ds_ident,ds_index}}
=
(
class_dictionary
,
rt_constructor
)
convertOverloadedCall
::
!{#
CommonDefs
}
![
TypeContext
]
!
SymbIdent
!
ExprInfoPtr
![
ClassApplication
]
!(!*
Heaps
,
![
ExprInfoPtr
])
->
(!*
Heaps
,
![
ExprInfoPtr
])
convertOverloadedCall
defs
contexts
{
symb_name
,
symb_kind
=
SK_OverloadedFunction
{
glob_module
,
glob_object
}
,
symb_arity
}
expr_ptr
[
class_appl
:
class_appls
]
heaps_and_ptrs
convertOverloadedCall
defs
contexts
{
symb_name
,
symb_kind
=
SK_OverloadedFunction
{
glob_module
,
glob_object
}}
expr_ptr
[
class_appl
:
class_appls
]
heaps_and_ptrs
#
mem_def
=
defs
.[
glob_module
].
com_member_defs
.[
glob_object
]
(
class_exprs
,
heaps_and_ptrs
)
=
convertClassApplsToExpressions
defs
contexts
class_appls
heaps_and_ptrs
(
inst_expr
,
(
heaps
,
ptrs
))
=
adjust_member_application
defs
contexts
mem_def
symb_arity
class_appl
class_exprs
heaps_and_ptrs
(
inst_expr
,
(
heaps
,
ptrs
))
=
adjust_member_application
defs
contexts
mem_def
class_appl
class_exprs
heaps_and_ptrs
=
({
heaps
&
hp_expression_heap
=
heaps
.
hp_expression_heap
<:=
(
expr_ptr
,
inst_expr
)},
ptrs
)
where
adjust_member_application
defs
contexts
{
me_symb
,
me_offset
,
me_class
}
symb_arity
(
CA_Instance
red_contexts
)
class_exprs
heaps_and_ptrs
adjust_member_application
defs
contexts
{
me_symb
,
me_offset
,
me_class
}
(
CA_Instance
red_contexts
)
class_exprs
heaps_and_ptrs
#
({
glob_module
,
glob_object
},
red_contexts
)
=
find_instance_of_member
me_class
me_offset
red_contexts
(
exprs
,
heaps_and_ptrs
)
=
convertClassApplsToExpressions
defs
contexts
red_contexts
heaps_and_ptrs
class_exprs
=
exprs
++
class_exprs
=
(
EI_Instance
{
glob_module
=
glob_module
,
glob_object
=
{
ds_ident
=
me_symb
,
ds_arity
=
length
class_exprs
,
ds_index
=
glob_object
}}
class_exprs
,
heaps_and_ptrs
)
adjust_member_application
defs
contexts
{
me_symb
,
me_offset
,
me_class
={
glob_module
,
glob_object
}}
symb_arity
(
CA_Context
tc
)
class_exprs
(
heaps
=:{
hp_type_heaps
},
ptrs
)
adjust_member_application
defs
contexts
{
me_symb
,
me_offset
,
me_class
={
glob_module
,
glob_object
}}
(
CA_Context
tc
)
class_exprs
(
heaps
=:{
hp_type_heaps
},
ptrs
)
#
(
class_context
,
address
,
hp_type_heaps
)
=
determineContextAddress
contexts
defs
tc
hp_type_heaps
{
class_dictionary
={
ds_index
,
ds_ident
}}
=
defs
.[
glob_module
].
com_class_defs
.[
glob_object
]
selector
=
selectFromDictionary
glob_module
ds_index
me_offset
defs
=
(
EI_Selection
(
generateClassSelection
address
[
RecordSelection
selector
me_offset
])
class_context
.
tc_var
class_exprs
,
({
heaps
&
hp_type_heaps
=
hp_type_heaps
},
ptrs
))
adjust_member_application
defs
contexts
_
_
(
CA_GlobalTypeCode
{
tci_index
,
tci_contexts
})
_
heaps_and_ptrs
adjust_member_application
defs
contexts
_
(
CA_GlobalTypeCode
{
tci_index
,
tci_contexts
})
_
heaps_and_ptrs
#
(
exprs
,
heaps_and_ptrs
)
=
convertClassApplsToExpressions
defs
contexts
tci_contexts
heaps_and_ptrs
=
(
EI_TypeCode
(
TCE_Constructor
tci_index
(
map
expressionToTypeCodeExpression
exprs
)),
heaps_and_ptrs
)
adjust_member_application
defs
contexts
_
_
(
CA_LocalTypeCode
new_var_ptr
)
_
heaps_and_ptrs
adjust_member_application
defs
contexts
_
(
CA_LocalTypeCode
new_var_ptr
)
_
heaps_and_ptrs
=
(
EI_TypeCode
(
TCE_Var
new_var_ptr
),
heaps_and_ptrs
)
find_instance_of_member
me_class
me_offset
{
rcs_class_context
=
{
rc_class
,
rc_inst_module
,
rc_inst_members
,
rc_red_contexts
},
rcs_constraints_contexts
}
...
...
@@ -911,8 +910,8 @@ where
{
ds_ident
,
ds_index
}
=
ins_members
.[
mem_offset
]
mem_expr
=
App
{
app_symb
=
{
symb_name
=
ds_ident
,
symb_kind
=
SK_Function
{
glob_object
=
ds_index
,
glob_module
=
mod_index
}
,
symb_arity
=
arity
},
symb_kind
=
SK_Function
{
glob_object
=
ds_index
,
glob_module
=
mod_index
}
},
app_args
=
class_arguments
,
app_info_ptr
=
nilPtr
}
=
build_class_members
mem_offset
ins_members
mod_index
class_arguments
arity
[
mem_expr
:
dictionary_args
]
...
...
@@ -920,8 +919,8 @@ where
build_dictionary
class_symbol
instance_types
dictionary_args
defs
expr_heap
ptrs
#
(
dict_type
,
dict_cons
)
=
getDictionaryTypeAndConstructor
class_symbol
defs
record_symbol
=
{
symb_name
=
dict_cons
.
ds_ident
,
symb_kind
=
SK_Constructor
{
glob_module
=
class_symbol
.
glob_module
,
glob_object
=
dict_cons
.
ds_index
}
,
symb_arity
=
dict_cons
.
ds_arity
}
symb_kind
=
SK_Constructor
{
glob_module
=
class_symbol
.
glob_module
,
glob_object
=
dict_cons
.
ds_index
}
}
dict_type_symbol
=
MakeTypeSymbIdent
{
glob_module
=
class_symbol
.
glob_module
,
glob_object
=
dict_type
.
ds_index
}
dict_type
.
ds_ident
dict_type
.
ds_arity
class_type
=
TA
dict_type_symbol
[
AttributedType
type
\\
type
<-
instance_types
]
(
app_info_ptr
,
expr_heap
)
=
newPtr
(
EI_DictionaryType
class_type
)
expr_heap
...
...
@@ -1265,7 +1264,7 @@ class updateExpression e :: !Index !e !*UpdateInfo -> (!e, !*UpdateInfo)
instance
updateExpression
Expression
where
updateExpression
group_index
(
App
app
=:{
app_symb
=
symb
=:{
symb_kind
,
symb_
arity
,
symb_
name
},
app_args
,
app_info_ptr
})
ui
updateExpression
group_index
(
App
app
=:{
app_symb
=
symb
=:{
symb_kind
,
symb_name
},
app_args
,
app_info_ptr
})
ui
#
(
app_args
,
ui
)
=
updateExpression
group_index
app_args
ui
|
isNilPtr
app_info_ptr
=
(
App
{
app
&
app_args
=
app_args
},
ui
)
...
...
@@ -1279,24 +1278,22 @@ where
->
(
App
{
app
&
app_args
=
app_args
},
ui
)
#
(
CheckedType
{
st_context
},
ui
)
=
ui
!
ui_fun_env
.[
fun_index
]
(
app_args
,
(
ui_var_heap
,
ui_error
))
=
mapAppendSt
(
build_context_arg
symb_name
)
st_context
app_args
(
ui
.
ui_var_heap
,
ui
.
ui_error
)
->
(
App
{
app
&
app_symb
=
{
symb
&
symb_arity
=
symb_arity
+
length
st_context
},
app_args
=
app_args
},
{
ui
&
ui_var_heap
=
ui_var_heap
,
ui_error
=
ui_error
})
->
(
App
{
app
&
app_args
=
app_args
},
{
ui
&
ui_var_heap
=
ui_var_heap
,
ui_error
=
ui_error
})
EI_Context
context_args
#
(
app_args
,
ui
=:{
ui_var_heap
,
ui_error
})
=
adjustClassExpressions
symb_name
context_args
app_args
ui
#!
main_dcl_module_n
=
ui
.
ui_x
.
UpdateInfoX
.
x_main_dcl_module_n
#!
fun_index
=
get_recursive_fun_index
group_index
symb_kind
main_dcl_module_n
ui
.
ui_fun_defs
|
fun_index
==
NoIndex
#
app
=
{
app
&
app_
symb
=
{
symb
&
symb_arity
=
length
context_args
+
symb_arity
},
app_
args
=
app_args
}
#
app
=
{
app
&
app_args
=
app_args
}
->
(
App
app
,
examine_calls
context_args
{
ui
&
ui_var_heap
=
ui_var_heap
,
ui_error
=
ui_error
})
#
(
CheckedType
{
st_context
},
ui
)
=
ui
!
ui_fun_env
.[
fun_index
]
nr_of_context_args
=
length
context_args
nr_of_lifted_contexts
=
length
st_context
-
nr_of_context_args
(
app_args
,
(
ui_var_heap
,
ui_error
))
=
mapAppendSt
(
build_context_arg
symb_name
)
(
take
nr_of_lifted_contexts
st_context
)
app_args
(
ui_var_heap
,
ui_error
)
->
(
App
{
app
&
app_symb
=
{
symb
&
symb_arity
=
nr_of_lifted_contexts
+
nr_of_context_args
+
symb_arity
},
app_args
=
app_args
},
examine_calls
context_args
{
ui
&
ui_var_heap
=
ui_var_heap
,
ui_error
=
ui_error
})
->
(
App
{
app
&
app_args
=
app_args
},
examine_calls
context_args
{
ui
&
ui_var_heap
=
ui_var_heap
,
ui_error
=
ui_error
})
EI_Instance
inst_symbol
context_args
#
(
context_args
,
ui
=:{
ui_var_heap
,
ui_error
})
=
adjustClassExpressions
symb_name
context_args
[]
ui
->
(
build_application
inst_symbol
context_args
app_args
symb_arity
app_info_ptr
,
->
(
build_application
inst_symbol
context_args
app_args
app_info_ptr
,
examine_calls
context_args
(
new_call
inst_symbol
.
glob_module
inst_symbol
.
glob_object
.
ds_index
{
ui
&
ui_var_heap
=
ui_var_heap
,
ui_error
=
ui_error
}))
EI_Selection
selectors
record_var
context_args
...
...
@@ -1339,10 +1336,9 @@ where
get_recursive_fun_index
group_index
_
main_dcl_module_n
fun_defs
=
NoIndex
build_application
def_symbol
=:{
glob_object
}
context_args
orig_args
nr_of_orig_args
app_info_ptr
build_application
def_symbol
=:{
glob_object
}
context_args
orig_args
app_info_ptr
=
App
{
app_symb
=
{
symb_name
=
glob_object
.
ds_ident
,
symb_kind
=
SK_Function
{
def_symbol
&
glob_object
=
glob_object
.
ds_index
},
symb_arity
=
glob_object
.
ds_arity
+
nr_of_orig_args
},
symb_kind
=
SK_Function
{
def_symbol
&
glob_object
=
glob_object
.
ds_index
}
},
app_args
=
context_args
++
orig_args
,
app_info_ptr
=
app_info_ptr
}
examine_application
(
SK_Function
{
glob_module
,
glob_object
})
ui
...
...
@@ -1554,7 +1550,7 @@ where
=
(
Var
{
var_name
=
v_tc_name
,
var_info_ptr
=
var_info_ptr
,
var_expr_ptr
=
nilPtr
},
{
ui
&
ui_var_heap
=
ui_var_heap
,
ui_error
=
ui_error
})
// MV ...
convertTypecode
(
TCE_Constructor
index
typecode_exprs
)
ui
=:{
ui_x
={
x_internal_type_id
}}
#
(
typecons_symb
,
ui
)
=
getSymbol
PD_TypeConsSymbol
SK_Constructor
(
USE_DummyModuleName
3
2
)
ui
#
(
typecons_symb
,
ui
)
=
getSymbol
PD_TypeConsSymbol
SK_Constructor
ui
(
constructor
,
ui
)
=
get_constructor
index
ui
(
typecode_exprs
,
ui
)
=
convertTypecodes
typecode_exprs
ui
#
(
ui_internal_type_id
,
ui
)