154 lines
4.1 KiB
Prolog
154 lines
4.1 KiB
Prolog
/*
|
|
|
|
Copyright © 2018, 2019, 2020 Simon Forman
|
|
|
|
This file is part of Thun
|
|
|
|
Thun is free software: you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation, either version 3 of the License, or
|
|
(at your option) any later version.
|
|
|
|
Thun is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with Thun. If not see <http://www.gnu.org/licenses/>.
|
|
|
|
|
|
Run with e.g.:
|
|
|
|
$ swipl -g fooooo -g halt source/joy2dot.pl > jd.dot
|
|
|
|
|
|
*/
|
|
:- use_module(library(dcg/basics)).
|
|
:- dynamic def/2.
|
|
|
|
|
|
joy_lex([tok(Token)|Ls]) --> chars(Token), !, joy_lex(Ls).
|
|
joy_lex([ lbracket|Ls]) --> "[", !, joy_lex(Ls).
|
|
joy_lex([ rbracket|Ls]) --> "]", !, joy_lex(Ls).
|
|
|
|
joy_lex(Ls) --> [Space], {code_type(Space, space)}, !, joy_lex(Ls).
|
|
|
|
joy_lex([]) --> [].
|
|
|
|
|
|
joy_parse([J|Js]) --> joy_term(J), !, joy_parse(Js).
|
|
joy_parse([]) --> [].
|
|
|
|
joy_term(list(J)) --> [lbracket], !, joy_parse(J), [rbracket].
|
|
joy_term(Atomic) --> [tok(Codes)], {joy_token(Atomic, Codes)}.
|
|
|
|
joy_token(int(I), Codes) :- number(I, Codes, []), !. % See dcg/basics.
|
|
joy_token(bool(true), `true`) :- !.
|
|
joy_token(bool(false), `false`) :- !.
|
|
joy_token(symbol(S), Codes) :- atom_codes(S, Codes).
|
|
|
|
|
|
text_to_expression(Text, Expression) :-
|
|
phrase(joy_lex(Tokens), Text), !,
|
|
phrase(joy_parse(Expression), Tokens).
|
|
|
|
% Apologies for all the (green, I hope) cuts. The strength of the Joy
|
|
% syntax is that it's uninteresting.
|
|
|
|
chars([Ch|Rest]) --> char(Ch), chars(Rest).
|
|
chars([Ch]) --> char(Ch).
|
|
|
|
char(Ch) --> [Ch], {Ch \== 0'[, Ch \== 0'], code_type(Ch, graph)}.
|
|
|
|
|
|
|
|
joy_def(Codes) :-
|
|
text_to_expression(Codes, [symbol(Name)|Body]),
|
|
% writeln(Name),
|
|
assert_def(Name, Body).
|
|
|
|
assert_defs(DefsFile) :-
|
|
read_file_to_codes(DefsFile, Codes, []),
|
|
lines(Codes, Lines),
|
|
maplist(joy_def, Lines).
|
|
|
|
assert_def(Symbol, Body) :-
|
|
retractall(def(Symbol, _)),
|
|
assertz(def(Symbol, Body)).
|
|
|
|
% Split on newline chars a list of codes into a list of lists of codes
|
|
% one per line. Helper function.
|
|
lines([], []) :- !.
|
|
lines(Codes, [Line|Lines]) :- append(Line, [0'\n|Rest], Codes), !, lines(Rest, Lines).
|
|
lines(Codes, [Codes]).
|
|
|
|
:- assert_defs("defs.txt").
|
|
|
|
/*
|
|
|
|
term_expansion(def(Def), def(Name, Body)) :-
|
|
text_to_expression(Def, [symbol(Name)|Body]).
|
|
|
|
|
|
% def(``).
|
|
def(`and duo unit`).
|
|
def(`app2 [grba swap grba swap] dip [infrst] cons ii`).
|
|
def(`b [i] dip i`).
|
|
def(`cleave fork popdd`).
|
|
def(`clop cleave popdd`).
|
|
def(`duo unit cons`).
|
|
def(`fba [xor xor void] [[and] [xor and] fork or void] clop popdd`).
|
|
def(`fork [i] app2`).
|
|
def(`grba [stack popd] dip`).
|
|
def(`ii [dip] dupdip i`).
|
|
def(`infra swons swaack [i] dip swaack`).
|
|
def(`infrst infra first`).
|
|
def(`or [unit] ii duo`).
|
|
def(`popd [pop] dip`).
|
|
def(`popdd [pop] dipd`).
|
|
def(`popop pop pop`).
|
|
def(`swons swap cons`).
|
|
% def(`uncons-pair [uncons] dip unswons rolldown`).
|
|
def(`unswons uncons swap`).
|
|
def(`xor [unit] ii [cons] [swap cons] clop duo`).
|
|
|
|
*/
|
|
|
|
symbols(E, S) :- symbols(E, [], S).
|
|
|
|
symbols(symbol(S)) --> seen_sym(S), !.
|
|
symbols(symbol(S)), [S] --> [].
|
|
symbols( bool(_)) --> [].
|
|
symbols( int(_)) --> [].
|
|
symbols( list(L)) --> symbols(L).
|
|
|
|
symbols([]) --> [].
|
|
symbols([T|Tail]) --> symbols(T), symbols(Tail).
|
|
|
|
seen_sym(Term, List, List) :- member(Term, List).
|
|
|
|
write_sym(Symbol) :- write('"'), write(Symbol), write('"').
|
|
|
|
fooooo :-
|
|
writeln("digraph joy_defs {"),
|
|
% writeln(" rankdir=LR;"),
|
|
forall(
|
|
def(Symbol, Body),
|
|
(
|
|
symbols(list(Body), Deps),
|
|
forall(
|
|
member(Dep, Deps),
|
|
(
|
|
write(" "),
|
|
write_sym(Symbol),
|
|
write(" -> "),
|
|
write_sym(Dep),
|
|
writeln(";")
|
|
)
|
|
)
|
|
)
|
|
),
|
|
writeln("}").
|
|
|