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

touched evaluator code

Browse Source
This commit is contained in:
hyung-hwan 2014-02-11 09:35:44 +00:00
parent cbf8d0e54e
commit 9a426594a3
4 changed files with 477 additions and 383 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

850
lib/h2-scheme-execute-evaluate.adb
View File

File diff suppressed because it is too large Load Diff

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

@ -80,7 +80,7 @@ procedure Execute (Interp: in out Interpreter_Record) is
if Is_Cons(O) then if Is_Cons(O) then
Reload_Frame (Interp, Opcode_Grouped_Call, O); Reload_Frame (Interp, Opcode_Grouped_Call, O);
else else
Pop_Frame (Interp); Pop_Frame (Interp); -- no <expression> to evaluate
end if; end if;
else else
O := Get_Cdr(O); -- next <clause> list O := Get_Cdr(O); -- next <clause> list
@ -96,7 +96,7 @@ procedure Execute (Interp: in out Interpreter_Record) is
if Is_Cons(O) then if Is_Cons(O) then
Reload_Frame (Interp, Opcode_Grouped_Call, O); Reload_Frame (Interp, Opcode_Grouped_Call, O);
else else
Pop_Frame (Interp); Pop_Frame (Interp); -- no <expression> to evaluate
end if; end if;
else else
Switch_Frame (Interp.Stack, Opcode_Evaluate_Object, Get_Car(R), Nil_Pointer); Switch_Frame (Interp.Stack, Opcode_Evaluate_Object, Get_Car(R), Nil_Pointer);

1
lib/h2-scheme.adb
View File

@ -1863,6 +1863,7 @@ end if;
Interp.Self := Aliased_Interp'Unchecked_Access; Interp.Self := Aliased_Interp'Unchecked_Access;
end; end;
Interp.State := 0;
Interp.Storage_Pool := Storage_Pool; Interp.Storage_Pool := Storage_Pool;
Interp.Symbol_Table := Nil_Pointer; Interp.Symbol_Table := Nil_Pointer;

5
lib/h2-scheme.ads
View File

@ -163,6 +163,7 @@ package H2.Scheme is
-- represents the value that can be stored in this field. -- represents the value that can be stored in this field.
type Object_Flags is mod 2 ** 4; type Object_Flags is mod 2 ** 4;
Syntax_Object: constant Object_Flags := Object_Flags'(2#0001#); Syntax_Object: constant Object_Flags := Object_Flags'(2#0001#);
Syntax_Checked: constant Object_Flags := Object_Flags'(2#0010#);
type Syntax_Code is ( type Syntax_Code is (
And_Syntax, And_Syntax,
@ -503,9 +504,13 @@ private
Data: Top_Array(1 .. 100) := (others => null); Data: Top_Array(1 .. 100) := (others => null);
end record; end record;
type Interpreter_State is mod 2 ** 4;
Force_Syntax_Check: constant Interpreter_State := Interpreter_State'(2#0001#);
--type Interpreter_Record is tagged limited record --type Interpreter_Record is tagged limited record
type Interpreter_Record is limited record type Interpreter_Record is limited record
Self: Interpreter_Pointer := Interpreter_Record'Unchecked_Access; -- Current instance's pointer Self: Interpreter_Pointer := Interpreter_Record'Unchecked_Access; -- Current instance's pointer
State: Interpreter_State := 0; -- Internal housekeeping state
Storage_Pool: Storage_Pool_Pointer := null; Storage_Pool: Storage_Pool_Pointer := null;
Trait: Option_Record(Trait_Option); Trait: Option_Record(Trait_Option);