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-and-itasks
sapl-interpreter
Commits
7b630f28
Commit
7b630f28
authored
Jan 26, 2016
by
Laszlo Domoszlai
Browse files
record field selection
parent
ff729da7
Changes
5
Hide whitespace changes
Inline
Side-by-side
interpreter/code.c
View file @
7b630f28
...
...
@@ -140,6 +140,7 @@ void set_create_thunk_fun(Code* code)
case
CT_SELECT_ADT
:
case
CT_SELECT_LIT
:
case
CT_SELECT_STR
:
case
CT_SELECT_REC
:
case
CT_IF
:
case
CT_LET
:
code
->
create_thunk
=
NULL
;
...
...
@@ -702,6 +703,28 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
abort
(
"no match"
);
}
case
CT_SELECT_REC
:
{
SelectEntry
*
select
=
(
SelectEntry
*
)
expr
;
push_a
(
NULL
);
exec
(
select
->
expr
,
frame_ptr
,
stack_top_a
);
Thunk
*
cons
=
pop_a
();
expr
=
select
->
bodies
[
0
];
if
(
expr
!=
NULL
)
{
for
(
int
i
=
0
;
i
<
cons
->
desc
->
arity
;
i
++
)
{
push_a
(
cons
->
_args
[
i
]);
}
continue
;
}
// This cannot happen in record field selection
abort
(
"no match"
);
}
case
CT_IF
:
{
placeholder
();
...
...
interpreter/code.h
View file @
7b630f28
...
...
@@ -19,6 +19,7 @@ enum CodeType {
CT_SELECT_ADT
,
CT_SELECT_LIT
,
CT_SELECT_STR
,
CT_SELECT_REC
,
// Record field selection
CT_IF
,
CT_LET
,
CT_THUNK
// constant, always fits the B stack
...
...
interpreter/parse.c
View file @
7b630f28
...
...
@@ -541,30 +541,48 @@ SelectEntry* parseSelect(char **ptr, Code* fallback, int fallback_nrargs) {
if
(
isADT
)
{
(
*
ptr
)
++
;
int
nrConses
=
1
;
ADTEntry
*
firstCase
=
(
ADTEntry
*
)
parseFunName
(
ptr
);
Code
*
firstBody
=
(
Code
*
)
parseSelectBody
(
ptr
,
child_fallback
,
child_fallback_base_nrargs
+
firstCase
->
base
.
arity
);
Desc
*
firstCase
=
(
Desc
*
)
parseFunName
(
ptr
);
entry
=
(
SelectEntry
*
)
alloc_code
(
sizeof
(
SelectEntry
)
+
sizeof
(
Code
*
)
*
firstCase
->
nrConses
);
entry
->
base
.
type
=
CT_SELECT_ADT
;
entry
->
base
.
nr_cases
=
firstCase
->
nrConses
;
// set the default case for all the entries
for
(
int
i
=
0
;
i
<
firstCase
->
nrConses
;
i
++
)
{
entry
->
bodies
[
i
]
=
defaultBody
;
if
(
firstCase
->
type
==
FT_ADT
)
{
nrConses
=
((
ADTEntry
*
)
firstCase
)
->
nrConses
;
}
if
(
isDefault
)
nrCases
--
;
Code
*
firstBody
=
(
Code
*
)
parseSelectBody
(
ptr
,
child_fallback
,
child_fallback_base_nrargs
+
firstCase
->
arity
);
nrCases
--
;
// firstCase
entry
->
bodies
[
firstCase
->
idx
]
=
firstBody
;
entry
=
(
SelectEntry
*
)
alloc_code
(
sizeof
(
SelectEntry
)
+
sizeof
(
Code
*
)
*
nrConses
);
for
(
int
i
=
0
;
i
<
nrCases
;
i
++
)
{
(
*
ptr
)
++
;
// skip type
ADTEntry
*
nextCase
=
(
ADTEntry
*
)
parseFunName
(
ptr
);
entry
->
bodies
[
nextCase
->
idx
]
=
(
Code
*
)
parseSelectBody
(
ptr
,
child_fallback
,
child_fallback_base_nrargs
+
nextCase
->
base
.
arity
);
if
(
firstCase
->
type
==
FT_ADT
)
{
entry
->
base
.
type
=
CT_SELECT_ADT
;
entry
->
base
.
nr_cases
=
nrConses
;
// set the default case for all the entries
for
(
int
i
=
0
;
i
<
nrConses
;
i
++
)
{
entry
->
bodies
[
i
]
=
defaultBody
;
}
if
(
isDefault
)
nrCases
--
;
nrCases
--
;
// firstCase
entry
->
bodies
[((
ADTEntry
*
)
firstCase
)
->
idx
]
=
firstBody
;
for
(
int
i
=
0
;
i
<
nrCases
;
i
++
)
{
(
*
ptr
)
++
;
// skip type
ADTEntry
*
nextCase
=
(
ADTEntry
*
)
parseFunName
(
ptr
);
entry
->
bodies
[
nextCase
->
idx
]
=
(
Code
*
)
parseSelectBody
(
ptr
,
child_fallback
,
child_fallback_base_nrargs
+
nextCase
->
base
.
arity
);
}
}
else
{
entry
->
base
.
type
=
CT_SELECT_REC
;
entry
->
base
.
nr_cases
=
1
;
entry
->
bodies
[
0
]
=
firstBody
;
}
}
else
...
...
tests/record_select.exp
0 → 100644
View file @
7b630f28
tests/record_select.sapl
0 → 100644
View file @
7b630f28
main = record.Start
record.Start = _Tuple2 (record.sel1 record.rec) (record.sel2 record.rec)
record.rec = record._R 9 "nine"
:: record._R = {record.f1::I, record.f2}
record.sel2 !_x_0 = select _x_0 (record._R f1_1_0 f2_1_1 -> f2_1_1)
record.sel1::I !_x_0 = select _x_0 (record._R f1_1_0 f2_1_1 -> f1_1_0)
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