kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-10-05 18:08:55 +03:00
Code Issues Projects Releases Wiki Activity

New SWI-prolog implementation

Browse Source 
with, in stepA_mal.mal, a new way to pass all test and break
self-hosting nevertheless.
This commit is contained in:
Nicolas Boulenguez 2020-08-21 22:48:58 +02:00 committed by Joel Martin
parent f1c1cde289
commit 0ee1a51777
24 changed files with 2213 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.travis.yml
View File

@ -73,6 +73,7 @@ matrix:
- {env: IMPL=pike, services: [docker]}
- {env: IMPL=plpgsql NO_SELF_HOST=1, services: [docker]} # step3 timeout
# - {env: IMPL=plsql, services: [docker]}
- {env: IMPL=prolog, services: [docker]}
- {env: IMPL=ps, services: [docker]}
- {env: IMPL=powershell NO_SELF_HOST_PERF=1, services: [docker]} # perf timeout
- {env: IMPL=python python_MODE=python2, services: [docker]}

4
Makefile
View File

@ -93,7 +93,7 @@ IMPLS = ada ada.2 awk bash basic bbc-basic c chuck clojure coffee common-lisp cp
elisp elixir elm erlang es6 factor fantom forth fsharp go groovy gnu-smalltalk \
guile haskell haxe hy io java js jq julia kotlin livescript logo lua make mal \
matlab miniMAL nasm nim objc objpascal ocaml perl perl6 php picolisp pike plpgsql \
plsql powershell ps python python.2 r racket rexx rpython ruby rust scala scheme skew \
plsql powershell prolog ps python python.2 r racket rexx rpython ruby rust scala scheme skew \
swift swift3 swift4 swift5 tcl ts vala vb vhdl vimscript wasm wren yorick xslt zig
EXTENSION = .mal
@ -134,6 +134,7 @@ step5_EXCLUDES += matlab # never completes at 10,000
step5_EXCLUDES += plpgsql # too slow for 10,000
step5_EXCLUDES += plsql # too slow for 10,000
step5_EXCLUDES += powershell # too slow for 10,000
step5_EXCLUDES += prolog # no iteration (but interpreter does TCO implicitly)
step5_EXCLUDES += $(if $(filter cpp,$(haxe_MODE)),haxe,) # cpp finishes 10,000, segfaults at 100,000
step5_EXCLUDES += xslt # iteration cannot be expressed
@ -243,6 +244,7 @@ pike_STEP_TO_PROG = impls/pike/$($(1)).pike
plpgsql_STEP_TO_PROG = impls/plpgsql/$($(1)).sql
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
python_STEP_TO_PROG = impls/python/$($(1)).py
python.2_STEP_TO_PROG = impls/python.2/$($(1)).py

14
README.md
View File

@ -41,7 +41,7 @@ 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 82 languages (85 different implementations and 105 runtime modes)**
**3. Mal is implemented in 83 languages (86 different implementations and 106 runtime modes)**
| Language | Creator |
| -------- | ------- |
@ -104,6 +104,7 @@ FAQ](docs/FAQ.md) where I attempt to answer some common questions.
| [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) |
| [Prolog](#prolog-logical-language) | [Nicolas Boulenguez](https://github.com/asarhaddon) |
| [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) |
@ -871,6 +872,17 @@ cd impls/powershell
powershell ./stepX_YYY.ps1
```
### Prolog
The Prolog implementation uses some constructs specific to SWI-Prolog,
includes readline support and has been tested on Debian GNU/Linux with
version 8.2.1.
```
cd impls/prolog
swipl stepX_YYY
```
### Python (2.X and 3.X)
```

21
impls/prolog/Dockerfile Normal file
View File

@ -0,0 +1,21 @@
FROM ubuntu:18.04
MAINTAINER Joel Martin <github@martintribe.org>
##########################################################
# General requirements for testing or common across many
# implementations
##########################################################
RUN apt-get -y update
# Required for running tests
RUN apt-get -y install make python
RUN mkdir -p /mal
WORKDIR /mal
##########################################################
# Specific implementation requirements
##########################################################
RUN apt-get -y install swi-prolog-nox

2
impls/prolog/Makefile Normal file
View File

@ -0,0 +1,2 @@
# Stub Makefile to make Travis test mode happy.
all clean:

264
impls/prolog/core.pl Normal file
View File

@ -0,0 +1,264 @@
% -*- mode: prolog; -*- select prolog mode in the emacs text editor
wrap_failure(Goal, Args, Res) :-
check(call(Goal,Args, Res),
"~a: wrong arguments: ~L", [Goal, Args]).
bool(Goal, true) :- call(Goal), !.
bool(_, false).
'nil?'([X], R) :- bool(=(nil,X), R).
'false?'([X], R) :- bool(=(false, X), R).
'true?'([X], R) :- bool(=(true, X), R).
% Numbers
'number?'([X], R) :- bool(integer(X), R).
add([X, Y], R) :- integer(X), integer(Y), R is X + Y.
sub([X, Y], R) :- integer(X), integer(Y), R is X - Y.
mul([X, Y], R) :- integer(X), integer(Y), R is X * Y.
div([X, Y], R) :- integer(X), integer(Y), Y \= 0, R is X / Y.
'<='([X, Y], R) :- integer(X), integer(Y), bool(=<(X, Y), R).
ge( [X, Y], R) :- integer(X), integer(Y), bool(>=(X, Y), R).
lt( [X, Y], R) :- integer(X), integer(Y), bool(<(X, Y), R).
gt( [X, Y], R) :- integer(X), integer(Y), bool(>(X, Y), R).
% Symbols
'symbol?'([false], false).
'symbol?'([nil], false).
'symbol?'([true], false).
'symbol?'([X], R) :- bool(atom(X), R).
symbol([X], R) :- string(X), atom_string(R, X).
% Keywords
'keyword?'([X], R) :- bool(=(X, mal_kwd(_)), R).
keyword([X], mal_kwd(X)) :- string(X).
keyword([R], R) :- R = mal_kwd(_).
% Sequences
'list?'([X], R) :- bool(list(_, X), R).
'vector?'([X], R) :- bool(vector(_, X), R).
'sequential?'([X], R) :- bool(unbox_seq(X, _), R).
'empty?'([X], R) :- bool(unbox_seq(X, []), R).
count([X], R) :- unbox_seq(X, S), !, length(S, R).
count([nil], 0).
vec([X], R) :- unbox_seq(X, S), vector(S, R).
cons([X, Y], R) :- unbox_seq(Y, Ys), list([X | Ys], R).
concat(Xs, Z) :- maplist(unbox_seq, Xs, Ys), append(Ys, Zs), list(Zs, Z).
nth([Sequence, Index], Element) :-
unbox_seq(Sequence, Xs),
check(nth0(Index, Xs, Element),
"nth: index ~d out of bounds of ~F", [Index, Sequence]).
first([X], Y) :- unbox_seq(X, Xs), !,
(Xs = [Y | _] -> true ; Y = nil).
first([nil], nil).
rest([X], R) :- unbox_seq(X, Xs), !,
(Xs = [_ | Rs] -> true ; Rs = []),
list(Rs, R).
rest([nil], R) :- list([], R).
map([Fn, Seq], R) :-
unbox_seq(Seq, Xs),
mal_fn(Goal, Fn),
maplist(enlist_apply(Goal), Xs, Rs), list(Rs, R).
enlist_apply(Goal, X, R) :- call(Goal, [X], R).
conj([Vector | Ys], R) :- vector(Xs, Vector), !,
append(Xs, Ys, Zs),
vector(Zs, R).
conj([List | Ys], R) :- list(Xs, List),
foldl(cons, Ys, Xs, Zs), list(Zs, R).
cons(X, Xs, [X | Xs]).
seq([X], nil) :- unbox_seq(X, []).
seq([X], X) :- list(_, X).
seq([X], R) :- vector(Xs, X), !, list(Xs, R).
seq([""], nil).
seq([S], R) :- string(S), !,
string_chars(S, Chars),
maplist(atom_string, Chars, Strings),
list(Strings, R).
seq([nil], nil).
% Maps (there is little not much we can do out of types).
'map?'([X], R) :- bool(is_map(X), R).
get([Map, Key], R) :- get(Map, Key, R).
get([_, _], nil).
'contains?'([Map, Key], R) :- bool(get(Map, Key, _), R).
dissoc([Map | Keys], Res) :- foldl(dissoc, Keys, Map, Res).
% Atoms
'atom?'([X], R) :- bool(mal_atom(_, X), R).
atom([A], R) :- mal_atom(A, R).
deref([A], R) :- mal_atom(R, A).
'reset!'([A, R], R) :- mal_atom(_, A), set_mal_atom_value(A, R).
'swap!'([Atom, Function | Args], R) :-
mal_atom(Old, Atom),
mal_fn(Goal, Function),
call(Goal, [Old | Args], R),
set_mal_atom_value(Atom, R).
apply([Fn | Xs], R) :-
flatten_last(Xs, Args),
mal_fn(Goal, Fn),
call(Goal, Args, R).
flatten_last([X], Xs) :- unbox_seq(X, Xs).
flatten_last([X | Xs], [X | Ys]) :- flatten_last(Xs, Ys).
% Strings
'string?'([X], R) :- bool(string(X), R).
'pr-str'(Args, R) :- with_output_to(string(R), print_list(t, " ", Args)).
str( Args, R) :- with_output_to(string(R), print_list(f, "", Args)).
prn( Args, nil) :- print_list(t, " ", Args), nl.
println( Args, nil) :- print_list(f, " ", Args), nl.
'read-string'([S], R) :- string(S), read_str(S, R).
slurp([Path], R) :-
string(Path),
(read_file_to_string(Path, R, []) -> true ; R = nil).
readline([Prompt], R) :-
string(Prompt),
write(Prompt),
read_line_to_string(current_input, R),
(R = end_of_file -> R = nil ; true).
throw([X], nil) :- throw(mal_error(X)).
'time-ms'([], Ms) :- get_time(S), Ms is round(1_000*S).
eq([X, Y], R) :- bool(mal_equal(X, Y), R).
'fn?'([X], R) :- bool(mal_fn(_, X), R).
'macro?'([X], R) :- bool(mal_macro(_, X), R).
'prolog-asserta'([String], nil) :-
string(String),
catch((read_term_from_atom(String, Term, []),
asserta(Term)),
Error,
throwf("prolog-asserta: ~w", [Error])).
'prolog-call'([String], Res) :-
string(String),
catch((read_term_from_atom(String, Term, []),
call(Term, Res)),
Error,
throwf("prolog-call: ~w", [Error])),
check(valid_mal(Res), "prolog-call: invalid result: ~w", [Res]).
core_ns([
% naming exceptions
'+', add,
'-', sub,
'*', mul,
'/', div,
'=', eq,
'<', lt,
'>=', ge,
'>', gt,
% step 4
'<=', '<=',
prn, prn,
list, list,
'list?', 'list?',
'empty?', 'empty?',
count, count,
'pr-str', 'pr-str',
str, str,
println, println,
% step 6
'read-string', 'read-string',
slurp, slurp,
atom, atom,
'atom?', 'atom?',
deref, deref,
'reset!', 'reset!',
'swap!', 'swap!',
% step 7
cons, cons,
concat, concat,
vec, vec,
% step 8
nth, nth,
first, first,
rest, rest,
% step 9
throw, throw,
apply, apply,
map, map,
'nil?', 'nil?',
'true?', 'true?',
'false?', 'false?',
'symbol?', 'symbol?',
symbol, symbol,
keyword, keyword,
'keyword?', 'keyword?',
vector, vector,
'vector?', 'vector?',
'sequential?', 'sequential?',
'hash-map', 'hash-map',
'map?', 'map?',
assoc, assoc,
dissoc, dissoc,
get, get,
'contains?', 'contains?',
keys, keys,
vals, vals,
% step A
readline, readline,
meta, meta,
'with-meta', 'with-meta',
'time-ms', 'time-ms',
conj, conj,
'string?', 'string?',
'number?', 'number?',
'fn?', 'fn?',
'macro?', 'macro?',
seq, seq,
'prolog-asserta', 'prolog-asserta',
'prolog-call', 'prolog-call']).

31
impls/prolog/env.pl Normal file
View File

@ -0,0 +1,31 @@
% -*- mode: prolog; -*- select prolog mode in the emacs text editor
:- format_predicate('V', env_format(_Arg,_Env)).
env(mal_env(Assoc, t)) :- empty_assoc(Assoc).
env(Outer, mal_env(Assoc, Outer)) :- empty_assoc(Assoc).
env_get(mal_env(Assoc, _), Key, Value) :- get_assoc(Key, Assoc, Value).
env_get(mal_env(_, Outer), Key, Value) :- env_get(Outer, Key, Value).
env_set(Env, Key, Value) :-
Env = mal_env(Old, _),
put_assoc(Key, Old, Value, New),
setarg(1, Env, New).
env_format(_Arg, mal_env(Assoc, _Outer)) :-
assoc_to_list(Assoc, Pairs),
maplist(env_format_pair, Pairs).
env_format_pair(K - V) :- format(" ~a:~F", [K, V]).
% Does *not* check that the keys are symbols. This is done once when
% the fn* structure is created.
env_bind(_Env, [], []).
env_bind(Env, ['&', K], Vs) :- !,
list(Vs, List),
env_set(Env, K, List).
env_bind(Env, [K | Ks], [V | Vs]) :-
env_set(Env, K, V),
env_bind(Env, Ks, Vs).

62
impls/prolog/printer.pl Normal file
View File

@ -0,0 +1,62 @@
% -*- mode: prolog; -*- select prolog mode in the emacs text editor
:- format_predicate('F', format_mal_form(_Arg,_Form)).
:- format_predicate('L', format_mal_list(_Arg,_Forms)).
format_mal_list(_Arg, Forms) :- print_list(t, " ", Forms).
format_mal_form(_Arg, Form) :- pr_str(t, Form).
pr_str(t, String) :- string(String), !,
write("\""),
string_codes(String, Codes),
maplist(pr_str_escape, Codes),
write("\"").
pr_str(_, Atomic) :- atomic(Atomic), !,
% number, symbol, nil, true, false, unreadable string.
write(Atomic).
pr_str(_, mal_kwd(Keyword)) :- !,
put_char(:),
write(Keyword).
pr_str(Readably, Vector) :- vector(Elements, Vector), !,
write("["),
print_list(Readably, " ", Elements),
write("]").
pr_str(Readably, List) :- list(Elements, List), !,
write("("),
print_list(Readably, " ", Elements),
write(")").
pr_str(Readably, Map) :- map_to_key_value_list(Map, Key_Value_List), !,
write("{"),
print_list(Readably, " ", Key_Value_List),
write("}").
pr_str(_, Fn) :- mal_fn(_Goal, Fn), !, write("<fn>").
pr_str(_, Macro) :- mal_macro(_Fn, Macro), !,
write("<macro>").
pr_str(_, Atom) :- mal_atom(Value, Atom), !,
format("(atom ~F)", [Value]).
pr_str(_, Invalid) :-
format(string(Msg), "pr_str detected an invalid form: ~w\n", [Invalid]),
print_message(warning, Msg),
abort.
pr_str_escape(0'\n) :- write("\\n").
pr_str_escape(0'") :- write("\\\"").
pr_str_escape(0'\\) :- write("\\\\").
pr_str_escape(C) :- put_code(C).
print_list(_, _, []).
print_list(Readably, Separator, [X | Xs]) :-
pr_str(Readably, X),
maplist(print_list_append(Readably, Separator), Xs).
print_list_append(Readably, Separator, Element) :-
write(Separator),
pr_str(Readably, Element).

65
impls/prolog/reader.pl Normal file
View File

@ -0,0 +1,65 @@
% -*- mode: prolog; -*- select prolog mode in the emacs text editor
:- use_module(library(dcg/basics)).
read_str(String, Form) :-
string_codes(String, Codes),
check(phrase(read_form(Form), Codes, _Rest),
"unbalanced expression: '~s'", [String]).
read_form(Res) --> zero_or_more_separators, (
`(`, !, read_list(`)`, Forms), { list(Forms, Res) }
| `[`, !, read_list(`]`, Forms), { vector(Forms, Res) }
| `{`, !, read_list(`}`, Forms), { 'hash-map'(Forms, Res) }
| `\``, !, read_form(Form), { list([quasiquote, Form], Res) }
| `\'`, !, read_form(Form), { list([quote, Form], Res) }
| `^`, !, read_form(Meta), read_form(Data), { list(['with-meta', Data, Meta], Res) }
| `:`, !, at_least_one_symcode(Codes), { string_codes(String, Codes),
Res = mal_kwd(String) }
| `\"`, !, until_quotes(Codes), { string_codes(Res, Codes) }
| `@`, !, read_form(Form), { list([deref, Form], Res) }
| `~@`, !, read_form(Form), { list(['splice-unquote', Form], Res) }
| `~`, !, read_form(Form), { list([unquote, Form], Res) }
| integer(Res)
| at_least_one_symcode(Cs), { atom_codes(Res, Cs) }).
read_list(Closing, [Form | Forms]) --> read_form(Form), !, read_list(Closing, Forms).
read_list(Closing, []) --> zero_or_more_separators, Closing.
zero_or_more_separators --> separator, !, zero_or_more_separators
| [].
separator --> [C], { sepcode(C) }, !.
separator --> `;`, string_without(`\n`, _Comment).
at_least_one_symcode([C | Cs]) --> [C], { symcode(C) }, zero_or_more_symcodes(Cs).
until_quotes([]) --> [0'"].
until_quotes([0'\n | Cs]) --> `\\n`, !, until_quotes(Cs).
until_quotes([0'" | Cs]) --> `\\\"`, !, until_quotes(Cs).
until_quotes([0'\\ | Cs]) --> `\\\\`, !, until_quotes(Cs).
until_quotes([C | Cs]) --> [C], until_quotes(Cs).
zero_or_more_symcodes(Cs) --> at_least_one_symcode(Cs), !.
zero_or_more_symcodes([]) --> [].
sepcode(0',).
sepcode(0' ).
sepcode(0'\n).
symcode(C) :- code_type(C, alnum).
symcode(0'!).
symcode(0'#).
symcode(0'$).
symcode(0'%).
symcode(0'&).
symcode(0'*).
symcode(0'+).
symcode(0'-).
symcode(0'/).
symcode(0'<).
symcode(0'=).
symcode(0'>).
symcode(0'?).
symcode(0'_).
symcode(0'|).

2
impls/prolog/run Executable file
View File

@ -0,0 +1,2 @@
#!/bin/bash
exec swipl $(dirname $0)/${STEP:-stepA_mal}.pl "${@}"

41
impls/prolog/step0_repl.pl Normal file
View File

@ -0,0 +1,41 @@
% -*- mode: prolog; -*- select prolog mode in the emacs text editor
:- initialization(main, main).
% Read
mal_read(Line) :-
write("user> "),
read_line_to_string(current_input, Line),
(Line = end_of_file -> throw(exit_repl) ; true),
(rl_add_history(Line) -> true ; true). % fails for duplicate lines
% Eval
eval(Ast, Ast).
% Print
print(Ast) :- writeln(Ast).
% REP
rep :-
mal_read(Ast),
eval(Ast, Evaluated),
print(Evaluated).
% Main program
repl :-
rep,
repl.
main(_Argv) :-
getenv("HOME", Home),
string_concat(Home, "/.mal-history", History),
(exists_file(History) -> rl_read_history(History) ; true),
catch(repl, exit_repl, nl),
(rl_write_history(History) -> true ; true).

44
impls/prolog/step1_read_print.pl Normal file
View File

@ -0,0 +1,44 @@
% -*- mode: prolog; -*- select prolog mode in the emacs text editor
:- initialization(main, main).
:- consult([printer, reader, types, utils]).
% Read
mal_read(Ast) :-
write("user> "),
read_line_to_string(current_input, Line),
(Line = end_of_file -> throw(exit_repl) ; true),
(rl_add_history(Line) -> true ; true), % fails for duplicate lines
read_str(Line, Ast).
% Eval
eval(Ast, Ast).
% Print
print(Ast) :- format("~F\n", [Ast]).
% REP
rep :-
mal_read(Ast),
eval(Ast, Evaluated),
print(Evaluated).
% Main program
repl :-
catch(rep, mal_error(Message), writeln(Message)),
repl.
main(_Argv) :-
getenv("HOME", Home),
string_concat(Home, "/.mal-history", History),
(exists_file(History) -> rl_read_history(History) ; true),
catch(repl, exit_repl, nl),
(rl_write_history(History) -> true ; true).

86
impls/prolog/step2_eval.pl Normal file
View File

@ -0,0 +1,86 @@
% -*- mode: prolog; -*- select prolog mode in the emacs text editor
:- initialization(main, main).
:- consult([printer, reader, types, utils]).
% Read
mal_read(Ast) :-
write("user> "),
read_line_to_string(current_input, Line),
(Line = end_of_file -> throw(exit_repl) ; true),
(rl_add_history(Line) -> true ; true), % fails for duplicate lines
read_str(Line, Ast).
% apply phase
eval_list(Env, First, Rest, Res) :-
eval(Env, First, Fn),
check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]),
maplist(eval(Env), Rest, Args),
call(Goal, Args, Res).
% The eval function itself.
% Uncomment this to get a trace.
%% eval(_, Ast, _) :-
%% format("EVAL: ~F\n", [Ast]),
%% fail. % Proceed with normal alternatives.
eval(Env, List, Res) :-
list([First | Args], List), !,
eval_list(Env, First, Args, Res).
eval(_, nil, nil).
eval(_, true, true).
eval(_, false, false).
eval(Env, Symbol, Res) :-
atom(Symbol), !,
check(get_assoc(Symbol, Env, Res), "'~F' not found", [Symbol]).
eval(Env, Vector, Res) :-
vector(Xs, Vector), !,
maplist(eval(Env), Xs, Ys),
vector(Ys, Res).
eval(Env, Map, Res) :- map_map(eval(Env), Map, Res).
eval(_, Anything_Else, Anything_Else).
% Print
print(Ast) :- format("~F\n", [Ast]).
% REP
rep(Env) :-
mal_read(Ast),
eval(Env, Ast, Evaluated),
print(Evaluated).
% Main program
repl(Env) :-
catch(rep(Env), mal_error(Message), writeln(Message)),
repl(Env).
add([X, Y], Res) :- integer(X), integer(Y), Res is X + Y.
sub([X, Y], Res) :- integer(X), integer(Y), Res is X - Y.
mul([X, Y], Res) :- integer(X), integer(Y), Res is X * Y.
div([X, Y], Res) :- integer(X), integer(Y), Y \== 0, Res is X / Y.
main(_Argv) :-
getenv("HOME", Home),
string_concat(Home, "/.mal-history", History),
(exists_file(History) -> rl_read_history(History) ; true),
mal_fn(add, Add),
mal_fn(sub, Sub),
mal_fn(mul, Mul),
mal_fn(div, Div),
list_to_assoc(['+' - Add, '-' - Sub, '*' - Mul, '/' - Div], Env),
catch(repl(Env), exit_repl, nl),
(rl_write_history(History) -> true ; true).

107
impls/prolog/step3_env.pl Normal file
View File

@ -0,0 +1,107 @@
% -*- mode: prolog; -*- select prolog mode in the emacs text editor
:- initialization(main, main).
:- consult([env, printer, reader, types, utils]).
% Read
mal_read(Ast) :-
write("user> "),
read_line_to_string(current_input, Line),
(Line = end_of_file -> throw(exit_repl) ; true),
(rl_add_history(Line) -> true ; true), % fails for duplicate lines
read_str(Line, Ast).
% Eval non-empty list depending on their first element.
eval_list(Env, 'def!', Args, Res) :- !,
check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]),
check(atom(Key), "def!: ~F is not a symbol", [Key]),
eval(Env, Form, Res),
env_set(Env, Key, Res).
eval_list(Env, 'let*', Args, Res) :- !,
check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]),
check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]),
env(Env, Let_Env),
check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]),
eval(Let_Env, Form, Res).
let_loop(Env, Key, Form) :- !,
check(atom(Key), "let*: ~F is not a key", [Key]),
eval(Env, Form, Value),
env_set(Env, Key, Value).
% apply phase
eval_list(Env, First, Rest, Res) :-
eval(Env, First, Fn),
check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]),
maplist(eval(Env), Rest, Args),
call(Goal, Args, Res).
% The eval function itself.
% Uncomment this to get a trace with environments.
%% eval(Env, Ast, _) :-
%% format("EVAL: ~F in ~V\n", [Ast, Env]),
%% fail. % Proceed with normal alternatives.
eval(Env, List, Res) :-
list([First | Args], List), !,
eval_list(Env, First, Args, Res).
eval(_, nil, nil).
eval(_, true, true).
eval(_, false, false).
eval(Env, Symbol, Res) :-
atom(Symbol), !,
check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]).
eval(Env, Vector, Res) :-
vector(Xs, Vector), !,
maplist(eval(Env), Xs, Ys),
vector(Ys, Res).
eval(Env, Map, Res) :- map_map(eval(Env), Map, Res).
eval(_, Anything_Else, Anything_Else).
% Print
print(Ast) :- format("~F\n", [Ast]).
% REP
rep(Env) :-
mal_read(Ast),
eval(Env, Ast, Evaluated),
print(Evaluated).
% Main program
repl(Env) :-
catch(rep(Env), mal_error(Message), writeln(Message)),
repl(Env).
add([X, Y], Res) :- integer(X), integer(Y), Res is X + Y.
sub([X, Y], Res) :- integer(X), integer(Y), Res is X - Y.
mul([X, Y], Res) :- integer(X), integer(Y), Res is X * Y.
div([X, Y], Res) :- integer(X), integer(Y), Y \== 0, Res is X / Y.
define_core_function(Env, Symbol, Core_Function) :-
mal_fn(Core_Function, Form),
env_set(Env, Symbol, Form).
main(_Argv) :-
getenv("HOME", Home),
string_concat(Home, "/.mal-history", History),
(exists_file(History) -> rl_read_history(History) ; true),
env(Env),
map_keyvals(define_core_function(Env), ['+', add, '-', sub, '*', mul, '/', div]),
catch(repl(Env), exit_repl, nl),
(rl_write_history(History) -> true ; true).

142
impls/prolog/step4_if_fn_do.pl Normal file
View File

@ -0,0 +1,142 @@
% -*- mode: prolog; -*- select prolog mode in the emacs text editor
:- initialization(main, main).
:- consult([core, env, printer, reader, types, utils]).
% Read
mal_read(Ast) :-
write("user> "),
read_line_to_string(current_input, Line),
(Line = end_of_file -> throw(exit_repl) ; true),
(rl_add_history(Line) -> true ; true), % fails for duplicate lines
read_str(Line, Ast).
% Eval non-empty list depending on their first element.
:- discontiguous eval_list/4.
eval_list(Env, 'def!', Args, Res) :- !,
check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]),
check(atom(Key), "def!: ~F is not a symbol", [Key]),
eval(Env, Form, Res),
env_set(Env, Key, Res).
eval_list(Env, 'let*', Args, Res) :- !,
check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]),
check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]),
env(Env, Let_Env),
check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]),
eval(Let_Env, Form, Res).
let_loop(Env, Key, Form) :- !,
check(atom(Key), "let*: ~F is not a key", [Key]),
eval(Env, Form, Value),
env_set(Env, Key, Value).
eval_list(Env, if, Args, Res) :- !,
check(if_assign_args(Args, Form, Then, Else),
"if: expects 2 or 3 arguments, got: ~L", [Args]),
eval(Env, Form, Test),
if_select(Test, Then, Else, Selected),
eval(Env, Selected, Res).
if_assign_args([Form, Then, Else], Form, Then, Else).
if_assign_args([Form, Then], Form, Then, nil).
if_select(false, _, Else, Else) :- !.
if_select(nil, _, Else, Else) :- !.
if_select(_, Then, _, Then).
eval_list(Env, 'fn*', Args, Res) :- !,
check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]),
check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]),
check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]),
mal_fn(apply_fn(Keys, Form, Env), Res).
apply_fn(Keys, Form, Env, Args, Res) :-
env(Env, Apply_Env),
check(env_bind(Apply_Env, Keys, Args),
"cannot apply fn*[~L] to [~L]", [Keys, Args]),
eval(Apply_Env, Form, Res).
eval_list(Env, do, Args, Res) :- !,
foldl(do_loop(Env), Args, nil, Res).
do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc).
% apply phase
eval_list(Env, First, Rest, Res) :-
eval(Env, First, Fn),
check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]),
maplist(eval(Env), Rest, Args),
call(Goal, Args, Res).
% The eval function itself.
% Uncomment this to get a trace with environments.
%% eval(Env, Ast, _) :-
%% format("EVAL: ~F in ~V\n", [Ast, Env]),
%% fail. % Proceed with normal alternatives.
eval(Env, List, Res) :-
list([First | Args], List), !,
eval_list(Env, First, Args, Res).
eval(_, nil, nil).
eval(_, true, true).
eval(_, false, false).
eval(Env, Symbol, Res) :-
atom(Symbol), !,
check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]).
eval(Env, Vector, Res) :-
vector(Xs, Vector), !,
maplist(eval(Env), Xs, Ys),
vector(Ys, Res).
eval(Env, Map, Res) :- map_map(eval(Env), Map, Res).
eval(_, Anything_Else, Anything_Else).
% Print
print(Ast) :- format("~F\n", [Ast]).
% REP
rep(Env) :-
mal_read(Ast),
eval(Env, Ast, Evaluated),
print(Evaluated).
% Main program
repl(Env) :-
catch(rep(Env), mal_error(Message), writeln(Message)),
repl(Env).
re(Env, String) :-
read_str(String, Ast),
eval(Env, Ast, _).
define_core_function(Env, Symbol, Core_Function) :-
mal_fn(wrap_failure(Core_Function), Form),
env_set(Env, Symbol, Form).
main(_Argv) :-
getenv("HOME", Home),
string_concat(Home, "/.mal-history", History),
(exists_file(History) -> rl_read_history(History) ; true),
env(Env),
core_ns(Core_Ns),
map_keyvals(define_core_function(Env), Core_Ns),
define_core_function(Env, eval, core_eval(Env)),
re(Env, "(def! not (fn* [a] (if a false true)))"),
catch(repl(Env), exit_repl, nl),
(rl_write_history(History) -> true ; true).

159
impls/prolog/step6_file.pl Normal file
View File

@ -0,0 +1,159 @@
% -*- mode: prolog; -*- select prolog mode in the emacs text editor
:- initialization(main, main).
:- consult([core, env, printer, reader, types, utils]).
% Read
mal_read(Ast) :-
write("user> "),
read_line_to_string(current_input, Line),
(Line = end_of_file -> throw(exit_repl) ; true),
(rl_add_history(Line) -> true ; true), % fails for duplicate lines
read_str(Line, Ast).
% Eval non-empty list depending on their first element.
:- discontiguous eval_list/4.
eval_list(Env, 'def!', Args, Res) :- !,
check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]),
check(atom(Key), "def!: ~F is not a symbol", [Key]),
eval(Env, Form, Res),
env_set(Env, Key, Res).
eval_list(Env, 'let*', Args, Res) :- !,
check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]),
check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]),
env(Env, Let_Env),
check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]),
eval(Let_Env, Form, Res).
let_loop(Env, Key, Form) :- !,
check(atom(Key), "let*: ~F is not a key", [Key]),
eval(Env, Form, Value),
env_set(Env, Key, Value).
eval_list(Env, if, Args, Res) :- !,
check(if_assign_args(Args, Form, Then, Else),
"if: expects 2 or 3 arguments, got: ~L", [Args]),
eval(Env, Form, Test),
if_select(Test, Then, Else, Selected),
eval(Env, Selected, Res).
if_assign_args([Form, Then, Else], Form, Then, Else).
if_assign_args([Form, Then], Form, Then, nil).
if_select(false, _, Else, Else) :- !.
if_select(nil, _, Else, Else) :- !.
if_select(_, Then, _, Then).
eval_list(Env, 'fn*', Args, Res) :- !,
check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]),
check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]),
check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]),
mal_fn(apply_fn(Keys, Form, Env), Res).
apply_fn(Keys, Form, Env, Args, Res) :-
env(Env, Apply_Env),
check(env_bind(Apply_Env, Keys, Args),
"cannot apply fn*[~L] to [~L]", [Keys, Args]),
eval(Apply_Env, Form, Res).
eval_list(Env, do, Args, Res) :- !,
foldl(do_loop(Env), Args, nil, Res).
do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc).
% apply phase
eval_list(Env, First, Rest, Res) :-
eval(Env, First, Fn),
check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]),
maplist(eval(Env), Rest, Args),
call(Goal, Args, Res).
% The eval function itself.
% Uncomment this to get a trace with environments.
%% eval(Env, Ast, _) :-
%% format("EVAL: ~F in ~V\n", [Ast, Env]),
%% fail. % Proceed with normal alternatives.
eval(Env, List, Res) :-
list([First | Args], List), !,
eval_list(Env, First, Args, Res).
eval(_, nil, nil).
eval(_, true, true).
eval(_, false, false).
eval(Env, Symbol, Res) :-
atom(Symbol), !,
check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]).
eval(Env, Vector, Res) :-
vector(Xs, Vector), !,
maplist(eval(Env), Xs, Ys),
vector(Ys, Res).
eval(Env, Map, Res) :- map_map(eval(Env), Map, Res).
eval(_, Anything_Else, Anything_Else).
% Print
print(Ast) :- format("~F\n", [Ast]).
% REP
rep(Env) :-
mal_read(Ast),
eval(Env, Ast, Evaluated),
print(Evaluated).
% Main program
repl(Env) :-
catch(rep(Env), mal_error(Message), writeln(Message)),
repl(Env).
re(Env, String) :-
read_str(String, Ast),
eval(Env, Ast, _).
define_core_function(Env, Symbol, Core_Function) :-
mal_fn(wrap_failure(Core_Function), Form),
env_set(Env, Symbol, Form).
core_eval(Env, [Ast], Res) :- eval(Env, Ast, Res).
main(Argv) :-
getenv("HOME", Home),
string_concat(Home, "/.mal-history", History),
(exists_file(History) -> rl_read_history(History) ; true),
env(Env),
core_ns(Core_Ns),
map_keyvals(define_core_function(Env), Core_Ns),
define_core_function(Env, eval, core_eval(Env)),
re(Env, "(def! not (fn* [a] (if a false true)))"),
re(Env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"),
( maplist(atom_string, Argv, [Script | Args])
-> % If Argv starts with a script, set arguments and load it.
list(Args, Mal_Argv),
env_set(Env, '*ARGV*', Mal_Argv),
format(string(Load_Script), "(load-file \"~s\")", [Script]),
re(Env, Load_Script)
; % else read from standard input.
list([], Mal_Argv),
env_set(Env, '*ARGV*', Mal_Argv),
catch(repl(Env), exit_repl, nl)
),
(rl_write_history(History) -> true ; true).

198
impls/prolog/step7_quote.pl Normal file
View File

@ -0,0 +1,198 @@
% -*- mode: prolog; -*- select prolog mode in the emacs text editor
:- initialization(main, main).
:- consult([core, env, printer, reader, types, utils]).
% Read
mal_read(Ast) :-
write("user> "),
read_line_to_string(current_input, Line),
(Line = end_of_file -> throw(exit_repl) ; true),
(rl_add_history(Line) -> true ; true), % fails for duplicate lines
read_str(Line, Ast).
% Eval non-empty list depending on their first element.
:- discontiguous eval_list/4.
eval_list(Env, 'def!', Args, Res) :- !,
check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]),
check(atom(Key), "def!: ~F is not a symbol", [Key]),
eval(Env, Form, Res),
env_set(Env, Key, Res).
eval_list(Env, 'let*', Args, Res) :- !,
check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]),
check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]),
env(Env, Let_Env),
check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]),
eval(Let_Env, Form, Res).
let_loop(Env, Key, Form) :- !,
check(atom(Key), "let*: ~F is not a key", [Key]),
eval(Env, Form, Value),
env_set(Env, Key, Value).
eval_list(Env, if, Args, Res) :- !,
check(if_assign_args(Args, Form, Then, Else),
"if: expects 2 or 3 arguments, got: ~L", [Args]),
eval(Env, Form, Test),
if_select(Test, Then, Else, Selected),
eval(Env, Selected, Res).
if_assign_args([Form, Then, Else], Form, Then, Else).
if_assign_args([Form, Then], Form, Then, nil).
if_select(false, _, Else, Else) :- !.
if_select(nil, _, Else, Else) :- !.
if_select(_, Then, _, Then).
eval_list(Env, 'fn*', Args, Res) :- !,
check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]),
check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]),
check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]),
mal_fn(apply_fn(Keys, Form, Env), Res).
apply_fn(Keys, Form, Env, Args, Res) :-
env(Env, Apply_Env),
check(env_bind(Apply_Env, Keys, Args),
"cannot apply fn*[~L] to [~L]", [Keys, Args]),
eval(Apply_Env, Form, Res).
eval_list(Env, do, Args, Res) :- !,
foldl(do_loop(Env), Args, nil, Res).
do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc).
eval_list(_, quote, Args, Res) :- !,
check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]).
eval_list(_, quasiquoteexpand, Args, Res) :- !,
check(Args = [X], "quasiquoteexpand: expects 1 argument, got: ~L", [Args]),
quasiquote(X, Res).
eval_list(Env, quasiquote, Args, Res) :- !,
check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]),
quasiquote(X, Y),
eval(Env, Y, Res).
quasiquote(List, Res) :-
list(Xs, List), !,
( Xs = [unquote | Args]
-> check(Args = [Res], "unquote: expects 1 argument, got: ", [Args])
; list([], Empty),
foldr(qq_loop, Empty, Xs, Res)).
quasiquote(Vector, Res) :-
vector(Xs, Vector), !,
list([], Empty),
foldr(qq_loop, Empty, Xs, Y),
list([vec, Y], Res).
quasiquote(nil, nil).
quasiquote(true, true).
quasiquote(false, false).
quasiquote(Symbol_Or_Map, Res) :-
(atom(Symbol_Or_Map) -> true ; is_map(Symbol_Or_Map)), !,
list([quote, Symbol_Or_Map], Res).
quasiquote(Anything_Else, Anything_Else).
qq_loop(Elt, Acc, Res) :-
list(['splice-unquote' | Args], Elt), !,
check(Args = [X], "splice-unquote: expects 1 argument, got:", [Args]),
list([concat, X, Acc], Res).
qq_loop(Elt, Acc, Res) :-
quasiquote(Elt, Quasiquoted),
list([cons, Quasiquoted, Acc], Res).
% apply phase
eval_list(Env, First, Rest, Res) :-
eval(Env, First, Fn),
check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]),
maplist(eval(Env), Rest, Args),
call(Goal, Args, Res).
% The eval function itself.
% Uncomment this to get a trace with environments.
%% eval(Env, Ast, _) :-
%% format("EVAL: ~F in ~V\n", [Ast, Env]),
%% fail. % Proceed with normal alternatives.
eval(Env, List, Res) :-
list([First | Args], List), !,
eval_list(Env, First, Args, Res).
eval(_, nil, nil).
eval(_, true, true).
eval(_, false, false).
eval(Env, Symbol, Res) :-
atom(Symbol), !,
check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]).
eval(Env, Vector, Res) :-
vector(Xs, Vector), !,
maplist(eval(Env), Xs, Ys),
vector(Ys, Res).
eval(Env, Map, Res) :- map_map(eval(Env), Map, Res).
eval(_, Anything_Else, Anything_Else).
% Print
print(Ast) :- format("~F\n", [Ast]).
% REP
rep(Env) :-
mal_read(Ast),
eval(Env, Ast, Evaluated),
print(Evaluated).
% Main program
repl(Env) :-
catch(rep(Env), mal_error(Message), writeln(Message)),
repl(Env).
re(Env, String) :-
read_str(String, Ast),
eval(Env, Ast, _).
define_core_function(Env, Symbol, Core_Function) :-
mal_fn(wrap_failure(Core_Function), Form),
env_set(Env, Symbol, Form).
core_eval(Env, [Ast], Res) :- eval(Env, Ast, Res).
main(Argv) :-
getenv("HOME", Home),
string_concat(Home, "/.mal-history", History),
(exists_file(History) -> rl_read_history(History) ; true),
env(Env),
core_ns(Core_Ns),
map_keyvals(define_core_function(Env), Core_Ns),
define_core_function(Env, eval, core_eval(Env)),
re(Env, "(def! not (fn* [a] (if a false true)))"),
re(Env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"),
( maplist(atom_string, Argv, [Script | Args])
-> % If Argv starts with a script, set arguments and load it.
list(Args, Mal_Argv),
env_set(Env, '*ARGV*', Mal_Argv),
format(string(Load_Script), "(load-file \"~s\")", [Script]),
re(Env, Load_Script)
; % else read from standard input.
list([], Mal_Argv),
env_set(Env, '*ARGV*', Mal_Argv),
catch(repl(Env), exit_repl, nl)
),
(rl_write_history(History) -> true ; true).

228
impls/prolog/step8_macros.pl Normal file
View File

@ -0,0 +1,228 @@
% -*- mode: prolog; -*- select prolog mode in the emacs text editor
:- initialization(main, main).
:- consult([core, env, printer, reader, types, utils]).
% Read
mal_read(Ast) :-
write("user> "),
read_line_to_string(current_input, Line),
(Line = end_of_file -> throw(exit_repl) ; true),
(rl_add_history(Line) -> true ; true), % fails for duplicate lines
read_str(Line, Ast).
% Eval non-empty list depending on their first element.
:- discontiguous eval_list/4.
eval_list(Env, 'def!', Args, Res) :- !,
check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]),
check(atom(Key), "def!: ~F is not a symbol", [Key]),
eval(Env, Form, Res),
env_set(Env, Key, Res).
eval_list(Env, 'let*', Args, Res) :- !,
check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]),
check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]),
env(Env, Let_Env),
check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]),
eval(Let_Env, Form, Res).
let_loop(Env, Key, Form) :- !,
check(atom(Key), "let*: ~F is not a key", [Key]),
eval(Env, Form, Value),
env_set(Env, Key, Value).
eval_list(Env, if, Args, Res) :- !,
check(if_assign_args(Args, Form, Then, Else),
"if: expects 2 or 3 arguments, got: ~L", [Args]),
eval(Env, Form, Test),
if_select(Test, Then, Else, Selected),
eval(Env, Selected, Res).
if_assign_args([Form, Then, Else], Form, Then, Else).
if_assign_args([Form, Then], Form, Then, nil).
if_select(false, _, Else, Else) :- !.
if_select(nil, _, Else, Else) :- !.
if_select(_, Then, _, Then).
eval_list(Env, 'fn*', Args, Res) :- !,
check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]),
check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]),
check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]),
mal_fn(apply_fn(Keys, Form, Env), Res).
apply_fn(Keys, Form, Env, Args, Res) :-
env(Env, Apply_Env),
check(env_bind(Apply_Env, Keys, Args),
"cannot apply fn*[~L] to [~L]", [Keys, Args]),
eval(Apply_Env, Form, Res).
eval_list(Env, do, Args, Res) :- !,
foldl(do_loop(Env), Args, nil, Res).
do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc).
eval_list(_, quote, Args, Res) :- !,
check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]).
eval_list(_, quasiquoteexpand, Args, Res) :- !,
check(Args = [X], "quasiquoteexpand: expects 1 argument, got: ~L", [Args]),
quasiquote(X, Res).
eval_list(Env, quasiquote, Args, Res) :- !,
check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]),
quasiquote(X, Y),
eval(Env, Y, Res).
quasiquote(List, Res) :-
list(Xs, List), !,
( Xs = [unquote | Args]
-> check(Args = [Res], "unquote: expects 1 argument, got: ", [Args])
; list([], Empty),
foldr(qq_loop, Empty, Xs, Res)).
quasiquote(Vector, Res) :-
vector(Xs, Vector), !,
list([], Empty),
foldr(qq_loop, Empty, Xs, Y),
list([vec, Y], Res).
quasiquote(nil, nil).
quasiquote(true, true).
quasiquote(false, false).
quasiquote(Symbol_Or_Map, Res) :-
(atom(Symbol_Or_Map) -> true ; is_map(Symbol_Or_Map)), !,
list([quote, Symbol_Or_Map], Res).
quasiquote(Anything_Else, Anything_Else).
qq_loop(Elt, Acc, Res) :-
list(['splice-unquote' | Args], Elt), !,
check(Args = [X], "splice-unquote: expects 1 argument, got:", [Args]),
list([concat, X, Acc], Res).
qq_loop(Elt, Acc, Res) :-
quasiquote(Elt, Quasiquoted),
list([cons, Quasiquoted, Acc], Res).
eval_list(Env, 'defmacro!', Args, Res) :- !,
check(Args = [Key, Form],
"defmacro!: expects 2 arguments, got: ~L", [Args]),
check(atom(Key), "defmacro!: ~F is not a key", [Key]),
eval(Env, Form, Fn),
check(mal_fn(_Goal, Fn), "defmacro!: ~F is not a function", [Fn]),
mal_macro(Fn, Res),
env_set(Env, Key, Res).
eval_list(Env, macroexpand, Args, Res) :- !,
check(Args = [X], "macroexpand: expects 1 argument, got: ~L", [Args]),
macroexpand(Env, X, Res).
macroexpand(Env, Ast, Res) :-
list([Key | Args], Ast),
env_get(Env, Key, Macro),
mal_macro(Fn, Macro), !,
mal_fn(Goal, Fn),
call(Goal, Args, New_Ast),
macroexpand(Env, New_Ast, Res).
macroexpand(_, Ast, Ast).
% apply phase
eval_list(Env, First, Rest, Res) :-
eval(Env, First, Fn),
( mal_macro(F, Fn)
-> % If the Fn macro refers to F, apply F then evaluate,
mal_fn(Goal, F),
call(Goal, Rest, New_Ast),
eval(Env, New_Ast, Res)
; % else evaluate arguments, apply Fn.
check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]),
maplist(eval(Env), Rest, Args),
call(Goal, Args, Res)).
% The eval function itself.
% Uncomment this to get a trace with environments.
%% eval(Env, Ast, _) :-
%% format("EVAL: ~F in ~V\n", [Ast, Env]),
%% fail. % Proceed with normal alternatives.
eval(Env, List, Res) :-
list([First | Args], List), !,
eval_list(Env, First, Args, Res).
eval(_, nil, nil).
eval(_, true, true).
eval(_, false, false).
eval(Env, Symbol, Res) :-
atom(Symbol), !,
check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]).
eval(Env, Vector, Res) :-
vector(Xs, Vector), !,
maplist(eval(Env), Xs, Ys),
vector(Ys, Res).
eval(Env, Map, Res) :-
map_map(eval(Env), Map, Res).
eval(_, Anything_Else, Anything_Else).
% Print
print(Ast) :- format("~F\n", [Ast]).
% REP
rep(Env) :-
mal_read(Ast),
eval(Env, Ast, Evaluated),
print(Evaluated).
% Main program
repl(Env) :-
catch(rep(Env), mal_error(Message), writeln(Message)),
repl(Env).
re(Env, String) :-
read_str(String, Ast),
eval(Env, Ast, _).
define_core_function(Env, Symbol, Core_Function) :-
mal_fn(wrap_failure(Core_Function), Form),
env_set(Env, Symbol, Form).
core_eval(Env, [Ast], Res) :- eval(Env, Ast, Res).
main(Argv) :-
getenv("HOME", Home),
string_concat(Home, "/.mal-history", History),
(exists_file(History) -> rl_read_history(History) ; true),
env(Env),
core_ns(Core_Ns),
map_keyvals(define_core_function(Env), Core_Ns),
define_core_function(Env, eval, core_eval(Env)),
re(Env, "(def! not (fn* [a] (if a false true)))"),
re(Env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"),
re(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)))))))"),
( maplist(atom_string, Argv, [Script | Args])
-> % If Argv starts with a script, set arguments and load it.
list(Args, Mal_Argv),
env_set(Env, '*ARGV*', Mal_Argv),
format(string(Load_Script), "(load-file \"~s\")", [Script]),
re(Env, Load_Script)
; % else read from standard input.
list([], Mal_Argv),
env_set(Env, '*ARGV*', Mal_Argv),
catch(repl(Env), exit_repl, nl)
),
(rl_write_history(History) -> true ; true).

241
impls/prolog/step9_try.pl Normal file
View File

@ -0,0 +1,241 @@
% -*- mode: prolog; -*- select prolog mode in the emacs text editor
:- initialization(main, main).
:- consult([core, env, printer, reader, types, utils]).
% Read
mal_read(Ast) :-
write("user> "),
read_line_to_string(current_input, Line),
(Line = end_of_file -> throw(exit_repl) ; true),
(rl_add_history(Line) -> true ; true), % fails for duplicate lines
read_str(Line, Ast).
% Eval non-empty list depending on their first element.
:- discontiguous eval_list/4.
eval_list(Env, 'def!', Args, Res) :- !,
check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]),
check(atom(Key), "def!: ~F is not a symbol", [Key]),
eval(Env, Form, Res),
env_set(Env, Key, Res).
eval_list(Env, 'let*', Args, Res) :- !,
check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]),
check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]),
env(Env, Let_Env),
check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]),
eval(Let_Env, Form, Res).
let_loop(Env, Key, Form) :- !,
check(atom(Key), "let*: ~F is not a key", [Key]),
eval(Env, Form, Value),
env_set(Env, Key, Value).
eval_list(Env, if, Args, Res) :- !,
check(if_assign_args(Args, Form, Then, Else),
"if: expects 2 or 3 arguments, got: ~L", [Args]),
eval(Env, Form, Test),
if_select(Test, Then, Else, Selected),
eval(Env, Selected, Res).
if_assign_args([Form, Then, Else], Form, Then, Else).
if_assign_args([Form, Then], Form, Then, nil).
if_select(false, _, Else, Else) :- !.
if_select(nil, _, Else, Else) :- !.
if_select(_, Then, _, Then).
eval_list(Env, 'fn*', Args, Res) :- !,
check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]),
check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]),
check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]),
mal_fn(apply_fn(Keys, Form, Env), Res).
apply_fn(Keys, Form, Env, Args, Res) :-
env(Env, Apply_Env),
check(env_bind(Apply_Env, Keys, Args),
"cannot apply fn*[~L] to [~L]", [Keys, Args]),
eval(Apply_Env, Form, Res).
eval_list(Env, do, Args, Res) :- !,
foldl(do_loop(Env), Args, nil, Res).
do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc).
eval_list(_, quote, Args, Res) :- !,
check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]).
eval_list(_, quasiquoteexpand, Args, Res) :- !,
check(Args = [X], "quasiquoteexpand: expects 1 argument, got: ~L", [Args]),
quasiquote(X, Res).
eval_list(Env, quasiquote, Args, Res) :- !,
check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]),
quasiquote(X, Y),
eval(Env, Y, Res).
quasiquote(List, Res) :-
list(Xs, List), !,
( Xs = [unquote | Args]
-> check(Args = [Res], "unquote: expects 1 argument, got: ", [Args])
; list([], Empty),
foldr(qq_loop, Empty, Xs, Res)).
quasiquote(Vector, Res) :-
vector(Xs, Vector), !,
list([], Empty),
foldr(qq_loop, Empty, Xs, Y),
list([vec, Y], Res).
quasiquote(nil, nil).
quasiquote(true, true).
quasiquote(false, false).
quasiquote(Symbol_Or_Map, Res) :-
(atom(Symbol_Or_Map) -> true ; is_map(Symbol_Or_Map)), !,
list([quote, Symbol_Or_Map], Res).
quasiquote(Anything_Else, Anything_Else).
qq_loop(Elt, Acc, Res) :-
list(['splice-unquote' | Args], Elt), !,
check(Args = [X], "splice-unquote: expects 1 argument, got:", [Args]),
list([concat, X, Acc], Res).
qq_loop(Elt, Acc, Res) :-
quasiquote(Elt, Quasiquoted),
list([cons, Quasiquoted, Acc], Res).
eval_list(Env, 'try*', Args, Res) :- !,
( Args = [Test]
-> eval(Env, Test, Res)
; check(Args = [Test, Catch],
"try*: expects 1 or 2 arguments, got: ~L", [Args]),
check(list(['catch*', Key, Form], Catch),
"try*: ~F is not a catch* list", [Catch]),
check(atom(Key), "catch*: ~F is not a key", [Key]),
catch(eval(Env, Test, Res), mal_error(Error),
(env(Env, Try_Env),
env_set(Try_Env, Key, Error),
eval(Try_Env, Form, Res)))).
eval_list(Env, 'defmacro!', Args, Res) :- !,
check(Args = [Key, Form],
"defmacro!: expects 2 arguments, got: ~L", [Args]),
check(atom(Key), "defmacro!: ~F is not a key", [Key]),
eval(Env, Form, Fn),
check(mal_fn(_Goal, Fn), "defmacro!: ~F is not a function", [Fn]),
mal_macro(Fn, Res),
env_set(Env, Key, Res).
eval_list(Env, macroexpand, Args, Res) :- !,
check(Args = [X], "macroexpand: expects 1 argument, got: ~L", [Args]),
macroexpand(Env, X, Res).
macroexpand(Env, Ast, Res) :-
list([Key | Args], Ast),
env_get(Env, Key, Macro),
mal_macro(Fn, Macro), !,
mal_fn(Goal, Fn),
call(Goal, Args, New_Ast),
macroexpand(Env, New_Ast, Res).
macroexpand(_, Ast, Ast).
% apply phase
eval_list(Env, First, Rest, Res) :-
eval(Env, First, Fn),
( mal_macro(F, Fn)
-> % If the Fn macro refers to F, apply F then evaluate,
mal_fn(Goal, F),
call(Goal, Rest, New_Ast),
eval(Env, New_Ast, Res)
; % else evaluate arguments, apply Fn.
check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]),
maplist(eval(Env), Rest, Args),
call(Goal, Args, Res)).
% The eval function itself.
% Uncomment this to get a trace with environments.
%% eval(Env, Ast, _) :-
%% format("EVAL: ~F in ~V\n", [Ast, Env]),
%% fail. % Proceed with normal alternatives.
eval(Env, List, Res) :-
list([First | Args], List), !,
eval_list(Env, First, Args, Res).
eval(_, nil, nil).
eval(_, true, true).
eval(_, false, false).
eval(Env, Symbol, Res) :-
atom(Symbol), !,
check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]).
eval(Env, Vector, Res) :-
vector(Xs, Vector), !,
maplist(eval(Env), Xs, Ys),
vector(Ys, Res).
eval(Env, Map, Res) :-
map_map(eval(Env), Map, Res).
eval(_, Anything_Else, Anything_Else).
% Print
print(Ast) :- format("~F\n", [Ast]).
% REP
rep(Env) :-
mal_read(Ast),
eval(Env, Ast, Evaluated),
print(Evaluated).
% Main program
repl(Env) :-
catch(rep(Env), mal_error(X), format("Exception: ~F\n", [X])),
repl(Env).
re(Env, String) :-
read_str(String, Ast),
eval(Env, Ast, _).
define_core_function(Env, Symbol, Core_Function) :-
mal_fn(wrap_failure(Core_Function), Form),
env_set(Env, Symbol, Form).
core_eval(Env, [Ast], Res) :- eval(Env, Ast, Res).
main(Argv) :-
getenv("HOME", Home),
string_concat(Home, "/.mal-history", History),
(exists_file(History) -> rl_read_history(History) ; true),
env(Env),
core_ns(Core_Ns),
map_keyvals(define_core_function(Env), Core_Ns),
define_core_function(Env, eval, core_eval(Env)),
re(Env, "(def! not (fn* [a] (if a false true)))"),
re(Env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"),
re(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)))))))"),
( maplist(atom_string, Argv, [Script | Args])
-> % If Argv starts with a script, set arguments and load it.
list(Args, Mal_Argv),
env_set(Env, '*ARGV*', Mal_Argv),
format(string(Load_Script), "(load-file \"~s\")", [Script]),
re(Env, Load_Script)
; % else read from standard input.
list([], Mal_Argv),
env_set(Env, '*ARGV*', Mal_Argv),
catch(repl(Env), exit_repl, nl)
),
(rl_write_history(History) -> true ; true).

244
impls/prolog/stepA_mal.pl Normal file
View File

@ -0,0 +1,244 @@
% -*- mode: prolog; -*- select prolog mode in the emacs text editor
:- initialization(main, main).
:- consult([core, env, printer, reader, types, utils]).
% Read
mal_read(Ast) :-
write("user> "),
read_line_to_string(current_input, Line),
(Line = end_of_file -> throw(exit_repl) ; true),
(rl_add_history(Line) -> true ; true), % fails for duplicate lines
read_str(Line, Ast).
% Eval non-empty list depending on their first element.
:- discontiguous eval_list/4.
eval_list(Env, 'def!', Args, Res) :- !,
check(Args = [Key, Form], "def!: expects 2 arguments, got: ~L", [Args]),
check(atom(Key), "def!: ~F is not a symbol", [Key]),
eval(Env, Form, Res),
env_set(Env, Key, Res).
eval_list(Env, 'let*', Args, Res) :- !,
check(Args = [Binds, Form], "let*: expects 2 arguments, got: ~L", [Args]),
check(unbox_seq(Binds, Xs), "let*: ~F is not a sequence", [Binds]),
env(Env, Let_Env),
check(map_keyvals(let_loop(Let_Env), Xs), "let*: odd length: ~L", [Binds]),
eval(Let_Env, Form, Res).
let_loop(Env, Key, Form) :- !,
check(atom(Key), "let*: ~F is not a key", [Key]),
eval(Env, Form, Value),
env_set(Env, Key, Value).
eval_list(Env, if, Args, Res) :- !,
check(if_assign_args(Args, Form, Then, Else),
"if: expects 2 or 3 arguments, got: ~L", [Args]),
eval(Env, Form, Test),
if_select(Test, Then, Else, Selected),
eval(Env, Selected, Res).
if_assign_args([Form, Then, Else], Form, Then, Else).
if_assign_args([Form, Then], Form, Then, nil).
if_select(false, _, Else, Else) :- !.
if_select(nil, _, Else, Else) :- !.
if_select(_, Then, _, Then).
eval_list(Env, 'fn*', Args, Res) :- !,
check(Args = [Params, Form], "fn*: expects 2 arguments, got: ~L", [Args]),
check(unbox_seq(Params, Keys), "fn*: ~F is not a sequence", [Params]),
check(maplist(atom, Keys), "fn*: ~F should contains symbols", [Params]),
mal_fn(apply_fn(Keys, Form, Env), Res).
apply_fn(Keys, Form, Env, Args, Res) :-
env(Env, Apply_Env),
check(env_bind(Apply_Env, Keys, Args),
"cannot apply fn*[~L] to [~L]", [Keys, Args]),
eval(Apply_Env, Form, Res).
eval_list(Env, do, Args, Res) :- !,
foldl(do_loop(Env), Args, nil, Res).
do_loop(Env, Elt, _Old_Acc, New_Acc) :- eval(Env, Elt, New_Acc).
eval_list(_, quote, Args, Res) :- !,
check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]).
eval_list(_, quasiquoteexpand, Args, Res) :- !,
check(Args = [X], "quasiquoteexpand: expects 1 argument, got: ~L", [Args]),
quasiquote(X, Res).
eval_list(Env, quasiquote, Args, Res) :- !,
check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]),
quasiquote(X, Y),
eval(Env, Y, Res).
quasiquote(List, Res) :-
list(Xs, List), !,
( Xs = [unquote | Args]
-> check(Args = [Res], "unquote: expects 1 argument, got: ", [Args])
; list([], Empty),
foldr(qq_loop, Empty, Xs, Res)).
quasiquote(Vector, Res) :-
vector(Xs, Vector), !,
list([], Empty),
foldr(qq_loop, Empty, Xs, Y),
list([vec, Y], Res).
quasiquote(nil, nil).
quasiquote(true, true).
quasiquote(false, false).
quasiquote(Symbol_Or_Map, Res) :-
(atom(Symbol_Or_Map) -> true ; is_map(Symbol_Or_Map)), !,
list([quote, Symbol_Or_Map], Res).
quasiquote(Anything_Else, Anything_Else).
qq_loop(Elt, Acc, Res) :-
list(['splice-unquote' | Args], Elt), !,
check(Args = [X], "splice-unquote: expects 1 argument, got:", [Args]),
list([concat, X, Acc], Res).
qq_loop(Elt, Acc, Res) :-
quasiquote(Elt, Quasiquoted),
list([cons, Quasiquoted, Acc], Res).
eval_list(Env, 'try*', Args, Res) :- !,
( Args = [Test]
-> eval(Env, Test, Res)
; check(Args = [Test, Catch],
"try*: expects 1 or 2 arguments, got: ~L", [Args]),
check(list(['catch*', Key, Form], Catch),
"try*: ~F is not a catch* list", [Catch]),
check(atom(Key), "catch*: ~F is not a key", [Key]),
catch(eval(Env, Test, Res), mal_error(Error),
(env(Env, Try_Env),
env_set(Try_Env, Key, Error),
eval(Try_Env, Form, Res)))).
eval_list(Env, 'defmacro!', Args, Res) :- !,
check(Args = [Key, Form],
"defmacro!: expects 2 arguments, got: ~L", [Args]),
check(atom(Key), "defmacro!: ~F is not a key", [Key]),
eval(Env, Form, Fn),
check(mal_fn(_Goal, Fn), "defmacro!: ~F is not a function", [Fn]),
mal_macro(Fn, Res),
env_set(Env, Key, Res).
eval_list(Env, macroexpand, Args, Res) :- !,
check(Args = [X], "macroexpand: expects 1 argument, got: ~L", [Args]),
macroexpand(Env, X, Res).
macroexpand(Env, Ast, Res) :-
list([Key | Args], Ast),
env_get(Env, Key, Macro),
mal_macro(Fn, Macro), !,
mal_fn(Goal, Fn),
call(Goal, Args, New_Ast),
macroexpand(Env, New_Ast, Res).
macroexpand(_, Ast, Ast).
% apply phase
eval_list(Env, First, Rest, Res) :-
eval(Env, First, Fn),
( mal_macro(F, Fn)
-> % If the Fn macro refers to F, apply F then evaluate,
mal_fn(Goal, F),
call(Goal, Rest, New_Ast),
eval(Env, New_Ast, Res)
; % else evaluate arguments, apply Fn.
check(mal_fn(Goal, Fn), "cannot apply, ~F is not a function", [Fn]),
maplist(eval(Env), Rest, Args),
call(Goal, Args, Res)).
% The eval function itself.
% Uncomment this to get a trace with environments.
%% eval(Env, Ast, _) :-
%% format("EVAL: ~F in ~V\n", [Ast, Env]),
%% fail. % Proceed with normal alternatives.
eval(Env, List, Res) :-
list([First | Args], List), !,
eval_list(Env, First, Args, Res).
eval(_, nil, nil).
eval(_, true, true).
eval(_, false, false).
eval(Env, Symbol, Res) :-
atom(Symbol), !,
check(env_get(Env, Symbol, Res), "'~F' not found", [Symbol]).
eval(Env, Vector, Res) :-
vector(Xs, Vector), !,
maplist(eval(Env), Xs, Ys),
vector(Ys, Res).
eval(Env, Map, Res) :-
map_map(eval(Env), Map, Res).
eval(_, Anything_Else, Anything_Else).
% Print
print(Ast) :- format("~F\n", [Ast]).
% REP
rep(Env) :-
mal_read(Ast),
eval(Env, Ast, Evaluated),
print(Evaluated).
% Main program
repl(Env) :-
catch(rep(Env), mal_error(X), format("Exception: ~F\n", [X])),
repl(Env).
re(Env, String) :-
read_str(String, Ast),
eval(Env, Ast, _).
define_core_function(Env, Symbol, Core_Function) :-
mal_fn(wrap_failure(Core_Function), Form),
env_set(Env, Symbol, Form).
core_eval(Env, [Ast], Res) :- eval(Env, Ast, Res).
main(Argv) :-
getenv("HOME", Home),
string_concat(Home, "/.mal-history", History),
(exists_file(History) -> rl_read_history(History) ; true),
env(Env),
core_ns(Core_Ns),
map_keyvals(define_core_function(Env), Core_Ns),
define_core_function(Env, eval, core_eval(Env)),
env_set(Env, '*host-language*', "prolog"),
re(Env, "(def! not (fn* [a] (if a false true)))"),
re(Env, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"),
re(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)))))))"),
( maplist(atom_string, Argv, [Script | Args])
-> % If Argv starts with a script, set arguments and load it.
list(Args, Mal_Argv),
env_set(Env, '*ARGV*', Mal_Argv),
format(string(Load_Script), "(load-file \"~s\")", [Script]),
re(Env, Load_Script)
; % else read from standard input.
list([], Mal_Argv),
env_set(Env, '*ARGV*', Mal_Argv),
re(Env, "(println (str \"Mal [\" *host-language* \"]\"))"),
catch(repl(Env), exit_repl, nl)
),
(rl_write_history(History) -> true ; true).

29
impls/prolog/tests/stepA_mal.mal Normal file
View File

@ -0,0 +1,29 @@
;; Testing basic prolog interop
(prolog-call "1+")
;/.*prolog-call: .*syntax_error.*
(prolog-call "atom_length(\"ab\")")
;=>2
(prolog-call "atom_concat(\"ab\", \"cd\")")
;=>abcd
(prolog-call "number_string(42)")
;=>"42"
(prolog-call "=(mal_kwd(\"kw\"))")
;=>:kw
(prolog-call "list([a, b])")
;=>(a b)
(prolog-call "vector([a, b])")
;=>[a b]
(prolog-call "'hash-map'([\"a\", 1])")
;=>{"a" 1}
(meta (prolog-call "=(mal_vector([a, b], 12))"))
;=>12
(prolog-call "=(mal_list([1, mal_formed(1)]))")
;/.*prolog-call: invalid result.*
(prolog-asserta "(mal_setenv(Name, Value, nil) :- setenv(Name, Value))")
;=>nil
(prolog-call "mal_setenv(\"answer\", 42)")
;=>nil
(prolog-call "getenv(\"answer\")")
;=>42

181
impls/prolog/types.pl Normal file
View File

@ -0,0 +1,181 @@
% -*- mode: prolog; -*- select prolog mode in the emacs text editor
:- discontiguous mal_equal/2.
:- discontiguous 'with-meta'/2.
:- discontiguous meta/2.
:- discontiguous valid_mal/1.
% A MAL number is represented by a Prolog integer.
% A MAL symbol is represented by a Prolog atom,
% including `false`, `nil` and `true`.
% A MAL string is represented by a Prolog string.
% A MAL keyword is represented as mal_kwd(String), and there is no
% reason to encapsulate this information.
% The remaining representations are encapsulated because they may have
% to evolve, and interfer directly with metadata.
mal_equal(X, X) :- atomic(X), !.
mal_equal(mal_kwd(S), mal_kwd(S)) :- !.
valid_mal(X) :- integer(X), !.
valid_mal(X) :- atom(X), !.
valid_mal(X) :- string(X), !.
valid_mal(mal_kwd(S)) :- !, string(S).
% Sequences
% list(?Forms, ?List)
% Bi-directional conversion between a list of MAL forms and a MAL list.
% At least one of the two arguments must be instantiated.
% Fails if the second argument is instantiated but not a MAL list.
% vector(?Forms, ?Vector)
% Similar for MAL vectors.
list(Forms, mal_list(Forms)) :- !.
list(Forms, mal_list(Forms, _Meta)) :- !.
vector(Forms, mal_vector(Forms)) :- !.
vector(Forms, mal_vector(Forms, _Meta)) :- !.
mal_equal(S1, S2) :-
unbox_seq(S1, L1), !,
unbox_seq(S2, L2),
maplist(mal_equal, L1, L2).
'with-meta'([X, Meta], mal_list( Forms, Meta)) :- list( Forms, X), !.
'with-meta'([X, Meta], mal_vector(Forms, Meta)) :- vector(Forms, X), !.
meta([mal_list(_, Meta)], Meta) :- !.
meta([mal_vector(_, Meta)], Meta) :- !.
valid_mal(mal_list(F)) :- !, maplist(valid_mal, F).
valid_mal(mal_list(F, M)) :- !, maplist(valid_mal, F), valid_mal(M).
valid_mal(mal_vector(F)) :- !, maplist(valid_mal, F).
valid_mal(mal_vector(F, M)) :- !, maplist(valid_mal, F), valid_mal(M).
% Maps
% Other files should not directly depend on Assoc, as there may be
% good reasons to change the map representation.
'hash-map'(Key_Value_List, mal_map(Res)) :-
empty_assoc(Assoc),
check(foldl_keyvals(assoc, Assoc, Key_Value_List, Res),
"hash-map: odd count of key and values in ~L", [Key_Value_List]).
is_map(mal_map(_Assoc)) :- !.
is_map(mal_map(_Assoc, _Meta)) :- !.
is_key(Key) :- string(Key), !.
is_key(mal_kwd(_)) :- !.
unbox_map(mal_map(Assoc), Assoc) :- !.
unbox_map(mal_map(Assoc, _Meta), Assoc) :- !.
get(Map, Key, Res) :-
unbox_map(Map, Assoc),
is_key(Key),
get_assoc(Key, Assoc, Res).
assoc([Map | Key_Value_List], mal_map(Res)) :-
unbox_map(Map, Assoc),
check(foldl_keyvals(assoc, Assoc, Key_Value_List, Res),
"assoc: odd count of key and values in [~L]", [Key_Value_List]).
assoc(Assoc, Key, Value, Res) :-
check(is_key(Key), "map keys must be strings or symbol, not ~F", [Key]),
put_assoc(Key, Assoc, Value, Res).
% This order of parameter is convenient with foldl.
dissoc(Key, Map, mal_map(Res)) :-
unbox_map(Map, Assoc),
is_key(Key),
% del_assoc fails if the key did previously exist,
% and we do not want to search twice.
(del_assoc(Key, Assoc, _Value, Res) -> true ; Res = Assoc).
map_map(Goal, Map, mal_map(Res)) :-
unbox_map(Map, Assoc),
map_assoc(Goal, Assoc, Res).
keys([Map], Res) :-
unbox_map(Map, Assoc),
assoc_to_keys(Assoc, Keys),
list(Keys, Res).
vals([Map], Res) :-
unbox_map(Map, Assoc),
assoc_to_values(Assoc, Vals),
list(Vals, Res).
% MAL map -> key/value Prolog list
% Fail if the form is not a map.
map_to_key_value_list(Map, Forms) :-
unbox_map(Map, Assoc),
assoc_to_list(Assoc, Pairs),
foldr(convert_pair, [], Pairs, Forms).
convert_pair(Key - Value, Acc, [Key, Value | Acc]).
mal_equal(Map1, Map2) :-
unbox_map(Map1, Assoc1), !,
unbox_map(Map2, Assoc2),
% map_assoc(mal_equal) does not work here because its result
% depends on the internal structure.
assoc_to_list(Assoc1, Pairs1),
assoc_to_list(Assoc2, Pairs2),
maplist(map_pair_equal, Pairs1, Pairs2).
map_pair_equal(K1 - V1, K2 - V2) :- K1 = K2, mal_equal(V1, V2).
'with-meta'([X, Meta], mal_map(Assoc, Meta)) :- unbox_map(X, Assoc), !.
meta([mal_map(_, Meta)], Meta) :- !.
valid_mal(mal_map(Assoc)) :- !,
is_assoc(Assoc),
assoc_to_list(Assoc, Pairs),
maplist(valid_mal_pair, Pairs).
valid_mal(mal_map(Assoc, Meta)) :- !,
is_assoc(Assoc),
assoc_to_list(Assoc, Pairs),
maplist(valid_mal_pair, Pairs),
valid_mal(Meta).
valid_mal_pair(K - V) :- is_key(K), valid_mal(V).
% Functions
% Goal is called with call(Goal, [Arg1, Arg2..], Res).
% It should never fail, and use mal_error/1 to report problems.
mal_fn(Goal, mal_fn(Goal)) :- !.
mal_fn(Goal, mal_fn(Goal, _Meta)) :- !.
'with-meta'([mal_fn(Goal), Meta], mal_fn(Goal, Meta)) :- !.
'with-meta'([mal_fn(Goal, _Meta), Meta], mal_fn(Goal, Meta)) :- !.
meta([mal_fn(_,Meta)], Meta) :- !.
valid_mal(mal_fn(_)) :- !.
valid_mal(mal_fn(_, Meta)) :- !, valid_mal(Meta).
% Macros
mal_macro(Fn, mal_macro(Fn)).
% Atoms
mal_atom(Value, mal_atom(Value)).
set_mal_atom_value(Atom, Value) :- setarg(1, Atom, Value).
valid_mal(mal_atom(Value)) :- !, valid_mal(Value).
% Catch-all clause for objects without metadata.
meta([_], nil) :- !.

46
impls/prolog/utils.pl Normal file
View File

@ -0,0 +1,46 @@
% -*- mode: prolog; -*- select prolog mode in the emacs text editor
% Convenient shortcuts, especially during steps 1 to 6.
% Similar to "assert", but raise an non-fatal error.
check(Condition, _, _) :- call(Condition), !.
check(_, Format, Arguments) :- throwf(Format, Arguments).
throwf(Format, Arguments) :-
format(string(Message), Format, Arguments),
throw(mal_error(Message)).
% Convenient shortcut: unbox(+Sequence, -List).
unbox_seq(Sequence, Forms) :- list(Forms, Sequence).
unbox_seq(Sequence, Forms) :- vector(Forms, Sequence).
% Abstract some loops.
% foldr(Goal, Vn, [X1, X2,...,Xn], V0) :-
% Goal(Xn, Vn, Vn-1),
% ...
% Goal(X2, V2, V1),
% Goal(X1, V1, V0),
foldr(_, Vn, [], Vn).
foldr(Goal, Vn, [X|Xs], V0) :-
foldr(Goal, Vn, Xs, V1),
call(Goal, X, V1, V0).
% foldl_keyvals(Goal, Init, [K1, V1, K2, V2, K3, V3], Acc3) :-
% Goal(Init, K1, V1, Acc1),
% Goal(Acc1, K2, V2, Acc2),
% Goal(Acc2, K3, V3, Acc3).
foldl_keyvals(_, Init, [], Init).
foldl_keyvals(Goal, Init, [K, V | KVs], Res) :-
call(Goal, Init, K, V, Acc),
foldl_keyvals(Goal, Acc, KVs, Res).
% map_keyvals(Goal, [K1, V1, K2, V2, K3, V3]) :-
% Goal(K1, V1),
% Goal(K2, V2),
% Goal(K3, V3).
map_keyvals(_, []).
map_keyvals(Goal, [K, V | KVs]) :-
call(Goal, K, V),
map_keyvals(Goal, KVs).

3
impls/tests/stepA_mal.mal
View File

@ -43,6 +43,9 @@
(do (list time-ms string? number? seq conj meta with-meta fn?) nil)
;=>nil
(map symbol? '(nil false true))
;=>(false false false)
;; ------------------------------------------------------------------
;>>> soft=True