diff --git a/README.md b/README.md index 66ebee3e..c81856fe 100644 --- a/README.md +++ b/README.md @@ -63,7 +63,7 @@ | [Perl 6](#perl-6) | [Hinrik Örn Sigurðsson](https://github.com/hinrik) | | [PHP](#php-53) | [Joel Martin](https://github.com/kanaka) | | [Picolisp](#picolisp) | [Vasilij Schneidermann](https://github.com/wasamasa) | -| [PL/pgSQL](#plpgsql-postgres-sql-procedural-language) (Postgres) | [Joel Martin](https://github.com/kanaka) | +| [PL/pgSQL](#plpgsql-postgresql-sql-procedural-language) (PostgreSQL) | [Joel Martin](https://github.com/kanaka) | | [PL/SQL](#plsql-oracle-sql-procedural-language) (Oracle) | [Joel Martin](https://github.com/kanaka) | | [PostScript](#postscript-level-23) | [Joel Martin](https://github.com/kanaka) | | [PowerShell](#powershell) | [Joel Martin](https://github.com/kanaka) | @@ -118,7 +118,7 @@ Here is the final diagram for [step A](process/guide.md#stepA): ![stepA_mal architecture](process/stepA_mal.png) -If you are interesting in creating a mal implementation (or just +If you are interested in creating a mal implementation (or just interested in using mal for something), please drop by the #mal channel on freenode. In addition to the [make-a-lisp process guide](process/guide.md) there is also a [mal/make-a-lisp @@ -782,17 +782,17 @@ cd picolisp ./run ``` -### PL/pgSQL (Postgres SQL Procedural Language) +### PL/pgSQL (PostgreSQL SQL Procedural Language) -The PL/pgSQL implementation of mal requires a running Postgres server +The PL/pgSQL implementation of mal requires a running PostgreSQL server (the "kanaka/mal-test-plpgsql" docker image automatically starts -a Postgres server). The implementation connects to the Postgres server +a PostgreSQL server). The implementation connects to the PostgreSQL server and create a database named "mal" to store tables and stored procedures. The wrapper script uses the psql command to connect to the server and defaults to the user "postgres" but this can be overridden with the PSQL_USER environment variable. A password can be specified using the PGPASSWORD environment variable. The implementation has been -tested with Postgres 9.4. +tested with PostgreSQL 9.4. ``` cd plpgsql @@ -803,14 +803,14 @@ PSQL_USER=myuser PGPASSWORD=mypass ./wrap.sh stepX_YYY.sql ### PL/SQL (Oracle SQL Procedural Language) -The PL/pgSQL implementation of mal requires a running Oracle DB +The PL/SQL implementation of mal requires a running Oracle DB server (the "kanaka/mal-test-plsql" docker image automatically starts an Oracle Express server). The implementation connects to the Oracle server to create types, tables and stored procedures. The -default SQL*Plus logon value (username/password@connect_identifier) is +default SQL\*Plus logon value (username/password@connect_identifier) is "system/oracle" but this can be overridden with the ORACLE_LOGON environment variable. The implementation has been tested with Oracle -Express Edition 11g Release 2. Note that any SQL*Plus connection +Express Edition 11g Release 2. Note that any SQL\*Plus connection warnings (user password expiration, etc) will interfere with the ability of the wrapper script to communicate with the DB. @@ -821,10 +821,10 @@ cd plsql ORACLE_LOGON=myuser/mypass@ORCL ./wrap.sh stepX_YYY.sql ``` -### Postscript Level 2/3 +### PostScript Level 2/3 -The Postscript implementation of mal requires ghostscript to run. It -has been tested with ghostscript 9.10. +The PostScript implementation of mal requires Ghostscript to run. It +has been tested with Ghostscript 9.10. ``` cd ps diff --git a/ada.2/Makefile b/ada.2/Makefile index 6fa626ce..2b17dda6 100644 --- a/ada.2/Makefile +++ b/ada.2/Makefile @@ -45,7 +45,6 @@ TYPES := $(call sources,\ types-atoms \ types-builtins \ types-fns \ - types-macros \ types-maps \ types-sequences \ types-strings \ diff --git a/ada.2/core.adb b/ada.2/core.adb index d1539b42..a9814c7d 100644 --- a/ada.2/core.adb +++ b/ada.2/core.adb @@ -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"); diff --git a/ada.2/printer.adb b/ada.2/printer.adb index 48a708a9..0891cd74 100644 --- a/ada.2/printer.adb +++ b/ada.2/printer.adb @@ -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, "# "); - Print_Form (Form_Ast.Macro.all.Ast); + Print_Form (Form_Ast.Fn.all.Ast); Append (Buffer, '>'); when Kind_Atom => Append (Buffer, "(atom "); diff --git a/ada.2/step4_if_fn_do.adb b/ada.2/step4_if_fn_do.adb index 08ab35b8..687e1c2e 100644 --- a/ada.2/step4_if_fn_do.adb +++ b/ada.2/step4_if_fn_do.adb @@ -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); diff --git a/ada.2/step5_tco.adb b/ada.2/step5_tco.adb index d48afa38..b69dbe38 100644 --- a/ada.2/step5_tco.adb +++ b/ada.2/step5_tco.adb @@ -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) diff --git a/ada.2/step6_file.adb b/ada.2/step6_file.adb index 8195d6fc..d10488af 100644 --- a/ada.2/step6_file.adb +++ b/ada.2/step6_file.adb @@ -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) diff --git a/ada.2/step7_quote.adb b/ada.2/step7_quote.adb index 70bfb925..d3f6d5c5 100644 --- a/ada.2/step7_quote.adb +++ b/ada.2/step7_quote.adb @@ -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"); diff --git a/ada.2/step8_macros.adb b/ada.2/step8_macros.adb index f67e0865..3786b8ed 100644 --- a/ada.2/step8_macros.adb +++ b/ada.2/step8_macros.adb @@ -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; diff --git a/ada.2/step9_try.adb b/ada.2/step9_try.adb index fe8d26db..bc26dd0f 100644 --- a/ada.2/step9_try.adb +++ b/ada.2/step9_try.adb @@ -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; diff --git a/ada.2/stepa_mal.adb b/ada.2/stepa_mal.adb index 2217f7b8..0c665904 100644 --- a/ada.2/stepa_mal.adb +++ b/ada.2/stepa_mal.adb @@ -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; diff --git a/ada.2/types-atoms.adb b/ada.2/types-atoms.adb index 766a1f18..fd3d4b30 100644 --- a/ada.2/types-atoms.adb +++ b/ada.2/types-atoms.adb @@ -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; diff --git a/ada.2/types-atoms.ads b/ada.2/types-atoms.ads index 8764ad44..86571f8e 100644 --- a/ada.2/types-atoms.ads +++ b/ada.2/types-atoms.ads @@ -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; diff --git a/ada.2/types-fns.adb b/ada.2/types-fns.adb index edffd320..6deb6e06 100644 --- a/ada.2/types-fns.adb +++ b/ada.2/types-fns.adb @@ -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 diff --git a/ada.2/types-fns.ads b/ada.2/types-fns.ads index 77f9b8a4..7a0b8f56 100644 --- a/ada.2/types-fns.ads +++ b/ada.2/types-fns.ads @@ -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. diff --git a/ada.2/types-macros.adb b/ada.2/types-macros.adb deleted file mode 100644 index 6e3ddd08..00000000 --- a/ada.2/types-macros.adb +++ /dev/null @@ -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; diff --git a/ada.2/types-macros.ads b/ada.2/types-macros.ads deleted file mode 100644 index be3a3763..00000000 --- a/ada.2/types-macros.ads +++ /dev/null @@ -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; diff --git a/ada.2/types.adb b/ada.2/types.adb index 96ca3ef4..6b0ebf0a 100644 --- a/ada.2/types.adb +++ b/ada.2/types.adb @@ -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; diff --git a/ada.2/types.ads b/ada.2/types.ads index 6dd0b71d..011288b6 100644 --- a/ada.2/types.ads +++ b/ada.2/types.ads @@ -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; diff --git a/basic/reader.in.bas b/basic/reader.in.bas index 24826461..53019041 100644 --- a/basic/reader.in.bas +++ b/basic/reader.in.bas @@ -167,12 +167,27 @@ SUB READ_FORM REM PRINT "READ_STRING" C=ASC(MID$(T$,LEN(T$),1)) IF C<>34 THEN R=-1:ER=-1:E$="expected '"+CHR$(34)+"', got EOF":GOTO READ_FORM_RETURN - R$=MID$(T$,2,LEN(T$)-2) - S1$=CHR$(92)+CHR$(92):S2$=CHR$(127):GOSUB REPLACE: REM protect backslashes - S1$=CHR$(92)+CHR$(34):S2$=CHR$(34):GOSUB REPLACE: REM unescape quotes - #cbm S1$=CHR$(92)+"n":S2$=CHR$(13):GOSUB REPLACE: REM unescape newlines - #qbasic S1$=CHR$(92)+"n":S2$=CHR$(10):GOSUB REPLACE: REM unescape newlines - S1$=CHR$(127):S2$=CHR$(92):GOSUB REPLACE: REM unescape backslashes + J=2:R$="" + READ_STRING_LOOP: + #qbasic I=INSTR(J,T$,CHR$(92)) + #cbm I=J + #cbm INSTR_LOOP: + #cbm IF I>LEN(T$) THEN I=0:GOTO INSTR_DONE + #cbm IF MID$(T$,I,1)=CHR$(92) THEN GOTO INSTR_DONE + #cbm I=I+1 + #cbm GOTO INSTR_LOOP + #cbm INSTR_DONE: + IF I=0 THEN GOTO READ_STRING_DONE + R$=R$+MID$(T$,J,I-J) + C$=MID$(T$,I+1,1) + #qbasic IF C$="n" THEN R$=R$+CHR$(10) ELSE R$=R$+C$ + #cbm IF C$="n" THEN R$=R$+CHR$(13) + #cbm IF C$<>"n" THEN R$=R$+C$ + J=I+2 + GOTO READ_STRING_LOOP + READ_STRING_DONE: + IF J=LEN(T$)+1 THEN R=-1:ER=-1:E$="expected '"+CHR$(34)+"', got EOF":GOTO READ_FORM_RETURN + R$=R$+MID$(T$,J,LEN(T$)-J) REM intern string value B$=R$:T=4:GOSUB STRING GOTO READ_FORM_RETURN diff --git a/c/Makefile b/c/Makefile index 4c113937..56c2e593 100644 --- a/c/Makefile +++ b/c/Makefile @@ -1,7 +1,7 @@ USE_READLINE ?= USE_GC ?= 1 -CFLAGS += -g -O2 -LDFLAGS += -g +CFLAGS ?= -g -O2 +LDFLAGS ?= -g ##################### @@ -19,26 +19,29 @@ GLIB_LDFLAGS ?= $(shell pkg-config --libs glib-2.0) FFI_CFLAGS ?= $(shell pkg-config libffi --cflags) FFI_LDFLAGS ?= $(shell pkg-config libffi --libs) - ifeq ($(shell uname -s),Darwin) -CFLAGS +=-DOSX=1 + darwin_CPPFLAGS ?= -DOSX=1 endif ifeq (,$(USE_READLINE)) RL_LIBRARY ?= edit else RL_LIBRARY ?= readline -CFLAGS += -DUSE_READLINE=1 + rl_CFLAGS ?= -DUSE_READLINE=1 endif -ifeq (,$(USE_GC)) -else -CFLAGS += -DUSE_GC=1 -LDFLAGS += -lgc +ifneq (,$(USE_GC)) + gc_CFLAGS ?= -DUSE_GC=1 + gc_LIBS ?= -lgc endif -CFLAGS += $(GLIB_CFLAGS) $(FFI_CFLAGS) -LDFLAGS += -l$(RL_LIBRARY) $(GLIB_LDFLAGS) $(FFI_LDFLAGS) -ldl +# Rewrite CPPFLAGS for the Make recipes, but let existing user options +# take precedence. +override CPPFLAGS := \ + ${darwin_CPPFLAGS} ${rl_CFLAGS} ${gc_CFLAGS} ${GLIB_CFLAGS} ${FFI_CFLAGS} \ + ${CPPFLAGS} +override LDLIBS += \ + ${gc_LIBS} -l${RL_LIBRARY} ${GLIB_LDFLAGS} ${FFI_LDFLAGS} -ldl ##################### @@ -50,11 +53,9 @@ mal: $(word $(words $(BINS)),$(BINS)) cp $< $@ $(OBJS) $(OTHER_OBJS): %.o: %.c $(OTHER_HDRS) - gcc $(CFLAGS) -c $(@:%.o=%.c) -o $@ $(patsubst %.o,%,$(filter step%,$(OBJS))): $(OTHER_OBJS) $(BINS): %: %.o - gcc $+ -o $@ $(LDFLAGS) clean: rm -f $(OBJS) $(BINS) $(OTHER_OBJS) mal diff --git a/lib/alias-hacks.mal b/lib/alias-hacks.mal new file mode 100644 index 00000000..3583c7d3 --- /dev/null +++ b/lib/alias-hacks.mal @@ -0,0 +1,24 @@ +;; aliases for common clojure names to mal builtins +;; NOTE: this is a hack +;; +;; Origin: https://github.com/chr15m/frock + +; TODO: re-implement as actually useful macros: +; destructuring, arg checking, etc. + +(def! _alias_add_implicit + (fn* [special added] + (fn* [x & xs] + (list special x (cons added xs))))) + +(defmacro! let (_alias_add_implicit 'let* 'do)) +(defmacro! when (_alias_add_implicit 'if 'do)) +(defmacro! def (_alias_add_implicit 'def! 'do)) +(defmacro! fn (_alias_add_implicit 'fn* 'do)) +(defmacro! defn (_alias_add_implicit 'def! 'fn)) + +(def! partial (fn* [pfn & args] + (fn* [& args-inner] + (apply pfn (concat args args-inner))))) + +nil diff --git a/python/tests/stepA_mal.mal b/python/tests/stepA_mal.mal index 79851922..44669f85 100644 --- a/python/tests/stepA_mal.mal +++ b/python/tests/stepA_mal.mal @@ -1,6 +1,6 @@ ;; Testing Python interop -;; Testing Python experesions +;; Testing Python expressions (py* "7") ;=>7 (py* "'7'") diff --git a/runtest.py b/runtest.py index 3a8e8c91..5fe11652 100755 --- a/runtest.py +++ b/runtest.py @@ -246,7 +246,7 @@ def assert_prompt(runner, prompts, timeout): if header: log("Started with:\n%s" % header) else: - log("Did not one of following prompt(s): %s" % repr(prompts)) + log("Did not receive one of following prompt(s): %s" % repr(prompts)) log(" Got : %s" % repr(r.buf)) sys.exit(1) diff --git a/tests/lib/alias-hacks.mal b/tests/lib/alias-hacks.mal new file mode 100644 index 00000000..c078ad89 --- /dev/null +++ b/tests/lib/alias-hacks.mal @@ -0,0 +1,55 @@ +;; Testing alias-hacks.mal +(load-file "../../lib/alias-hacks.mal") +;=>nil + +;; Testing let +(macroexpand (let binds a b)) +;=>(let* binds (do a b)) +(let [x 2] 3 x) +;=>2 + +;; Testing when +(macroexpand (when condition a b)) +;=>(if condition (do a b)) +(when false (nth () 0) a) +;=>nil +(when true 3 2) +;=>2 + +;; Testing name +(macroexpand (def name a b)) +;=>(def! name (do a b)) +(def x 1 2 3) +;=>3 +x +;=>3 + +;; Testing fn +(macroexpand (fn args a b)) +;=>(fn* args (do a b)) +((fn [x] 1 2) 3) +;=>2 + +;; Testing defn +(macroexpand (defn name args b)) +;=>(def! name (fn args b)) +(defn f [x] 1 2 x) +(f 3) +;=>3 + +;; Testing partial +((partial +) 1 2) +;=>3 +((partial + 1) 2) +;=>3 +((partial + 1 2)) +;=>3 +((partial not) false) +;=>true +((partial not false)) +;=>true +((partial (fn* [x y] (+ x y)) 1) 2) +;=>3 +((partial str 1 2) 3 4) +;=>"1234" + diff --git a/tests/step1_read_print.mal b/tests/step1_read_print.mal index 2abb4e9c..1a3bcf7a 100644 --- a/tests/step1_read_print.mal +++ b/tests/step1_read_print.mal @@ -50,6 +50,8 @@ abc-def ;=>(** 1 2) (* -3 6) ;=>(* -3 6) +(()()) +;=>(() ()) ;; Test commas as whitespace (1 2, 3,,,,),, @@ -139,6 +141,8 @@ false ;=>[+ 1 [+ 2 3]] [ + 1 [+ 2 3 ] ] ;=>[+ 1 [+ 2 3]] +([]) +;=>([]) ;; Testing read of hash maps {} @@ -153,10 +157,16 @@ false ;=>{"a" {"b" {"c" 3}}} { "a" {"b" { "cde" 3 } }} ;=>{"a" {"b" {"cde" 3}}} +;;; The regexp sorcery here ensures that each key goes with the correct +;;; value and that each key appears only once. +{"a1" 1 "a2" 2 "a3" 3} +;/{"a([1-3])" \1 "a(?!\1)([1-3])" \2 "a(?!\1)(?!\2)([1-3])" \3} { :a {:b { :cde 3 } }} ;=>{:a {:b {:cde 3}}} {"1" 1} ;=>{"1" 1} +({}) +;=>({}) ;; Testing read of comments ;; whole line comment (not an exception) diff --git a/tests/step8_macros.mal b/tests/step8_macros.mal index 8cce8dc9..59868928 100644 --- a/tests/step8_macros.mal +++ b/tests/step8_macros.mal @@ -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