1
1
mirror of https://github.com/kanaka/mal.git synced 2024-09-11 13:55:55 +03:00

All: swap step9,A. Fixes for bash, C, perl.

step9_interop -> stepA_interop
stepA_more -> step9_try

C: fix glib headers
bash: behavior change of declare -A and pattern replacement.
perl: squelch new 5.18 warnings related to switch/given statement.

Also, include some in-progress interop related files.
This commit is contained in:
Joel Martin 2014-10-09 23:48:47 -05:00
parent 1771ab50b8
commit 01c9731649
73 changed files with 1478 additions and 95 deletions

9
.gitignore vendored
View File

@ -16,14 +16,15 @@ c/step5_tco
c/step6_file
c/step7_quote
c/step8_macros
c/step9_interop
c/stepA_more
c/step9_try
c/stepA_interop
cs/*.exe
cs/*.dll
cs/*.mdb
clojure/target
clojure/.lein-repl-history
go/step*
go/mal
java/target/
java/dependency-reduced-pom.xml
rust/step0_repl
@ -35,5 +36,5 @@ rust/step5_tco
rust/step6_file
rust/step7_quote
rust/step8_macros
rust/step9_interop
rust/stepA_more
rust/step9_try
rust/stepA_interop

View File

@ -21,8 +21,8 @@ step5 = step5_tco
step6 = step6_file
step7 = step7_quote
step8 = step8_macros
step9 = step9_interop
stepA = stepA_more
step9 = step9_try
stepA = stepA_interop
EXCLUDE_TESTS += test^bash^step5 # no stack exhaustion or completion
EXCLUDE_TESTS += test^c^step5 # segfault
@ -34,9 +34,9 @@ EXCLUDE_TESTS += test^php^step5 # test completes, even at 100,000
EXCLUDE_TESTS += test^ruby^step5 # test completes, even at 100,000
# interop tests now implemented yet
EXCLUDE_TESTS += test^cs^step9 test^java^step9 test^mal^step9 \
test^mal^step0 test^php^step9 test^ps^step9 \
test^python^step9 test^ruby^step9
EXCLUDE_TESTS += test^cs^stepA test^java^stepA test^mal^stepA \
test^mal^step0 test^php^stepA test^ps^stepA \
test^python^stepA test^ruby^stepA
EXCLUDE_PERFS = perf^mal # TODO: fix this
@ -73,7 +73,7 @@ make_RUNSTEP = make -f ../$(2) $(3)
mal_RUNSTEP = $(call $(MAL_IMPL)_RUNSTEP,$(1),$(call $(MAL_IMPL)_STEP_TO_PROG,stepA),../$(2),") #"
perl_RUNSTEP = perl ../$(2) $(3)
php_RUNSTEP = php ../$(2) $(3)
ps_RUNSTEP = $(4)gs -q -dNODISPLAY -- ../$(2) $(3)$(4)
ps_RUNSTEP = $(4)gs -q -I./ -dNODISPLAY -- ../$(2) $(3)$(4)
python_RUNSTEP = $(PYTHON) ../$(2) $(3)
ruby_RUNSTEP = ruby ../$(2) $(3)

View File

@ -57,8 +57,8 @@ bash stepX_YYY.sh
### C
The C implementation of mal requires the following libraries: glib,
libffi6 and either the libedit or GNU readline library.
The C implementation of mal requires the following libraries (lib and
header packages): glib, libffi6 and either the libedit or GNU readline library.
```
cd c
@ -97,6 +97,8 @@ make
### Java 1.7
The Java implementation of mal requires maven2 to build.
```
cd java
mvn compile
@ -145,6 +147,9 @@ perl stepX_YYY.pl
### PHP 5.3
The PHP implementation of mal requires the php command line interface
to run.
```
cd php
php stepX_YYY.php
@ -152,6 +157,9 @@ php stepX_YYY.php
### Postscript Level 2/3
The Postscript implementation of mal requires ghostscript to run. It
has been tested with ghostscript 9.10.
```
cd ps
gs -q -dNODISPLAY -I./ stepX_YYY.ps

View File

@ -1,5 +1,5 @@
SOURCES_BASE = types.sh reader.sh printer.sh
SOURCES_LISP = env.sh core.sh stepA_more.sh
SOURCES_LISP = env.sh core.sh stepA_interop.sh
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
all: mal.sh

View File

@ -157,14 +157,20 @@ EVAL () {
macroexpand)
MACROEXPAND "${a1}" "${env}"
return ;;
sh*) MACROEXPAND "${a1}" "${env}"
try*) MACROEXPAND "${a1}" "${env}"
EVAL "${r}" "${env}"
local output=""
local line=""
while read line; do
output="${output}${line}\n"
done < <(eval ${ANON["${r}"]})
_string "${output%\\n}"
[[ -z "${__ERROR}" ]] && return
_nth "${a2}" 0; local a20="${r}"
if [ "${ANON["${a20}"]}" == "catch__STAR__" ]; then
_nth "${a2}" 1; local a21="${r}"
_nth "${a2}" 2; local a22="${r}"
_list "${a21}"; local binds="${r}"
ENV "${env}" "${binds}" "${__ERROR}"
local try_env="${r}"
__ERROR=
MACROEXPAND "${a22}" "${try_env}"
EVAL "${r}" "${try_env}"
fi # if no catch* clause, just propagate __ERROR
return ;;
do) _count "${ast}"
_slice "${ast}" 1 $(( ${r} - 2 ))
@ -245,6 +251,7 @@ for _arg in "${@:2}"; do _string "${_arg}"; _conj! "${argv}" "${r}"; done
ENV_SET "${REPL_ENV}" "__STAR__ARGV__STAR__" "${argv}";
# core.mal: defined using the language itself
REP "(def! *host-language* \"bash\")"
REP "(def! not (fn* (a) (if a false true)))"
REP "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"
@ -257,6 +264,7 @@ if [[ "${1}" ]]; then
fi
# repl loop
REP "(println (str \"Mal [\" *host-language* \"]\"))"
while true; do
READLINE "user> " || exit "$?"
[[ "${r}" ]] && REP "${r}" && echo "${r}"

View File

@ -104,7 +104,7 @@ _false? () { [[ ${1} =~ ^fals_ ]]; }
_symbol () {
__new_obj_hash_code
r="symb_${r}"
ANON["${r}"]="${1//$'\*'/__STAR__}"
ANON["${r}"]="${1//\*/__STAR__}"
}
_symbol? () { [[ ${1} =~ ^symb_ ]]; }
@ -124,7 +124,7 @@ _number? () { [[ ${1} =~ ^numb_ ]]; }
_string () {
__new_obj_hash_code
r="strn_${r}"
ANON["${r}"]="${1//$'\*'/__STAR__}"
ANON["${r}"]="${1//\*/__STAR__}"
}
_string? () { [[ ${1} =~ ^strn_ ]]; }
@ -173,7 +173,7 @@ _hash_map () {
__new_obj_hash_code
local name="hmap_${r}"
local obj="${__obj_magic}_${name}"
declare -A -g ${obj}
declare -A -g ${obj}; eval "${obj}=()"
ANON["${name}"]="${obj}"
while [[ "${1}" ]]; do

View File

@ -9,7 +9,7 @@ TESTS =
SOURCES_BASE = readline.h readline.c types.h types.c \
reader.h reader.c printer.h printer.c \
interop.h interop.c
SOURCES_LISP = env.c core.h core.c stepA_more.c
SOURCES_LISP = env.c core.h core.c stepA_interop.c
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
@ -17,7 +17,7 @@ SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
SRCS = step0_repl.c step1_read_print.c step2_eval.c step3_env.c \
step4_if_fn_do.c step5_tco.c step6_file.c step7_quote.c \
step8_macros.c step9_interop.c stepA_more.c
step8_macros.c step9_try.c stepA_interop.c
OBJS = $(SRCS:%.c=%.o)
BINS = $(OBJS:%.o=%)
OTHER_OBJS = types.o readline.o reader.o printer.o env.o core.o interop.o

View File

@ -2,8 +2,9 @@
#include <stdio.h>
#include <string.h>
#include <glib/gregex.h>
#include <glib-object.h>
//#include <glib/gregex.h>
//#include <glib-object.h>
#include <glib.h>
#include "types.h"
#include "reader.h"

View File

@ -181,10 +181,26 @@ MalVal *EVAL(MalVal *ast, Env *env) {
MalVal *a1 = _nth(ast, 1);
return macroexpand(a1, env);
} else if ((a0->type & MAL_SYMBOL) &&
strcmp(".", a0->val.string) == 0) {
//g_print("eval apply .\n");
MalVal *el = eval_ast(_slice(ast, 1, _count(ast)), env);
return invoke_native(el);
strcmp("try*", a0->val.string) == 0) {
//g_print("eval apply try*\n");
MalVal *a1 = _nth(ast, 1);
MalVal *a2 = _nth(ast, 2);
MalVal *res = EVAL(a1, env);
if (!mal_error) { return res; }
MalVal *a20 = _nth(a2, 0);
if (strcmp("catch*", a20->val.string) == 0) {
MalVal *a21 = _nth(a2, 1);
MalVal *a22 = _nth(a2, 2);
Env *catch_env = new_env(env,
_listX(1, a21),
_listX(1, mal_error));
//malval_free(mal_error);
mal_error = NULL;
res = EVAL(a22, catch_env);
return res;
} else {
return &mal_nil;
}
} else if ((a0->type & MAL_SYMBOL) &&
strcmp("do", a0->val.string) == 0) {
//g_print("eval apply do\n");
@ -287,6 +303,7 @@ void init_repl_env(int argc, char *argv[]) {
env_set(repl_env, "*ARGV*", _argv);
// core.mal: defined using the language itself
RE(repl_env, "", "(def! *host-language* \"c\")");
RE(repl_env, "", "(def! not (fn* (a) (if a false true)))");
RE(repl_env, "",
"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
@ -311,6 +328,7 @@ int main(int argc, char *argv[])
}
// repl loop
RE(repl_env, "", "(println (str \"Mal [\" *host-language* \"]\"))");
for(;;) {
exp = RE(repl_env, prompt, NULL);
if (mal_error && strcmp("EOF", mal_error->val.string) == 0) {

View File

@ -1,5 +1,5 @@
SOURCES_BASE = src/readline.clj src/reader.clj src/printer.clj
SOURCES_LISP = src/env.clj src/core.clj src/stepA_more.clj
SOURCES_LISP = src/env.clj src/core.clj src/stepA_interop.clj
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
all:

View File

@ -18,8 +18,8 @@
:step6 {:main step6-file}
:step7 {:main step7-quote}
:step8 {:main step8-macros}
:step9 {:main step9-interop}
:stepA {:main stepA-more}}
:step9 {:main step9-try}
:stepA {:main stepA-interop}}
:main stepA-more)

View File

@ -1,4 +1,4 @@
(ns step9-interop
(ns step9-try
(:refer-clojure :exclude [macroexpand])
(:require [clojure.repl]
[readline]
@ -94,9 +94,20 @@
'macroexpand
(macroexpand a1 env)
'clj*
(eval (reader/read-string a1))
'try*
(if (= 'catch* (nth a2 0))
(try
(EVAL a1 env)
(catch clojure.lang.ExceptionInfo ei
(EVAL (nth a2 2) (env/env env
[(nth a2 1)]
[(:data (ex-data ei))])))
(catch Throwable t
(EVAL (nth a2 2) (env/env env
[(nth a2 1)]
[(.getMessage t)]))))
(EVAL a1 env))
'do
(do (eval-ast (->> ast (drop-last) (drop 1)) env)
(recur (last ast) env))
@ -141,6 +152,7 @@
(env/env-set repl-env '*ARGV* ())
;; core.mal: defined using the language itself
(rep "(def! *host-language* \"clojure\")")
(rep "(def! not (fn* [a] (if a false true)))")
(rep "(def! load-file (fn* [f] (eval (read-string (str \"(do \" (slurp f) \")\")))))")
(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
@ -161,4 +173,6 @@
(env/env-set repl-env '*ARGV* (rest args))
(if args
(rep (str "(load-file \"" (first args) "\")"))
(repl-loop)))
(do
(rep "(println (str \"Mal [\" *host-language* \"]\"))")
(repl-loop))))

View File

@ -1,4 +1,4 @@
(ns stepA-more
(ns stepA-interop
(:refer-clojure :exclude [macroexpand])
(:require [clojure.repl]
[readline]

View File

@ -5,7 +5,7 @@ DEBUG =
TESTS =
SOURCES_BASE = readline.cs types.cs reader.cs printer.cs
SOURCES_LISP = env.cs core.cs stepA_more.cs
SOURCES_LISP = env.cs core.cs stepA_interop.cs
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
OTHER_SOURCES = getline.cs
@ -14,7 +14,7 @@ OTHER_SOURCES = getline.cs
SRCS = step0_repl.cs step1_read_print.cs step2_eval.cs step3_env.cs \
step4_if_fn_do.cs step5_tco.cs step6_file.cs step7_quote.cs \
step8_macros.cs stepA_more.cs
step8_macros.cs step9_try.cs stepA_interop.cs
LIB_SRCS = $(filter-out step%,$(OTHER_SOURCES) $(SOURCES))

66
cs/interop.cs Normal file
View File

@ -0,0 +1,66 @@
using System;
using System.CodeDom.Compiler;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using Microsoft.CSharp;
public static class EvalProvider
{
public static Func<T, TResult> CreateEvalMethod<T, TResult>(string code, string[] usingStatements = null, string[] assemblies = null)
{
Type returnType = typeof(TResult);
Type inputType = typeof(T);
var includeUsings = new HashSet<string>(new[] { "System" });
includeUsings.Add(returnType.Namespace);
includeUsings.Add(inputType.Namespace);
if (usingStatements != null)
foreach (var usingStatement in usingStatements)
includeUsings.Add(usingStatement);
using (CSharpCodeProvider compiler = new CSharpCodeProvider())
{
var name = "F" + Guid.NewGuid().ToString().Replace("-", string.Empty);
var includeAssemblies = new HashSet<string>(new[] { "system.dll" });
if (assemblies != null)
foreach (var assembly in assemblies)
includeAssemblies.Add(assembly);
var parameters = new CompilerParameters(includeAssemblies.ToArray())
{
GenerateInMemory = true
};
string source = string.Format(@"
{0}
namespace {1}
{{
public static class EvalClass
{{
public static {2} Eval({3} arg)
{{
{4}
}}
}}
}}", GetUsing(includeUsings), name, returnType.Name, inputType.Name, code);
var compilerResult = compiler.CompileAssemblyFromSource(parameters, source);
var compiledAssembly = compilerResult.CompiledAssembly;
var type = compiledAssembly.GetType(string.Format("{0}.EvalClass", name));
var method = type.GetMethod("Eval");
return (Func<T, TResult>)Delegate.CreateDelegate(typeof(Func<T, TResult>), method);
}
}
private static string GetUsing(HashSet<string> usingStatements)
{
StringBuilder result = new StringBuilder();
foreach (string usingStatement in usingStatements)
{
result.AppendLine(string.Format("using {0};", usingStatement));
}
return result.ToString();
}
}

View File

@ -14,7 +14,7 @@ using MalFunction = Mal.types.MalFunction;
using Env = Mal.env.Env;
namespace Mal {
class stepA_more {
class step9_try {
// read
static MalVal READ(string str) {
return reader.read_str(str);

288
cs/stepA_interop.cs Normal file
View File

@ -0,0 +1,288 @@
using System;
using System.IO;
using System.Collections;
using System.Collections.Generic;
using Mal;
using MalVal = Mal.types.MalVal;
using MalString = Mal.types.MalString;
using MalSymbol = Mal.types.MalSymbol;
using MalInteger = Mal.types.MalInteger;
using MalList = Mal.types.MalList;
using MalVector = Mal.types.MalVector;
using MalHashMap = Mal.types.MalHashMap;
using MalFunction = Mal.types.MalFunction;
using Env = Mal.env.Env;
namespace Mal {
class stepA_interop {
// read
static MalVal READ(string str) {
return reader.read_str(str);
}
// eval
public static bool is_pair(MalVal x) {
return x is MalList && ((MalList)x).size() > 0;
}
public static MalVal quasiquote(MalVal ast) {
if (!is_pair(ast)) {
return new MalList(new MalSymbol("quote"), ast);
} else {
MalVal a0 = ((MalList)ast)[0];
if ((a0 is MalSymbol) &&
(((MalSymbol)a0).getName() == "unquote")) {
return ((MalList)ast)[1];
} else if (is_pair(a0)) {
MalVal a00 = ((MalList)a0)[0];
if ((a00 is MalSymbol) &&
(((MalSymbol)a00).getName() == "splice-unquote")) {
return new MalList(new MalSymbol("concat"),
((MalList)a0)[1],
quasiquote(((MalList)ast).rest()));
}
}
return new MalList(new MalSymbol("cons"),
quasiquote(a0),
quasiquote(((MalList)ast).rest()));
}
}
public static bool is_macro_call(MalVal ast, Env env) {
if (ast is MalList) {
MalVal a0 = ((MalList)ast)[0];
if (a0 is MalSymbol &&
env.find(((MalSymbol)a0).getName()) != null) {
MalVal mac = env.get(((MalSymbol)a0).getName());
if (mac is MalFunction &&
((MalFunction)mac).isMacro()) {
return true;
}
}
}
return false;
}
public static MalVal macroexpand(MalVal ast, Env env) {
while (is_macro_call(ast, env)) {
MalSymbol a0 = (MalSymbol)((MalList)ast)[0];
MalFunction mac = (MalFunction) env.get(a0.getName());
ast = mac.apply(((MalList)ast).rest());
}
return ast;
}
static MalVal eval_ast(MalVal ast, Env env) {
if (ast is MalSymbol) {
MalSymbol sym = (MalSymbol)ast;
return env.get(sym.getName());
} else if (ast is MalList) {
MalList old_lst = (MalList)ast;
MalList new_lst = ast.list_Q() ? new MalList()
: (MalList)new MalVector();
foreach (MalVal mv in old_lst.getValue()) {
new_lst.conj_BANG(EVAL(mv, env));
}
return new_lst;
} else if (ast is MalHashMap) {
var new_dict = new Dictionary<string, MalVal>();
foreach (var entry in ((MalHashMap)ast).getValue()) {
new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env));
}
return new MalHashMap(new_dict);
} else {
return ast;
}
}
static MalVal EVAL(MalVal orig_ast, Env env) {
MalVal a0, a1, a2, res;
MalList el;
while (true) {
//System.out.println("EVAL: " + printer._pr_str(orig_ast, true));
if (!orig_ast.list_Q()) {
return eval_ast(orig_ast, env);
}
// apply list
MalVal expanded = macroexpand(orig_ast, env);
if (!expanded.list_Q()) { return expanded; }
MalList ast = (MalList) expanded;
if (ast.size() == 0) { return ast; }
a0 = ast[0];
String a0sym = a0 is MalSymbol ? ((MalSymbol)a0).getName()
: "__<*fn*>__";
switch (a0sym) {
case "def!":
a1 = ast[1];
a2 = ast[2];
res = EVAL(a2, env);
env.set(((MalSymbol)a1).getName(), res);
return res;
case "let*":
a1 = ast[1];
a2 = ast[2];
MalSymbol key;
MalVal val;
Env let_env = new Env(env);
for(int i=0; i<((MalList)a1).size(); i+=2) {
key = (MalSymbol)((MalList)a1)[i];
val = ((MalList)a1)[i+1];
let_env.set(key.getName(), EVAL(val, let_env));
}
orig_ast = a2;
env = let_env;
break;
case "quote":
return ast[1];
case "quasiquote":
orig_ast = quasiquote(ast[1]);
break;
case "defmacro!":
a1 = ast[1];
a2 = ast[2];
res = EVAL(a2, env);
((MalFunction)res).setMacro();
env.set(((MalSymbol)a1).getName(), res);
return res;
case "macroexpand":
a1 = ast[1];
return macroexpand(a1, env);
case "try*":
try {
return EVAL(ast[1], env);
} catch (Exception e) {
if (ast.size() > 2) {
MalVal exc;
a2 = ast[2];
MalVal a20 = ((MalList)a2)[0];
if (((MalSymbol)a20).getName() == "catch*") {
if (e is Mal.types.MalException) {
exc = ((Mal.types.MalException)e).getValue();
} else {
exc = new MalString(e.StackTrace);
}
return EVAL(((MalList)a2)[2],
new Env(env, ((MalList)a2).slice(1,2),
new MalList(exc)));
}
}
throw e;
}
case "do":
eval_ast(ast.slice(1, ast.size()-1), env);
orig_ast = ast[ast.size()-1];
break;
case "if":
a1 = ast[1];
MalVal cond = EVAL(a1, env);
if (cond == Mal.types.Nil || cond == Mal.types.False) {
// eval false slot form
if (ast.size() > 3) {
orig_ast = ast[3];
} else {
return Mal.types.Nil;
}
} else {
// eval true slot form
orig_ast = ast[2];
}
break;
case "fn*":
MalList a1f = (MalList)ast[1];
MalVal a2f = ast[2];
Env cur_env = env;
return new MalFunction(a2f, env, a1f,
args => EVAL(a2f, new Env(cur_env, a1f, args)) );
default:
el = (MalList)eval_ast(ast, env);
var f = (MalFunction)el[0];
MalVal fnast = f.getAst();
if (fnast != null) {
orig_ast = fnast;
env = f.genEnv(el.rest());
} else {
return f.apply(el.rest());
}
break;
}
}
}
// print
static string PRINT(MalVal exp) {
return printer._pr_str(exp, true);
}
// repl
static MalVal RE(Env env, string str) {
return EVAL(READ(str), env);
}
static void Main(string[] args) {
string prompt = "user> ";
// core.cs: defined using C#
var repl_env = new env.Env(null);
foreach (var entry in core.ns) {
repl_env.set(entry.Key, entry.Value);
}
repl_env.set("eval", new MalFunction(a => EVAL(a[0], repl_env)));
MalList _argv = new MalList();
for (int i=1; i < args.Length; i++) {
_argv.conj_BANG(new MalString(args[i]));
}
repl_env.set("*ARGV*", _argv);
// core.mal: defined using the language itself
RE(repl_env, "(def! *host-language* \"c#\")");
RE(repl_env, "(def! not (fn* (a) (if a false true)))");
RE(repl_env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
RE(repl_env, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
RE(repl_env, "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
int fileIdx = 0;
if (args.Length > 0 && args[0] == "--raw") {
Mal.readline.mode = Mal.readline.Mode.Raw;
fileIdx = 1;
}
if (args.Length > fileIdx) {
RE(repl_env, "(load-file \"" + args[fileIdx] + "\")");
return;
}
// repl loop
RE(repl_env, "(println (str \"Mal [\" *host-language* \"]\"))");
while (true) {
string line;
try {
line = Mal.readline.Readline(prompt);
if (line == null) { break; }
} catch (IOException e) {
Console.WriteLine("IOException: " + e.Message);
break;
}
try {
Console.WriteLine(PRINT(RE(repl_env, line)));
} catch (Mal.types.MalContinue) {
continue;
} catch (Mal.types.MalException e) {
Console.WriteLine("Error: " +
printer._pr_str(e.getValue(), false));
continue;
} catch (Exception e) {
Console.WriteLine("Error: " + e.Message);
Console.WriteLine(e.StackTrace);
continue;
}
}
}
}
}

View File

@ -6,7 +6,7 @@ All:
- keyword type
- gensym reader inside quasiquote
- per impl tests for step5_tco, step9_interop (if possible)
- per impl tests for step5_tco (if possible)
- regular expression matching in runtest
- Print full exception when test gets EOF from expect
@ -17,6 +17,8 @@ All:
- Move try* to step6
- Remove macros from mal
- Implement/fix interop: C#, Java, Mal, PHP, Postscript, Ruby
---------------------------------------------
Bash:
@ -28,7 +30,6 @@ C:
- GC
C#:
- step9_interop
Clojure:
@ -37,7 +38,6 @@ Go:
https://gobyexample.com/variadic-functions
Java:
- step9_interop
- Use gradle instead of mvn
http://blog.paralleluniverse.co/2014/05/01/modern-java/
@ -51,7 +51,6 @@ Make:
Mal:
- line numbers in errors
- step5_tco
- step9_interop
Perl:
- fix metadata on native functions
@ -62,7 +61,8 @@ Postscript:
- add negative numbers
Python:
- error: python ../python/stepA_more.py ../mal/stepA_more.mal ../mal/stepA_more.mal
- error: python ../python/stepA_interop.py ../mal/stepA_interop.mal ../mal/stepA_interop.mal
- interop tests
Ruby:

View File

@ -5,14 +5,14 @@ export GOPATH := $(dir $(abspath $(lastword $(MAKEFILE_LIST))))
SOURCES_BASE = src/types/types.go src/readline/readline.go \
src/reader/reader.go src/printer/printer.go \
src/env/env.go src/core/core.go
SOURCES_LISP = src/stepA_more/stepA_more.go
SOURCES_LISP = src/stepA_interop/stepA_interop.go
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
#####################
SRCS = step0_repl.go step1_read_print.go step2_eval.go step3_env.go \
step4_if_fn_do.go step5_tco.go step6_file.go step7_quote.go \
step8_macros.go stepA_more.go
step8_macros.go step9_try.go stepA_interop.go
BINS = $(SRCS:%.go=%)
#####################

View File

@ -0,0 +1,306 @@
package main
import (
"fmt"
"strings"
"errors"
"os"
)
import (
"readline"
. "types"
"reader"
"printer"
. "env"
"core"
)
// read
func READ(str string) (MalType, error) {
return reader.Read_str(str)
}
// eval
func is_pair(x MalType) bool {
slc, e := GetSlice(x)
if e != nil { return false }
return len(slc) > 0
}
func quasiquote(ast MalType) MalType {
if !is_pair(ast) {
return List{[]MalType{Symbol{"quote"}, ast},nil}
} else {
slc, _ := GetSlice(ast)
a0 := slc[0]
if Symbol_Q(a0) && (a0.(Symbol).Val == "unquote") {
return slc[1]
} else if is_pair(a0) {
slc0, _ := GetSlice(a0)
a00 := slc0[0]
if Symbol_Q(a00) && (a00.(Symbol).Val == "splice-unquote") {
return List{[]MalType{Symbol{"concat"},
slc0[1],
quasiquote(List{slc[1:],nil})},nil}
}
}
return List{[]MalType{Symbol{"cons"},
quasiquote(a0),
quasiquote(List{slc[1:],nil})},nil}
}
}
func is_macro_call(ast MalType, env EnvType) bool {
if List_Q(ast) {
slc, _ := GetSlice(ast)
a0 := slc[0]
if Symbol_Q(a0) && env.Find(a0.(Symbol).Val) != nil {
mac, e := env.Get(a0.(Symbol).Val)
if e != nil { return false }
if MalFunc_Q(mac) {
return mac.(MalFunc).GetMacro()
}
}
}
return false
}
func macroexpand(ast MalType, env EnvType) (MalType, error) {
var mac MalType
var e error
for ; is_macro_call(ast, env) ; {
slc, _ := GetSlice(ast)
a0 := slc[0]
mac, e = env.Get(a0.(Symbol).Val); if e != nil { return nil, e }
fn := mac.(MalFunc)
ast, e = Apply(fn, slc[1:]); if e != nil { return nil, e }
}
return ast, nil
}
func eval_ast(ast MalType, env EnvType) (MalType, error) {
//fmt.Printf("eval_ast: %#v\n", ast)
if Symbol_Q(ast) {
return env.Get(ast.(Symbol).Val)
} else if List_Q(ast) {
lst := []MalType{}
for _, a := range ast.(List).Val {
exp, e := EVAL(a, env)
if e != nil { return nil, e }
lst = append(lst, exp)
}
return List{lst,nil}, nil
} else if Vector_Q(ast) {
lst := []MalType{}
for _, a := range ast.(Vector).Val {
exp, e := EVAL(a, env)
if e != nil { return nil, e }
lst = append(lst, exp)
}
return Vector{lst,nil}, nil
} else if HashMap_Q(ast) {
m := ast.(HashMap)
new_hm := HashMap{map[string]MalType{},nil}
for k, v := range m.Val {
ke, e1 := EVAL(k, env)
if e1 != nil { return nil, e1 }
if _, ok := ke.(string); !ok {
return nil, errors.New("non string hash-map key")
}
kv, e2 := EVAL(v, env)
if e2 != nil { return nil, e2 }
new_hm.Val[ke.(string)] = kv
}
return new_hm, nil
} else {
return ast, nil
}
}
func EVAL(ast MalType, env EnvType) (MalType, error) {
var e error
for {
//fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true))
switch ast.(type) {
case List: // continue
default: return eval_ast(ast, env)
}
// apply list
ast, e = macroexpand(ast, env); if e != nil { return nil, e }
if (!List_Q(ast)) { return ast, nil }
a0 := ast.(List).Val[0]
var a1 MalType = nil; var a2 MalType = nil
switch len(ast.(List).Val) {
case 1:
a1 = nil; a2 = nil
case 2:
a1 = ast.(List).Val[1]; a2 = nil
default:
a1 = ast.(List).Val[1]; a2 = ast.(List).Val[2]
}
a0sym := "__<*fn*>__"
if Symbol_Q(a0) { a0sym = a0.(Symbol).Val }
switch a0sym {
case "def!":
res, e := EVAL(a2, env)
if e != nil { return nil, e }
return env.Set(a1.(Symbol).Val, res), nil
case "let*":
let_env, e := NewEnv(env, nil, nil)
if e != nil { return nil, e }
arr1, e := GetSlice(a1)
if e != nil { return nil, e }
for i := 0; i < len(arr1); i+=2 {
if !Symbol_Q(arr1[i]) {
return nil, errors.New("non-symbol bind value")
}
exp, e := EVAL(arr1[i+1], let_env)
if e != nil { return nil, e }
let_env.Set(arr1[i].(Symbol).Val, exp)
}
ast = a2
env = let_env
case "quote":
return a1, nil
case "quasiquote":
ast = quasiquote(a1)
case "defmacro!":
fn, e := EVAL(a2, env)
fn = fn.(MalFunc).SetMacro()
if e != nil { return nil, e }
return env.Set(a1.(Symbol).Val, fn), nil
case "macroexpand":
return macroexpand(a1, env)
case "try*":
var exc MalType
exp, e := EVAL(a1, env)
if e == nil {
return exp, nil
} else {
if a2 != nil && List_Q(a2) {
a2s, _ := GetSlice(a2)
if Symbol_Q(a2s[0]) && (a2s[0].(Symbol).Val == "catch*") {
switch e.(type) {
case MalError: exc = e.(MalError).Obj
default: exc = e.Error()
}
binds := NewList(a2s[1])
new_env, e := NewEnv(env, binds, NewList(exc))
if e != nil { return nil, e }
exp, e = EVAL(a2s[2], new_env)
if e == nil { return exp, nil }
}
}
return nil, e
}
case "do":
lst := ast.(List).Val
_, e := eval_ast(List{lst[1:len(lst)-1],nil}, env)
if e != nil { return nil, e }
if len(lst) == 1 { return nil, nil }
ast = lst[len(lst)-1]
case "if":
cond, e := EVAL(a1, env)
if e != nil { return nil, e }
if cond == nil || cond == false {
if len(ast.(List).Val) >= 4 {
ast = ast.(List).Val[3]
} else {
return nil, nil
}
} else {
ast = a2
}
case "fn*":
fn := MalFunc{EVAL, a2, env, a1, false, NewEnv, nil}
return fn, nil
default:
el, e := eval_ast(ast, env)
if e != nil { return nil, e }
f := el.(List).Val[0]
if MalFunc_Q(f) {
fn := f.(MalFunc)
ast = fn.Exp
env, e = NewEnv(fn.Env, fn.Params, List{el.(List).Val[1:],nil})
if e != nil { return nil, e }
} else {
fn, ok := f.(Func)
if !ok { return nil, errors.New("attempt to call non-function") }
return fn.Fn(el.(List).Val[1:])
}
}
} // TCO loop
}
// print
func PRINT(exp MalType) (string, error) {
return printer.Pr_str(exp, true), nil
}
var repl_env, _ = NewEnv(nil, nil, nil)
// repl
func rep(str string) (MalType, error) {
var exp MalType
var res string
var e error
if exp, e = READ(str); e != nil { return nil, e }
if exp, e = EVAL(exp, repl_env); e != nil { return nil, e }
if res, e = PRINT(exp); e != nil { return nil, e }
return res, nil
}
func main() {
// core.go: defined using go
for k, v := range core.NS {
repl_env.Set(k, Func{v.(func([]MalType)(MalType,error)),nil})
}
repl_env.Set("eval", Func{func(a []MalType) (MalType, error) {
return EVAL(a[0], repl_env) },nil})
repl_env.Set("*ARGV*", List{})
// core.mal: defined using the language itself
rep("(def! *host-language* \"go\")")
rep("(def! not (fn* (a) (if a false true)))")
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
// called with mal script to load and eval
if len(os.Args) > 1 {
args := make([]MalType, 0, len(os.Args)-2)
for _,a := range os.Args[2:] {
args = append(args, a)
}
repl_env.Set("*ARGV*", List{args,nil})
if _,e := rep("(load-file \"" + os.Args[1] + "\")"); e != nil {
fmt.Printf("Error: %v\n", e)
os.Exit(1)
}
os.Exit(0)
}
// repl loop
rep("(println (str \"Mal [\" *host-language* \"]\"))")
for {
text, err := readline.Readline("user> ")
text = strings.TrimRight(text, "\n");
if (err != nil) {
return
}
var out MalType
var e error
if out, e = rep(text); e != nil {
if e.Error() == "<empty line>" { continue }
fmt.Printf("Error: %v\n", e)
continue
}
fmt.Printf("%v\n", out)
}
}

View File

@ -5,7 +5,7 @@ TESTS =
SOURCES_BASE = src/main/java/mal/readline.java src/main/java/mal/types.java \
src/main/java/mal/reader.java src/main/java/mal/printer.java
SOURCES_LISP = src/main/java/mal/env.java src/main/java/mal/core.java \
src/main/java/mal/stepA_more.java
src/main/java/mal/stepA_interop.java
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
#.PHONY: stats tests $(TESTS)

View File

@ -15,7 +15,7 @@ import mal.printer;
import mal.env.Env;
import mal.core;
public class stepA_more {
public class step9_try {
// read
public static MalVal READ(String str) throws MalThrowable {
return reader.read_str(str);

View File

@ -0,0 +1,302 @@
package mal;
import java.io.IOException;
import java.io.StringWriter;
import java.io.PrintWriter;
import java.util.List;
import java.util.Map;
import java.util.HashMap;
import java.util.Iterator;
import mal.types.*;
import mal.readline;
import mal.reader;
import mal.printer;
import mal.env.Env;
import mal.core;
public class stepA_interop {
// read
public static MalVal READ(String str) throws MalThrowable {
return reader.read_str(str);
}
// eval
public static Boolean is_pair(MalVal x) {
return x instanceof MalList && ((MalList)x).size() > 0;
}
public static MalVal quasiquote(MalVal ast) {
if (!is_pair(ast)) {
return new MalList(new MalSymbol("quote"), ast);
} else {
MalVal a0 = ((MalList)ast).nth(0);
if ((a0 instanceof MalSymbol) &&
(((MalSymbol)a0).getName() == "unquote")) {
return ((MalList)ast).nth(1);
} else if (is_pair(a0)) {
MalVal a00 = ((MalList)a0).nth(0);
if ((a00 instanceof MalSymbol) &&
(((MalSymbol)a00).getName() == "splice-unquote")) {
return new MalList(new MalSymbol("concat"),
((MalList)a0).nth(1),
quasiquote(((MalList)ast).rest()));
}
}
return new MalList(new MalSymbol("cons"),
quasiquote(a0),
quasiquote(((MalList)ast).rest()));
}
}
public static Boolean is_macro_call(MalVal ast, Env env)
throws MalThrowable {
if (ast instanceof MalList) {
MalVal a0 = ((MalList)ast).nth(0);
if (a0 instanceof MalSymbol &&
env.find(((MalSymbol)a0).getName()) != null) {
MalVal mac = env.get(((MalSymbol)a0).getName());
if (mac instanceof MalFunction &&
((MalFunction)mac).isMacro()) {
return true;
}
}
}
return false;
}
public static MalVal macroexpand(MalVal ast, Env env)
throws MalThrowable {
while (is_macro_call(ast, env)) {
MalSymbol a0 = (MalSymbol)((MalList)ast).nth(0);
MalFunction mac = (MalFunction) env.get(a0.getName());
ast = mac.apply(((MalList)ast).rest());
}
return ast;
}
public static MalVal eval_ast(MalVal ast, Env env) throws MalThrowable {
if (ast instanceof MalSymbol) {
MalSymbol sym = (MalSymbol)ast;
return env.get(sym.getName());
} else if (ast instanceof MalList) {
MalList old_lst = (MalList)ast;
MalList new_lst = ast.list_Q() ? new MalList()
: (MalList)new MalVector();
for (MalVal mv : (List<MalVal>)old_lst.value) {
new_lst.conj_BANG(EVAL(mv, env));
}
return new_lst;
} else if (ast instanceof MalHashMap) {
MalHashMap new_hm = new MalHashMap();
Iterator it = ((MalHashMap)ast).value.entrySet().iterator();
while (it.hasNext()) {
Map.Entry entry = (Map.Entry)it.next();
new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env));
}
return new_hm;
} else {
return ast;
}
}
public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable {
MalVal a0, a1,a2, a3, res;
MalList el;
while (true) {
//System.out.println("EVAL: " + printer._pr_str(orig_ast, true));
if (!orig_ast.list_Q()) {
return eval_ast(orig_ast, env);
}
// apply list
MalVal expanded = macroexpand(orig_ast, env);
if (!expanded.list_Q()) { return expanded; }
MalList ast = (MalList) expanded;
if (ast.size() == 0) { return ast; }
a0 = ast.nth(0);
String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName()
: "__<*fn*>__";
switch (a0sym) {
case "def!":
a1 = ast.nth(1);
a2 = ast.nth(2);
res = EVAL(a2, env);
env.set(((MalSymbol)a1).getName(), res);
return res;
case "let*":
a1 = ast.nth(1);
a2 = ast.nth(2);
MalSymbol key;
MalVal val;
Env let_env = new Env(env);
for(int i=0; i<((MalList)a1).size(); i+=2) {
key = (MalSymbol)((MalList)a1).nth(i);
val = ((MalList)a1).nth(i+1);
let_env.set(key.getName(), EVAL(val, let_env));
}
orig_ast = a2;
env = let_env;
break;
case "quote":
return ast.nth(1);
case "quasiquote":
orig_ast = quasiquote(ast.nth(1));
break;
case "defmacro!":
a1 = ast.nth(1);
a2 = ast.nth(2);
res = EVAL(a2, env);
((MalFunction)res).setMacro();
env.set(((MalSymbol)a1).getName(), res);
return res;
case "macroexpand":
a1 = ast.nth(1);
return macroexpand(a1, env);
case "try*":
try {
return EVAL(ast.nth(1), env);
} catch (Throwable t) {
if (ast.size() > 2) {
MalVal exc;
a2 = ast.nth(2);
MalVal a20 = ((MalList)a2).nth(0);
if (((MalSymbol)a20).getName().equals("catch*")) {
if (t instanceof MalException) {
exc = ((MalException)t).getValue();
} else {
StringWriter sw = new StringWriter();
t.printStackTrace(new PrintWriter(sw));
String tstr = sw.toString();
exc = new MalString(t.getMessage() + ": " + tstr);
}
return EVAL(((MalList)a2).nth(2),
new Env(env, ((MalList)a2).slice(1,2),
new MalList(exc)));
}
}
throw t;
}
case "do":
eval_ast(ast.slice(1, ast.size()-1), env);
orig_ast = ast.nth(ast.size()-1);
break;
case "if":
a1 = ast.nth(1);
MalVal cond = EVAL(a1, env);
if (cond == types.Nil || cond == types.False) {
// eval false slot form
if (ast.size() > 3) {
orig_ast = ast.nth(3);
} else {
return types.Nil;
}
} else {
// eval true slot form
orig_ast = ast.nth(2);
}
break;
case "fn*":
final MalList a1f = (MalList)ast.nth(1);
final MalVal a2f = ast.nth(2);
final Env cur_env = env;
return new MalFunction (a2f, (mal.env.Env)env, a1f) {
public MalVal apply(MalList args) throws MalThrowable {
return EVAL(a2f, new Env(cur_env, a1f, args));
}
};
default:
el = (MalList)eval_ast(ast, env);
MalFunction f = (MalFunction)el.nth(0);
MalVal fnast = f.getAst();
if (fnast != null) {
orig_ast = fnast;
env = f.genEnv(el.slice(1));
} else {
return f.apply(el.rest());
}
}
}
}
// print
public static String PRINT(MalVal exp) {
return printer._pr_str(exp, true);
}
// repl
public static MalVal RE(Env env, String str) throws MalThrowable {
return EVAL(READ(str), env);
}
public static void main(String[] args) throws MalThrowable {
String prompt = "user> ";
final Env repl_env = new Env(null);
// core.java: defined using Java
for (String key : core.ns.keySet()) {
repl_env.set(key, core.ns.get(key));
}
repl_env.set("eval", new MalFunction() {
public MalVal apply(MalList args) throws MalThrowable {
return EVAL(args.nth(0), repl_env);
}
});
MalList _argv = new MalList();
for (Integer i=1; i < args.length; i++) {
_argv.conj_BANG(new MalString(args[i]));
}
repl_env.set("*ARGV*", _argv);
// core.mal: defined using the language itself
RE(repl_env, "(def! *host-language* \"java\")");
RE(repl_env, "(def! not (fn* (a) (if a false true)))");
RE(repl_env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
RE(repl_env, "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
RE(repl_env, "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
Integer fileIdx = 0;
if (args.length > 0 && args[0].equals("--raw")) {
readline.mode = readline.Mode.JAVA;
fileIdx = 1;
}
if (args.length > fileIdx) {
RE(repl_env, "(load-file \"" + args[fileIdx] + "\")");
return;
}
// repl loop
RE(repl_env, "(println (str \"Mal [\" *host-language* \"]\"))");
while (true) {
String line;
try {
line = readline.readline(prompt);
if (line == null) { continue; }
} catch (readline.EOFException e) {
break;
} catch (IOException e) {
System.out.println("IOException: " + e.getMessage());
break;
}
try {
System.out.println(PRINT(RE(repl_env, line)));
} catch (MalContinue e) {
continue;
} catch (MalException e) {
System.out.println("Error: " + printer._pr_str(e.getValue(), false));
continue;
} catch (MalThrowable t) {
System.out.println("Error: " + t.getMessage());
continue;
} catch (Throwable t) {
System.out.println("Uncaught " + t + ": " + t.getMessage());
continue;
}
}
}
}

View File

@ -2,7 +2,7 @@
TESTS = tests/types.js tests/reader.js
SOURCES_BASE = node_readline.js types.js reader.js printer.js
SOURCES_LISP = env.js core.js stepA_more.js
SOURCES_LISP = env.js core.js stepA_interop.js
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
WEB_SOURCES = $(SOURCES:node_readline.js=jq_readline.js)

View File

@ -104,12 +104,17 @@ function _EVAL(ast, env) {
return env.set(a1, func);
case 'macroexpand':
return macroexpand(a1, env);
case "js*":
return eval(a1.toString());
case ".":
var el = eval_ast(ast.slice(2), env),
f = eval(a1.toString());
return f.apply(f, el);
case "try*":
try {
return EVAL(a1, env);
} catch (exc) {
if (a2 && a2[0].value === "catch*") {
if (exc instanceof Error) { exc = exc.message; }
return EVAL(a2[2], new Env(env, [a2[1]], [exc]));
} else {
throw exc;
}
}
case "do":
eval_ast(ast.slice(1, -1), env);
ast = ast[ast.length-1];
@ -157,6 +162,7 @@ repl_env.set('eval', function(ast) { return EVAL(ast, repl_env); });
repl_env.set('*ARGV*', []);
// core.mal: defined using the language itself
rep("(def! *host-language* \"javascript\")")
rep("(def! not (fn* (a) (if a false true)))");
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
@ -171,6 +177,7 @@ if (typeof process !== 'undefined' && process.argv.length > 2) {
// repl loop
if (typeof require !== 'undefined' && require.main === module) {
// Synchronous node.js commandline mode
rep("(println (str \"Mal [\" *host-language* \"]\"))");
while (true) {
var line = readline.readline("user> ");
if (line === null) { break; }

View File

@ -1,8 +1,8 @@
TESTS = tests/types.mk tests/reader.mk tests/step9_interop.mk
TESTS = tests/types.mk tests/reader.mk tests/stepA_interop.mk
SOURCES_BASE = util.mk readline.mk gmsl.mk types.mk reader.mk printer.mk
SOURCES_LISP = env.mk core.mk stepA_more.mk
SOURCES_LISP = env.mk core.mk stepA_interop.mk
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
mal.mk: $(SOURCES)

View File

@ -99,10 +99,21 @@ $(if $(__ERROR),,\
$(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\
$(if $(call _EQ,macroexpand,$($(a0)_value)),\
$(call MACROEXPAND,$(call _nth,$(1),1),$(2)),\
$(if $(call _EQ,make*,$($(a0)_value)),\
$(if $(call _EQ,try*,$($(a0)_value)),\
$(foreach a1,$(call _nth,$(1),1),\
$(and $(EVAL_DEBUG),$(info make*: $$(eval __result := $(call str_decode,$(value $(a1)_value)))))\
$(eval __result := $(call str_decode,$(value $(a1)_value)))$(call _string,$(__result))),\
$(foreach res,$(call EVAL,$(a1),$(2)),\
$(if $(__ERROR),\
$(foreach a2,$(call _nth,$(1),2),\
$(foreach a20,$(call _nth,$(a2),0),\
$(if $(call _EQ,catch*,$($(a20)_value)),\
$(foreach a21,$(call _nth,$(a2),1),\
$(foreach a22,$(call _nth,$(a2),2),\
$(foreach binds,$(call _list,$(a21)),\
$(foreach catch_env,$(call ENV,$(2),$(binds),$(__ERROR)),\
$(eval __ERROR :=)\
$(call EVAL,$(a22),$(catch_env)))))),\
$(res)))),\
$(res)))),\
$(if $(call _EQ,do,$($(a0)_value)),\
$(call slast,$(call EVAL_AST,$(call srest,$(1)),$(2))),\
$(if $(call _EQ,if,$($(a0)_value)),\
@ -154,6 +165,7 @@ _argv := $(call _list)
REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv))
# core.mal: defined in terms of the language itself
$(call do,$(call REP, (def! *host-language* "make") ))
$(call do,$(call REP, (def! not (fn* (a) (if a false true))) ))
$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")"))))) ))
$(call do,$(call REP, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) ))
@ -167,7 +179,9 @@ $(if $(MAKECMDGOALS),\
$(eval INTERACTIVE :=),)
# repl loop
$(if $(strip $(INTERACTIVE)),$(call REPL))
$(if $(strip $(INTERACTIVE)),\
$(call do,$(call REP, (println (str "Mal [" *host-language* "]")) )) \
$(call REPL))
.PHONY: none $(MAKECMDGOALS)
none $(MAKECMDGOALS):

View File

@ -2,7 +2,7 @@
TESTS =
SOURCES_BASE =
SOURCES_LISP = env.mal core.mal stepA_more.mal
SOURCES_LISP = env.mal core.mal stepA_interop.mal
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
#.PHONY: stats tests $(TESTS)

181
mal/stepA_interop.mal Normal file
View File

@ -0,0 +1,181 @@
(load-file "../mal/env.mal")
(load-file "../mal/core.mal")
;; read
(def! READ (fn* [strng]
(read-string strng)))
;; eval
(def! is-pair (fn* [x]
(if (sequential? x)
(if (> (count x) 0)
true))))
(def! QUASIQUOTE (fn* [ast]
(cond
(not (is-pair ast))
(list 'quote ast)
(= 'unquote (first ast))
(nth ast 1)
(if (is-pair (first ast))
(if (= 'splice-unquote (first (first ast)))
true))
(list 'concat (nth (first ast) 1) (QUASIQUOTE (rest ast)))
"else"
(list 'cons (QUASIQUOTE (first ast)) (QUASIQUOTE (rest ast))))))
(def! is-macro-call (fn* [ast env]
(if (list? ast)
(let* [a0 (first ast)]
(if (symbol? a0)
(if (env-find env a0)
(let* [m (meta (env-get env a0))]
(if m
(if (get m "ismacro")
true)))))))))
(def! MACROEXPAND (fn* [ast env]
(if (is-macro-call ast env)
(let* [mac (env-get env (first ast))]
(MACROEXPAND (apply mac (rest ast)) env))
ast)))
(def! eval-ast (fn* [ast env] (do
;;(do (prn "eval-ast" ast "/" (keys env)) )
(cond
(symbol? ast) (env-get env ast)
(list? ast) (map (fn* [exp] (EVAL exp env)) ast)
(vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast))
(map? ast) (apply hash-map
(apply concat
(map (fn* [k] [k (EVAL (get ast k) env)])
(keys ast))))
"else" ast))))
(def! LET (fn* [env args]
(if (> (count args) 0)
(do
(env-set env (nth args 0) (EVAL (nth args 1) env))
(LET env (rest (rest args)))))))
(def! EVAL (fn* [ast env] (do
;;(do (prn "EVAL" ast "/" (keys @env)) )
(if (not (list? ast))
(eval-ast ast env)
;; apply list
(let* [ast (MACROEXPAND ast env)]
(if (not (list? ast))
ast
(let* [a0 (first ast)]
(cond
(= 'def! a0)
(env-set env (nth ast 1) (EVAL (nth ast 2) env))
(= 'let* a0)
(let* [let-env (new-env env)]
(do
(LET let-env (nth ast 1))
(EVAL (nth ast 2) let-env)))
(= 'quote a0)
(nth ast 1)
(= 'quasiquote a0)
(let* [a1 (nth ast 1)]
(EVAL (QUASIQUOTE a1) env))
(= 'defmacro! a0)
(let* [a1 (nth ast 1)
a2 (nth ast 2)
f (EVAL a2 env)
m (or (meta f) {})
mac (with-meta f (assoc m "ismacro" true))]
(env-set env a1 mac))
(= 'macroexpand a0)
(let* [a1 (nth ast 1)]
(MACROEXPAND a1 env))
(= 'try* a0)
(if (= 'catch* (nth (nth ast 2) 0))
(try*
(EVAL (nth ast 1) env)
(catch* exc
(EVAL (nth (nth ast 2) 2)
(new-env env
[(nth (nth ast 2)1)]
[exc]))))
(EVAL (nth ast 1) env))
(= 'do a0)
(let* [el (eval-ast (rest ast) env)]
(nth el (- (count el) 1)))
(= 'if a0)
(let* [cond (EVAL (nth ast 1) env)]
(if (or (= cond nil) (= cond false))
(if (> (count ast) 3)
(EVAL (nth ast 3) env)
nil)
(EVAL (nth ast 2) env)))
(= 'fn* a0)
(fn* [& args]
(EVAL (nth ast 2) (new-env env (nth ast 1) args)))
"else"
(let* [el (eval-ast ast env)
f (first el)
args (rest el)]
(apply f args))))))))))
;; print
(def! PRINT (fn* [exp] (pr-str exp)))
;; repl
(def! repl-env (new-env))
(def! rep (fn* [strng]
(PRINT (EVAL (READ strng) repl-env))))
;; core.mal: defined directly using mal
(map (fn* [data] (env-set repl-env (nth data 0) (nth data 1))) core_ns)
(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env)))
(env-set repl-env '*ARGV* (rest *ARGV*))
;; core.mal: defined using the new language itself
(rep (str "(def! *host-language* \"" *host-language* "-mal\")"))
(rep "(def! not (fn* [a] (if a false true)))")
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
;; repl loop
(def! repl-loop (fn* []
(let* [line (readline "mal-user> ")]
(if line
(do
(if (not (= "" line))
(try*
(println (rep line))
(catch* exc
(println "Uncaught exception:" exc))))
(repl-loop))))))
(def! -main (fn* [& args]
(if (> (count args) 0)
(rep (str "(load-file \"" (first args) "\")"))
(do
(rep "(println (str \"Mal [\" *host-language* \"]\"))")
(repl-loop)))))
(apply -main *ARGV*)

View File

@ -2,7 +2,7 @@ TESTS =
SOURCES_BASE = readline.pm types.pm reader.pm printer.pm \
interop.pm
SOURCES_LISP = env.pm core.pm stepA_more.pl
SOURCES_LISP = env.pm core.pm stepA_interop.pl
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
#all: mal.pl

View File

@ -1,6 +1,7 @@
package interop;
use strict;
use warnings FATAL => qw(all);
no if $] >= 5.018, warnings => "experimental::smartmatch";
use feature qw(switch);
use Exporter 'import';
our @EXPORT_OK = qw( pl_to_mal );

View File

@ -1,6 +1,7 @@
package printer;
use strict;
use warnings FATAL => qw(all);
no if $] >= 5.018, warnings => "experimental::smartmatch";
use feature qw(switch);
use Exporter 'import';
our @EXPORT_OK = qw( _pr_str );

View File

@ -2,6 +2,7 @@ package reader;
use feature qw(switch);
use strict;
use warnings FATAL => qw(all);
no if $] >= 5.018, warnings => "experimental::smartmatch";
use Exporter 'import';
our @EXPORT_OK = qw( read_str );

View File

@ -1,5 +1,6 @@
use strict;
use warnings FATAL => qw(all);
no if $] >= 5.018, warnings => "experimental::smartmatch";
use File::Basename;
use lib dirname (__FILE__);
use readline qw(mal_readline);

View File

@ -1,5 +1,6 @@
use strict;
use warnings FATAL => qw(all);
no if $] >= 5.018, warnings => "experimental::smartmatch";
use File::Basename;
use lib dirname (__FILE__);
use readline qw(mal_readline);

View File

@ -1,5 +1,6 @@
use strict;
use warnings FATAL => qw(all);
no if $] >= 5.018, warnings => "experimental::smartmatch";
use File::Basename;
use lib dirname (__FILE__);
use readline qw(mal_readline);

View File

@ -1,5 +1,6 @@
use strict;
use warnings FATAL => qw(all);
no if $] >= 5.018, warnings => "experimental::smartmatch";
use File::Basename;
use lib dirname (__FILE__);
use readline qw(mal_readline);

View File

@ -1,5 +1,6 @@
use strict;
use warnings FATAL => qw(all);
no if $] >= 5.018, warnings => "experimental::smartmatch";
use File::Basename;
use lib dirname (__FILE__);
use readline qw(mal_readline);

View File

@ -1,5 +1,6 @@
use strict;
use warnings FATAL => qw(all);
no if $] >= 5.018, warnings => "experimental::smartmatch";
use File::Basename;
use lib dirname (__FILE__);
use readline qw(mal_readline);

View File

@ -1,5 +1,6 @@
use strict;
use warnings FATAL => qw(all);
no if $] >= 5.018, warnings => "experimental::smartmatch";
use File::Basename;
use lib dirname (__FILE__);
use readline qw(mal_readline);

View File

@ -1,5 +1,6 @@
use strict;
use warnings FATAL => qw(all);
no if $] >= 5.018, warnings => "experimental::smartmatch";
use File::Basename;
use lib dirname (__FILE__);
use readline qw(mal_readline);

View File

@ -1,5 +1,6 @@
use strict;
use warnings FATAL => qw(all);
no if $] >= 5.018, warnings => "experimental::smartmatch";
use File::Basename;
use lib dirname (__FILE__);
use readline qw(mal_readline);
@ -137,8 +138,32 @@ sub EVAL {
when (/^macroexpand$/) {
return macroexpand($a1, $env);
}
when (/^pl\*$/) {
return pl_to_mal(eval(${$a1}));
when (/^try\*$/) {
do {
local $@;
my $ret;
eval {
use autodie; # always "throw" errors
$ret = EVAL($a1, $env);
1;
} or do {
my $err = $@;
if ($a2 && ${$a2->nth(0)} eq "catch\*") {
my $exc;
if (ref $err) {
$exc = $err;
} else {
$exc = String->new(substr $err, 0, -1);
}
return EVAL($a2->nth(2), Env->new($env,
List->new([$a2->nth(1)]),
List->new([$exc])));
} else {
die $err;
}
};
return $ret;
};
}
when (/^do$/) {
eval_ast($ast->slice(1, $#{$ast->{val}}-1), $env);
@ -193,13 +218,18 @@ my @_argv = map {String->new($_)} @ARGV[1..$#ARGV];
$repl_env->set('*ARGV*', List->new(\@_argv));
# core.mal: defined using the language itself
REP("(def! *host-language* \"javascript\")");
REP("(def! not (fn* (a) (if a false true)))");
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
if (scalar(@ARGV) > 0) {
REP("(load-file \"" . $ARGV[0] . "\")");
exit 0;
}
REP("(println (str \"Mal [\" *host-language* \"]\"))");
while (1) {
my $line = mal_readline("user> ");
if (! defined $line) { last; }

View File

@ -1,5 +1,6 @@
use strict;
use warnings FATAL => qw(all);
no if $] >= 5.018, warnings => "experimental::smartmatch";
use File::Basename;
use lib dirname (__FILE__);
use readline qw(mal_readline);

View File

@ -1,6 +1,7 @@
package types;
use strict;
use warnings FATAL => qw(all);
no if $] >= 5.018, warnings => "experimental::smartmatch";
use feature qw(switch);
use Exporter 'import';
our @EXPORT_OK = qw(_sequential_Q _equal_Q _clone

View File

@ -2,7 +2,7 @@
TESTS =
SOURCES_BASE = readline.php types.php reader.php printer.php
SOURCES_LISP = env.php core.php stepA_more.php
SOURCES_LISP = env.php core.php stepA_interop.php
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
.PHONY: stats tests $(TESTS)

View File

@ -108,8 +108,24 @@ function MAL_EVAL($ast, $env) {
return $env->set($ast[1]->value, $func);
case "macroexpand":
return macroexpand($ast[1], $env);
case "php*":
return eval($ast[1]);
case "try*":
$a1 = $ast[1];
$a2 = $ast[2];
if ($a2[0]->value === "catch*") {
try {
return MAL_EVAL($a1, $env);
} catch (Error $e) {
$catch_env = new Env($env, array($a2[1]),
array($e->obj));
return MAL_EVAL($a2[2], $catch_env);
} catch (Exception $e) {
$catch_env = new Env($env, array($a2[1]),
array($e->getMessage()));
return MAL_EVAL($a2[2], $catch_env);
}
} else {
return MAL_EVAL($a1, $env);
}
case "do":
eval_ast($ast->slice(1, -1), $env);
$ast = $ast[count($ast)-1];
@ -168,6 +184,7 @@ for ($i=2; $i < count($argv); $i++) {
$repl_env->set('*ARGV*', $_argv);
// core.mal: defined using the language itself
rep("(def! *host-language* \"php\")");
rep("(def! not (fn* (a) (if a false true)))");
rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
@ -179,6 +196,7 @@ if (count($argv) > 1) {
}
// repl loop
rep("(println (str \"Mal [\" *host-language* \"]\"))");
do {
try {
$line = mal_readline("user> ");

View File

@ -0,0 +1,25 @@
;; Testing basic php interop
(php* "return 7;")
;=>7
(php* "return '7';")
;=>"7"
(php* "return array(7,8,9);")
;=>(7 8 9)
(php* "return array(\"abc\" => 789);")
;=>{"abc" 789}
(php* "print \"hello\n\";")
; hello
;=>nil
(php* "global $foo; $foo=8;")
(php* "global $foo; return $foo;")
;=>8
(php* "global $f; $f = function($v) { return 1+$v; };")
(php* "global $f; return array_map($f, array(1,2,3));")
;=>(2 3 4)

View File

@ -2,7 +2,7 @@
TESTS =
SOURCES_BASE = types.ps reader.ps printer.ps
SOURCES_LISP = env.ps core.ps stepA_more.ps
SOURCES_LISP = env.ps core.ps stepA_interop.ps
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
.PHONY: stats tests $(TESTS)

21
ps/interop.ps Normal file
View File

@ -0,0 +1,21 @@
% ps_val -> ps2mal -> mal_val
/ps2mal {
% convert a PS value to a Mal value (recursively)
[ exch
{ %forall returned values
dup ==
dup type /arraytype eq {
(here1\n) print
_list_from_array
}{ dup type /dicttype eq {
(here2\n) print
_hash_map_from_dict
}{
(here3\n) print
% no-op
} ifelse } ifelse
} forall
]
(here4\n) print
} def

View File

@ -144,20 +144,6 @@ end } def
env exch a1 exch env_set % def! it
}{ /macroexpand a0 eq { %if defmacro!
ast 1 _nth env macroexpand
}{ /ps* a0 eq { %if ps*
count /stackcnt exch def
ast 1 _nth
{
token not { exit } if
exch
} loop
exec
count stackcnt gt { % if new operands on stack
% return an list of new operands
count stackcnt sub array astore
}{
null % return nil
} ifelse
}{ /do a0 eq { %if do
ast _count 2 gt { %if ast has more than 2 elements
ast 1 ast _count 2 sub _slice env eval_ast pop
@ -165,6 +151,42 @@ end } def
ast ast _count 1 sub _nth % last ast becomes new ast
env
/loop? true def % loop
}{ /try* a0 eq { %if try*
{ %try
countdictstack /dictcnt exch def
count /stackcnt exch def
ast 1 _nth env EVAL
} stopped { %catch
% clean up the dictionary stack
1 1 countdictstack dictcnt sub { %foreach added dict
%(popping dict\n) print
pop end % pop idx and pop dict
%(new ast: ) print ast true _pr_str print (\n) print
} for
% clean up the operand stack
count 1 exch 1 exch stackcnt sub { %foreach added operand
%(op stack: ) print pstack
pop pop % pop idx and operand
%(popped op stack\n) print pstack
} for
% get error data and reset $error dict
/errdata get_error_data def
$error /newerror false put
$error /errorinfo null put
ast _count 3 lt { %if no third (catch*) form
errdata throw
} if
ast 2 _nth 0 _nth (catch*) eq not { %if third form not catch*
(No catch* in throw form) _throw
} if
ast 2 _nth 2 _nth
env
ast 2 _nth 1 _nth 1 _list
errdata 1 _list
env_new
EVAL
} if
}{ /if a0 eq { %if if
/a1 ast 1 _nth def
/cond a1 env EVAL def
@ -222,6 +244,7 @@ core_ns { _function _ref } forall
(*ARGV*) [ ] _list_from_array _ref
% core.mal: defined using the language itself
(\(def! *host-language* "postscript"\)) RE pop
(\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop
(\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\)"\)\)\)\)\)) RE pop
(\(defmacro! cond \(fn* \(& xs\) \(if \(> \(count xs\) 0\) \(list 'if \(first xs\) \(if \(> \(count xs\) 1\) \(nth xs 1\) \(throw "odd number of forms to cond"\)\) \(cons 'cond \(rest \(rest xs\)\)\)\)\)\)\)) RE pop
@ -238,6 +261,7 @@ userdict /ARGUMENTS known { %if command line arguments
} if
% repl loop
(\(println \(str "Mal [" *host-language* "]"\)\)) RE pop
{ %loop
(user> ) _readline
not { exit } if % exit if EOF

View File

@ -3,7 +3,7 @@ TESTS =
SOURCES_BASE = mal_readline.py mal_types.py reader.py printer.py
SOURCES_LISP = env.py core.py stepA_more.py
SOURCES_LISP = env.py core.py stepA_interop.py
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)

View File

@ -97,12 +97,17 @@ def EVAL(ast, env):
else:
exec(compile(ast[1], '', 'single') in globals())
return None
elif "py*" == a0:
return eval(ast[1])
elif "." == a0:
el = eval_ast(ast[2:], env)
f = eval(ast[1])
return f(*el)
elif "try*" == a0:
a1, a2 = ast[1], ast[2]
if a2[0] == "catch*":
try:
return EVAL(a1, env);
except Exception as exc:
exc = exc.args[0]
catch_env = Env(env, [a2[1]], [exc])
return EVAL(a2[2], catch_env)
else:
return EVAL(a1, env);
elif "do" == a0:
eval_ast(ast[1:-1], env)
ast = ast[-1]
@ -143,6 +148,7 @@ repl_env.set('eval', lambda ast: EVAL(ast, repl_env))
repl_env.set('*ARGV*', types._list(*sys.argv[2:]))
# core.mal: defined using the language itself
REP("(def! *host-language* \"python\")")
REP("(def! not (fn* (a) (if a false true)))")
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
@ -153,6 +159,7 @@ if len(sys.argv) >= 2:
sys.exit(0)
# repl loop
REP("(println (str \"Mal [\" *host-language* \"]\"))")
while True:
try:
line = mal_readline.readline("user> ")

View File

@ -1,7 +1,7 @@
TESTS =
SOURCES_BASE = mal_readline.rb types.rb reader.rb printer.rb
SOURCES_LISP = env.rb core.rb stepA_more.rb
SOURCES_LISP = env.rb core.rb stepA_interop.rb
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
#all: mal.rb

View File

@ -0,0 +1,27 @@
;; Testing basic ruby interop
(rb* "7")
;=>7
(rb* "'7'")
;=>"7"
(rb* "[7,8,9]")
;=>(7 8 9)
(rb* "{\"abc\" => 789}")
;=>{"abc" 789}
(rb* "print 'hello\n'")
; hello
;=>nil
(rb* "$foo=8;")
(rb* "$foo")
;=>8
(rb* "['a','b','c'].map{|x| 'X'+x+'Y'}.join(' ')")
;=>"XaY XbY XcY"
(rb* "[1,2,3].map{|x| 1+x}")
;=>(2 3 4)

View File

@ -51,6 +51,10 @@ abc-def
;=>(+ 1 (+ 2 3))
( + 1 (+ 2 3 ) )
;=>(+ 1 (+ 2 3))
(* 1 2)
;=>(* 1 2)
(** 1 2)
;=>(** 1 2)
;; Testing read of vectors
[+ 1 2]