kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-08-16 17:20:23 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #407 from asarhaddon/ada.2-updates

Browse Source 
Test that macros use closures like functions. Fix ada.2 accordingly.
This commit is contained in:
Joel Martin 2019-07-08 09:50:11 -05:00 committed by GitHub
commit e118d60124
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
19 changed files with 96 additions and 131 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
ada.2/Makefile
View File

@ -45,7 +45,6 @@ TYPES := $(call sources,\
types-atoms \
types-builtins \
types-fns \
types-macros \
types-maps \
types-sequences \
types-strings \

10
ada.2/core.adb
View File

@ -178,8 +178,10 @@ package body Core is
return A1.Builtin_With_Meta.all.Meta;
when Kind_Builtin =>
return Types.Nil;
when Kind_Atom =>
return A1.Atom.all.Meta;
when others =>
Err.Raise_With ("expected a function, map or sequence");
Err.Raise_With ("expected an atom, function, map or sequence");
end case;
end;
end Meta;
@ -445,8 +447,10 @@ package body Core is
when Kind_Map =>
return A1.Map.all.With_Meta (A2);
when Kind_Fn =>
return Types.Fns.New_Function (A1.Fn.all.Params, A1.Fn.all.Ast,
A1.Fn.all.Env, A2);
return (Kind_Fn, Types.Fns.New_Function
(A1.Fn.all.Params, A1.Fn.all.Ast, A1.Fn.all.Env, A2));
when Kind_Atom =>
return A1.Atom.all.With_Meta (A2);
when others =>
Err.Raise_With
("parameter 1 must be a function, map or sequence");

5
ada.2/printer.adb
View File

@ -2,7 +2,6 @@ with Ada.Characters.Latin_1;
with Types.Atoms;
with Types.Fns;
with Types.Macros;
with Types.Maps;
pragma Warnings (Off, "unit ""Types.Sequences"" is not referenced");
with Types.Sequences;
@ -79,9 +78,9 @@ package body Printer is
Append (Buffer, '>');
when Kind_Macro =>
Append (Buffer, "#<macro (");
Print_List (Form_Ast.Macro.all.Params.all.Data);
Print_List (Form_Ast.Fn.all.Params.all.Data);
Append (Buffer, ") -> ");
Print_Form (Form_Ast.Macro.all.Ast);
Print_Form (Form_Ast.Fn.all.Ast);
Append (Buffer, '>');
when Kind_Atom =>
Append (Buffer, "(atom ");

4
ada.2/step4_if_fn_do.adb
View File

@ -135,10 +135,10 @@ procedure Step4_If_Fn_Do is
begin
Err.Check (Params.Kind in Types.Kind_Sequence,
"first argument of fn* must be a sequence");
return Types.Fns.New_Function
return (Kind_Fn, Types.Fns.New_Function
(Params => Params.Sequence,
Ast => Ast.Sequence.all.Data (3),
Env => Env);
Env => Env));
end;
else
First := Eval (First, Env);

5
ada.2/step5_tco.adb
View File

@ -141,6 +141,7 @@ procedure Step5_Tco is
for I in 2 .. Ast.Sequence.all.Length - 1 loop
Result := Eval (Ast.Sequence.all.Data (I), Env);
end loop;
pragma Unreferenced (Result);
end;
Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length);
goto Restart;
@ -152,10 +153,10 @@ procedure Step5_Tco is
Err.Check (Params.Kind in Types.Kind_Sequence,
"first argument of fn* must be a sequence");
Env_Reusable := False;
return Types.Fns.New_Function
return (Kind_Fn, Types.Fns.New_Function
(Params => Params.Sequence,
Ast => Ast.Sequence.all.Data (3),
Env => Env);
Env => Env));
end;
else
-- Equivalent to First := Eval (First, Env)

5
ada.2/step6_file.adb
View File

@ -145,6 +145,7 @@ procedure Step6_File is
for I in 2 .. Ast.Sequence.all.Length - 1 loop
Result := Eval (Ast.Sequence.all.Data (I), Env);
end loop;
pragma Unreferenced (Result);
end;
Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length);
goto Restart;
@ -156,10 +157,10 @@ procedure Step6_File is
Err.Check (Params.Kind in Types.Kind_Sequence,
"first argument of fn* must be a sequence");
Env_Reusable := False;
return Types.Fns.New_Function
return (Kind_Fn, Types.Fns.New_Function
(Params => Params.Sequence,
Ast => Ast.Sequence.all.Data (3),
Env => Env);
Env => Env));
end;
else
-- Equivalent to First := Eval (First, Env)

5
ada.2/step7_quote.adb
View File

@ -157,6 +157,7 @@ procedure Step7_Quote is
for I in 2 .. Ast.Sequence.all.Length - 1 loop
Result := Eval (Ast.Sequence.all.Data (I), Env);
end loop;
pragma Unreferenced (Result);
end;
Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length);
goto Restart;
@ -168,10 +169,10 @@ procedure Step7_Quote is
Err.Check (Params.Kind in Types.Kind_Sequence,
"first argument of fn* must be a sequence");
Env_Reusable := False;
return Types.Fns.New_Function
return (Kind_Fn, Types.Fns.New_Function
(Params => Params.Sequence,
Ast => Ast.Sequence.all.Data (3),
Env => Env);
Env => Env));
end;
elsif First.Str.all = "quasiquote" then
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");

32
ada.2/step8_macros.adb
View File

@ -11,7 +11,6 @@ with Printer;
with Reader;
with Readline;
with Types.Fns;
with Types.Macros;
with Types.Maps;
with Types.Sequences;
with Types.Strings;
@ -159,7 +158,10 @@ procedure Step8_Macros is
Val : Types.T;
begin
Err.Check (Fun.Kind = Kind_Fn, "expected a function");
Val := Types.Macros.New_Macro (Fun.Fn.all);
Val := (Kind_Macro, Types.Fns.New_Function
(Params => Fun.Fn.all.Params,
Ast => Fun.Fn.all.Ast,
Env => Fun.Fn.all.Env));
Env.all.Set (Key, Val); -- Check key kind.
return Val;
end;
@ -171,6 +173,7 @@ procedure Step8_Macros is
for I in 2 .. Ast.Sequence.all.Length - 1 loop
Result := Eval (Ast.Sequence.all.Data (I), Env);
end loop;
pragma Unreferenced (Result);
end;
Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length);
goto Restart;
@ -182,10 +185,10 @@ procedure Step8_Macros is
Err.Check (Params.Kind in Types.Kind_Sequence,
"first argument of fn* must be a sequence");
Env_Reusable := False;
return Types.Fns.New_Function
return (Kind_Fn, Types.Fns.New_Function
(Params => Params.Sequence,
Ast => Ast.Sequence.all.Data (3),
Env => Env);
Env => Env));
end;
elsif First.Str.all = "macroexpand" then
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
@ -220,27 +223,20 @@ procedure Step8_Macros is
if Macroexpanding then
-- Evaluate the macro with tail call optimization.
if not Env_Reusable then
Env := Envs.New_Env (Outer => Env);
Env := Envs.New_Env (Outer => First.Fn.all.Env);
Env_Reusable := True;
end if;
Env.all.Set_Binds
(Binds => First.Macro.all.Params.all.Data,
(Binds => First.Fn.all.Params.all.Data,
Exprs => Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length));
Ast := First.Macro.all.Ast;
Ast := First.Fn.all.Ast;
goto Restart;
else
-- Evaluate the macro normally.
declare
New_Env : constant Envs.Ptr := Envs.New_Env (Outer => Env);
begin
New_Env.all.Set_Binds
(Binds => First.Macro.all.Params.all.Data,
Exprs => Ast.Sequence.all.Data
(2 .. Ast.Sequence.all.Length));
Ast := Eval (First.Macro.all.Ast, New_Env);
-- Then evaluate the result with TCO.
goto Restart;
end;
Ast := First.Fn.all.Apply
(Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length));
-- Then evaluate the result with TCO.
goto Restart;
end if;
when Types.Kind_Function =>
null;

32
ada.2/step9_try.adb
View File

@ -11,7 +11,6 @@ with Printer;
with Reader;
with Readline;
with Types.Fns;
with Types.Macros;
with Types.Maps;
with Types.Sequences;
with Types.Strings;
@ -159,7 +158,10 @@ procedure Step9_Try is
Val : Types.T;
begin
Err.Check (Fun.Kind = Kind_Fn, "expected a function");
Val := Types.Macros.New_Macro (Fun.Fn.all);
Val := (Kind_Macro, Types.Fns.New_Function
(Params => Fun.Fn.all.Params,
Ast => Fun.Fn.all.Ast,
Env => Fun.Fn.all.Env));
Env.all.Set (Key, Val); -- Check key kind.
return Val;
end;
@ -171,6 +173,7 @@ procedure Step9_Try is
for I in 2 .. Ast.Sequence.all.Length - 1 loop
Result := Eval (Ast.Sequence.all.Data (I), Env);
end loop;
pragma Unreferenced (Result);
end;
Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length);
goto Restart;
@ -182,10 +185,10 @@ procedure Step9_Try is
Err.Check (Params.Kind in Types.Kind_Sequence,
"first argument of fn* must be a sequence");
Env_Reusable := False;
return Types.Fns.New_Function
return (Kind_Fn, Types.Fns.New_Function
(Params => Params.Sequence,
Ast => Ast.Sequence.all.Data (3),
Env => Env);
Env => Env));
end;
elsif First.Str.all = "macroexpand" then
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
@ -250,27 +253,20 @@ procedure Step9_Try is
if Macroexpanding then
-- Evaluate the macro with tail call optimization.
if not Env_Reusable then
Env := Envs.New_Env (Outer => Env);
Env := Envs.New_Env (Outer => First.Fn.all.Env);
Env_Reusable := True;
end if;
Env.all.Set_Binds
(Binds => First.Macro.all.Params.all.Data,
(Binds => First.Fn.all.Params.all.Data,
Exprs => Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length));
Ast := First.Macro.all.Ast;
Ast := First.Fn.all.Ast;
goto Restart;
else
-- Evaluate the macro normally.
declare
New_Env : constant Envs.Ptr := Envs.New_Env (Outer => Env);
begin
New_Env.all.Set_Binds
(Binds => First.Macro.all.Params.all.Data,
Exprs => Ast.Sequence.all.Data
(2 .. Ast.Sequence.all.Length));
Ast := Eval (First.Macro.all.Ast, New_Env);
-- Then evaluate the result with TCO.
goto Restart;
end;
Ast := First.Fn.all.Apply
(Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length));
-- Then evaluate the result with TCO.
goto Restart;
end if;
when Types.Kind_Function =>
null;

32
ada.2/stepa_mal.adb
View File

@ -12,7 +12,6 @@ with Reader;
with Readline;
with Types.Builtins;
with Types.Fns;
with Types.Macros;
with Types.Maps;
with Types.Sequences;
with Types.Strings;
@ -160,7 +159,10 @@ procedure StepA_Mal is
Val : Types.T;
begin
Err.Check (Fun.Kind = Kind_Fn, "expected a function");
Val := Types.Macros.New_Macro (Fun.Fn.all);
Val := (Kind_Macro, Types.Fns.New_Function
(Params => Fun.Fn.all.Params,
Ast => Fun.Fn.all.Ast,
Env => Fun.Fn.all.Env));
Env.all.Set (Key, Val); -- Check key kind.
return Val;
end;
@ -172,6 +174,7 @@ procedure StepA_Mal is
for I in 2 .. Ast.Sequence.all.Length - 1 loop
Result := Eval (Ast.Sequence.all.Data (I), Env);
end loop;
pragma Unreferenced (Result);
end;
Ast := Ast.Sequence.all.Data (Ast.Sequence.all.Length);
goto Restart;
@ -183,10 +186,10 @@ procedure StepA_Mal is
Err.Check (Params.Kind in Types.Kind_Sequence,
"first argument of fn* must be a sequence");
Env_Reusable := False;
return Types.Fns.New_Function
return (Kind_Fn, Types.Fns.New_Function
(Params => Params.Sequence,
Ast => Ast.Sequence.all.Data (3),
Env => Env);
Env => Env));
end;
elsif First.Str.all = "macroexpand" then
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
@ -251,27 +254,20 @@ procedure StepA_Mal is
if Macroexpanding then
-- Evaluate the macro with tail call optimization.
if not Env_Reusable then
Env := Envs.New_Env (Outer => Env);
Env := Envs.New_Env (Outer => First.Fn.all.Env);
Env_Reusable := True;
end if;
Env.all.Set_Binds
(Binds => First.Macro.all.Params.all.Data,
(Binds => First.Fn.all.Params.all.Data,
Exprs => Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length));
Ast := First.Macro.all.Ast;
Ast := First.Fn.all.Ast;
goto Restart;
else
-- Evaluate the macro normally.
declare
New_Env : constant Envs.Ptr := Envs.New_Env (Outer => Env);
begin
New_Env.all.Set_Binds
(Binds => First.Macro.all.Params.all.Data,
Exprs => Ast.Sequence.all.Data
(2 .. Ast.Sequence.all.Length));
Ast := Eval (First.Macro.all.Ast, New_Env);
-- Then evaluate the result with TCO.
goto Restart;
end;
Ast := First.Fn.all.Apply
(Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length));
-- Then evaluate the result with TCO.
goto Restart;
end if;
when Types.Kind_Function =>
null;

14
ada.2/types-atoms.adb
View File

@ -29,8 +29,12 @@ package body Types.Atoms is
procedure Keep_References (Object : in out Instance) is
begin
Keep (Object.Data);
Keep (Object.Meta);
end Keep_References;
function Meta (Item : in Instance) return T
is (Item.F_Meta);
function Reset (Args : in T_Array) return T is
begin
Err.Check (Args'Length = 2 and then Args (Args'First).Kind = Kind_Atom,
@ -62,4 +66,14 @@ package body Types.Atoms is
end;
end Swap;
function With_Meta (Item : in Instance;
Metadata : in T) return T is
Ref : constant Atom_Ptr := new Instance;
begin
Garbage_Collected.Register (Garbage_Collected.Pointer (Ref));
Ref.all.Data := Item.Data;
Ref.all.F_Meta := Metadata;
return (Kind_Atom, Ref);
end With_Meta;
end Types.Atoms;

5
ada.2/types-atoms.ads
View File

@ -13,10 +13,15 @@ package Types.Atoms is
-- Helper for print.
function Deref (Item : in Instance) return T with Inline;
function With_Meta (Item : in Instance;
Metadata : in T) return T;
function Meta (Item : in Instance) return T;
private
type Instance is new Garbage_Collected.Instance with record
Data : T;
F_Meta : T;
end record;
overriding procedure Keep_References (Object : in out Instance) with Inline;

4
ada.2/types-fns.adb
View File

@ -36,7 +36,7 @@ package body Types.Fns is
function New_Function (Params : in Sequence_Ptr;
Ast : in T;
Env : in Envs.Ptr;
Metadata : in T := Nil) return T
Metadata : in T := Nil) return Fn_Ptr
is
-- Env and Params are not null and require an immediate
-- initialization.
@ -50,7 +50,7 @@ package body Types.Fns is
Garbage_Collected.Register (Garbage_Collected.Pointer (Ref));
Err.Check ((for all P of Params.all.Data => P.Kind = Kind_Symbol),
"formal parameters must be symbols");
return (Kind_Fn, Ref);
return Ref;
end New_Function;
function Params (Item : in Instance) return Sequence_Ptr

2
ada.2/types-fns.ads
View File

@ -13,7 +13,7 @@ package Types.Fns is
function New_Function (Params : in Sequence_Ptr;
Ast : in T;
Env : in Envs.Ptr;
Metadata : in T := Nil) return T
Metadata : in T := Nil) return Fn_Ptr
with Inline;
-- Raise an exception if Params contains something else than symbols.

28
ada.2/types-macros.adb
View File

@ -1,28 +0,0 @@
pragma Warnings (Off, "unit ""Types.Sequences"" is not referenced");
with Types.Sequences;
pragma Warnings (On, "unit ""Types.Sequences"" is not referenced");
package body Types.Macros is
function Ast (Item : in Instance) return T
is (Item.F_Ast);
procedure Keep_References (Object : in out Instance) is
begin
Keep (Object.F_Ast);
Object.F_Params.all.Keep;
end Keep_References;
function New_Macro (Func : in Fns.Instance) return T is
-- Params is not null and requires an immediate initialization.
Ref : constant Macro_Ptr := new Instance'
(Garbage_Collected.Instance with Func.Ast, Func.Params);
begin
Garbage_Collected.Register (Garbage_Collected.Pointer (Ref));
return (Kind_Macro, Ref);
end New_Macro;
function Params (Item : in Instance) return Sequence_Ptr
is (Item.F_Params);
end Types.Macros;

22
ada.2/types-macros.ads
View File

@ -1,22 +0,0 @@
with Garbage_Collected;
with Types.Fns;
package Types.Macros is
type Instance (<>) is abstract new Garbage_Collected.Instance with private;
function New_Macro (Func : in Fns.Instance) return T with Inline;
function Ast (Item : in Instance) return T with Inline;
function Params (Item : in Instance) return Sequence_Ptr with Inline;
private
type Instance is new Garbage_Collected.Instance with record
F_Ast : T;
F_Params : Sequence_Ptr;
end record;
overriding procedure Keep_References (Object : in out Instance) with Inline;
end Types.Macros;

5
ada.2/types.adb
View File

@ -2,7 +2,6 @@ pragma Warnings (Off, "no entities of ""Types.*"" are referenced");
with Types.Atoms;
with Types.Builtins;
with Types.Fns;
with Types.Macros;
with Types.Maps;
with Types.Sequences;
pragma Warnings (On, "no entities of ""Types.*"" are referenced");
@ -51,10 +50,8 @@ package body Types is
Object.Map.all.Keep;
when Kind_Builtin_With_Meta =>
Object.Builtin_With_Meta.all.Keep;
when Kind_Fn =>
when Kind_Fn | Kind_Macro =>
Object.Fn.all.Keep;
when Kind_Macro =>
Object.Macro.all.Keep;
end case;
end Keep;

6
ada.2/types.ads
View File

@ -1,7 +1,6 @@
limited with Types.Atoms;
limited with Types.Builtins;
limited with Types.Fns;
limited with Types.Macros;
limited with Types.Maps;
limited with Types.Sequences;
limited with Types.Strings;
@ -49,7 +48,6 @@ package Types is
type Builtin_Ptr is not null access function (Args : in T_Array) return T;
type Builtin_With_Meta_Ptr is not null access Builtins.Instance;
type Fn_Ptr is not null access Fns.Instance;
type Macro_Ptr is not null access Macros.Instance;
type Map_Ptr is not null access Maps.Instance;
type Sequence_Ptr is not null access Sequences.Instance;
type String_Ptr is not null access Strings.Instance;
@ -74,10 +72,8 @@ package Types is
Builtin : Builtin_Ptr;
when Kind_Builtin_With_Meta =>
Builtin_With_Meta : Builtin_With_Meta_Ptr;
when Kind_Fn =>
when Kind_Fn | Kind_Macro =>
Fn : Fn_Ptr;
when Kind_Macro =>
Macro : Macro_Ptr;
end case;
end record;

10
tests/step8_macros.mal
View File

@ -148,3 +148,13 @@ x
(let* [x (or nil "yes")] x)
;=>"yes"
;>>> soft=True
;; Test that macros use closures
(def! x 2)
(defmacro! a (fn* [] x))
(a)
;=>2
(let* (x 3) (a))
;=>2