hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

revised the reader code according to the previous rame change

Browse Source
This commit is contained in:
hyung-hwan 2014-02-06 03:28:14 +00:00
parent 032dda2263
commit c0ff07698d
2 changed files with 20 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
lib/h2-scheme-execute.adb
View File

@ -669,7 +669,7 @@ Ada.Text_IO.Put_Line ("ERROR: PREMATURE LIST END");
end if; end if;
when Single_Quote_Token => when Single_Quote_Token =>
Push_Frame (Interp, Opcode_Close_Quote, Nil_Pointer); Push_Frame (Interp, Opcode_Close_Quote_In_List, Nil_Pointer);
Push_Frame (Interp, Opcode_Read_Object, Nil_Pointer); Push_Frame (Interp, Opcode_Read_Object, Nil_Pointer);
when Integer_Token => when Integer_Token =>
@ -726,7 +726,7 @@ Ada.Text_IO.Put_Line ("ERROR: PREMATURE LIST END");
when Single_Quote_Token => when Single_Quote_Token =>
Ada.Text_IO.Put_Line ("ERROR: CDR QUOT LIST END"); Ada.Text_IO.Put_Line ("ERROR: CDR QUOT LIST END");
Set_Frame_Opcode (Interp.Stack, Opcode_Read_List_End); Set_Frame_Opcode (Interp.Stack, Opcode_Read_List_End);
Push_Frame (Interp, Opcode_Close_Quote, Nil_Pointer); Push_Frame (Interp, Opcode_Close_Quote_In_List, Nil_Pointer);
Push_Frame (Interp, Opcode_Read_Object, Nil_Pointer); Push_Frame (Interp, Opcode_Read_Object, Nil_Pointer);
when Integer_Token => when Integer_Token =>
@ -779,7 +779,7 @@ Ada.Text_IO.Put_Line ("ERROR: CDR QUOT LIST END");
-- The first item in the chain is actually Cdr of the last cell. -- The first item in the chain is actually Cdr of the last cell.
V := Reverse_Cons(Get_Cdr(V), Get_Car(V)); V := Reverse_Cons(Get_Cdr(V), Get_Car(V));
Pop_Frame (Interp); Pop_Frame (Interp);
Set_Frame_Result (Interp.Stack, V); Chain_Frame_Intermediate (Interp, Interp.Stack, V);
when others => when others =>
Ada.Text_IO.Put_Line ("Right parenthesis expected"); Ada.Text_IO.Put_Line ("Right parenthesis expected");
raise Syntax_Error; raise Syntax_Error;
@ -796,6 +796,17 @@ Ada.Text_IO.Put_Line ("Right parenthesis expected");
Set_Frame_Result (Interp.Stack, Get_Car(V)); Set_Frame_Result (Interp.Stack, Get_Car(V));
end Close_List; end Close_List;
procedure Close_Quote_In_List is
pragma Inline (Close_Quote_In_List);
V: Object_Pointer;
begin
V := Get_Frame_Result(Interp.Stack);
V := Make_Cons(Interp.Self, V, Nil_Pointer);
V := Make_Cons(Interp.Self, Interp.Symbol.Quote, V);
Pop_Frame (Interp);
Chain_Frame_Intermediate (Interp, Interp.Stack, V);
end Close_Quote_In_List;
procedure Close_Quote is procedure Close_Quote is
pragma Inline (Close_Quote); pragma Inline (Close_Quote);
V: Object_Pointer; V: Object_Pointer;
@ -803,7 +814,7 @@ Ada.Text_IO.Put_Line ("Right parenthesis expected");
V := Get_Frame_Result(Interp.Stack); V := Get_Frame_Result(Interp.Stack);
V := Make_Cons(Interp.Self, V, Nil_Pointer); V := Make_Cons(Interp.Self, V, Nil_Pointer);
V := Make_Cons(Interp.Self, Interp.Symbol.Quote, V); V := Make_Cons(Interp.Self, Interp.Symbol.Quote, V);
Pop_Frame (Interp); -- Done with the current frame Pop_Frame (Interp);
Set_Frame_Result (Interp.Stack, V); Set_Frame_Result (Interp.Stack, V);
end Close_Quote; end Close_Quote;
@ -999,6 +1010,9 @@ ada.text_io.put_line (Opcode_Type'Image(Get_Frame_Opcode(Interp.Stack)));
when Opcode_Close_Quote => when Opcode_Close_Quote =>
Close_Quote; Close_Quote;
when Opcode_Close_Quote_In_List =>
Close_Quote_In_List;
end case; end case;
end loop; end loop;

3
lib/h2-scheme.adb
View File

@ -117,7 +117,8 @@ package body H2.Scheme is
Opcode_Read_List_Cdr, Opcode_Read_List_Cdr,
Opcode_Read_List_End, Opcode_Read_List_End,
Opcode_Close_List, Opcode_Close_List,
Opcode_Close_Quote Opcode_Close_Quote,
Opcode_Close_Quote_In_List
); );
for Opcode_Type'Size use Object_Integer'Size; for Opcode_Type'Size use Object_Integer'Size;