Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
curry
pakcs
Commits
e4046422
Commit
e4046422
authored
Jan 30, 2020
by
Michael Hanus
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Improve printing w.r.t. class dictionaries, example corrected
parent
4eae8c87
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
22 additions
and
14 deletions
+22
-14
examples/assembler.curry
examples/assembler.curry
+11
-9
src/evaluator.pl
src/evaluator.pl
+11
-5
No files found.
examples/assembler.curry
View file @
e4046422
--
a
one-pass assembler:
--
A
one-pass assembler:
-- translate arbitrary `Jump` instructions into machine code
-- use logical variables to resolve forward jump addresses
{-# OPTIONS_CYMAKE -Wno-overlapping #-}
-- we consider only two assembler instructions: jumps and labels
data Instruction = Jump LabelId | Label LabelId
deriving Eq
...
...
@@ -17,7 +19,7 @@ type SymTab = [(LabelId,Int)]
assembler :: [Instruction] -> SymTab -> Int -> [Int]
assembler [] _ _ = []
assembler (Jump l : ins) st a
| lookupST l st label st1 = 9
:
label
:
assembler ins st1 (a+2)
| lookupST l st label st1 = 9
:
label
:
assembler ins st1 (a+2)
where label,st1 free
assembler (Label l : ins) st a
| st1 =:= insertST l a st = assembler ins st1 a
...
...
@@ -26,19 +28,19 @@ assembler (Label l : ins) st a
-- insert an address of a labelid in a symboltable:
insertST :: LabelId -> Int -> SymTab -> SymTab
insertST l a [] = [(l,a)]
insertST l a ((l1,a1):st) | l==l1 && a==a1 = (l1,a1) : st
insertST l a ((l1,a1):st) | l/=l1 = (l1,a1) : (insertST l a st)
insertST l a ((l1,a1):st) | l=
:
=l1 && a=
:
=a1 = (l1,a1) : st
insertST l a ((l1,a1):st) | l/=l1
= (l1,a1) : (insertST l a st)
-- lookup an address of a labelid in a symboltable:
lookupST :: LabelId -> SymTab -> Int -> SymTab -> Bool
lookupST l [] a st1
= st1=:=[(l,a)]
lookupST l []
a st1 = st1
=:=
[(l,a)]
lookupST l ((l1,a1):st) a st1 =
if l==l1 then a=:=a1 & st1=:=(l1,a1):st
else
let st2 free in
lookupST l st a st2 & st1=:=(l1,a1):st2
if l==l1 then a
=:=
a1 & st1
=:=
(l1,a1):st
else lookupST l st a st2 & st1
=:=
(l1,a1):st2
where st2 free
-- Example evaluation:
main :: [Int]
main = assembler [Label L0, Jump L1, Jump L0, Label L1] [] 0
-----> Result: [9,4,9,0]
src/evaluator.pl
View file @
e4046422
...
...
@@ -507,7 +507,8 @@ writeCurryD(S,D,_,T) :-
write
(
S
,
')'
).
writeCurryD
(
S
,
D
,
Nested
,
T
)
:-
D1
is
D
-
1
,
T
=..
[
IntCons
,
Arg1
,
Arg2
],
T
=..
[
IntCons
|
Args
],
omitClassDicts
(
Args
,[
Arg1
,
Arg2
]),
revTransFunctor
(
IntCons
,
Cons
),
\
+
isId
(
Cons
),
% write as an infix operator:
!,
...
...
@@ -521,12 +522,17 @@ writeCurryD(S,D,Nested,T) :-
T
=..
[
IntCons
|
Args
],
revTransFunctor
(
IntCons
,
Cons
),
(
Nested
=
nested
->
write
(
S
,
'('
)
;
true
),
write
(
S
,
Cons
),
writeCurryArgs
(
S
,
D1
,
Nested
,
Args
).
(
isId
(
Cons
)
->
write
(
S
,
Cons
)
;
write
(
S
,
'('
),
write
(
S
,
Cons
),
write
(
S
,
')'
)),
omitClassDicts
(
Args
,
RArgs
),
writeCurryArgs
(
S
,
D1
,
Nested
,
RArgs
).
% omit class dictionary arguments
omitClassDicts
([],[]).
omitClassDicts
([
A
|
As
],
Bs
)
:-
isInstDict
(
A
),
!,
omitClassDicts
(
As
,
Bs
).
omitClassDicts
([
A
|
As
],[
A
|
Bs
])
:-
omitClassDicts
(
As
,
Bs
).
writeCurryArgs
(
S
,
_
,
Nested
,[])
:-
(
Nested
=
nested
->
write
(
S
,
')'
)
;
true
).
writeCurryArgs
(
S
,
D
,
Nested
,[
A
|
As
])
:-
isInstDict
(
A
),
!,
% omit class dicts
writeCurryArgs
(
S
,
D
,
Nested
,
As
).
writeCurryArgs
(
S
,
D
,
Nested
,[
A
|
As
])
:-
write
(
S
,
' '
),
writeCurryD
(
S
,
D
,
nested
,
A
),
...
...
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