From 22efb3d9c921970e94c195520222c4c2400df7a2 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Wed, 28 Aug 2024 18:00:35 +0200 Subject: [PATCH] ada.2: fix environments for closures --- impls/ada.2/Dockerfile | 2 +- impls/ada.2/envs.ads | 2 -- impls/ada.2/run | 2 +- impls/ada.2/step5_tco.adb | 11 +---------- impls/ada.2/step6_file.adb | 11 +---------- impls/ada.2/step7_quote.adb | 11 +---------- impls/ada.2/step8_macros.adb | 11 +---------- impls/ada.2/step9_try.adb | 16 ++-------------- impls/ada.2/stepa_mal.adb | 16 ++-------------- 9 files changed, 10 insertions(+), 72 deletions(-) diff --git a/impls/ada.2/Dockerfile b/impls/ada.2/Dockerfile index 8b6e8c793a..54cfbefb8a 100644 --- a/impls/ada.2/Dockerfile +++ b/impls/ada.2/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:20.04 +FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## diff --git a/impls/ada.2/envs.ads b/impls/ada.2/envs.ads index e9870e2eb0..aeeaa149eb 100644 --- a/impls/ada.2/envs.ads +++ b/impls/ada.2/envs.ads @@ -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; diff --git a/impls/ada.2/run b/impls/ada.2/run index 8ba68a5484..6efdc3de32 100755 --- a/impls/ada.2/run +++ b/impls/ada.2/run @@ -1,2 +1,2 @@ -#!/bin/bash +#!/bin/sh exec $(dirname $0)/${STEP:-stepA_mal} "${@}" diff --git a/impls/ada.2/step5_tco.adb b/impls/ada.2/step5_tco.adb index 18754079b8..52fc19f679 100644 --- a/impls/ada.2/step5_tco.adb +++ b/impls/ada.2/step5_tco.adb @@ -48,10 +48,6 @@ procedure Step5_Tco is -- optimization goes to <>. 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 <> @@ -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; diff --git a/impls/ada.2/step6_file.adb b/impls/ada.2/step6_file.adb index 45cce5d679..6fb5ef355e 100644 --- a/impls/ada.2/step6_file.adb +++ b/impls/ada.2/step6_file.adb @@ -52,10 +52,6 @@ procedure Step6_File is -- optimization goes to <>. 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 <> @@ -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; diff --git a/impls/ada.2/step7_quote.adb b/impls/ada.2/step7_quote.adb index dc134f13fc..10941a059a 100644 --- a/impls/ada.2/step7_quote.adb +++ b/impls/ada.2/step7_quote.adb @@ -54,10 +54,6 @@ procedure Step7_Quote is -- optimization goes to <>. 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 <> @@ -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; diff --git a/impls/ada.2/step8_macros.adb b/impls/ada.2/step8_macros.adb index 98c7e7022a..4b0633c4bb 100644 --- a/impls/ada.2/step8_macros.adb +++ b/impls/ada.2/step8_macros.adb @@ -54,10 +54,6 @@ procedure Step8_Macros is -- optimization goes to <>. 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 <> @@ -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; diff --git a/impls/ada.2/step9_try.adb b/impls/ada.2/step9_try.adb index 7ae8b4afcc..b6b2928287 100644 --- a/impls/ada.2/step9_try.adb +++ b/impls/ada.2/step9_try.adb @@ -54,10 +54,6 @@ procedure Step9_Try is -- optimization goes to <>. 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 <> @@ -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; diff --git a/impls/ada.2/stepa_mal.adb b/impls/ada.2/stepa_mal.adb index e790871c0f..620e0fa341 100644 --- a/impls/ada.2/stepa_mal.adb +++ b/impls/ada.2/stepa_mal.adb @@ -55,10 +55,6 @@ procedure StepA_Mal is -- optimization goes to <>. 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 <> @@ -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;