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
6bd1fd28
Commit
6bd1fd28
authored
Dec 17, 2001
by
John van Groningen
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
implement pattern matching of strict, unboxed and overloaded lists
in let, with and where expressions
parent
f9248303
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
122 additions
and
23 deletions
+122
-23
backend/backendconvert.icl
backend/backendconvert.icl
+11
-1
backendC/CleanCompilerSources/codegen1.c
backendC/CleanCompilerSources/codegen1.c
+23
-0
backendC/CleanCompilerSources/codegen2.c
backendC/CleanCompilerSources/codegen2.c
+43
-4
frontend/checkFunctionBodies.icl
frontend/checkFunctionBodies.icl
+28
-7
frontend/type.icl
frontend/type.icl
+17
-11
No files found.
backend/backendconvert.icl
View file @
6bd1fd28
...
...
@@ -1866,7 +1866,17 @@ where
convertExpr
(
TupleSelect
{
ds_arity
}
n
expr
)
=
beTupleSelectNode
ds_arity
n
(
convertExpr
expr
)
convertExpr
(
MatchExpr
{
glob_module
,
glob_object
={
ds_index
,
ds_arity
}}
expr
)
=
beMatchNode
ds_arity
(
beConstructorSymbol
glob_module
ds_index
)
(
convertExpr
expr
)
|
glob_module
==
cPredefinedModuleIndex
&&
(
let
pd_cons_index
=
ds_index
+
FirstConstructorPredefinedSymbolIndex
in
pd_cons_index
==
PD_UnboxedConsSymbol
||
pd_cons_index
==
PD_UnboxedTailStrictConsSymbol
||
pd_cons_index
==
PD_OverloadedConsSymbol
)
=
case
expr
of
App
{
app_args
=[
src_expr
],
app_symb
={
symb_kind
=
SK_Function
{
glob_module
=
decons_module
,
glob_object
=
deconsindex
}}}
->
beMatchNode
ds_arity
(
beOverloadedConsSymbol
glob_module
ds_index
decons_module
deconsindex
)
(
convertExpr
src_expr
)
_
->
convertExpr
expr
=
beMatchNode
ds_arity
(
beConstructorSymbol
glob_module
ds_index
)
(
convertExpr
expr
)
convertExpr
(
Conditional
{
if_cond
=
cond
,
if_then
,
if_else
=
Yes
else
})
=
beIfNode
(
convertExpr
cond
)
(
convertExpr
if_then
)
(
convertExpr
else
)
...
...
backendC/CleanCompilerSources/codegen1.c
View file @
6bd1fd28
...
...
@@ -2374,6 +2374,9 @@ SymbDef create_match_function (SymbolP constructor_symbol,int constructor_arity,
if
(
strict_constructor
){
struct
arg
**
rhs_arg_p
,
*
lhs_arg
;
StateP
constructor_arg_state_p
;
#if STRICT_LISTS
StateS
head_and_tail_states
[
2
];
#endif
lhs_function_arg
=
NewArgument
(
constructor_node
);
lhs_function_arg
->
arg_state
=
StrictState
;
...
...
@@ -2381,6 +2384,26 @@ SymbDef create_match_function (SymbolP constructor_symbol,int constructor_arity,
rhs_root
=
NewNode
(
TupleSymbol
,
NULL
,
constructor_arity
);
rhs_arg_p
=&
rhs_root
->
node_arguments
;
#if STRICT_LISTS
if
(
constructor_symbol
->
symb_kind
==
cons_symb
&&
constructor_symbol
->
symb_head_strictness
>
1
||
constructor_symbol
->
symb_tail_strictness
){
constructor_symbol
->
symb_def
->
sdef_constructor
->
cl_state_p
;
if
(
constructor_symbol
->
symb_head_strictness
>
1
){
if
(
constructor_symbol
->
symb_head_strictness
==
4
)
head_and_tail_states
[
0
]
=*
constructor_symbol
->
symb_state_p
;
else
head_and_tail_states
[
0
]
=
StrictState
;
}
else
head_and_tail_states
[
0
]
=
LazyState
;
if
(
constructor_symbol
->
symb_tail_strictness
)
head_and_tail_states
[
1
]
=
StrictState
;
else
head_and_tail_states
[
1
]
=
LazyState
;
constructor_arg_state_p
=
head_and_tail_states
;
}
else
#endif
constructor_arg_state_p
=
constructor_symbol
->
symb_def
->
sdef_constructor
->
cl_state_p
;
for_l
(
lhs_arg
,
constructor_node
->
node_arguments
,
arg_next
){
...
...
backendC/CleanCompilerSources/codegen2.c
View file @
6bd1fd28
...
...
@@ -2754,7 +2754,7 @@ LabDef *unboxed_cons_label (SymbolP cons_symbol_p)
if
(
cons_symbol_p
->
symb_unboxed_cons_state_p
->
state_type
==
SimpleState
&&
BETWEEN
(
IntObj
,
FileObj
,
cons_symbol_p
->
symb_unboxed_cons_state_p
->
state_object
))
return
&
unboxed_cons_labels
[
cons_symbol_p
->
symb_unboxed_cons_state_p
->
state_object
-
IntObj
][
cons_symbol_p
->
symb_tail_strictness
];
else
if
(
cons_symbol_p
->
symb_unboxed_cons_state_p
->
state_type
==
RecordState
){
unboxed_record_cons_lab
.
lab_mod
=
NULL
;
unboxed_record_cons_lab
.
lab_mod
=
ExportLocalLabels
?
CurrentModule
:
NULL
;
unboxed_record_cons_lab
.
lab_pref
=
cons_symbol_p
->
symb_tail_strictness
?
"r_Cons#!"
:
"r_Cons#"
;
unboxed_record_cons_lab
.
lab_issymbol
=
False
;
unboxed_record_cons_lab
.
lab_name
=
cons_symbol_p
->
symb_unboxed_cons_state_p
->
state_record_symbol
->
sdef_ident
->
ident_name
;
...
...
@@ -3901,9 +3901,13 @@ void FillMatchNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_id,CodeGe
}
}
if
(
!
symbol_arity_eq_one
)
if
(
!
symbol_arity_eq_one
){
#if STRICT_LISTS
if
(
symbol
->
symb_kind
==
cons_symb
&&
symbol
->
symb_head_strictness
>
1
||
symbol
->
symb_tail_strictness
)
strict_constructor
=
1
;
#endif
new_match_sdef
=
create_match_function
(
symbol
,
node
->
node_arity
,
strict_constructor
);
else
}
else
new_match_sdef
=
create_select_and_match_function
(
symbol
,
strict_constructor
);
ConvertSymbolToDandNLabel
(
&
name
,
&
codelab
,
new_match_sdef
);
...
...
@@ -4009,7 +4013,42 @@ void FillMatchNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_id,CodeGe
*
bsp_p
+=
b_size
;
AdjustTuple
(
a_size
,
b_size
,
asp_p
,
bsp_p
,
arity
,
demanded_state_array
,
constructor_args_state_p
,
a_size
,
b_size
);
}
else
{
}
else
#if STRICT_LISTS
if
(
symbol
->
symb_kind
==
cons_symb
&&
(
symbol
->
symb_head_strictness
>
1
||
symbol
->
symb_tail_strictness
)){
StateS
head_and_tail_states
[
2
];
if
(
symbol
->
symb_head_strictness
>
1
){
if
(
symbol
->
symb_head_strictness
==
4
)
head_and_tail_states
[
0
]
=*
symbol
->
symb_state_p
;
else
head_and_tail_states
[
0
]
=
StrictState
;
}
else
head_and_tail_states
[
0
]
=
LazyState
;
if
(
symbol
->
symb_tail_strictness
)
head_and_tail_states
[
1
]
=
StrictState
;
else
head_and_tail_states
[
1
]
=
LazyState
;
if
(
symbol
->
symb_head_strictness
==
4
){
DetermineSizeOfState
(
head_and_tail_states
[
0
],
&
a_size
,
&
b_size
);
++
a_size
;
GenReplRArgs
(
a_size
,
b_size
);
*
asp_p
-=
1
-
a_size
;
*
bsp_p
+=
b_size
;
AdjustTuple
(
a_size
,
b_size
,
asp_p
,
bsp_p
,
2
,
demanded_state_array
,
head_and_tail_states
,
a_size
,
b_size
);
}
else
{
GenReplArgs
(
2
,
2
);
*
asp_p
-=
1
-
2
;
AdjustTuple
(
2
,
0
,
asp_p
,
bsp_p
,
2
,
demanded_state_array
,
head_and_tail_states
,
2
,
0
);
}
}
else
#endif
{
*
asp_p
-=
1
;
UnpackTuple
(
*
asp_p
,
asp_p
,
bsp_p
,
True
,
demanded_state_arity
,
demanded_state_array
);
}
...
...
frontend/checkFunctionBodies.icl
View file @
6bd1fd28
...
...
@@ -58,9 +58,9 @@ get_unboxed_list_indices_and_decons_u_ident :: *CheckState -> (!Index,!Index,!In
get_unboxed_list_indices_and_decons_u_ident
cs
=:{
cs_predef_symbols
,
cs_x
}
#
(
stdStrictLists_index
,
cs_predef_symbols
)=
cs_predef_symbols
![
PD_StdStrictLists
].
pds_def
#
(
cons_u_index
,
cs_predef_symbols
)=
cs_predef_symbols
![
PD_cons_u
].
pds_def
#
(
nil_u_index
,
cs_predef_symbols
)=
cs_predef_symbols
![
PD_nil_u
].
pds_def
#
(
decons_u_symbol
,
cs_predef_symbols
)=
cs_predef_symbols
![
PD_decons_u
]
#
decons_u_index
=
decons_u_symbol
.
pds_def
#
(
nil_u_index
,
cs_predef_symbols
)=
cs_predef_symbols
![
PD_nil_u
].
pds_def
#
cs
={
cs
&
cs_predef_symbols
=
cs_predef_symbols
,
cs_x
.
x_needed_modules
=
cs_x
.
x_needed_modules
bitor
cNeedStdStrictLists
}
=
(
stdStrictLists_index
,
cons_u_index
,
decons_u_index
,
nil_u_index
,
predefined_idents
.[
PD_decons_u
],
cs
)
...
...
@@ -71,18 +71,18 @@ make_unboxed_list type_symbol expr_heap cs
#
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
);
get_unboxed_tail_strict_list_indices_and_decons_u_ident
cs
=:{
cs_predef_symbols
,
cs_x
}
get_unboxed_tail_strict_list_indices_and_decons_u
ts
_ident
::
*
CheckState
->
(!
Index
,!
Index
,!
Index
,!
Index
,!
Ident
,!*
CheckState
);
get_unboxed_tail_strict_list_indices_and_decons_u
ts
_ident
cs
=:{
cs_predef_symbols
,
cs_x
}
#
(
stdStrictLists_index
,
cs_predef_symbols
)=
cs_predef_symbols
![
PD_StdStrictLists
].
pds_def
#
(
cons_uts_index
,
cs_predef_symbols
)=
cs_predef_symbols
![
PD_cons_uts
].
pds_def
#
(
nil_uts_index
,
cs_predef_symbols
)=
cs_predef_symbols
![
PD_nil_uts
].
pds_def
#
(
decons_uts_symbol
,
cs_predef_symbols
)=
cs_predef_symbols
![
PD_decons_uts
]
#
decons_uts_index
=
decons_uts_symbol
.
pds_def
#
(
nil_uts_index
,
cs_predef_symbols
)=
cs_predef_symbols
![
PD_nil_uts
].
pds_def
#
cs
={
cs
&
cs_predef_symbols
=
cs_predef_symbols
,
cs_x
.
x_needed_modules
=
cs_x
.
x_needed_modules
bitor
cNeedStdStrictLists
}
=
(
stdStrictLists_index
,
cons_uts_index
,
decons_uts_index
,
nil_uts_index
,
predefined_idents
.[
PD_decons_uts
],
cs
)
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
#
(
stdStrictLists_index
,
cons_uts_index
,
decons_uts_index
,
nil_uts_index
,
decons_uts_ident
,
cs
)
=
get_unboxed_tail_strict_list_indices_and_decons_u
ts
_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_kind
=
SK_OverloadedFunction
{
glob_object
=
decons_uts_index
,
glob_module
=
stdStrictLists_index
}},
app_args
=[],
app_info_ptr
=
new_info_ptr
}
...
...
@@ -92,9 +92,9 @@ get_overloaded_list_indices_and_decons_ident :: *CheckState -> (!Index,!Index,!I
get_overloaded_list_indices_and_decons_ident
cs
=:{
cs_predef_symbols
,
cs_x
}
#
(
stdStrictLists_index
,
cs_predef_symbols
)=
cs_predef_symbols
![
PD_StdStrictLists
].
pds_def
#
(
cons_index
,
cs_predef_symbols
)=
cs_predef_symbols
![
PD_cons
].
pds_def
#
(
nil_index
,
cs_predef_symbols
)=
cs_predef_symbols
![
PD_nil
].
pds_def
#
(
decons_symbol
,
cs_predef_symbols
)=
cs_predef_symbols
![
PD_decons
]
#
decons_index
=
decons_symbol
.
pds_def
#
(
nil_index
,
cs_predef_symbols
)=
cs_predef_symbols
![
PD_nil
].
pds_def
#
cs
={
cs
&
cs_predef_symbols
=
cs_predef_symbols
,
cs_x
.
x_needed_modules
=
cs_x
.
x_needed_modules
bitor
cNeedStdStrictLists
}
=
(
stdStrictLists_index
,
cons_index
,
decons_index
,
nil_index
,
predefined_idents
.[
PD_decons
],
cs
)
...
...
@@ -1808,7 +1808,28 @@ transfromPatternIntoBind mod_index def_level (AP_Algebraic cons_symbol=:{glob_mo
position
var_store
expr_heap
e_info
cs
->
(
opt_var_bind
++
binds
,
var_store
,
expr_heap
,
e_info
,
cs
)
#
(
tuple_cons
,
cs
)
=
getPredefinedGlobalSymbol
(
GetTupleConsIndex
ds_arity
)
PD_PredefinedModule
STE_Constructor
ds_arity
cs
(
match_var
,
match_bind
,
var_store
,
expr_heap
)
#
(
src_expr
,
expr_heap
,
cs
)
=
add_decons_call_for_overloaded_lists
src_expr
expr_heap
cs
with
add_decons_call_for_overloaded_lists
src_expr
expr_heap
cs
|
glob_module
==
cPredefinedModuleIndex
#
pd_cons_index
=
ds_index
+
FirstConstructorPredefinedSymbolIndex
|
pd_cons_index
==
PD_UnboxedConsSymbol
#
(
stdStrictLists_index
,_,
decons_u_index
,_,
decons_u_ident
,
cs
)
=
get_unboxed_list_indices_and_decons_u_ident
cs
#
(
new_info_ptr
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
#
decons_u_expr
=
App
{
app_symb
={
symb_name
=
decons_u_ident
,
symb_kind
=
SK_OverloadedFunction
{
glob_object
=
decons_u_index
,
glob_module
=
stdStrictLists_index
}},
app_args
=[
src_expr
],
app_info_ptr
=
new_info_ptr
}
=
(
decons_u_expr
,
expr_heap
,
cs
)
|
pd_cons_index
==
PD_UnboxedTailStrictConsSymbol
#
(
stdStrictLists_index
,_,
decons_uts_index
,_,
decons_uts_ident
,
cs
)
=
get_unboxed_tail_strict_list_indices_and_decons_uts_ident
cs
#
(
new_info_ptr
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
#
decons_uts_expr
=
App
{
app_symb
={
symb_name
=
decons_uts_ident
,
symb_kind
=
SK_OverloadedFunction
{
glob_object
=
decons_uts_index
,
glob_module
=
stdStrictLists_index
}},
app_args
=[
src_expr
],
app_info_ptr
=
new_info_ptr
}
=
(
decons_uts_expr
,
expr_heap
,
cs
)
|
pd_cons_index
==
PD_OverloadedConsSymbol
#
(
stdStrictLists_index
,_,
decons_index
,_,
decons_ident
,
cs
)
=
get_overloaded_list_indices_and_decons_ident
cs
#
(
new_info_ptr
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
#
decons_expr
=
App
{
app_symb
={
symb_name
=
decons_ident
,
symb_kind
=
SK_OverloadedFunction
{
glob_object
=
decons_index
,
glob_module
=
stdStrictLists_index
}},
app_args
=[
src_expr
],
app_info_ptr
=
new_info_ptr
}
=
(
decons_expr
,
expr_heap
,
cs
)
=
(
src_expr
,
expr_heap
,
cs
)
#
(
match_var
,
match_bind
,
var_store
,
expr_heap
)
=
bind_match_expr
(
MatchExpr
cons_symbol
src_expr
)
opt_var_bind
position
var_store
expr_heap
->
transform_sub_patterns
mod_index
def_level
args
tuple_cons
.
glob_object
0
match_var
match_bind
position
var_store
expr_heap
e_info
cs
...
...
frontend/type.icl
View file @
6bd1fd28
...
...
@@ -1547,17 +1547,23 @@ where
attributedBasicType
{
box
=
type
}
ts
=:{
ts_attr_store
}
=
({
at_annotation
=
AN_None
,
at_attribute
=
TA_TempVar
ts_attr_store
,
at_type
=
type
},
{
ts
&
ts_attr_store
=
inc
ts_attr_store
})
requirements
ti
(
MatchExpr
{
glob_object
={
ds_arity
,
ds_index
},
glob_module
}
expr
)
(
reqs
,
ts
)
#
cp
=
CP_Expression
expr
({
tst_result
,
tst_args
,
tst_attr_env
},
ts
)
=
standardLhsConstructorType
cp
ds_index
glob_module
ds_arity
ti
ts
(
e_type
,
opt_expr_ptr
,
(
reqs
,
ts
))
=
requirements
ti
expr
(
reqs
,
ts
)
reqs
=
{
reqs
&
req_attr_coercions
=
tst_attr_env
++
reqs
.
req_attr_coercions
,
req_type_coercions
=
[{
tc_demanded
=
tst_result
,
tc_offered
=
e_type
,
tc_position
=
cp
,
tc_coercible
=
True
}
:
reqs
.
req_type_coercions
]
}
ts
=
{
ts
&
ts_expr_heap
=
storeAttribute
opt_expr_ptr
tst_result
.
at_attribute
ts
.
ts_expr_heap
}
|
ds_arity
<>
1
#
tuple_type
=
MakeTypeSymbIdent
{
glob_object
=
PD_Arity2TupleTypeIndex
+(
ds_arity
-2
),
glob_module
=
cPredefinedModuleIndex
}
predefined_idents
.[
PD_Arity2TupleType
+(
ds_arity
-2
)]
ds_arity
=
({
at_type
=
TA
tuple_type
tst_args
,
at_attribute
=
TA_Unique
,
at_annotation
=
AN_None
},
No
,
(
reqs
,
ts
))
=
(
hd
tst_args
,
No
,
(
reqs
,
ts
))
requirements
ti
(
MatchExpr
{
glob_object
={
ds_arity
,
ds_index
},
glob_module
}
expr
)
reqs_ts
=:(
reqs
,
ts
)
|
glob_module
==
cPredefinedModuleIndex
&&
(
let
pd_cons_index
=
ds_index
+
FirstConstructorPredefinedSymbolIndex
in
pd_cons_index
==
PD_UnboxedConsSymbol
||
pd_cons_index
==
PD_UnboxedTailStrictConsSymbol
||
pd_cons_index
==
PD_OverloadedConsSymbol
)
=
requirements
ti
expr
reqs_ts
#
cp
=
CP_Expression
expr
({
tst_result
,
tst_args
,
tst_attr_env
},
ts
)
=
standardLhsConstructorType
cp
ds_index
glob_module
ds_arity
ti
ts
(
e_type
,
opt_expr_ptr
,
(
reqs
,
ts
))
=
requirements
ti
expr
(
reqs
,
ts
)
reqs
=
{
reqs
&
req_attr_coercions
=
tst_attr_env
++
reqs
.
req_attr_coercions
,
req_type_coercions
=
[{
tc_demanded
=
tst_result
,
tc_offered
=
e_type
,
tc_position
=
cp
,
tc_coercible
=
True
}
:
reqs
.
req_type_coercions
]
}
ts
=
{
ts
&
ts_expr_heap
=
storeAttribute
opt_expr_ptr
tst_result
.
at_attribute
ts
.
ts_expr_heap
}
|
ds_arity
<>
1
#
tuple_type
=
MakeTypeSymbIdent
{
glob_object
=
PD_Arity2TupleTypeIndex
+(
ds_arity
-2
),
glob_module
=
cPredefinedModuleIndex
}
predefined_idents
.[
PD_Arity2TupleType
+(
ds_arity
-2
)]
ds_arity
=
({
at_type
=
TA
tuple_type
tst_args
,
at_attribute
=
TA_Unique
,
at_annotation
=
AN_None
},
No
,
(
reqs
,
ts
))
=
(
hd
tst_args
,
No
,
(
reqs
,
ts
))
requirements
_
(
AnyCodeExpr
_
_
_)
(
reqs
,
ts
)
#
(
fresh_v
,
ts
)
=
freshAttributedVariable
ts
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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