Skip to content
GitLab
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
e20ad282
Commit
e20ad282
authored
Nov 23, 1999
by
Sjaak Smetsers
Browse files
change: dynamics are now converted before 'fusion'
parent
04775aea
Changes
8
Expand all
Hide whitespace changes
Inline
Side-by-side
frontend/convertDynamics.dcl
View file @
e20ad282
...
...
@@ -2,6 +2,12 @@ definition module convertDynamics
import
syntax
,
transform
,
convertcases
convertDynamicPatternsIntoUnifyAppls
::
{!
GlobalTCType
}
!{#
CommonDefs
}
!*{!
Group
}
!*{#
FunDef
}
!*
PredefinedSymbols
!*
VarHeap
!*
TypeHeaps
!*
ExpressionHeap
->
(!*{!
Group
},
!*{#
FunDef
},
!*
PredefinedSymbols
,
!*{#{#
CheckedTypeDef
}},
!
ImportedConstructors
,
!*
VarHeap
,
!*
TypeHeaps
,
!*
ExpressionHeap
)
/*
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !*{! Group} !*{#FunDef} !*PredefinedSymbols
!*{#{#
CheckedTypeDef
}}
!
Imported
Function
s
!*
VarHeap
!*
TypeHeaps
!*
ExpressionHeap
!*{#{# CheckedTypeDef}} !Imported
Constructor
s !*VarHeap !*TypeHeaps !*ExpressionHeap
-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
*/
\ No newline at end of file
frontend/convertDynamics.icl
View file @
e20ad282
This diff is collapsed.
Click to expand it.
frontend/convertcases.dcl
View file @
e20ad282
...
...
@@ -18,10 +18,16 @@ convertIclModule :: !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructor
->
(!*{#{#
CheckedTypeDef
}},
!
ImportedConstructors
,
!*
VarHeap
,
!*
TypeHeaps
)
newFunction
::
!(
Optional
Ident
)
!
FunctionBody
![
AType
]
!
AType
!
Int
!(!
Int
,
![
FunctionInfoPtr
],!*
FunctionHeap
)
newFunction
::
!(
Optional
Ident
)
!
FunctionBody
![
FreeVar
]
![
AType
]
!
AType
!
Int
!(!
Int
,
![
FunctionInfoPtr
],!*
FunctionHeap
)
->
(!
SymbIdent
,
!(!
Int
,
![
FunctionInfoPtr
],!*
FunctionHeap
))
copyExpression
::
![(
FreeVar
,
AType
)]
!
Expression
!*
VarHeap
->
(![
Expression
],
![.(
FreeVar
,
AType
)],
!
Expression
,
!*
VarHeap
)
::
TypedVariable
=
{
tv_free_var
::
!
FreeVar
,
tv_type
::
!
AType
}
copyExpression
::
![
TypedVariable
]
!
Expression
!*
VarHeap
->
(![
Expression
],
![
TypedVariable
],
![
FreeVar
],
!
Expression
,
!*
VarHeap
)
addNewFunctionsToGroups
::
!{#.
CommonDefs
}
FunctionHeap
![
FunctionInfoPtr
]
!*{!
Group
}
!*{#{#
CheckedTypeDef
}}
!
ImportedFunctions
!*
TypeHeaps
!*
VarHeap
->
(!*{!
Group
},
![
FunDef
],
!*{#{#
CheckedTypeDef
}},
!
ImportedConstructors
,
!*
TypeHeaps
,
!*
VarHeap
)
...
...
frontend/convertcases.icl
View file @
e20ad282
...
...
@@ -89,9 +89,11 @@ where
=
(
TupleSelect
tuple_symbol
arg_nr
expr
,
ci
)
convertCases
bound_vars
group_index
common_defs
(
Case
case_expr
)
ci
=
convertCasesInCaseExpression
bound_vars
group_index
common_defs
cHasNoDefault
case_expr
ci
/*
convertCases bound_vars group_index common_defs (DynamicExpr dynamik) ci
# (dynamik, ci) = convertCases bound_vars group_index common_defs dynamik ci
= (DynamicExpr dynamik, ci)
*/
convertCases
bound_vars
group_index
common_defs
expr
ci
=
(
expr
,
ci
)
...
...
@@ -110,10 +112,25 @@ where
cHasNoDefault
:==
nilPtr
convertDefaultToExpression
default_ptr
(
EI_Default
expr
type
prev_default
)
bound_vars
group_index
common_defs
ci
=:{
ci_var_heap
}
#
(
act_args
,
free_typed_vars
,
expression
,
ci_var_heap
)
=
copyExpression
bound_vars
expr
ci_var_heap
(
fun_symb
,
ci
)
=
newDefaultFunction
free_typed_vars
expression
type
prev_default
group_index
common_defs
{
ci
&
ci_var_heap
=
ci_var_heap
}
#
ci_var_heap
=
foldSt
(\({
fv_info_ptr
},
type
)
->
writePtr
fv_info_ptr
(
VI_BoundVar
type
))
bound_vars
ci_var_heap
(
expression
,
{
cp_free_vars
,
cp_var_heap
,
cp_local_vars
})
=
copy
expr
{
cp_free_vars
=
[],
cp_var_heap
=
ci_var_heap
,
cp_local_vars
=
[]
}
(
act_args
,
free_typed_vars
,
ci_var_heap
)
=
foldSt
retrieveVariable
cp_free_vars
([],
[],
cp_var_heap
)
(
fun_symb
,
ci
)
=
new_default_function
free_typed_vars
cp_local_vars
expression
type
prev_default
group_index
common_defs
{
ci
&
ci_var_heap
=
ci_var_heap
}
=
(
App
{
app_symb
=
fun_symb
,
app_args
=
act_args
,
app_info_ptr
=
nilPtr
},
{
ci
&
ci_expr_heap
=
ci
.
ci_expr_heap
<:=
(
default_ptr
,
EI_DefaultFunction
fun_symb
act_args
)})
where
new_default_function
free_vars
local_vars
rhs_expr
result_type
prev_default
group_index
common_defs
ci
#
(
guarded_exprs
,
ci
)
=
convertPatternExpression
[]
[
free_vars
]
group_index
common_defs
prev_default
rhs_expr
ci
fun_bodies
=
map
build_pattern
guarded_exprs
arg_types
=
map
(\(_,
type
)
->
type
)
free_vars
(
fun_symb
,
(
ci_next_fun_nr
,
ci_new_functions
,
ci_fun_heap
))
=
newFunction
No
(
BackendBody
fun_bodies
)
local_vars
arg_types
result_type
group_index
(
ci
.
ci_next_fun_nr
,
ci
.
ci_new_functions
,
ci
.
ci_fun_heap
)
=
(
fun_symb
,
{
ci
&
ci_fun_heap
=
ci_fun_heap
,
ci_next_fun_nr
=
ci_next_fun_nr
,
ci_new_functions
=
ci_new_functions
})
build_pattern
([
right_patterns
:
_
],
bb_rhs
)
=
{
bb_args
=
right_patterns
,
bb_rhs
=
bb_rhs
}
convertDefaultToExpression
default_ptr
(
EI_DefaultFunction
fun_symb
act_args
)
bound_vars
group_index
common_defs
ci
=
(
App
{
app_symb
=
fun_symb
,
app_args
=
act_args
,
app_info_ptr
=
nilPtr
},
ci
)
...
...
@@ -144,40 +161,35 @@ combineDefaults default_ptr this_default bound_vars guards group_index common_de
=
(
this_default
,
ci
)
::
TypedVariable
=
{
tv_free_var
::
!
FreeVar
,
tv_type
::
!
AType
}
copyExpression
::
![
TypedVariable
]
!
Expression
!*
VarHeap
->
(![
Expression
],
![
TypedVariable
],
![
FreeVar
],
!
Expression
,
!*
VarHeap
)
copyExpression
bound_vars
expression
var_heap
#
var_heap
=
foldSt
(\{
tv_free_var
={
fv_info_ptr
},
tv_type
}
->
writePtr
fv_info_ptr
(
VI_BoundVar
tv_type
))
bound_vars
var_heap
(
expression
,
{
cp_free_vars
,
cp_var_heap
,
cp_local_vars
})
=
copy
expression
{
cp_free_vars
=
[],
cp_var_heap
=
var_heap
,
cp_local_vars
=
[]
}
(
bound_vars
,
free_typed_vars
,
var_heap
)
=
foldSt
retrieve_variable
cp_free_vars
([],
[],
cp_var_heap
)
=
(
bound_vars
,
free_typed_vars
,
cp_local_vars
,
expression
,
var_heap
)
where
retrieve_variable
(
var_info_ptr
,
type
)
(
bound_vars
,
free_typed_vars
,
var_heap
)
#
(
VI_FreeVar
name
new_ptr
count
type
,
var_heap
)
=
readPtr
var_info_ptr
var_heap
=
(
[
Var
{
var_name
=
name
,
var_info_ptr
=
var_info_ptr
,
var_expr_ptr
=
nilPtr
}
:
bound_vars
],
[{
tv_free_var
=
{
fv_def_level
=
NotALevel
,
fv_name
=
name
,
fv_info_ptr
=
new_ptr
,
fv_count
=
count
},
tv_type
=
type
}
:
free_typed_vars
],
var_heap
)
retrieveVariable
(
var_info_ptr
,
type
)
(
bound_vars
,
free_typed_vars
,
var_heap
)
#
(
VI_FreeVar
name
new_ptr
count
type
,
var_heap
)
=
readPtr
var_info_ptr
var_heap
=
(
[
Var
{
var_name
=
name
,
var_info_ptr
=
var_info_ptr
,
var_expr_ptr
=
nilPtr
}
:
bound_vars
],
[({
fv_def_level
=
NotALevel
,
fv_name
=
name
,
fv_info_ptr
=
new_ptr
,
fv_count
=
count
},
type
)
:
free_typed_vars
],
var_heap
)
copyCaseExpression
bound_vars
opt_variable
guards_and_default
var_heap
#
var_heap
=
foldSt
(\({
fv_name
,
fv_info_ptr
},
type
)
->
writePtr
fv_info_ptr
(
VI_BoundVar
type
))
bound_vars
var_heap
(
opt_copied_var
,
var_heap
)
=
copy_variable
opt_variable
var_heap
(
expression
,
{
cp_free_vars
,
cp_var_heap
})
=
copy
guards_and_default
({
cp_free_vars
=
[],
cp_var_heap
=
var_heap
}
==>
(
"copyCaseExpression"
,
bound_vars
,
guards_and_default
))
(
bound_vars
,
free_typed_vars
,
var_heap
)
=
foldSt
retrieveVariable
cp_free_vars
([],
[],
cp_var_heap
)
(
opt_free_var
,
var_heap
)
=
toOptionalFreeVar
opt_copied_var
var_heap
=
(
bound_vars
,
free_typed_vars
,
opt_free_var
,
expression
,
var_heap
)
where
copy_variable
(
Yes
(
var
=:{
var_name
,
var_info_ptr
},
var_type
))
var_heap
#
(
new_info
,
var_heap
)
=
newPtr
VI_Empty
var_heap
=
(
Yes
(
var_info_ptr
,
var_type
),
var_heap
<:=
(
var_info_ptr
,
VI_FreeVar
var_name
new_info
0
var_type
))
copy_variable
No
var_heap
=
(
No
,
var_heap
)
copyExpression
::
![(
FreeVar
,
AType
)]
!
Expression
!*
VarHeap
->
(![
Expression
],
![.(
FreeVar
,
AType
)],
!
Expression
,
!*
VarHeap
)
copyExpression
bound_vars
expression
var_heap
#
var_heap
=
foldSt
(\({
fv_name
,
fv_info_ptr
},
type
)
->
writePtr
fv_info_ptr
(
VI_BoundVar
type
))
bound_vars
var_heap
(
expression
,
{
cp_free_vars
,
cp_var_heap
})
=
copy
expression
{
cp_free_vars
=
[],
cp_var_heap
=
var_heap
}
(
bound_vars
,
free_typed_vars
,
var_heap
)
=
foldSt
retrieveVariable
cp_free_vars
([],
[],
cp_var_heap
)
=
(
bound_vars
,
free_typed_vars
,
expression
,
var_heap
)
[({
fv_def_level
=
NotALevel
,
fv_name
=
name
,
fv_info_ptr
=
new_ptr
,
fv_count
=
count
},
type
)
:
free_typed_vars
],
var_heap
)
convertCasesInCaseExpression
bound_vars
group_index
common_defs
default_ptr
{
case_expr
,
case_guards
,
case_default
,
case_ident
,
case_info_ptr
}
ci
#
(
case_default
,
ci
)
=
combineDefaults
default_ptr
case_default
bound_vars
case_guards
group_index
common_defs
ci
(
case_expr
,
ci
)
=
convertCases
bound_vars
group_index
common_defs
case_expr
ci
(
EI_CaseTypeAndRefCounts
case_type
ref_counts
,
ci_expr_heap
)
=
readPtr
case_info_ptr
ci
.
ci_expr_heap
(
act_vars
,
form_vars
,
opt_free_var
,
(
case_guards
,
case_default
),
ci_var_heap
)
=
copy
C
ase
E
xpression
bound_vars
(
get_variable
case_expr
case_type
.
ct_pattern_type
)
(
case_guards
,
case_default
)
ci
.
ci_var_heap
(
fun_symb
,
ci
)
=
new
C
ase
F
unction
case_ident
case_guards
case_default
case_type
opt_free_var
form_vars
(
act_vars
,
form_vars
,
opt_free_var
,
local_vars
,
(
case_guards
,
case_default
),
ci_var_heap
)
=
copy
_c
ase
_e
xpression
bound_vars
(
get_variable
case_expr
case_type
.
ct_pattern_type
)
(
case_guards
,
case_default
)
ci
.
ci_var_heap
(
fun_symb
,
ci
)
=
new
_c
ase
_f
unction
case_ident
case_guards
case_default
case_type
opt_free_var
form_vars
local_vars
group_index
common_defs
default_ptr
{
ci
&
ci_var_heap
=
ci_var_heap
,
ci_expr_heap
=
ci_expr_heap
}
=
(
App
{
app_symb
=
fun_symb
,
app_args
=
[
case_expr
:
act_vars
],
app_info_ptr
=
nilPtr
},
ci
)
where
...
...
@@ -185,6 +197,31 @@ where
=
Yes
(
var
,
pattern_type
)
get_variable
_
_
=
No
copy_case_expression
bound_vars
opt_variable
guards_and_default
var_heap
#
var_heap
=
foldSt
(\({
fv_name
,
fv_info_ptr
},
type
)
->
writePtr
fv_info_ptr
(
VI_BoundVar
type
))
bound_vars
var_heap
(
opt_copied_var
,
var_heap
)
=
copy_variable
opt_variable
var_heap
(
expression
,
{
cp_free_vars
,
cp_var_heap
,
cp_local_vars
})
=
copy
guards_and_default
{
cp_free_vars
=
[],
cp_var_heap
=
var_heap
,
cp_local_vars
=
[]
}
(
bound_vars
,
free_typed_vars
,
var_heap
)
=
foldSt
retrieveVariable
cp_free_vars
([],
[],
cp_var_heap
)
(
opt_free_var
,
var_heap
)
=
toOptionalFreeVar
opt_copied_var
var_heap
=
(
bound_vars
,
free_typed_vars
,
opt_free_var
,
cp_local_vars
,
expression
,
var_heap
)
copy_variable
(
Yes
(
var
=:{
var_name
,
var_info_ptr
},
var_type
))
var_heap
#
(
new_info
,
var_heap
)
=
newPtr
VI_Empty
var_heap
=
(
Yes
(
var_info_ptr
,
var_type
),
var_heap
<:=
(
var_info_ptr
,
VI_FreeVar
var_name
new_info
0
var_type
))
copy_variable
No
var_heap
=
(
No
,
var_heap
)
new_case_function
opt_id
patterns
case_default
{
ct_result_type
,
ct_pattern_type
,
ct_cons_types
}
opt_var
free_vars
local_vars
group_index
common_defs
prev_default
ci
=:{
ci_expr_heap
}
#
(
default_ptr
,
ci_expr_heap
)
=
makePtrToDefault
case_default
ct_result_type
prev_default
ci_expr_heap
(
fun_bodies
,
ci
)
=
convertPatterns
patterns
ct_cons_types
opt_var
[]
free_vars
default_ptr
group_index
common_defs
{
ci
&
ci_expr_heap
=
ci_expr_heap
}
(
fun_bodies
,
ci
)
=
convertDefault
default_ptr
opt_var
[]
free_vars
group_index
common_defs
(
fun_bodies
,
ci
)
(
fun_symb
,
(
ci_next_fun_nr
,
ci_new_functions
,
ci_fun_heap
))
=
newFunction
opt_id
(
BackendBody
fun_bodies
)
local_vars
[
ct_pattern_type
:
[
type
\\
(_,
type
)
<-
free_vars
]]
ct_result_type
group_index
(
ci
.
ci_next_fun_nr
,
ci
.
ci_new_functions
,
ci
.
ci_fun_heap
)
=
(
fun_symb
,
{
ci
&
ci_fun_heap
=
ci_fun_heap
,
ci_next_fun_nr
=
ci_next_fun_nr
,
ci_new_functions
=
ci_new_functions
})
makePtrToDefault
(
Yes
default_expr
)
type
prev_default_ptr
expr_heap
...
...
@@ -215,31 +252,10 @@ where
typed_free_var_to_pattern
(
free_var
,
type
)
=
FP_Variable
free_var
newDefaultFunction
free_vars
rhs_expr
result_type
prev_default
group_index
common_defs
ci
#
(
guarded_exprs
,
ci
)
=
convertPatternExpression
[]
[
free_vars
]
group_index
common_defs
prev_default
rhs_expr
ci
fun_bodies
=
map
build_pattern
guarded_exprs
arg_types
=
map
(\(_,
type
)
->
type
)
free_vars
(
fun_symb
,
(
ci_next_fun_nr
,
ci_new_functions
,
ci_fun_heap
))
=
newFunction
No
(
BackendBody
fun_bodies
)
arg_types
result_type
group_index
(
ci
.
ci_next_fun_nr
,
ci
.
ci_new_functions
,
ci
.
ci_fun_heap
)
=
(
fun_symb
,
{
ci
&
ci_fun_heap
=
ci_fun_heap
,
ci_next_fun_nr
=
ci_next_fun_nr
,
ci_new_functions
=
ci_new_functions
})
where
build_pattern
([
right_patterns
:
_
],
bb_rhs
)
=
{
bb_args
=
right_patterns
,
bb_rhs
=
bb_rhs
}
newCaseFunction
opt_id
patterns
case_default
{
ct_result_type
,
ct_pattern_type
,
ct_cons_types
}
opt_var
free_vars
group_index
common_defs
prev_default
ci
=:{
ci_expr_heap
}
#
(
default_ptr
,
ci_expr_heap
)
=
makePtrToDefault
case_default
ct_result_type
prev_default
ci_expr_heap
(
fun_bodies
,
ci
)
=
convertPatterns
patterns
ct_cons_types
opt_var
[]
free_vars
default_ptr
group_index
common_defs
{
ci
&
ci_expr_heap
=
ci_expr_heap
}
(
fun_bodies
,
ci
)
=
convertDefault
default_ptr
opt_var
[]
free_vars
group_index
common_defs
(
fun_bodies
,
ci
)
(
fun_symb
,
(
ci_next_fun_nr
,
ci_new_functions
,
ci_fun_heap
))
=
newFunction
opt_id
(
BackendBody
fun_bodies
)
[
ct_pattern_type
:
map
(\(_,
type
)
->
type
)
free_vars
]
ct_result_type
group_index
(
ci
.
ci_next_fun_nr
,
ci
.
ci_new_functions
,
ci
.
ci_fun_heap
)
=
(
fun_symb
,
{
ci
&
ci_fun_heap
=
ci_fun_heap
,
ci_next_fun_nr
=
ci_next_fun_nr
,
ci_new_functions
=
ci_new_functions
})
newFunction
::
!(
Optional
Ident
)
!
FunctionBody
![
AType
]
!
AType
!
Int
!(!
Int
,
![
FunctionInfoPtr
],!*
FunctionHeap
)
newFunction
::
!(
Optional
Ident
)
!
FunctionBody
![
FreeVar
]
![
AType
]
!
AType
!
Int
!(!
Int
,
![
FunctionInfoPtr
],!*
FunctionHeap
)
->
(!
SymbIdent
,
!(!
Int
,
![
FunctionInfoPtr
],!*
FunctionHeap
))
newFunction
opt_id
fun_bodies
arg_types
result_type
group_index
(
ci_next_fun_nr
,
ci_new_functions
,
ci_fun_heap
)
newFunction
opt_id
fun_bodies
local_vars
arg_types
result_type
group_index
(
ci_next_fun_nr
,
ci_new_functions
,
ci_fun_heap
)
#
(
fun_def_ptr
,
ci_fun_heap
)
=
newPtr
FI_Empty
ci_fun_heap
fun_id
=
getIdent
opt_id
ci_next_fun_nr
arity
=
length
arg_types
...
...
@@ -263,7 +279,7 @@ newFunction opt_id fun_bodies arg_types result_type group_index (ci_next_fun_nr,
,
fun_index
=
NoIndex
,
fun_kind
=
FK_Function
,
fun_lifted
=
0
,
fun_info
=
{
EmptyFunInfo
&
fi_group_index
=
group_index
}
,
fun_info
=
{
EmptyFunInfo
&
fi_group_index
=
group_index
,
fi_local_vars
=
local_vars
}
}
=
({
symb_name
=
fun_id
,
symb_kind
=
SK_GeneratedFunction
fun_def_ptr
ci_next_fun_nr
,
symb_arity
=
arity
},
(
inc
ci_next_fun_nr
,
[
fun_def_ptr
:
ci_new_functions
],
...
...
@@ -721,25 +737,27 @@ convertRootExpression bound_vars group_index common_defs _ expr ci
::
CopyInfo
=
{
cp_free_vars
::
![(
VarInfoPtr
,
AType
)]
,
cp_local_vars
::
![
FreeVar
]
,
cp_var_heap
::
!.
VarHeap
}
class
copy
e
::
!
e
!*
CopyInfo
->
(!
e
,
!*
CopyInfo
)
instance
copy
BoundVar
where
copy
var
=:{
var_name
,
var_info_ptr
}
cp_info
=:{
cp_free_vars
,
cp_var_heap
}
#!
var_info
=
sreadPtr
var_info_ptr
cp_var_heap
copy
var
=:{
var_name
,
var_info_ptr
}
cp_info
=:{
cp_var_heap
}
#
(
var_info
,
cp_var_heap
)
=
readPtr
var_info_ptr
cp_var_heap
cp_info
=
{
cp_info
&
cp_var_heap
=
cp_var_heap
}
=
case
var_info
of
VI_FreeVar
name
new_info_ptr
count
type
->
({
var
&
var_info_ptr
=
new_info_ptr
},
{
cp_free_vars
=
cp_free_vars
,
cp_var_heap
=
cp_var_heap
<:=
(
var_info_ptr
,
VI_FreeVar
name
new_info_ptr
(
inc
count
)
type
)})
->
({
var
&
var_info_ptr
=
new_info_ptr
},
{
cp_info
&
cp_var_heap
=
cp_info
.
cp_var_heap
<:=
(
var_info_ptr
,
VI_FreeVar
name
new_info_ptr
(
inc
count
)
type
)})
VI_LocalVar
->
(
var
,
{
cp_
free_vars
=
cp_free_vars
,
cp_var_heap
=
cp_var_heap
}
)
->
(
var
,
cp_
info
)
VI_BoundVar
type
#
(
new_info_ptr
,
cp_var_heap
)
=
newPtr
VI_Empty
cp_var_heap
->
({
var
&
var_info_ptr
=
new_info_ptr
},
{
cp_free_vars
=
[
(
var_info_ptr
,
type
)
:
cp_free_vars
],
#
(
new_info_ptr
,
cp_var_heap
)
=
newPtr
VI_Empty
cp_info
.
cp_var_heap
->
({
var
&
var_info_ptr
=
new_info_ptr
},
{
cp_info
&
cp_free_vars
=
[
(
var_info_ptr
,
type
)
:
cp_info
.
cp_free_vars
],
cp_var_heap
=
cp_var_heap
<:=
(
var_info_ptr
,
VI_FreeVar
var_name
new_info_ptr
1
type
)
})
_
->
abort
"copy [BoundVar] (convertcases, 612)"
<<-
(
var_info
--->
(
var_name
,
ptrToInt
var_info_ptr
))
...
...
@@ -755,10 +773,13 @@ where
copy
(
fun_expr
@
exprs
)
cp_info
#
((
fun_expr
,
exprs
),
cp_info
)
=
copy
(
fun_expr
,
exprs
)
cp_info
=
(
fun_expr
@
exprs
,
cp_info
)
copy
(
Let
lad
=:{
let_binds
,
let_expr
})
cp_info
=:{
cp_var_heap
}
#
(
(
let_binds
,
let_expr
),
cp_info
)
=
copy
(
let_binds
,
let_expr
)
{
cp_info
&
cp_var_heap
=
foldSt
(\{
bind_dst
={
fv_info_ptr
}}
->
writePtr
fv_info_ptr
VI_LocalVar
)
let_binds
cp_var_heap
}
copy
(
Let
lad
=:{
let_binds
,
let_expr
})
cp_info
=:{
cp_var_heap
,
cp_local_vars
}
#
(
cp_local_vars
,
cp_var_heap
)
=
foldSt
bind_let_var
let_binds
(
cp_local_vars
,
cp_var_heap
)
#
((
let_binds
,
let_expr
),
cp_info
)
=
copy
(
let_binds
,
let_expr
)
{
cp_info
&
cp_var_heap
=
cp_var_heap
,
cp_local_vars
=
cp_local_vars
}
=
(
Let
{
lad
&
let_expr
=
let_expr
,
let_binds
=
let_binds
},
cp_info
)
where
bind_let_var
{
bind_dst
}
(
local_vars
,
var_heap
)
=
([
bind_dst
:
local_vars
],
var_heap
<:=
(
bind_dst
.
fv_info_ptr
,
VI_LocalVar
))
copy
(
Case
case_expr
)
cp_info
#
(
case_expr
,
cp_info
)
=
copy
case_expr
cp_info
=
(
Case
case_expr
,
cp_info
)
...
...
@@ -783,9 +804,11 @@ where
copy
(
TupleSelect
tuple_symbol
arg_nr
expr
)
cp_info
#
(
expr
,
cp_info
)
=
copy
expr
cp_info
=
(
TupleSelect
tuple_symbol
arg_nr
expr
,
cp_info
)
/*
copy (DynamicExpr dynamik) cp_info
# (dynamik, cp_info) = copy dynamik cp_info
= (DynamicExpr dynamik, cp_info)
*/
copy
EE
cp_info
=
(
EE
,
cp_info
)
copy
expr
cp_info
...
...
@@ -811,7 +834,7 @@ where
copy
selector
cp_info
=
(
selector
,
cp_info
)
/*
instance copy DynamicExpr
where
copy dynamik=:{dyn_expr,dyn_uni_vars,dyn_type_code} cp_info=:{cp_var_heap}
...
...
@@ -842,6 +865,9 @@ copyVarInfo var_info_ptr cp_info=:{cp_free_vars, cp_var_heap}
# (new_info_ptr, cp_var_heap) = newPtr VI_Empty cp_var_heap
-> (new_info_ptr, { cp_free_vars = [ (var_info_ptr, type) : cp_free_vars ],
cp_var_heap = cp_var_heap <:= (var_info_ptr, VI_FreeVar { id_name = "_t", id_info = nilPtr } new_info_ptr 1 type) })
*/
instance
copy
Case
where
copy
this_case
=:{
case_expr
,
case_guards
,
case_default
}
cp_info
...
...
@@ -856,9 +882,11 @@ where
copy
(
BasicPatterns
type
patterns
)
cp_info
#
(
patterns
,
cp_info
)
=
copy
patterns
cp_info
=
(
BasicPatterns
type
patterns
,
cp_info
)
/*
copy (DynamicPatterns patterns) cp_info
# (patterns, cp_info) = copy patterns cp_info
= (DynamicPatterns patterns, cp_info)
*/
instance
copy
AlgebraicPattern
where
...
...
@@ -871,7 +899,7 @@ where
copy
pattern
=:{
bp_expr
}
cp_info
#
(
bp_expr
,
cp_info
)
=
copy
bp_expr
cp_info
=
({
pattern
&
bp_expr
=
bp_expr
},
cp_info
)
/*
instance copy DynamicPattern
where
copy pattern=:{dp_var={fv_info_ptr},dp_rhs,dp_type_patterns_vars, dp_type_code} cp_info=:{cp_var_heap}
...
...
@@ -880,7 +908,7 @@ where
<:= (fv_info_ptr, VI_LocalVar) }
(dp_type_code, cp_info) = copy dp_type_code cp_info
= ({ pattern & dp_rhs = dp_rhs, dp_type_code = dp_type_code }, cp_info)
*/
instance
copy
[
a
]
|
copy
a
where
copy
l
cp_info
=
mapSt
copy
l
cp_info
...
...
@@ -998,8 +1026,10 @@ where
=
weightedRefCount
dcl_functions
common_defs
depth
(
expression
,
expressions
)
rc_info
weightedRefCount
dcl_functions
common_defs
depth
(
TupleSelect
tuple_symbol
arg_nr
expr
)
rc_info
=
weightedRefCount
dcl_functions
common_defs
depth
expr
rc_info
/*
weightedRefCount dcl_functions common_defs depth (DynamicExpr {dyn_expr}) rc_info
= weightedRefCount dcl_functions common_defs depth dyn_expr rc_info
*/
weightedRefCount
dcl_functions
common_defs
depth
(
AnyCodeExpr
_
_
_)
rc_info
=
rc_info
weightedRefCount
dcl_functions
common_defs
depth
(
ABCCodeExpr
_
_)
rc_info
...
...
@@ -1132,17 +1162,17 @@ instance weightedRefCount App
where
weightedRefCount
dcl_functions
common_defs
depth
{
app_symb
,
app_args
}
rc_info
#
rc_info
=
weightedRefCount
dcl_functions
common_defs
depth
app_args
rc_info
=
check_import
dcl_functions
common_defs
app_symb
.
symb_kind
rc_info
=
check_import
dcl_functions
common_defs
app_symb
rc_info
where
check_import
dcl_functions
common_defs
symb_kind
=
:(
SK_Function
{
glob_module
,
glob_object
}
)
rc_info
=:{
rc_imports
,
rc_var_heap
}
check_import
dcl_functions
common_defs
{
symb_kind
=
SK_Function
{
glob_module
,
glob_object
}
}
rc_info
=:{
rc_imports
,
rc_var_heap
}
=
checkImportOfDclFunction
dcl_functions
common_defs
glob_module
glob_object
rc_info
check_import
dcl_functions
common_defs
symb_kind
=:(
SK_Constructor
{
glob_module
,
glob_object
})
rc_info
=:{
rc_imports
,
rc_var_heap
}
check_import
dcl_functions
common_defs
{
symb_name
,
symb_kind
=
symb_kind
=:(
SK_Constructor
{
glob_module
,
glob_object
})
}
rc_info
=:{
rc_imports
,
rc_var_heap
}
|
glob_module
<>
cIclModIndex
#
{
cons_type_ptr
}
=
common_defs
.[
glob_module
].
com_cons_defs
.[
glob_object
]
(
rc_imports
,
rc_var_heap
)
=
checkImportedSymbol
symb_kind
cons_type_ptr
(
rc_imports
,
rc_var_heap
)
=
{
rc_info
&
rc_imports
=
rc_imports
,
rc_var_heap
=
rc_var_heap
}
=
rc_info
check_import
dcl_functions
common_defs
symb_kind
rc_info
check_import
dcl_functions
common_defs
_
rc_info
=
rc_info
...
...
@@ -1272,9 +1302,10 @@ where
is_moved
LES_Moved
=
True
is_moved
_
=
False
distributeLets
depth
(
DynamicExpr
dynamik
=:{
dyn_expr
})
dl_info
/*
distributeLets depth (DynamicExpr dynamik=:{dyn_expr}) dl_info
# (dyn_expr, dl_info) = distributeLets depth dyn_expr dl_info
= (DynamicExpr { dynamik & dyn_expr = dyn_expr }, dl_info)
*/
distributeLets
depth
expr
=:(
TypeCodeExpression
_)
dl_info
=
(
expr
,
dl_info
)
distributeLets
depth
(
AnyCodeExpr
in_params
out_params
code_expr
)
dl_info
=:{
di_var_heap
}
...
...
frontend/syntax.dcl
View file @
e20ad282
...
...
@@ -478,7 +478,7 @@ cIsALocalVar :== False
VI_ExpandedType
!
SymbolType
|
/* for storing the (expanded) type of an imported function */
VI_Record
![
AuxiliaryPattern
]
|
VI_Pattern
!
AuxiliaryPattern
|
VI_Default
!
Int
|
/* used during conversion of dynamics; the Int indiacted the refenrence count */
VI_Default
!
Int
|
VI_Indirection
!
Int
|
/* used during conversion of dynamics; the Int indiacted the refenrence count */
VI_Body
!
SymbIdent
!
TransformedBody
![
FreeVar
]
|
/* used during fusion */
VI_Dictionary
!
SymbIdent
![
Expression
]
![
Type
]
|
/* used during fusion */
VI_Extended
!
ExtendedVarInfo
!
VarInfo
...
...
frontend/syntax.icl
View file @
e20ad282
...
...
@@ -434,7 +434,7 @@ cIsALocalVar :== False
VI_ExpandedType
!
SymbolType
|
/* for storing the (expanded) type of an imported function */
VI_Record
![
AuxiliaryPattern
]
|
VI_Pattern
!
AuxiliaryPattern
|
VI_Default
!
Int
|
/* used during conversion of dynamics; the Int indiacted the refenrence count */
VI_Default
!
Int
|
VI_Indirection
!
Int
|
/* used during conversion of dynamics; the Int indiacted the refenrence count */
VI_Body
!
SymbIdent
!
TransformedBody
![
FreeVar
]
|
/* used during fusion */
VI_Dictionary
!
SymbIdent
![
Expression
]
![
Type
]
|
/* used during fusion */
VI_Extended
!
ExtendedVarInfo
!
VarInfo
...
...
@@ -1332,7 +1332,7 @@ where
// was (<<<) file (App {app_symb, app_args})
// = file <<< app_symb <<< ' ' <<< app_args
(<<<)
file
(
f_exp
@
a_exp
)
=
file
<<<
'('
<<<
f_exp
<<<
" @ "
<<<
a_exp
<<<
')'
(<<<)
file
(
Let
{
let_binds
,
let_expr
})
=
write_binds
(
file
<<<
"let "
<<<
'\n'
)
let_binds
<<<
"in
\n
"
<<<
let_expr
(<<<)
file
(
Let
{
let_info_ptr
,
let_binds
,
let_expr
})
=
write_binds
(
file
<<<
"let "
<<<
ptrToInt
let_info_ptr
<<<
'\n'
)
let_binds
<<<
"in
\n
"
<<<
let_expr
where
write_binds
file
[]
=
file
...
...
@@ -1516,7 +1516,7 @@ where
instance
<<<
FreeVar
where
(<<<)
file
{
fv_name
,
fv_info_ptr
}
=
file
<<<
fv_name
<<<
'<'
<<<
ptrToInt
fv_info_ptr
<<<
'>'
(<<<)
file
{
fv_name
,
fv_info_ptr
,
fv_count
}
=
file
<<<
fv_name
<<<
'.'
<<<
fv_count
<<<
'<'
<<<
ptrToInt
fv_info_ptr
<<<
'>'
instance
<<<
DynamicType
where
...
...
frontend/trans.dcl
View file @
e20ad282
...
...
@@ -13,8 +13,9 @@ cAccumulating :== -3
analyseGroups
::
!{#
CommonDefs
}
!*{!
Group
}
!*{#
FunDef
}
!*
VarHeap
!*
ExpressionHeap
->
(!
CleanupInfo
,
!*{!
ConsClasses
},
!*{!
Group
},
!*{#
FunDef
},
!*
VarHeap
,
!*
ExpressionHeap
)
transformGroups
::
!
CleanupInfo
!*{!
Group
}
!*{#
FunDef
}
!{!.
ConsClasses
}
!{#
CommonDefs
}
!{#
{#
FunType
}
}
!*
VarHeap
!*
TypeHeaps
!*
ExpressionHeap
->
(!*{!
Group
},
!*{#
FunDef
},
!*{#{#
CheckedTypeDef
}},
!
ImportedConstructors
,
!*
VarHeap
,
!*
TypeHeaps
,
!*
ExpressionHeap
)
transformGroups
::
!
CleanupInfo
!*{!
Group
}
!*{#
FunDef
}
!{!.
ConsClasses
}
!{#
CommonDefs
}
!{#
{#
FunType
}
}
!*{#{#
CheckedTypeDef
}}
!
ImportedConstructors
!*
VarHeap
!*
TypeHeaps
!*
ExpressionHeap
->
(!*{!
Group
},
!*{#
FunDef
},
!*{#{#
CheckedTypeDef
}},
!
ImportedConstructors
,
!*
VarHeap
,
!*
TypeHeaps
,
!*
ExpressionHeap
)
partitionateFunctions
::
!*{#
FunDef
}
![
IndexRange
]
->
(!*{!
Group
},
!*{#
FunDef
})
...
...
frontend/trans.icl
View file @
e20ad282
...
...
@@ -224,16 +224,24 @@ instance consumerRequirements Expression where
{
ai
&
ai_next_var
=
new_next_var
,
ai_next_var_of_fun
=
new_ai_next_var_of_fun
,
ai_var_heap
=
ai_var_heap
}
=
consumerRequirements
let_expr
common_defs
ai
// XXX why not not_an_unsafe_pattern
where
init_variables
[{
bind_dst
={
fv_info_ptr
}}
:
binds
]
ai_next_var
ai_next_var_of_fun
ai_var_heap
=
init_variables
binds
(
inc
ai_next_var
)
(
inc
ai_next_var_of_fun
)
(
writePtr
fv_info_ptr
(
VI_AccVar
ai_next_var
ai_next_var_of_fun
)
ai_var_heap
)
init_variables
[{
bind_dst
={
fv_count
,
fv_info_ptr
}}
:
binds
]
ai_next_var
ai_next_var_of_fun
ai_var_heap
/* Sjaak ... */
|
fv_count
>
0
=
init_variables
binds
(
inc
ai_next_var
)
(
inc
ai_next_var_of_fun
)
(
writePtr
fv_info_ptr
(
VI_AccVar
ai_next_var
ai_next_var_of_fun
)
ai_var_heap
)
=
init_variables
binds
ai_next_var
ai_next_var_of_fun
ai_var_heap
/* ... Sjaak */
init_variables
[]
ai_next_var
ai_next_var_of_fun
ai_var_heap
=
(
ai_next_var
,
ai_next_var_of_fun
,
ai_var_heap
)
acc_requirements_of_let_binds
[
{
bind_src
,
bind_dst
={
fv_info_ptr
}}
:
binds
]
ai_next_var
common_defs
ai
#
(
bind_var
,
_,
ai
)
=
consumerRequirements
bind_src
common_defs
ai
ai_class_subst
=
unifyClassifications
ai_next_var
bind_var
ai
.
ai_class_subst
=
acc_requirements_of_let_binds
binds
(
inc
ai_next_var
)
common_defs
{
ai
&
ai_class_subst
=
ai_class_subst
}
acc_requirements_of_let_binds
[
{
bind_src
,
bind_dst
}
:
binds
]
ai_next_var
common_defs
ai
/* Sjaak ... */
|
bind_dst
.
fv_count
>
0
#
(
bind_var
,
_,
ai
)
=
consumerRequirements
bind_src
common_defs
ai
ai_class_subst
=
unifyClassifications
ai_next_var
bind_var
ai
.
ai_class_subst
=
acc_requirements_of_let_binds
binds
(
inc
ai_next_var
)
common_defs
{
ai
&
ai_class_subst
=
ai_class_subst
}
=
acc_requirements_of_let_binds
binds
ai_next_var
common_defs
ai
/* ... Sjaak */
acc_requirements_of_let_binds
[]
ai_next_var
_
ai
=
ai
...
...
@@ -412,9 +420,9 @@ instance consumerRequirements DynamicPattern where
=
consumerRequirements
dp_rhs
common_defs
ai
bindPatternVars
[
fv
=:{
fv_info_ptr
,
fv_count
}
:
vars
]
next_var
next_var_of_fun
var_heap
//
| fv_count > 0
|
fv_count
>
0
=
bindPatternVars
vars
(
inc
next_var
)
(
inc
next_var_of_fun
)
(
writePtr
fv_info_ptr
(
VI_AccVar
next_var
next_var_of_fun
)
var_heap
)
//
= bindPatternVars vars next_var next_var_of_fun (writePtr fv_info_ptr (VI_Count 0 False) var_heap)
=
bindPatternVars
vars
next_var
next_var_of_fun
(
writePtr
fv_info_ptr
(
VI_Count
0
False
)
var_heap
)
bindPatternVars
[]
next_var
next_var_of_fun
var_heap
=
(
next_var
,
next_var_of_fun
,
var_heap
)
...
...
@@ -1743,13 +1751,21 @@ where
::
ImportedConstructors
:==
[
Global
Index
]
transformGroups
::
!
CleanupInfo
!*{!
Group
}
!*{#
FunDef
}
!{!.
ConsClasses
}
!{#
CommonDefs
}
!{#
{#
FunType
}
}
!*
VarHeap
!*
TypeHeaps
!*
ExpressionHeap
->
(!*{!
Group
},
!*{#
FunDef
},
!*{#{#
CheckedTypeDef
}},
!
ImportedConstructors
,
!*
VarHeap
,
!*
TypeHeaps
,
!*
ExpressionHeap
)
transformGroups
cleanup_info
groups
fun_defs
cons_args
common_defs
imported_funs
var_heap
type_heaps
symbol_heap
/* Sjaak ... */
// transformGroups :: !CleanupInfo !*{! Group} !*{#FunDef} !{!.ConsClasses} !{# CommonDefs} !{# {# FunType} } !*VarHeap !*TypeHeaps !*ExpressionHeap
// -> (!*{! Group}, !*{#FunDef}, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
transformGroups
::
!
CleanupInfo
!*{!
Group
}
!*{#
FunDef
}
!{!.
ConsClasses
}
!{#
CommonDefs
}
!{#
{#
FunType
}
}
!*{#{#
CheckedTypeDef
}}
!
ImportedConstructors
!*
VarHeap
!*
TypeHeaps
!*
ExpressionHeap
->
(!*{!
Group
},
!*{#
FunDef
},
!*{#{#
CheckedTypeDef
}},
!
ImportedConstructors
,
!*
VarHeap
,
!*
TypeHeaps
,
!*
ExpressionHeap
)
/* ... Sjaak */
// transformGroups cleanup_info groups fun_defs cons_args common_defs imported_funs var_heap type_heaps symbol_heap
transformGroups
cleanup_info
groups
fun_defs
cons_args
common_defs
imported_funs
imported_types
collected_imports
var_heap
type_heaps
symbol_heap
#!
(
nr_of_funs
,
fun_defs
)
=
usize
fun_defs
#
imported_types
=
{
com_type_defs
\\
{
com_type_defs
}
<-:
common_defs
}
//
# imported_types = {com_type_defs \\ {com_type_defs} <-: common_defs }
#
(
groups
,
imported_types
,
collected_imports
,
ti
)
=
transform_groups
0
groups
common_defs
imported_funs
imported_types
[]
=
transform_groups
0
groups
common_defs
imported_funs
imported_types
collected_imports
{
ti_fun_defs
=
fun_defs
,
ti_instances
=
createArray
nr_of_funs
II_Empty
,
ti_cons_args
=
cons_args
,
ti_new_functions
=
[],
ti_fun_heap
=
newHeap
,
ti_var_heap
=
var_heap
,
ti_symbol_heap
=
symbol_heap
,
ti_type_heaps
=
type_heaps
,
ti_next_fun_nr
=
nr_of_funs
,
ti_cleanup_info
=
cleanup_info
,
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment