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 branch 'master' into bjh21-unterminated-strings

Browse Source
This commit is contained in:
Ben Harris 2019-07-08 21:33:58 +01:00
commit 5b30912762
27 changed files with 234 additions and 164 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
README.md
View File

@ -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

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;

27
basic/reader.in.bas
View File

@ -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
View File

@ -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
View 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

2
python/tests/stepA_mal.mal
View File

@ -1,6 +1,6 @@
;; Testing Python interop
;; Testing Python experesions
;; Testing Python expressions
(py* "7")
;=>7
(py* "'7'")

2
runtest.py
View File

@ -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
View 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"

10
tests/step1_read_print.mal
View File

@ -50,6 +50,8 @@ abc-def
;=>(** 1 2)
(* -3 6)
;=>(* -3 6)
(()())
;=>(() ())
;; Test commas as whitespace
(1 2, 3,,,,),,
@ -149,6 +151,8 @@ false
;=>[+ 1 [+ 2 3]]
[ + 1 [+ 2 3 ] ]
;=>[+ 1 [+ 2 3]]
([])
;=>([])
;; Testing read of hash maps
{}
@ -163,8 +167,14 @@ 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}}}
({})
;=>({})
;; Testing read of comments
;; whole line comment (not an exception)

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