Merge branch 'kanaka:master' into patch-1

IMPLS.yml

@@ -73,6 +73,7 @@ IMPL:
   - {IMPL: prolog}
   - {IMPL: ps}
   - {IMPL: powershell, NO_SELF_HOST_PERF: 1}
+  - {IMPL: purs}
   - {IMPL: python, python_MODE: python2}
   - {IMPL: python, python_MODE: python3}
   - {IMPL: python.2}
@@ -81,6 +82,7 @@ IMPL:
   - {IMPL: rexx}
   - {IMPL: rpython, SLOW: 1}
   - {IMPL: ruby}
+  - {IMPL: ruby.2}
   - {IMPL: rust}
   - {IMPL: scala}
   - {IMPL: scheme, scheme_MODE: chibi}

Makefile.impls

@@ -38,7 +38,7 @@ IMPLS = ada ada.2 awk bash basic bbc-basic c c.2 chuck clojure coffee common-lis
 	elisp elixir elm erlang es6 factor fantom fennel forth fsharp go groovy gnu-smalltalk \
 	guile haskell haxe hy io janet java java-truffle js jq julia kotlin livescript logo lua make mal \
 	matlab miniMAL nasm nim objc objpascal ocaml perl perl6 php picolisp pike plpgsql \
-	plsql powershell prolog ps python python.2 r racket rexx rpython ruby rust scala scheme skew sml \
+	plsql powershell prolog ps purs python python.2 r racket rexx rpython ruby ruby.2 rust scala scheme skew sml \
 	swift swift3 swift4 swift5 tcl ts vala vb vhdl vimscript wasm wren yorick xslt zig
 
 step5_EXCLUDES += bash        # never completes at 10,000
@@ -168,13 +168,15 @@ plsql_STEP_TO_PROG =         impls/plsql/$($(1)).sql
 powershell_STEP_TO_PROG =    impls/powershell/$($(1)).ps1
 prolog_STEP_TO_PROG =        impls/prolog/$($(1)).pl
 ps_STEP_TO_PROG =            impls/ps/$($(1)).ps
+purs_STEP_TO_PROG =          impls/purs/$($(1)).js
 python_STEP_TO_PROG =        impls/python/$($(1)).py
 python.2_STEP_TO_PROG =      impls/python.2/$($(1)).py
 r_STEP_TO_PROG =             impls/r/$($(1)).r
 racket_STEP_TO_PROG =        impls/racket/$($(1)).rkt
 rexx_STEP_TO_PROG =          impls/rexx/$($(1)).rexxpp
 rpython_STEP_TO_PROG =       impls/rpython/$($(1))
 ruby_STEP_TO_PROG =          impls/ruby/$($(1)).rb
+ruby.2_STEP_TO_PROG =        impls/ruby.2/$($(1)).rb
 rust_STEP_TO_PROG =          impls/rust/$($(1))
 scala_STEP_TO_PROG =         impls/scala/target/scala-2.11/classes/$($(1)).class
 scheme_STEP_TO_PROG =        $(scheme_STEP_TO_PROG_$(scheme_MODE))

README.md

@@ -42,7 +42,7 @@ process guide](process/guide.md) there is also a [mal/make-a-lisp
 FAQ](docs/FAQ.md) where I attempt to answer some common questions.
 
 
-**3. Mal is implemented in 86 languages (91 different implementations and 113 runtime modes)**
+**3. Mal is implemented in 87 languages (93 different implementations and 115 runtime modes)**
 
 | Language | Creator |
 | -------- | ------- |
@@ -83,7 +83,7 @@ FAQ](docs/FAQ.md) where I attempt to answer some common questions.
 | [Io](#io) | [Dov Murik](https://github.com/dubek) |
 | [Janet](#janet) | [sogaiu](https://github.com/sogaiu) |
 | [Java](#java-17) | [Joel Martin](https://github.com/kanaka)  |
-| [Java](#java-truffle) (Truffle/GraalVM) | [Matt McGill](https://github.com/mmcgill)
+| [Java](#java-using-truffle-for-graalvm) (Truffle/GraalVM) | [Matt McGill](https://github.com/mmcgill)
 | [JavaScript](#javascriptnode) ([Demo](http://kanaka.github.io/mal)) | [Joel Martin](https://github.com/kanaka) |
 | [jq](#jq) | [Ali MohammadPur](https://github.com/alimpfard) |
 | [Julia](#julia) | [Joel Martin](https://github.com/kanaka)  |
@@ -110,13 +110,15 @@ FAQ](docs/FAQ.md) where I attempt to answer some common questions.
 | [PostScript](#postscript-level-23) | [Joel Martin](https://github.com/kanaka)  |
 | [PowerShell](#powershell) | [Joel Martin](https://github.com/kanaka)  |
 | [Prolog](#prolog-logical-language) | [Nicolas Boulenguez](https://github.com/asarhaddon) |
+| [PureScript](#purescript) | [mrsekut](https://github.com/mrsekut) |
 | [Python](#python-2x-and-3x) (2.X & 3.X) | [Joel Martin](https://github.com/kanaka) |
 | [Python #2](#python2-3x) (3.X) | [Gavin Lewis](https://github.com/epylar) |
 | [RPython](#rpython) | [Joel Martin](https://github.com/kanaka)  |
 | [R](#r) | [Joel Martin](https://github.com/kanaka)  |
 | [Racket](#racket-53) | [Joel Martin](https://github.com/kanaka)  |
 | [Rexx](#rexx) | [Dov Murik](https://github.com/dubek) |
 | [Ruby](#ruby-19) | [Joel Martin](https://github.com/kanaka)  |
+| [Ruby #2](#ruby) | [Ryan Cook](https://github.com/cookrn)  |
 | [Rust](#rust-138) | [Joel Martin](https://github.com/kanaka)  |
 | [Scala](#scala) | [Joel Martin](https://github.com/kanaka)  |
 | [Scheme (R7RS)](#scheme-r7rs) | [Vasilij Schneidermann](https://github.com/wasamasa) |
@@ -937,6 +939,15 @@ cd impls/prolog
 swipl stepX_YYY
 ```
 
+### PureScript
+The PureScript implementation requires the spago compiler version 0.20.2.
+
+```
+cd impls/purs
+make
+node ./stepX_YYY.js
+```
+
 ### Python (2.X and 3.X)
 
 ```
@@ -1002,6 +1013,19 @@ cd impls/ruby
 ruby stepX_YYY.rb
 ```
 
+### Ruby #2
+
+A second Ruby implementation with the following goals:
+
+- No global variables
+- No modification (monkey-patching) of core Ruby classes
+- Modularized into the `Mal` module namespace
+
+```
+cd impls/ruby.2
+ruby stepX_YYY.rb
+```
+
 ### Rust (1.38+)
 
 The rust implementation of mal requires the rust compiler and build
@@ -1026,16 +1050,15 @@ scala -classpath target/scala*/classes stepX_YYY
 
 ### Scheme (R7RS) ###
 
-The Scheme implementation of mal has been tested with Chibi-Scheme
-0.7.3, Kawa 2.4, Gauche 0.9.5, CHICKEN 4.11.0, Sagittarius 0.8.3,
-Cyclone 0.6.3 (Git version) and Foment 0.4 (Git version).  You should
+The Scheme implementation of MAL has been tested with Chibi-Scheme
+0.10, Kawa 3.1.1, Gauche 0.9.6, CHICKEN 5.1.0, Sagittarius 0.9.7,
+Cyclone 0.32.0 (Git version) and Foment 0.4 (Git version).  You should
 be able to get it running on other conforming R7RS implementations
 after figuring out how libraries are loaded and adjusting the
 `Makefile` and `run` script accordingly.
 
 ```
 cd impls/scheme
-make symlinks
 # chibi
 scheme_MODE=chibi ./run
 # kawa

impls/ada.2/core.adb

@@ -179,10 +179,8 @@ 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 an atom, function, map or sequence");
+               Err.Raise_With ("expected a function, map or sequence");
          end case;
       end;
    end Meta;
@@ -451,8 +449,6 @@ package body Core is
             when Kind_Fn =>
                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");

impls/ada.2/types-atoms.adb

@@ -29,12 +29,8 @@ 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,
@@ -66,14 +62,4 @@ 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;

impls/ada.2/types-atoms.ads

@@ -13,15 +13,10 @@ 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;

impls/ada/core.adb

@@ -563,7 +563,18 @@ package body Core is
 
       Sym_Handle := Car (Rest_List);
 
-      return New_Symbol_Mal_Type (':' & Deref_String (Sym_Handle).Get_String);
+      case Deref (Sym_Handle).Sym_Type is
+         when Str =>
+            return New_Symbol_Mal_Type (':' & Deref_String (Sym_Handle).Get_String);
+         when Sym =>
+            if Deref_Sym (Sym_Handle).Get_Sym (1) = ':' then
+               return Sym_Handle;
+            end if;
+         when others =>
+            null;
+      end case;
+
+      raise Runtime_Exception with "keyword: expects a keyword or string";
 
    end Keyword;
 

impls/ada/step8_macros.adb

@@ -50,7 +50,10 @@ procedure Step8_Macros is
       Fn_Body := Car (Deref_List (Cdr (Args)).all);
       Res := Eval (Fn_Body, Env);
       Lambda_P := Deref_Lambda (Res);
-      Lambda_P.Set_Is_Macro (True);
+      Res := New_Lambda_Mal_Type (Params => Lambda_P.all.Get_Params,
+                                  Expr   => Lambda_P.all.Get_Expr,
+                                  Env    => Lambda_P.all.Get_Env);
+      Deref_Lambda (Res).Set_Is_Macro (True);
       Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res);
       return Res;
    end Def_Macro;
@@ -65,7 +68,6 @@ procedure Step8_Macros is
    begin
 
       Res := Ast;
-      E := Env;
 
       loop
 
@@ -77,15 +79,15 @@ procedure Step8_Macros is
 
          -- Get the macro in the list from the env
          -- or return null if not applicable.
-         LP := Get_Macro (Res, E);
+         LP := Get_Macro (Res, Env);
 
       exit when LP = null or else not LP.Get_Is_Macro;
 
 	  declare
 	     Fn_List : Mal_Handle := Cdr (LMT);
 	     Params : List_Mal_Type;
 	  begin
-	     E := Envs.New_Env (E);
+	     E := Envs.New_Env (LP.Get_Env);
 
 	     Params := Deref_List (LP.Get_Params).all;
 	     if Envs.Bind (E, Params, Deref_List (Fn_List).all) then

impls/ada/step9_try.adb

@@ -50,7 +50,10 @@ procedure Step9_Try is
       Fn_Body := Car (Deref_List (Cdr (Args)).all);
       Res := Eval (Fn_Body, Env);
       Lambda_P := Deref_Lambda (Res);
-      Lambda_P.Set_Is_Macro (True);
+      Res := New_Lambda_Mal_Type (Params => Lambda_P.all.Get_Params,
+                                  Expr   => Lambda_P.all.Get_Expr,
+                                  Env    => Lambda_P.all.Get_Env);
+      Deref_Lambda (Res).Set_Is_Macro (True);
       Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res);
       return Res;
    end Def_Macro;
@@ -65,7 +68,6 @@ procedure Step9_Try is
    begin
 
       Res := Ast;
-      E := Env;
 
       loop
 
@@ -77,15 +79,15 @@ procedure Step9_Try is
 
          -- Get the macro in the list from the env
          -- or return null if not applicable.
-         LP := Get_Macro (Res, E);
+         LP := Get_Macro (Res, Env);
 
       exit when LP = null or else not LP.Get_Is_Macro;
 
 	  declare
 	     Fn_List : Mal_Handle := Cdr (LMT);
 	     Params : List_Mal_Type;
 	  begin
-	     E := Envs.New_Env (E);
+	     E := Envs.New_Env (LP.Get_Env);
 
 	     Params := Deref_List (LP.Get_Params).all;
 	     if Envs.Bind (E, Params, Deref_List (Fn_List).all) then

impls/ada/stepa_mal.adb

@@ -50,7 +50,10 @@ procedure StepA_Mal is
       Fn_Body := Car (Deref_List (Cdr (Args)).all);
       Res := Eval (Fn_Body, Env);
       Lambda_P := Deref_Lambda (Res);
-      Lambda_P.Set_Is_Macro (True);
+      Res := New_Lambda_Mal_Type (Params => Lambda_P.all.Get_Params,
+                                  Expr   => Lambda_P.all.Get_Expr,
+                                  Env    => Lambda_P.all.Get_Env);
+      Deref_Lambda (Res).Set_Is_Macro (True);
       Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res);
       return Res;
    end Def_Macro;
@@ -65,7 +68,6 @@ procedure StepA_Mal is
    begin
 
       Res := Ast;
-      E := Env;
 
       loop
 
@@ -77,17 +79,18 @@ procedure StepA_Mal is
 
          -- Get the macro in the list from the env
          -- or return null if not applicable.
-         LP := Get_Macro (Res, E);
+         LP := Get_Macro (Res, Env);
 
       exit when LP = null or else not LP.Get_Is_Macro;
 
 	  declare
 	     Fn_List : Mal_Handle := Cdr (LMT);
 	     Params : List_Mal_Type;
 	  begin
-	     E := Envs.New_Env (E);
+	     E := Envs.New_Env (LP.Get_Env);
 
 	     Params := Deref_List (LP.Get_Params).all;
+
 	     if Envs.Bind (E, Params, Deref_List (Fn_List).all) then
 
 	        Res := Eval (LP.Get_Expr, E);

impls/awk/step8_macros.awk

@@ -233,7 +233,7 @@ function EVAL_let(ast, env,    ret_env,    idx, params, params_idx, params_len,
 	return body
 }
 
-function EVAL_defmacro(ast, env,    idx, sym, ret, len)
+function EVAL_defmacro(ast, env,    idx, sym, ret, len, fun_idx, mac_idx)
 {
 	idx = substr(ast, 2)
 	if (types_heap[idx]["len"] != 3) {
@@ -259,7 +259,17 @@ function EVAL_defmacro(ast, env,    idx, sym, ret, len)
 		env_release(env)
 		return "!\"Incompatible type for argument 2 of 'defmacro!'. Expects function, supplied " types_typename(ret) "."
 	}
-	types_heap[substr(ret, 2)]["is_macro"] = 1
+
+	# Replace `ret` with a clone setting the `is_macro` bit.
+	fun_idx = substr(ret, 2)
+	mac_idx = types_allocate()
+	types_addref(types_heap[mac_idx]["params"] = types_heap[fun_idx]["params"])
+	types_addref(types_heap[mac_idx]["body"] = types_heap[fun_idx]["body"])
+	env_addref(types_heap[mac_idx]["env"] = types_heap[fun_idx]["env"])
+	types_heap[mac_idx]["is_macro"] = 1
+	types_release(ret)
+	ret = "$" mac_idx
+
 	env_set(env, sym, ret)
 	types_addref(ret)
 	env_release(env)

impls/awk/step9_try.awk

@@ -233,7 +233,7 @@ function EVAL_let(ast, env,    ret_env,    idx, params, params_idx, params_len,
 	return body
 }
 
-function EVAL_defmacro(ast, env,    idx, sym, ret, len)
+function EVAL_defmacro(ast, env,    idx, sym, ret, len, fun_idx, mac_idx)
 {
 	idx = substr(ast, 2)
 	if (types_heap[idx]["len"] != 3) {
@@ -259,7 +259,17 @@ function EVAL_defmacro(ast, env,    idx, sym, ret, len)
 		env_release(env)
 		return "!\"Incompatible type for argument 2 of 'defmacro!'. Expects function, supplied " types_typename(ret) "."
 	}
-	types_heap[substr(ret, 2)]["is_macro"] = 1
+
+	# Replace `ret` with a clone setting the `is_macro` bit.
+	fun_idx = substr(ret, 2)
+	mac_idx = types_allocate()
+	types_addref(types_heap[mac_idx]["params"] = types_heap[fun_idx]["params"])
+	types_addref(types_heap[mac_idx]["body"] = types_heap[fun_idx]["body"])
+	env_addref(types_heap[mac_idx]["env"] = types_heap[fun_idx]["env"])
+	types_heap[mac_idx]["is_macro"] = 1
+	types_release(ret)
+	ret = "$" mac_idx
+
 	env_set(env, sym, ret)
 	types_addref(ret)
 	env_release(env)