kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-11-11 00:52:44 +03:00
Code Issues Projects Releases Wiki Activity

ada.2: fix environments for closures

Browse Source
This commit is contained in:
Nicolas Boulenguez 2024-08-28 18:00:35 +02:00 committed by Joel Martin
parent a645b468f8
commit 454d635109
9 changed files with 10 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
impls/ada.2/Dockerfile
View File

@ -1,4 +1,4 @@
FROM ubuntu:20.04
FROM ubuntu:24.04
MAINTAINER Joel Martin <github@martintribe.org>
##########################################################

2
impls/ada.2/envs.ads
View File

@ -14,8 +14,6 @@ package Envs is
subtype Ptr is not null Link;
function New_Env (Outer : in Link := null) return Ptr with Inline;
-- Set_Binds is provided as distinct subprograms because we some
-- time spare the creation of a subenvironment.
procedure Set_Binds (Env : in out Instance;
Binds : in Types.T_Array;

2
impls/ada.2/run
View File

@ -1,2 +1,2 @@
#!/bin/bash
#!/bin/sh
exec $(dirname $0)/${STEP:-stepA_mal} "${@}"

11
impls/ada.2/step5_tco.adb
View File

@ -48,10 +48,6 @@ procedure Step5_Tco is
-- optimization goes to <<Restart>>.
Ast : Types.T := Ast0;
Env : Envs.Ptr := Env0;
Env_Reusable : Boolean := False;
-- True when the environment has been created in this recursion
-- level, and has not yet been referenced by a closure. If so,
-- we can reuse it instead of creating a subenvironment.
First : Types.T;
begin
<<Restart>>
@ -106,10 +102,7 @@ procedure Step5_Tco is
renames Ast.Sequence.all.Data (2).Sequence.all.Data;
begin
Err.Check (Bindings'Length mod 2 = 0, "expected even binds");
if not Env_Reusable then
Env := Envs.New_Env (Outer => Env);
Env_Reusable := True;
end if;
Env := Envs.New_Env (Outer => Env);
for I in 0 .. Bindings'Length / 2 - 1 loop
Env.all.Set (Bindings (Bindings'First + 2 * I),
Eval (Bindings (Bindings'First + 2 * I + 1), Env));
@ -146,7 +139,6 @@ procedure Step5_Tco is
begin
Err.Check (Params.Kind in Types.Kind_Sequence,
"first argument of fn* must be a sequence");
Env_Reusable := False;
return (Kind_Fn, Types.Fns.New_Function
(Params => Params.Sequence,
Ast => Ast.Sequence.all.Data (3),
@ -185,7 +177,6 @@ procedure Step5_Tco is
end if;
-- Like Types.Fns.Apply, except that we use TCO.
Env := Envs.New_Env (Outer => First.Fn.all.Env);
Env_Reusable := True;
Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data,
Exprs => Args);
Ast := First.Fn.all.Ast;

11
impls/ada.2/step6_file.adb
View File

@ -52,10 +52,6 @@ procedure Step6_File is
-- optimization goes to <<Restart>>.
Ast : Types.T := Ast0;
Env : Envs.Ptr := Env0;
Env_Reusable : Boolean := False;
-- True when the environment has been created in this recursion
-- level, and has not yet been referenced by a closure. If so,
-- we can reuse it instead of creating a subenvironment.
First : Types.T;
begin
<<Restart>>
@ -110,10 +106,7 @@ procedure Step6_File is
renames Ast.Sequence.all.Data (2).Sequence.all.Data;
begin
Err.Check (Bindings'Length mod 2 = 0, "expected even binds");
if not Env_Reusable then
Env := Envs.New_Env (Outer => Env);
Env_Reusable := True;
end if;
Env := Envs.New_Env (Outer => Env);
for I in 0 .. Bindings'Length / 2 - 1 loop
Env.all.Set (Bindings (Bindings'First + 2 * I),
Eval (Bindings (Bindings'First + 2 * I + 1), Env));
@ -150,7 +143,6 @@ procedure Step6_File is
begin
Err.Check (Params.Kind in Types.Kind_Sequence,
"first argument of fn* must be a sequence");
Env_Reusable := False;
return (Kind_Fn, Types.Fns.New_Function
(Params => Params.Sequence,
Ast => Ast.Sequence.all.Data (3),
@ -189,7 +181,6 @@ procedure Step6_File is
end if;
-- Like Types.Fns.Apply, except that we use TCO.
Env := Envs.New_Env (Outer => First.Fn.all.Env);
Env_Reusable := True;
Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data,
Exprs => Args);
Ast := First.Fn.all.Ast;

11
impls/ada.2/step7_quote.adb
View File

@ -54,10 +54,6 @@ procedure Step7_Quote is
-- optimization goes to <<Restart>>.
Ast : Types.T := Ast0;
Env : Envs.Ptr := Env0;
Env_Reusable : Boolean := False;
-- True when the environment has been created in this recursion
-- level, and has not yet been referenced by a closure. If so,
-- we can reuse it instead of creating a subenvironment.
First : Types.T;
begin
<<Restart>>
@ -112,10 +108,7 @@ procedure Step7_Quote is
renames Ast.Sequence.all.Data (2).Sequence.all.Data;
begin
Err.Check (Bindings'Length mod 2 = 0, "expected even binds");
if not Env_Reusable then
Env := Envs.New_Env (Outer => Env);
Env_Reusable := True;
end if;
Env := Envs.New_Env (Outer => Env);
for I in 0 .. Bindings'Length / 2 - 1 loop
Env.all.Set (Bindings (Bindings'First + 2 * I),
Eval (Bindings (Bindings'First + 2 * I + 1), Env));
@ -155,7 +148,6 @@ procedure Step7_Quote is
begin
Err.Check (Params.Kind in Types.Kind_Sequence,
"first argument of fn* must be a sequence");
Env_Reusable := False;
return (Kind_Fn, Types.Fns.New_Function
(Params => Params.Sequence,
Ast => Ast.Sequence.all.Data (3),
@ -198,7 +190,6 @@ procedure Step7_Quote is
end if;
-- Like Types.Fns.Apply, except that we use TCO.
Env := Envs.New_Env (Outer => First.Fn.all.Env);
Env_Reusable := True;
Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data,
Exprs => Args);
Ast := First.Fn.all.Ast;

11
impls/ada.2/step8_macros.adb
View File

@ -54,10 +54,6 @@ procedure Step8_Macros is
-- optimization goes to <<Restart>>.
Ast : Types.T := Ast0;
Env : Envs.Ptr := Env0;
Env_Reusable : Boolean := False;
-- True when the environment has been created in this recursion
-- level, and has not yet been referenced by a closure. If so,
-- we can reuse it instead of creating a subenvironment.
First : Types.T;
begin
<<Restart>>
@ -112,10 +108,7 @@ procedure Step8_Macros is
renames Ast.Sequence.all.Data (2).Sequence.all.Data;
begin
Err.Check (Bindings'Length mod 2 = 0, "expected even binds");
if not Env_Reusable then
Env := Envs.New_Env (Outer => Env);
Env_Reusable := True;
end if;
Env := Envs.New_Env (Outer => Env);
for I in 0 .. Bindings'Length / 2 - 1 loop
Env.all.Set (Bindings (Bindings'First + 2 * I),
Eval (Bindings (Bindings'First + 2 * I + 1), Env));
@ -170,7 +163,6 @@ procedure Step8_Macros is
begin
Err.Check (Params.Kind in Types.Kind_Sequence,
"first argument of fn* must be a sequence");
Env_Reusable := False;
return (Kind_Fn, Types.Fns.New_Function
(Params => Params.Sequence,
Ast => Ast.Sequence.all.Data (3),
@ -223,7 +215,6 @@ procedure Step8_Macros is
end if;
-- Like Types.Fns.Apply, except that we use TCO.
Env := Envs.New_Env (Outer => First.Fn.all.Env);
Env_Reusable := True;
Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data,
Exprs => Args);
Ast := First.Fn.all.Ast;

16
impls/ada.2/step9_try.adb
View File

@ -54,10 +54,6 @@ procedure Step9_Try is
-- optimization goes to <<Restart>>.
Ast : Types.T := Ast0;
Env : Envs.Ptr := Env0;
Env_Reusable : Boolean := False;
-- True when the environment has been created in this recursion
-- level, and has not yet been referenced by a closure. If so,
-- we can reuse it instead of creating a subenvironment.
First : Types.T;
begin
<<Restart>>
@ -112,10 +108,7 @@ procedure Step9_Try is
renames Ast.Sequence.all.Data (2).Sequence.all.Data;
begin
Err.Check (Bindings'Length mod 2 = 0, "expected even binds");
if not Env_Reusable then
Env := Envs.New_Env (Outer => Env);
Env_Reusable := True;
end if;
Env := Envs.New_Env (Outer => Env);
for I in 0 .. Bindings'Length / 2 - 1 loop
Env.all.Set (Bindings (Bindings'First + 2 * I),
Eval (Bindings (Bindings'First + 2 * I + 1), Env));
@ -170,7 +163,6 @@ procedure Step9_Try is
begin
Err.Check (Params.Kind in Types.Kind_Sequence,
"first argument of fn* must be a sequence");
Env_Reusable := False;
return (Kind_Fn, Types.Fns.New_Function
(Params => Params.Sequence,
Ast => Ast.Sequence.all.Data (3),
@ -202,10 +194,7 @@ procedure Step9_Try is
when Err.Error =>
null;
end;
if not Env_Reusable then
Env := Envs.New_Env (Outer => Env);
Env_Reusable := True;
end if;
Env := Envs.New_Env (Outer => Env);
Env.all.Set (A3 (A3'First + 1), Err.Data); -- check key kind
Ast := A3 (A3'Last);
goto Restart;
@ -253,7 +242,6 @@ procedure Step9_Try is
end if;
-- Like Types.Fns.Apply, except that we use TCO.
Env := Envs.New_Env (Outer => First.Fn.all.Env);
Env_Reusable := True;
Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data,
Exprs => Args);
Ast := First.Fn.all.Ast;

16
impls/ada.2/stepa_mal.adb
View File

@ -55,10 +55,6 @@ procedure StepA_Mal is
-- optimization goes to <<Restart>>.
Ast : Types.T := Ast0;
Env : Envs.Ptr := Env0;
Env_Reusable : Boolean := False;
-- True when the environment has been created in this recursion
-- level, and has not yet been referenced by a closure. If so,
-- we can reuse it instead of creating a subenvironment.
First : Types.T;
begin
<<Restart>>
@ -113,10 +109,7 @@ procedure StepA_Mal is
renames Ast.Sequence.all.Data (2).Sequence.all.Data;
begin
Err.Check (Bindings'Length mod 2 = 0, "expected even binds");
if not Env_Reusable then
Env := Envs.New_Env (Outer => Env);
Env_Reusable := True;
end if;
Env := Envs.New_Env (Outer => Env);
for I in 0 .. Bindings'Length / 2 - 1 loop
Env.all.Set (Bindings (Bindings'First + 2 * I),
Eval (Bindings (Bindings'First + 2 * I + 1), Env));
@ -171,7 +164,6 @@ procedure StepA_Mal is
begin
Err.Check (Params.Kind in Types.Kind_Sequence,
"first argument of fn* must be a sequence");
Env_Reusable := False;
return (Kind_Fn, Types.Fns.New_Function
(Params => Params.Sequence,
Ast => Ast.Sequence.all.Data (3),
@ -203,10 +195,7 @@ procedure StepA_Mal is
when Err.Error =>
null;
end;
if not Env_Reusable then
Env := Envs.New_Env (Outer => Env);
Env_Reusable := True;
end if;
Env := Envs.New_Env (Outer => Env);
Env.all.Set (A3 (A3'First + 1), Err.Data); -- check key kind
Ast := A3 (A3'Last);
goto Restart;
@ -259,7 +248,6 @@ procedure StepA_Mal is
end case;
-- Like Types.Fns.Apply, except that we use TCO.
Env := Envs.New_Env (Outer => First.Fn.all.Env);
Env_Reusable := True;
Env.all.Set_Binds (Binds => First.Fn.all.Params.all.Data,
Exprs => Args);
Ast := First.Fn.all.Ast;