Commit e4046422 authored by Michael Hanus 's avatar Michael Hanus

Improve printing w.r.t. class dictionaries, example corrected

parent 4eae8c87
-- 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]
......@@ -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),
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment