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

fixed a bug of not reversing binding values in handling 'let'

Browse Source
This commit is contained in:
hyung-hwan 2014-01-23 15:34:06 +00:00
parent 99c7c03d14
commit acad93d2cf
1 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -152,20 +152,29 @@ procedure Execute (Interp: in out Interpreter_Record) is
pragma Assert (Get_Cdr(Y) = Nil_Pointer); -- ensure only 1 return value pragma Assert (Get_Cdr(Y) = Nil_Pointer); -- ensure only 1 return value
Y := Get_Car(Y); -- the first value Y := Get_Car(Y); -- the first value
Pop_Frame (Interp); pragma Assert (Interp.Environment = Get_Frame_Environment(Interp.Stack));
if Y = False_Pointer then if Y = False_Pointer then
-- <test> evaluated to #f. -- <test> evaluated to #f.
X := Get_Cdr(X); -- cons cell containing <alternate> X := Get_Cdr(X); -- cons cell containing <alternate>
if Is_Cons(X) then if Is_Cons(X) then
-- evaluate <alternate> -- Switch the current current to evaluate <alternate>
Push_Frame (Interp, Opcode_Evaluate_Object, Get_Car(X)); -- Keep the environment untouched.
Set_Frame_Opcode (Interp.Stack, Opcode_Evaluate_Object);
Set_Frame_Operand (Interp.Stack, Get_Car(X));
Clear_Frame_Result (Interp.Stack);
else else
-- return nil if no <alternate> is specified Pop_Frame (Interp);
-- Return nil if no <alternate> is specified
Chain_Frame_Result (Interp, Interp.Stack, Nil_Pointer); Chain_Frame_Result (Interp, Interp.Stack, Nil_Pointer);
end if; end if;
else else
-- all values except #f are true values. evaluate <consequent> -- All values except #f are true values. evaluate <consequent>
Push_Frame (Interp, Opcode_Evaluate_Object, Get_Car(X)); -- Switch the current current to evaluate <consequent>
-- Keep the environment untouched.
Set_Frame_Opcode (Interp.Stack, Opcode_Evaluate_Object);
Set_Frame_Operand (Interp.Stack, Get_Car(X));
Clear_Frame_Result (Interp.Stack);
end if; end if;
Pop_Tops (Interp, 2); Pop_Tops (Interp, 2);
@ -204,7 +213,7 @@ procedure Execute (Interp: in out Interpreter_Record) is
Push_Top (Interp, Y'Unchecked_Access); Push_Top (Interp, Y'Unchecked_Access);
X := Get_Frame_Operand(Interp.Stack); -- <bindings> and onward X := Get_Frame_Operand(Interp.Stack); -- <bindings> and onward
Y := Get_Frame_Result(Interp.Stack); Y := Reverse_Cons(Get_Frame_Result(Interp.Stack));
pragma Assert (Interp.Environment = Get_Frame_Environment(Interp.Stack)); pragma Assert (Interp.Environment = Get_Frame_Environment(Interp.Stack));