From b69cc9068e2044de877d2f0fc563de8c58e5eae6 Mon Sep 17 00:00:00 2001 From: Ben Harris Date: Sat, 22 Jun 2019 17:27:46 +0100 Subject: [PATCH 01/16] basic: Fix handling of unterminated strings by rewriting string reader. I've essentially translated the BBC BASIC FNunquote_string into these more primitive dialects, including writing an implementation of INSTR in CBM BASIC because it's not natively present. The result is ugly but functional. Fun fact: QBasic thinks INSTR uses INSTR([start, ]needle, haystack); BBC BASIC uses INSTR(needle, haystack[, start]). --- basic/reader.in.bas | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) 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 From d9f0fb513e84b6d9377ae88c721c48898976e270 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sun, 23 Jun 2019 20:40:55 +0200 Subject: [PATCH 02/16] C: improve build configurability (issue #397) --- c/Makefile | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) 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 From a688720499a151771d1531caf7f79d31aafdc1e6 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sun, 30 Jun 2019 23:37:16 +0200 Subject: [PATCH 03/16] Test that macros use closures --- tests/step8_macros.mal | 10 ++++++++++ 1 file changed, 10 insertions(+) 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 From 87663bb7691fd64954bbe2649151714447f26165 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sun, 30 Jun 2019 23:37:25 +0200 Subject: [PATCH 04/16] ada.2: let macros use closures. Allow metadata for atoms. Implement macros as a bit in the function record as advised in the process. No need to reinvent Apply anymore. Also add an explicit Unreferenced pragma to silent a new compiler warning. --- ada.2/Makefile | 1 - ada.2/core.adb | 10 +++++++--- ada.2/printer.adb | 5 ++--- ada.2/step4_if_fn_do.adb | 4 ++-- ada.2/step5_tco.adb | 5 +++-- ada.2/step6_file.adb | 5 +++-- ada.2/step7_quote.adb | 5 +++-- ada.2/step8_macros.adb | 32 ++++++++++++++------------------ ada.2/step9_try.adb | 32 ++++++++++++++------------------ ada.2/stepa_mal.adb | 32 ++++++++++++++------------------ ada.2/types-atoms.adb | 14 ++++++++++++++ ada.2/types-atoms.ads | 5 +++++ ada.2/types-fns.adb | 4 ++-- ada.2/types-fns.ads | 2 +- ada.2/types-macros.adb | 28 ---------------------------- ada.2/types-macros.ads | 22 ---------------------- ada.2/types.adb | 5 +---- ada.2/types.ads | 6 +----- 18 files changed, 86 insertions(+), 131 deletions(-) delete mode 100644 ada.2/types-macros.adb delete mode 100644 ada.2/types-macros.ads 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; From d0efab874539327aba310047f53330b8633431cf Mon Sep 17 00:00:00 2001 From: Chris McCormick Date: Mon, 1 Jul 2019 16:05:26 +0800 Subject: [PATCH 05/16] Added alias hacks from frock to lib. See #321. Thanks @asarhaddon for your guidance. --- lib/alias-hacks.mal | 24 +++++++++++++++++ tests/lib/alias-hacks.mal | 55 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 79 insertions(+) create mode 100644 lib/alias-hacks.mal create mode 100644 tests/lib/alias-hacks.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/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" + From 98a83a874a540d8d03f02b53cb9b0b4d7e21a5e6 Mon Sep 17 00:00:00 2001 From: scott-silver Date: Fri, 5 Jul 2019 11:01:14 -0700 Subject: [PATCH 06/16] Update README.md grammatical error --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 66ebee3e..9669748b 100644 --- a/README.md +++ b/README.md @@ -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 From 0821b2d4587ae391b0a4e516616ec7e22a14e7f6 Mon Sep 17 00:00:00 2001 From: scott-silver Date: Sat, 6 Jul 2019 11:45:15 -0700 Subject: [PATCH 07/16] Add missing word --- runtest.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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) From beeffb021cfaf12a87ff29cf6bbd92db1d4f683b Mon Sep 17 00:00:00 2001 From: Ben Harris Date: Sun, 7 Jul 2019 10:09:01 +0100 Subject: [PATCH 08/16] step 1: Test reading some simple nested collections. These tests are intended to catch the cases where the routine for reading a list, vector, or hashmap fails to consume the trailing token (')', ']', or '}' as the case may be) from the input. None of the existing step 1 tests detected this, and I only found it by playing around in the REPL. --- tests/step1_read_print.mal | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/tests/step1_read_print.mal b/tests/step1_read_print.mal index 5a2b9155..eec31c9d 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 {} @@ -155,6 +159,8 @@ false ;=>{"a" {"b" {"cde" 3}}} { :a {:b { :cde 3 } }} ;=>{:a {:b {:cde 3}}} +({}) +;=>({}) ;; Testing read of comments ;; whole line comment (not an exception) From 31ef021712bf18a90609822cfcb7c327ab2e60f0 Mon Sep 17 00:00:00 2001 From: Ben Harris Date: Tue, 14 May 2019 23:33:44 +0100 Subject: [PATCH 09/16] python: Correct spelling in a test comment. --- python/tests/stepA_mal.mal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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'") From 69990448a0f11f9e7a390e848a3b9867203411b9 Mon Sep 17 00:00:00 2001 From: Ben Harris Date: Sun, 19 May 2019 12:22:36 +0100 Subject: [PATCH 10/16] README: Escape asterisks in "SQL*Plus". --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 66ebee3e..4511c6e4 100644 --- a/README.md +++ b/README.md @@ -807,10 +807,10 @@ The PL/pgSQL 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. From e007416e0c059bf2a398020fe0a544ee9852801a Mon Sep 17 00:00:00 2001 From: Ben Harris Date: Sun, 19 May 2019 12:26:35 +0100 Subject: [PATCH 11/16] README: Correct capitalisation of "PostScript" and "Ghostscript". --- README.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 4511c6e4..a2aaf1c5 100644 --- a/README.md +++ b/README.md @@ -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 From 26460a25ff67999e67d584f5c249109ec3a3b372 Mon Sep 17 00:00:00 2001 From: Ben Harris Date: Sun, 19 May 2019 12:27:25 +0100 Subject: [PATCH 12/16] README: Correct a stray mention of PL/pgSQL in the PL/SQL section. --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index a2aaf1c5..5f438962 100644 --- a/README.md +++ b/README.md @@ -803,7 +803,7 @@ 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 From 33102dd1b4c6805fb0010e1a11957c60525d9c01 Mon Sep 17 00:00:00 2001 From: Ben Harris Date: Sun, 19 May 2019 12:33:52 +0100 Subject: [PATCH 13/16] README: Pedantically refer to PostgreSQL by its proper name. --- README.md | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index 5f438962..66eab5cd 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) | @@ -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 From 876e6545c27d3422fb9c478844449a482341d6fe Mon Sep 17 00:00:00 2001 From: Ben Harris Date: Sun, 7 Jul 2019 11:12:22 +0100 Subject: [PATCH 14/16] step 1: Test a hash-map with more than one entry. All the existing tests in step 1 use empty or single-element hash-maps. That avoids any dependency on the ordering of printed hash-maps, but it does mean that some code paths (e.g. printing the space between hash-map elements) aren't tested. Add a test that creates a three-element hash-map and uses some regexp trickery to check that all the right keys and values come out. --- tests/step1_read_print.mal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/step1_read_print.mal b/tests/step1_read_print.mal index 5a2b9155..a67973dd 100644 --- a/tests/step1_read_print.mal +++ b/tests/step1_read_print.mal @@ -153,6 +153,8 @@ false ;=>{"a" {"b" {"c" 3}}} { "a" {"b" { "cde" 3 } }} ;=>{"a" {"b" {"cde" 3}}} +{"1" 1 "2" 2 "3" 3} +;/{"([1-3])" \1 "(?!\1)([1-3])" \2 "(?!\1)(?!\2)([1-3])" \3} { :a {:b { :cde 3 } }} ;=>{:a {:b {:cde 3}}} From d6383c83d28a5bfdb24fec0fc0e7b34adb4bb287 Mon Sep 17 00:00:00 2001 From: Ben Harris Date: Sun, 7 Jul 2019 13:35:04 +0100 Subject: [PATCH 15/16] step 1: Fix non-trivial hash-map test on PHP. It seems that the PHP implementation converts integer-like strings as hash-map keys into integers, so {"1" 1} becomes {1 1}. I don't know if that's a bug, but it's certainly not the bug I was trying to test for. Use different keys to avoid this problem. --- tests/step1_read_print.mal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/step1_read_print.mal b/tests/step1_read_print.mal index a67973dd..95e2e921 100644 --- a/tests/step1_read_print.mal +++ b/tests/step1_read_print.mal @@ -153,8 +153,8 @@ false ;=>{"a" {"b" {"c" 3}}} { "a" {"b" { "cde" 3 } }} ;=>{"a" {"b" {"cde" 3}}} -{"1" 1 "2" 2 "3" 3} -;/{"([1-3])" \1 "(?!\1)([1-3])" \2 "(?!\1)(?!\2)([1-3])" \3} +{"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}}} From e69f0ea3d4286dcd5d46f36b71b9fdc08bf6993b Mon Sep 17 00:00:00 2001 From: Ben Harris Date: Sun, 7 Jul 2019 13:39:35 +0100 Subject: [PATCH 16/16] step 1: Explain intention behind regexp magic in non-trivial hash-map test. [skip travis] --- tests/step1_read_print.mal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/step1_read_print.mal b/tests/step1_read_print.mal index 95e2e921..5d24cfaf 100644 --- a/tests/step1_read_print.mal +++ b/tests/step1_read_print.mal @@ -153,6 +153,8 @@ 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 } }}