mirror of
https://github.com/kanaka/mal.git
synced 2024-08-16 17:20:23 +03:00
Merge branch 'master' into bjh21-php-hashmap
This commit is contained in:
commit
7260b29879
24
README.md
24
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
|
||||
|
@ -45,7 +45,6 @@ TYPES := $(call sources,\
|
||||
types-atoms \
|
||||
types-builtins \
|
||||
types-fns \
|
||||
types-macros \
|
||||
types-maps \
|
||||
types-sequences \
|
||||
types-strings \
|
||||
|
@ -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");
|
||||
|
@ -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 ");
|
||||
|
@ -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);
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
|
@ -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");
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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.
|
||||
|
||||
|
@ -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;
|
@ -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;
|
@ -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;
|
||||
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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
|
||||
|
27
c/Makefile
27
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
|
||||
|
24
lib/alias-hacks.mal
Normal file
24
lib/alias-hacks.mal
Normal file
@ -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
|
@ -1,6 +1,6 @@
|
||||
;; Testing Python interop
|
||||
|
||||
;; Testing Python experesions
|
||||
;; Testing Python expressions
|
||||
(py* "7")
|
||||
;=>7
|
||||
(py* "'7'")
|
||||
|
@ -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)
|
||||
|
||||
|
55
tests/lib/alias-hacks.mal
Normal file
55
tests/lib/alias-hacks.mal
Normal file
@ -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"
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user