sexp.prolog

load(File, SExp)
    :-  read_file_to_string(File, Text, [])
    ,   string_chars(Text, Atoms)
    ,   phrase(entry(SExp), Atoms, [])
    ,   !
    .

entry(Res) --> spaces, many(sexp, Res).

sexp(Res)
    --> block(Res)
    ;   single(Res)
    .

block(Res)
    --> ['(']
    ,   entry(Res)
    ,   [')']
    ,   spaces
    .

single(Atom)
    --> some(nonSpace, Res)
    ,   spaces
    ,   { string_chars(Word, Res), atom_string(Atom, Word) }
    .

spaces --> many(space, _).

space(C) --> [C], { member(C, [' ', '\n', '\t']) }.

nonSpace(C) --> [C], { \+ member(C, [' ', '\n', '\t', '(', ')']) }.

some(P, [X | Xs])
    --> call(P, X)
    ,   many(P, Xs)
    ,   !
    .

many(P, Xs) --> some(P, Xs), !.
many(_, []) --> {}.

toLC([[let, Name | Body] | Rest], [Name -> Rest, Body]) :- atom(Name).
toLC([[let, [Name | Args] | Body] | Rest], [Name -> Rest, Args -> Body]) :- atom(Name).

if(true,  Yes, _, Yes).
if(false, _, No, No).

eq(X, X, true).
eq(X, Y, false) :- X \= Y.

minus(A, B, C) :- C is A - B.
add(A, B, C)   :- C is A + B.

subst(Fact, Formal -> Body, Res) :-
    zip(Formal, Fact, Dict),
    subst_aux(Dict, Body, Res),
    !.

subst_aux(_Dict, _Target, _) :-
    % writeln({dict: Dict, target: Target}),
    fail.

subst_aux(Dict, Params -> Body, Params -> Res) :-
    remove(Params, Dict, Without),
    subst_aux(Without, Body, Res).

subst_aux(Dict) -->
    maplist(subst_aux(Dict)).

subst_aux(Names, A, B) :-
    member(A - B, Names),
    !.

subst_aux(Names, A, A) :-
    \+ member(A - _, Names).

remove(Names) -->
    exclude(elem(Names)).

elem(Names, A - _) :- member(A, Names).

zip([], [], []).
zip([A | As], [B | Bs], [A - B | Cs]) :- zip(As, Bs, Cs).

eval(Dict, Blob, DictN-Res) :-
    [F | Xs] = Blob,
    member(F - Impl, Dict),
    (   Impl = native(Goal)
    ,   Bundle =.. [Goal | Xs]
    ->  call(Bundle, Res)

    ;   Impl = (_ -> _)
    ->  subst(Xs, Impl, Res)
    ).