├── formalism ├── .gitignore ├── makefile └── typed_prolog.tex ├── src ├── tests │ ├── syntax_error1.pl │ ├── clp.pl │ ├── ground.pl │ ├── import_unexported │ │ ├── import_bar.pl │ │ └── export_foo.pl │ ├── negation.pl │ ├── not_equal.pl │ ├── truncate.pl │ ├── atom_number.pl │ ├── duplicate_constructors.pl │ ├── atom_concat.pl │ ├── more_binops.pl │ ├── unify_with_occurs.pl │ ├── labeling.pl │ ├── duplicate_types.pl │ ├── duplicate_clauses.pl │ ├── ensure_exported.pl │ ├── trim.pl │ ├── id.pl │ ├── comparison.pl │ ├── ill_typed1.pl │ ├── type_error1.pl │ ├── ill_typed2.pl │ ├── module_test │ │ ├── module1.pl │ │ ├── module2.pl │ │ └── module3.pl │ ├── atom_lte.pl │ ├── bitwise.pl │ ├── benchmark_against.pl │ ├── nested_capture.pl │ └── test.pl ├── main.pl ├── README.md ├── io.pl ├── printer.pl ├── common.pl ├── typechecker.pl ├── translator.pl ├── syntax.pl ├── module_handler.pl └── compiler.pl ├── .gitignore ├── makefile └── README.md /formalism/.gitignore: -------------------------------------------------------------------------------- 1 | *.aux 2 | *.log 3 | *.pdf 4 | -------------------------------------------------------------------------------- /formalism/makefile: -------------------------------------------------------------------------------- 1 | all: 2 | rubber --pdf typed_prolog 3 | -------------------------------------------------------------------------------- /src/tests/syntax_error1.pl: -------------------------------------------------------------------------------- 1 | module(syntax_error1, hello, []). 2 | 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Emacs temp files 2 | *~ 3 | \#*\# 4 | 5 | # compiled code 6 | output.pl 7 | -------------------------------------------------------------------------------- /src/tests/clp.pl: -------------------------------------------------------------------------------- 1 | module('clp', [], []). 2 | 3 | clausedef(test, [], []). 4 | test :- 5 | X #> Y. 6 | -------------------------------------------------------------------------------- /src/tests/ground.pl: -------------------------------------------------------------------------------- 1 | module(ground, [], []). 2 | 3 | clausedef(test, [A], [A]). 4 | test(A) :- 5 | ground(A). 6 | -------------------------------------------------------------------------------- /src/tests/import_unexported/import_bar.pl: -------------------------------------------------------------------------------- 1 | module(import_bar, [], []). 2 | 3 | use_module('export_foo.pl', [], [bar]). 4 | -------------------------------------------------------------------------------- /src/tests/negation.pl: -------------------------------------------------------------------------------- 1 | module(negation, [], []). 2 | 3 | clausedef(test, [], []). 4 | test :- 5 | \+ (5 is 27). 6 | 7 | -------------------------------------------------------------------------------- /src/tests/not_equal.pl: -------------------------------------------------------------------------------- 1 | module(not_equal, [], []). 2 | 3 | clausedef(test, [A], [A, A]). 4 | test(A, B) :- 5 | A \== B. -------------------------------------------------------------------------------- /src/tests/truncate.pl: -------------------------------------------------------------------------------- 1 | module(truncate, [], []). 2 | 3 | clausedef(test, [], []). 4 | test :- 5 | Y is truncate(0^(-2)). 6 | -------------------------------------------------------------------------------- /src/tests/atom_number.pl: -------------------------------------------------------------------------------- 1 | module(atom_number, [], []). 2 | 3 | clausedef(test, [], []). 4 | test :- 5 | atom_number(_, 123). 6 | -------------------------------------------------------------------------------- /src/tests/duplicate_constructors.pl: -------------------------------------------------------------------------------- 1 | module(duplicate_constructors, [], []). 2 | 3 | datadef(foo, [], [foo]). 4 | datadef(bar, [], [foo]). 5 | -------------------------------------------------------------------------------- /src/tests/atom_concat.pl: -------------------------------------------------------------------------------- 1 | module(atom_concat, [], []). 2 | 3 | clausedef(test, [], [atom]). 4 | test(X) :- 5 | atom_concat('moo', 'cow', X). 6 | -------------------------------------------------------------------------------- /src/tests/more_binops.pl: -------------------------------------------------------------------------------- 1 | module(more_binops, [], []). 2 | 3 | clausedef(test, [], [int, int]). 4 | test(X, Y) :- 5 | X is 2^Y, 6 | Y is X mod 2. 7 | -------------------------------------------------------------------------------- /src/tests/unify_with_occurs.pl: -------------------------------------------------------------------------------- 1 | module(unify_with_occurs, [], []). 2 | 3 | clausedef(test, [], []). 4 | test :- 5 | unify_with_occurs_check(X, 7). 6 | -------------------------------------------------------------------------------- /src/tests/labeling.pl: -------------------------------------------------------------------------------- 1 | module(labeling, [], []). 2 | 3 | clausedef(test, [], [int]). 4 | test(X) :- 5 | X #>= 0, 6 | X #=< 10, 7 | fd_labeling([X]). 8 | 9 | -------------------------------------------------------------------------------- /src/tests/duplicate_types.pl: -------------------------------------------------------------------------------- 1 | module(duplicate_types, [], []). 2 | 3 | datadef(foo, [], [foo]). 4 | datadef(foo, [], [bar]). 5 | 6 | clausedef(useFoo, [], [foo]). 7 | useFoo(foo). 8 | -------------------------------------------------------------------------------- /src/tests/duplicate_clauses.pl: -------------------------------------------------------------------------------- 1 | module(duplicate_clauses, [], []). 2 | 3 | clausedef(test1, [], [int, int]). 4 | clausedef(test1, [], [int, int]). 5 | test1(X, Y) :- 6 | X is Y. 7 | -------------------------------------------------------------------------------- /src/tests/import_unexported/export_foo.pl: -------------------------------------------------------------------------------- 1 | module(export_foo, [fooProcedure/1], [foo]). 2 | 3 | clausedef(fooProcedure, [], [int]). 4 | fooProcedure(1). 5 | 6 | datadef(foo, [], [foo]). 7 | -------------------------------------------------------------------------------- /src/tests/ensure_exported.pl: -------------------------------------------------------------------------------- 1 | module(ensure_exported, [bar/1, bar/2], []). 2 | 3 | % Should not compile, as bar/1 doesn't exist. 4 | clausedef(bar, [], [atom, atom]). 5 | bar(_, _) :- true. 6 | bar(_, _) :- false. 7 | -------------------------------------------------------------------------------- /src/tests/trim.pl: -------------------------------------------------------------------------------- 1 | module(trim, [], []). 2 | 3 | clausedef(doNotTrim, [], []). 4 | doNotTrim :- 5 | X = 1. 6 | 7 | clausedef(trimMe, [], [relation([int])]). 8 | trimMe(F) :- 9 | call(F, 7). 10 | -------------------------------------------------------------------------------- /src/tests/id.pl: -------------------------------------------------------------------------------- 1 | module(id, [], []). 2 | 3 | datadef(bool, [], [true, false]). 4 | 5 | clausedef(test, [], []). 6 | test :- 7 | Id = lambda([X, X], true), 8 | call(Id, true, _), 9 | call(Id, 0, _). 10 | -------------------------------------------------------------------------------- /src/tests/comparison.pl: -------------------------------------------------------------------------------- 1 | module(comparison, [], []). 2 | 3 | clausedef(test1, [], []). 4 | test1 :- 5 | 3 + 7 < 10 + 11. 6 | 7 | clausedef(test2, [], [int]). 8 | test2(Y) :- 9 | X #= 3 * Y, 10 | X #> 7 + 8. 11 | 12 | -------------------------------------------------------------------------------- /src/tests/ill_typed1.pl: -------------------------------------------------------------------------------- 1 | module(ill_typed1, [], []). 2 | 3 | datadef(bool, [], [true, false]). 4 | 5 | clausedef(test, [], []). 6 | test :- 7 | Test = lambda([F], 8 | (call(F, true), 9 | call(F, 0))). 10 | -------------------------------------------------------------------------------- /src/tests/type_error1.pl: -------------------------------------------------------------------------------- 1 | module(type_error1, [], []). 2 | 3 | datadef(foo, [], [foo]). 4 | datadef(bar, [], [bar]). 5 | 6 | clausedef(needsFoo, [], [foo]). 7 | needsFoo(_). 8 | 9 | clausedef(callsFoo, [], []). 10 | callsFoo :- 11 | needsFoo(bar). 12 | -------------------------------------------------------------------------------- /src/tests/ill_typed2.pl: -------------------------------------------------------------------------------- 1 | module(ill_typed2, [], []). 2 | 3 | datadef(moo, [], [moo]). 4 | datadef(cow, [], [cow]). 5 | 6 | clausedef(foo, [], [int, moo, cow]). 7 | foo(_, Moo, Cow) :- 8 | foo2(Moo, Cow). 9 | 10 | clausedef(foo2, [], [cow, moo]). 11 | foo2(cow, moo). 12 | -------------------------------------------------------------------------------- /src/tests/module_test/module1.pl: -------------------------------------------------------------------------------- 1 | module(module1, [mylength/2], [mylist]). 2 | 3 | datadef(mylist, [A], [mycons(A, mylist(A)), mynil]). 4 | 5 | clausedef(mylength, [A], [mylist(A), int]). 6 | mylength(mynil, 0). 7 | mylength(mycons(_, Rest), Len) :- 8 | mylength(Rest, RestLen), 9 | Len is RestLen + 1. 10 | -------------------------------------------------------------------------------- /src/tests/atom_lte.pl: -------------------------------------------------------------------------------- 1 | module(atom_lte, [], []). 2 | 3 | % test at the end of the clause 4 | clausedef(mkAtom, [], [atom]). 5 | mkAtom(Atom) :- Atom = '<='. 6 | mkAtom(Atom) :- Atom = 'div'. 7 | 8 | % test within conjunction 9 | clausedef(mkAtom2, [], [atom]). 10 | mkAtom2(Atom) :- Atom = '<=', Atom = '<='. 11 | 12 | % test within disjunction 13 | clausedef(mkAtom3, [], [atom]). 14 | mkAtom3(Atom) :- Atom = '<='; Atom = 'div'. 15 | -------------------------------------------------------------------------------- /src/tests/module_test/module2.pl: -------------------------------------------------------------------------------- 1 | module(module2, [myappend/3], []). 2 | 3 | use_module('module1.pl', [mylength/2], [mylist]). 4 | 5 | clausedef(localLength, [A], [mylist(A), int]). 6 | localLength(List, Len) :- 7 | mylength(List, Len). 8 | 9 | clausedef(myappend, [A], [mylist(A), mylist(A), mylist(A)]). 10 | myappend(mynil, List, List). 11 | myappend(mycons(H, T), Other, mycons(H, Rest)) :- 12 | myappend(T, Other, Rest). 13 | -------------------------------------------------------------------------------- /makefile: -------------------------------------------------------------------------------- 1 | SWIPL_VERSION_STRING=$(shell swipl --version) 2 | SWIPL_FLAGS= 3 | PROBE= version 7 4 | 5 | ifneq (,$(findstring $(PROBE),$(SWIPL_VERSION_STRING))) 6 | SWIPL_FLAGS += --traditional 7 | endif 8 | 9 | output.pl: src/common.pl src/compiler.pl src/io.pl src/main.pl src/module_handler.pl src/printer.pl src/syntax.pl src/translator.pl src/typechecker.pl 10 | swipl $(SWIPL_FLAGS) -q -s src/compiler.pl -g "public_7_processFileForSwipl('src/main.pl', 'output.pl')." -t halt. 11 | -------------------------------------------------------------------------------- /src/tests/bitwise.pl: -------------------------------------------------------------------------------- 1 | module(bitwise, [], []). 2 | 3 | clausedef(test_shift_left, [], [int, int, int]). 4 | test_shift_left(A, B, C) :- 5 | A is B << C. 6 | 7 | clausedef(test_shift_right, [], [int, int, int]). 8 | test_shift_right(A, B, C) :- 9 | A is B >> C. 10 | 11 | clausedef(test_bitwise_and, [], [int, int, int]). 12 | test_bitwise_and(A, B, C) :- 13 | A is B /\ C. 14 | 15 | clausedef(test_bitwise_or, [], [int, int, int]). 16 | test_bitwise_or(A, B, C) :- 17 | A is B \/ C. 18 | 19 | -------------------------------------------------------------------------------- /src/tests/module_test/module3.pl: -------------------------------------------------------------------------------- 1 | module(module3, [], []). 2 | 3 | use_module('module1.pl', [mylength/2], [mylist]). 4 | use_module('module2.pl', [myappend/3], []). 5 | 6 | clausedef(module_tests, [], []). 7 | module_tests :- 8 | mylength(mycons(0, mycons(1, mynil)), Res1), 9 | Res1 == 2, 10 | 11 | myappend(mycons(0, mycons(1, mynil)), 12 | mycons(2, mycons(3, mynil)), 13 | Res2), 14 | Res2 == mycons(0, mycons(1, mycons(2, mycons(3, mynil)))). 15 | -------------------------------------------------------------------------------- /src/tests/benchmark_against.pl: -------------------------------------------------------------------------------- 1 | % -List[A] 2 | % -B 3 | % -relation(B, A, B) 4 | % -B 5 | foldLeft([], Accum, _, Accum). 6 | foldLeft([H|T], Accum, Relation, Result) :- 7 | call(Relation, Accum, H, TempAccum), 8 | foldLeft(T, TempAccum, Relation, Result). 9 | 10 | add(A, B, C) :- 11 | C is A + B. 12 | 13 | addListWithFoldLeft(List, Retval) :- 14 | foldLeft(List, 0, add, Retval). 15 | 16 | makeList(0, _, []). 17 | makeList(N, Item, [Item|Rest]) :- 18 | NewN is N - 1, 19 | makeList(NewN, Item, Rest). 20 | 21 | benchmarkBigList :- 22 | makeList(50000000, 1, List), 23 | addListWithFoldLeft(List, _). 24 | -------------------------------------------------------------------------------- /src/tests/nested_capture.pl: -------------------------------------------------------------------------------- 1 | module(nested_capture, [], []). 2 | 3 | clausedef(onFailure, [], [relation([]), relation([])]). 4 | onFailure(Rel1, _) :- 5 | call(Rel1), 6 | !. 7 | onFailure(_, Rel2) :- 8 | call(Rel2), 9 | !, 10 | fail. 11 | 12 | clausedef(yolo_UNSAFE_format_shim, [A], [atom, list(A)]). 13 | yolo_UNSAFE_format_shim(Atom, List) :- 14 | format(Atom, List). 15 | 16 | clausedef(outer, [], [int]). 17 | outer(Int) :- 18 | onFailure( 19 | lambda([], fail), 20 | lambda([], 21 | (yolo_UNSAFE_format_shim('OUTER FAILURE OCCURRED~n', []), 22 | onFailure(lambda([], 23 | (yolo_UNSAFE_format_shim('INTEGER: ~w~n', [Int]))), 24 | lambda([], 25 | (yolo_UNSAFE_format_shim('UNREACHABLE~n', []))))))). 26 | -------------------------------------------------------------------------------- /src/main.pl: -------------------------------------------------------------------------------- 1 | module(main, [processFileForSwipl/2, processFileForGnuProlog/2], []). 2 | 3 | use_module('module_handler.pl', [handleModules/5], []). 4 | use_module('typechecker.pl', [typecheckClauses/4], []). 5 | use_module('translator.pl', [translateClauses/3], [engine_type]). 6 | use_module('printer.pl', [writeTranslatedClauses/2], []). 7 | 8 | % This is a hack so that the compiler flags itself as using CLP. 9 | % We need this under SWI-PL in order to properly parse programs that 10 | % use CLP. 11 | clausedef(useClp, [], []). 12 | useClp :- 13 | X #= X. 14 | 15 | clausedef(processFile, [], [atom, engine_type, atom]). 16 | processFile(InputFile, Engine, OutputFile) :- 17 | handleModules(InputFile, DataDefs, ClauseDefs, GlobalVarDefs, Clauses), !, 18 | typecheckClauses(DataDefs, ClauseDefs, GlobalVarDefs, Clauses), !, 19 | translateClauses(Clauses, Engine, TranslatedClauses), !, 20 | writeTranslatedClauses(TranslatedClauses, OutputFile), !. 21 | 22 | % these stubs are needed so we can call them directly without having 23 | % to manually lookup to see what they got translated to due to modules. 24 | clausedef(processFileForSwipl, [], [atom, atom]). 25 | processFileForSwipl(InputFile, OutputFile) :- 26 | processFile(InputFile, swipl, OutputFile). 27 | 28 | clausedef(processFileForGnuProlog, [], [atom, atom]). 29 | processFileForGnuProlog(InputFile, OutputFile) :- 30 | processFile(InputFile, gnuprolog, OutputFile). 31 | -------------------------------------------------------------------------------- /src/README.md: -------------------------------------------------------------------------------- 1 | Todo list: 2 | 3 | 1. Fix bug where we will allow a type definition that doesn't use all the type 4 | parameters in a definition, as with just plain `list`. This is recognized as 5 | a valid type, though attempts to use it won't work (as expected). 6 | 2. Get rid of the course-grained `yolo_UNSAFE`. Replace it with two separate mechanisms: 7 | 1. A raw call, wherein we escape directly into Prolog. We provide explicit types for 8 | what the raw call does, where in a worst case we can provide type parameters for 9 | everything. This allows us to do more typechecking than we currently do. 10 | 2. A raw term, for which no name mangling occurs. Something like 11 | `yolo_UNSAFE_raw_term(foo(1))`. Everything within is passed along-as is. 12 | If you want to combine raw and non-raw terms, then you'll have to use variables 13 | as intermediaries, as with `Cooked = cooked(1, 2), Raw = yolo_UNSAFE_raw_term(foo(Cooked))`. 14 | 3. Allow for blanket imports. 15 | 4. User-facing syntax relations should just be `relation(A, B)`, not `relation([A, B])` 16 | 17 | Done: 18 | 19 | 1. Get `is` working 20 | 2. Variables introduced inside of a lambda should not live beyond the scope 21 | of the lambda 22 | 3. Translation for lambdas. 23 | 4. Make things emit variables that aren't singletons 24 | 5. Actually write the code to a file 25 | 6. Order `call_lambda`s so that versions with the same arity are next to each other. 26 | 7. Add support for global variables which can be translated to different representations 27 | for different engines. 28 | 8. Add support for modules. 29 | -------------------------------------------------------------------------------- /formalism/typed_prolog.tex: -------------------------------------------------------------------------------- 1 | \documentclass[10pt]{article} 2 | \usepackage[cm]{fullpage} 3 | \usepackage{longtable} 4 | \usepackage{amsmath} 5 | \usepackage{amsfonts} 6 | \usepackage{color} 7 | \usepackage{xspace} 8 | \usepackage{xargs} 9 | \usepackage{array} 10 | \usepackage{caption} 11 | \usepackage{txfonts} 12 | \usepackage{proof} 13 | \usepackage{mdframed} 14 | \usepackage{multirow} 15 | \usepackage{stmaryrd} 16 | 17 | \newcommand{\alt}{\ \mid\ } 18 | \newcommand{\lalt}{\ \ \ \alt} 19 | \newcommand{\mtt}[1]{\ensuremath{\mathit{#1}}} 20 | \newcommand{\anywhere}[1]{\ensuremath{\mbox{#1}}} 21 | \newcommand{\kw}[1]{\anywhere{\sffamily{\bfseries\small {#1}}}} 22 | \newcommand{\term}{\ensuremath{\mtt{term}}\xspace} 23 | \newcommand{\atom}{\ensuremath{\mtt{atom}}\xspace} 24 | \newcommand{\name}{\ensuremath{\mtt{name}}\xspace} 25 | \newcommand{\datadef}{\ensuremath{\mtt{datadef}}\xspace} 26 | 27 | \begin{document} 28 | 29 | \title{Basic Prolog Type System} 30 | \author{} 31 | \date{} 32 | 33 | \maketitle 34 | 35 | \section{Syntax} 36 | 37 | \begin{gather*} 38 | x \in \mtt{Variable} \qquad n \in \mathbb{Z} \qquad \atom \in \mtt{Atom} \qquad T \in \mtt{TypeVariable} \qquad \name \in \mtt{Name} 39 | \end{gather*} 40 | 41 | \begin{align*} 42 | p \in \mtt{Program} &::= \overrightarrow{\datadef}\;\vec{c} 43 | \\ 44 | \datadef \in \mtt{DataDefinition} &::= \kw{data}\; \name[\vec{T}] = \overrightarrow{\name_i(\vec{\tau})} 45 | \\ 46 | s \in \mtt{Structure} &::= \atom(\vec{t}) 47 | \\ 48 | \term \in \mtt{Term} &::= x \alt \atom \alt n \alt s \alt \lambda 49 | \\ 50 | \lambda \in \mtt{Lambda} &::= \kw{lambda}\;\overrightarrow{\term}\;b 51 | \\ 52 | c \in \mtt{Clause} &::= \name[\vec{T}] : \vec{\tau} = \overrightarrow{(\overrightarrow{\term}) \Leftarrow b.} 53 | \\ 54 | b \in \mtt{Body} &::= b_1 \land b_2 \alt b_2 \lor b_2 55 | \alt \kw{call}\;term \alt s 56 | \end{align*} 57 | 58 | \section{Typing Rules} 59 | \begin{align*} 60 | \tau \in \mtt{Type} &= \kw{int} \alt \name[\vec{\tau}] \alt T \alt \kw{relation}(\vec{\tau}) 61 | \end{align*} 62 | 63 | \end{document} 64 | -------------------------------------------------------------------------------- /src/io.pl: -------------------------------------------------------------------------------- 1 | module(io, [read_clauses_from_file/3, writeClauses/2], []). 2 | 3 | use_module('common.pl', [forall/2], [option]). 4 | 5 | datadef(stream, [A], [stream(A)]). 6 | datadef(mode, [], [read_mode, write_mode]). 7 | 8 | clausedef(yolo_UNSAFE_translate_mode, [A], [mode, A]). 9 | yolo_UNSAFE_translate_mode(read_mode, Op) :- Op = read, !. 10 | yolo_UNSAFE_translate_mode(write_mode, Op) :- Op = write, !. 11 | 12 | clausedef(yolo_UNSAFE_open_file, [A], [atom, mode, stream(A)]). 13 | yolo_UNSAFE_open_file(Filename, Mode, stream(Stream)) :- 14 | yolo_UNSAFE_translate_mode(Mode, OpenMode), 15 | open(Filename, OpenMode, Stream). 16 | 17 | clausedef(yolo_UNSAFE_close_file, [A], [stream(A)]). 18 | yolo_UNSAFE_close_file(stream(Stream)) :- 19 | close(Stream). 20 | 21 | clausedef(withOpenStream, [A], [atom, mode, relation([stream(A)])]). 22 | withOpenStream(Filename, Mode, CallThis) :- 23 | yolo_UNSAFE_open_file(Filename, Mode, Stream), 24 | ((call(CallThis, Stream), yolo_UNSAFE_close_file(Stream), !); 25 | (yolo_UNSAFE_close_file(Stream), fail)). 26 | 27 | clausedef(yolo_UNSAFE_read_clause, [A, B, C], [stream(A), relation([B, C]), option(C)]). 28 | yolo_UNSAFE_read_clause(stream(Wrapped), Translator, Translated) :- 29 | read_clause(Wrapped, RawClause, []), 30 | (RawClause == end_of_file -> 31 | (Translated = none); 32 | (call(Translator, RawClause, TranslatedClause), 33 | Translated = some(TranslatedClause))). 34 | 35 | clausedef(read_clauses_from_stream, [A, B, C], [stream(A), relation([B, C]), list(C)]). 36 | read_clauses_from_stream(Stream, Translator, Result) :- 37 | Helper = lambda([Accum], 38 | (yolo_UNSAFE_read_clause(Stream, Translator, OpResult), 39 | (OpResult = some(Cur) -> 40 | (Accum = [Cur|Rest], 41 | call(Helper, Rest)); 42 | (Accum = [])))), 43 | call(Helper, Result). 44 | 45 | clausedef(read_clauses_from_file, [A, B], [atom, relation([A, B]), list(B)]). 46 | read_clauses_from_file(Filename, Translator, Result) :- 47 | withOpenStream(Filename, read_mode, 48 | lambda([Stream], 49 | read_clauses_from_stream(Stream, Translator, Result))). 50 | 51 | clausedef(yolo_UNSAFE_write_clause, [A, B], [A, stream(B)]). 52 | yolo_UNSAFE_write_clause(Clause, stream(Stream)) :- 53 | copy_term(Clause, Copy), 54 | numbervars(Copy, 0, _, [singletons(true)]), 55 | write_term(Stream, Copy, [numbervars(true), quoted(true)]), 56 | format(Stream, ' .~n', []). 57 | 58 | clausedef(writeClauses, [A], [list(A), atom]). 59 | writeClauses(Clauses, Filename) :- 60 | withOpenStream( 61 | Filename, write_mode, 62 | lambda([Stream], 63 | forall(Clauses, 64 | lambda([Clause], yolo_UNSAFE_write_clause(Clause, Stream))))). 65 | -------------------------------------------------------------------------------- /src/tests/test.pl: -------------------------------------------------------------------------------- 1 | module(test, [], []). 2 | 3 | clausedef(map, [A, B], [list(A), relation([A, B]), list(B)]). 4 | map([], _, []). 5 | map([HA|TA], F, [HB|TB]) :- 6 | call(F, HA, HB), 7 | map(TA, F, TB). 8 | 9 | clausedef(filter, [A], [list(A), relation([A]), list(A)]). 10 | filter([], _, []). 11 | filter([H|T], R, ResultList) :- 12 | (call(R, H) -> 13 | ResultList = [H|Rest]; 14 | ResultList = Rest), 15 | filter(T, R, Rest). 16 | 17 | clausedef(lessThanN, [], [list(int), int, list(int)]). 18 | lessThanN(List, N, NewList) :- 19 | filter(List, lambda([Cur], Cur < N), NewList). 20 | 21 | clausedef(foldLeft, [A, B], [list(A), B, relation([B, A, B]), B]). 22 | foldLeft([], Accum, _, Accum). 23 | foldLeft([H|T], Accum, Relation, Result) :- 24 | call(Relation, Accum, H, NewAccum), 25 | foldLeft(T, NewAccum, Relation, Result). 26 | 27 | clausedef(addListWithFoldLeft, [], [list(int), int]). 28 | addListWithFoldLeft(List, Retval) :- 29 | foldLeft(List, 0, lambda([Acc, N, NewAcc], NewAcc is N + Acc), Retval). 30 | 31 | clausedef(addList, [], [list(int), int]). 32 | addList(List, Retval) :- 33 | Helper = lambda([CurList, Accum], 34 | (CurList = [H|T] -> 35 | (NewAccum is Accum + H, 36 | call(Helper, T, NewAccum)); 37 | (Retval = Accum))), 38 | call(Helper, List, 0), 39 | ensureType(Helper). 40 | 41 | clausedef(ensureType, [], [relation([list(int), int])]). 42 | ensureType(_). 43 | 44 | clausedef(add, [], [int, int, int]). 45 | add(X, Y, Z) :- 46 | Z is X * Y. 47 | 48 | clausedef(plus1, [], [list(int), list(int)]). 49 | plus1(Input, Output) :- 50 | map(Input, lambda([X, Y], Y is X + 1), Output). 51 | 52 | clausedef(test, [], []). 53 | test :- 54 | X = lambda([], A is 1), 55 | call(X), 56 | A = []. 57 | 58 | clausedef(makeList, [A], [int, A, list(A)]). 59 | makeList(0, _, []). 60 | makeList(N, Item, [Item|Rest]) :- 61 | NewN is N - 1, 62 | makeList(NewN, Item, Rest). 63 | 64 | clausedef(benchmarkBigList, [], []). 65 | benchmarkBigList :- 66 | makeList(50000000, 1, List), 67 | addListWithFoldLeft(List, _). 68 | 69 | 70 | clausedef(compare, [], [int, int]). 71 | compare(X, Y) :- 72 | X =< Y. 73 | 74 | globalvardef(counter, [], int). 75 | clausedef(freshInt, [], [int]). 76 | freshInt(N) :- 77 | getvar(counter, N), 78 | NewN is N + 1, 79 | setvar(counter, NewN). 80 | 81 | clausedef(yolo_UNSAFE_test, [], [list(int)]). 82 | yolo_UNSAFE_test(Ints) :- 83 | bagof(X, member(X, [1,2,3]), Ints). 84 | 85 | clausedef(test_atom, [], [atom]). 86 | test_atom(Atom) :- 87 | Atom = hello. 88 | 89 | clausedef(runTests, [], []). 90 | runTests :- 91 | plus1([1,2,3], Res1), 92 | Res1 == [2,3,4], 93 | 94 | lessThanN([1,2,3,4,5], 3, Res2), 95 | Res2 == [1,2], 96 | 97 | addListWithFoldLeft([1,2,3], Res3), 98 | Res3 == 6, 99 | 100 | addList([4,5,6], Res4), 101 | Res4 == 15, 102 | 103 | test, 104 | 105 | setvar(counter, 0), 106 | freshInt(N1), 107 | N1 == 0, 108 | freshInt(N2), 109 | N2 == 1, 110 | 111 | yolo_UNSAFE_test(Ints), 112 | Ints == [1,2,3], 113 | 114 | test_atom(Hello), 115 | Hello == hello. 116 | -------------------------------------------------------------------------------- /src/printer.pl: -------------------------------------------------------------------------------- 1 | module(printer, [writeTranslatedClauses/2], []). 2 | 3 | use_module('common.pl', [map/3], []). 4 | use_module('syntax.pl', [], 5 | [op, exp, expLhs, term, bodyPairOp, body, type, defclause, 6 | typeConstructor, defdata, clauseclause, defglobalvar, 7 | defmodule, def_use_module, loadedFile, bodyUnaryOp, unop, 8 | compareOp]). 9 | use_module('io.pl', [writeClauses/2], []). 10 | 11 | % Handles writing to files. Assumes that translation has already occurred, so that 12 | % it won't encounter getvar, setvar, lambda, or higher order calls. 13 | 14 | % A whole lot of this file is unsafe because we are going down to raw Prolog 15 | % terms, for which we no not have an associated type. 16 | 17 | clausedef(translateOp, [], [op, atom]). 18 | translateOp(plus, '+'). 19 | translateOp(minus, '-'). 20 | translateOp(mul, '*'). 21 | translateOp(div, '/'). 22 | translateOp(op_min, min). 23 | translateOp(op_max, max). 24 | translateOp(shift_left, '<<'). 25 | translateOp(shift_right, '>>'). 26 | translateOp(bitwise_and, '/\\'). 27 | translateOp(bitwise_or, '\\/'). 28 | translateOp(int_div, '//'). 29 | translateOp(int_rem, 'rem'). 30 | translateOp(int_mod, 'mod'). 31 | translateOp(op_exponent, '^'). 32 | 33 | clausedef(translateCompareOp, [], [compareOp, atom]). 34 | translateCompareOp(lt, '<'). 35 | translateCompareOp(lte, '=<'). 36 | translateCompareOp(gt, '>'). 37 | translateCompareOp(gte, '>='). 38 | translateCompareOp(clp_lt, '#<'). 39 | translateCompareOp(clp_lte, '#=<'). 40 | translateCompareOp(clp_gt, '#>'). 41 | translateCompareOp(clp_gte, '#>='). 42 | translateCompareOp(clp_eq, '#='). 43 | translateCompareOp(clp_neq, '#\\='). 44 | 45 | clausedef(translateUnop, [], [unop, atom]). 46 | translateUnop(op_msb, msb). 47 | translateUnop(op_abs, abs). 48 | translateUnop(op_truncate, truncate). 49 | 50 | clausedef(translateBodyUnaryOp, [], [bodyUnaryOp, atom]). 51 | translateBodyUnaryOp(not, '\\+'). 52 | 53 | clausedef(translateBodyPairOp, [], [bodyPairOp, atom]). 54 | translateBodyPairOp(and, ','). 55 | translateBodyPairOp(or, ';'). 56 | translateBodyPairOp(implies, '->'). 57 | 58 | clausedef(yolo_UNSAFE_translate_exp, [A], [exp, A]). 59 | yolo_UNSAFE_translate_exp(exp_var(X), NewX) :- X = NewX. 60 | yolo_UNSAFE_translate_exp(exp_num(N), NewN) :- N = NewN. 61 | yolo_UNSAFE_translate_exp(binop(E1, Op, E2), Output) :- 62 | translateOp(Op, NewOp), 63 | yolo_UNSAFE_translate_exp(E1, NewE1), 64 | yolo_UNSAFE_translate_exp(E2, NewE2), 65 | Output =.. [NewOp, NewE1, NewE2]. 66 | yolo_UNSAFE_translate_exp(unaryop(Op, E), Output) :- 67 | translateUnop(Op, NewOp), 68 | yolo_UNSAFE_translate_exp(E, NewE), 69 | Output =.. [NewOp, NewE]. 70 | 71 | clausedef(yolo_UNSAFE_translate_exp_lhs, [A], [expLhs, A]). 72 | yolo_UNSAFE_translate_exp_lhs(lhs_var(X), NewX) :- X = NewX. 73 | yolo_UNSAFE_translate_exp_lhs(lhs_num(N), NewN) :- N = NewN. 74 | 75 | clausedef(translateTerms, [A], [list(term), list(A)]). 76 | translateTerms(Terms, Result) :- 77 | map(Terms, 78 | lambda([T, R], yolo_UNSAFE_translate_term(T, R)), 79 | Result). 80 | 81 | clausedef(yolo_UNSAFE_translate_term, [A], [term, A]). 82 | yolo_UNSAFE_translate_term(term_var(X), NewX) :- X = NewX. 83 | yolo_UNSAFE_translate_term(term_num(N), NewN) :- N = NewN. 84 | % lambdas have been translated away 85 | yolo_UNSAFE_translate_term(term_constructor(Name, Terms), Result) :- 86 | translateTerms(Terms, NewTerms), 87 | Result =.. [Name|NewTerms]. 88 | 89 | clausedef(yolo_UNSAFE_translate_body, [A], [body, A]). 90 | yolo_UNSAFE_translate_body(body_is(Lhs, Exp), Result) :- 91 | yolo_UNSAFE_translate_exp_lhs(Lhs, NewLhs), 92 | yolo_UNSAFE_translate_exp(Exp, NewExp), 93 | Result =.. [is, NewLhs, NewExp]. 94 | yolo_UNSAFE_translate_body(bodyComparison(Exp1, Op, Exp2), Result) :- 95 | yolo_UNSAFE_translate_exp(Exp1, NewExp1), 96 | yolo_UNSAFE_translate_exp(Exp2, NewExp2), 97 | translateCompareOp(Op, AtomOp), 98 | Result =.. [AtomOp, NewExp1, NewExp2]. 99 | % setvar and getvar has been translated away 100 | yolo_UNSAFE_translate_body(bodyUnary(Op, Body), Result) :- 101 | translateBodyUnaryOp(Op, NewOp), 102 | yolo_UNSAFE_translate_body(Body, NewBody), 103 | Result =.. [NewOp, NewBody]. 104 | yolo_UNSAFE_translate_body(bodyPair(B1, Op, B2), Result) :- 105 | translateBodyPairOp(Op, NewOp), 106 | yolo_UNSAFE_translate_body(B1, NewB1), 107 | yolo_UNSAFE_translate_body(B2, NewB2), 108 | Result =.. [NewOp, NewB1, NewB2]. 109 | % higher order calls have been translated away 110 | yolo_UNSAFE_translate_body(firstOrderCall(Name, Terms), Result) :- 111 | translateTerms(Terms, NewTerms), 112 | Result =.. [Name|NewTerms]. 113 | 114 | clausedef(yolo_UNSAFE_translate_clause, [A], [clauseclause, A]). 115 | yolo_UNSAFE_translate_clause(clauseclause(Name, Params, Body), NewClause) :- 116 | translateTerms(Params, NewParams), 117 | yolo_UNSAFE_translate_body(Body, NewBody), 118 | Head =.. [Name|NewParams], 119 | (NewBody == true -> 120 | (NewClause = Head); 121 | (NewClause =.. [':-', Head, NewBody])). 122 | 123 | clausedef(writeTranslatedClauses, [], [list(clauseclause), atom]). 124 | writeTranslatedClauses(Clauses, Filename) :- 125 | map(Clauses, 126 | lambda([Clause, NewClause], 127 | yolo_UNSAFE_translate_clause(Clause, NewClause)), 128 | TranslatedClauses), 129 | writeClauses(TranslatedClauses, Filename). 130 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # typed-prolog 2 | A basic type system on top of Prolog, along with higher-order clauses. Translates to normal Prolog. 3 | 4 | 5 | ## Central Features ## 6 | 7 | Typed-Prolog provides the following basic features: 8 | 9 | - An algebraic type system with local type inference, based on [Hindley-Milner](https://en.wikipedia.org/wiki/Hindley%E2%80%93Milner_type_system). 10 | This means the following two core components: 11 | - Generic types (introduced with datatype definitions) 12 | - Parametric polymorphism (only supported at the clause level) 13 | - Higher-order clauses, the equivalent of higher-order functions in a logic programming setting. 14 | Type inference is automatic for these. 15 | These functions compile down to standard first-order Prolog, via [defunctionalization](https://en.wikipedia.org/wiki/Defunctionalization). 16 | In practice, not only does this make such functions safer to use (we do not resort to any `eval`-like metaprogramming), these also run much faster. 17 | - Staightforward modules 18 | - Global variables 19 | 20 | ## Example ## 21 | 22 | Below is an example which uses a variety of features of Typed-Prolog. 23 | 24 | ```prolog 25 | module(routines, [myMap/3, sum/2, sumNative/2], [myList]). 26 | 27 | datadef(myList, [A], [myCons(A, myList(A)), myNil]). 28 | 29 | clausedef(foldRight, [A, B], [myList(A), B, relation([A, B, B]), B]). 30 | foldRight(myNil, Accum, _, Accum). 31 | foldRight(myCons(H, T), Accum, Relation, Result) :- 32 | foldRight(T, Accum, Relation, TailAccum), 33 | call(Relation, H, TailAccum, Result). 34 | 35 | clausedef(myMap, [A, B], [myList(A), relation([A, B]), myList(B)]). 36 | myMap(Input, Mapper, Output) :- 37 | foldRight(Input, 38 | myNil, 39 | lambda([A, CurList, myCons(B, CurList)], 40 | call(Mapper, A, B)), 41 | Output). 42 | 43 | clausedef(sum, [], [myList(int), int]). 44 | sum(Input, Output) :- 45 | foldRight(Input, 46 | 0, 47 | lambda([X, Y, Z], 48 | Z is X + Y), 49 | Output). 50 | 51 | clausedef(sumNative, [], [list(int), int]). 52 | sumNative(Input, Output) :- 53 | sumNative(Input, 0, Output). 54 | 55 | clausedef(sumNative, [], [list(int), int, int]). 56 | sumNative([], Sum, Sum). 57 | sumNative([H|T], Accum, Sum) :- 58 | NewAccum is Accum + H, 59 | sumNative(T, NewAccum, Sum). 60 | ``` 61 | 62 | The above example, if saved in the file `routines.pl`, should compile. 63 | The above example shows the following parts: 64 | 65 | 1. Module definition, using `module`. 66 | This takes three components: 67 | 1. The name of the module, which should match the filename 68 | 2. The export list of procedures, which describe procedures which this module makes public to other modules. 69 | Any procedures defined in the file which are **not** part of this list are considered private to the module, and cannot be accessed from outside of the module. 70 | For example, in the above code `myMap/3` is public, but `foldRight/4` is private. 71 | 3. The export list of datatypes, which describe datatypes which this modules makes public to other modules. 72 | All constructors of the given datatype are exported. 73 | Any datatypes defined in the file which are **not** part of this list are considered private to the module, and cannot be accessed from outside of the module. 74 | The only datatype in play in the example is `myList`, which is publicly exported. 75 | 2. Datatype definition, using `datadef`. 76 | This takes three components: 77 | 1. The name of the datatype 78 | 2. A list of generic types which are introduced in the datatype. 79 | If the datatype is not generic, an empty list (`[]`) must be used. 80 | 3. The constructors for the datatype, which are permitted to be recursive. 81 | 3. Clause definition, using `clausedef`. 82 | While clause definitions may be located anywhere in the file, it is good practice to put them immediately before their corresponding clauses, as is done in the example. 83 | This takes three components: 84 | 1. The name of the clause 85 | 2. Any type variables the clause introduces. 86 | If the clause does not introduce any type variables, then an empty list (`[]`) must be used. 87 | 3. The types of the parameters to the clause, specified in a list. 88 | 4. The `relation([...])` type, which is used for higher-order clauses. 89 | Note the use of square braces in the type. 90 | Values of type `relation([...])` are called with the `call` built-in, which behaves **substantially differently** from the typical `call` metaprogramming routine. 91 | Uses of `call` here ultimately are translated down into typical first-order clauses. 92 | 5. The `lambda` keyword, which introduces values of type `relation([...])`. 93 | These consist of two components: 94 | 1. A parameter list, which is no more constrained than the parameter list for clauses. 95 | That is, unification is employed for the parameters, and they need not be variables (though they may be, if desired). 96 | Unlike with `clausedef`, the types of the parameters are inferred, and there is no way to explicitly annotate parameter types here. 97 | 2. The body, which is a snippet of executable code. 98 | If multiple conjuncts are needed, they should be enclosed in an outer set of parentheses (as in, the body should be a functor with the name `,`). 99 | 6. The `int` type, which is short for `integer`. 100 | This behaves with `is` as one might expect. 101 | 7. The `list(...)` type, which is for the typical lists built into Prolog. 102 | These are referenced with the usual notation (e.g., `[H|T]`) 103 | 104 | All procedures **must** have a `clausedef` associated with them. 105 | -------------------------------------------------------------------------------- /src/common.pl: -------------------------------------------------------------------------------- 1 | module(common, [map/3, filter/3, foldLeft/4, forall/2, exists/2, 2 | setContains/2, flatMap/3, foldRight/4, existsOnce/2, 3 | zip/3, find/3, beginsWith/2, contains/2, 4 | atomContains/2, notMember/2, appendDiffList/3, 5 | makeSetFromList/2, setUnion/3, setDifference/3, 6 | sortItems/4, onFailure/2, yolo_UNSAFE_format_shim/2, 7 | duplicates/2, setsOverlap/2, once/1], 8 | [pair, tup3, tup4, tup5, tup6, tup7, tup8, option]). 9 | 10 | datadef(pair, [A, B], [pair(A, B)]). 11 | datadef(tup3, [A, B, C], [tup3(A, B, C)]). 12 | datadef(tup4, [A, B, C, D], [tup4(A, B, C, D)]). 13 | datadef(tup5, [A, B, C, D, E], [tup5(A, B, C, D, E)]). 14 | datadef(tup6, [A, B, C, D, E, F], [tup6(A, B, C, D, E, F)]). 15 | datadef(tup7, [A, B, C, D, E, F, G], [tup7(A, B, C, D, E, F, G)]). 16 | datadef(tup8, [A, B, C, D, E, F, G, H], [tup8(A, B, C, D, E, F, G, H)]). 17 | 18 | datadef(option, [A], [some(A), none]). 19 | 20 | clausedef(map, [A, B], [list(A), relation([A, B]), list(B)]). 21 | map([], _, []). 22 | map([HA|TA], F, [HB|TB]) :- 23 | call(F, HA, HB), 24 | map(TA, F, TB). 25 | 26 | clausedef(flatMap, [A, B], [list(A), relation([A, list(B)]), list(B)]). 27 | flatMap(List, Relation, ResultList) :- 28 | foldRight( 29 | List, [], 30 | lambda([Cur, Accum, NewAccum], 31 | (call(Relation, Cur, CurList), 32 | append(CurList, Accum, NewAccum))), 33 | ResultList). 34 | 35 | clausedef(filter, [A], [list(A), relation([A]), list(A)]). 36 | filter([], _, []). 37 | filter([H|T], R, ResultList) :- 38 | (call(R, H) -> 39 | ResultList = [H|Rest]; 40 | ResultList = Rest), 41 | filter(T, R, Rest). 42 | 43 | clausedef(foldRight, [A, B], [list(A), B, relation([A, B, B]), B]). 44 | foldRight([], Accum, _, Accum). 45 | foldRight([H|T], Accum, Relation, Result) :- 46 | foldRight(T, Accum, Relation, TailAccum), 47 | call(Relation, H, TailAccum, Result). 48 | 49 | clausedef(foldLeft, [A, B], [list(A), B, relation([B, A, B]), B]). 50 | foldLeft([], Accum, _, Accum). 51 | foldLeft([H|T], Accum, Relation, Result) :- 52 | call(Relation, Accum, H, NewAccum), 53 | foldLeft(T, NewAccum, Relation, Result). 54 | 55 | clausedef(forall, [A], [list(A), relation([A])]). 56 | forall([], _). 57 | forall([H|T], Relation) :- 58 | call(Relation, H), 59 | forall(T, Relation). 60 | 61 | clausedef(exists, [A], [list(A), relation([A])]). 62 | exists(List, Relation) :- 63 | find(List, Relation, some(_)). 64 | 65 | clausedef(existsOnce, [A], [list(A), relation([A])]). 66 | existsOnce(List, Relation) :- 67 | findOnce(List, Relation, some(_)). 68 | 69 | % unlike the usual definition, this will fail if the two input lists 70 | % are not of the same length. 71 | clausedef(zip, [A, B], [list(A), list(B), list(pair(A, B))]). 72 | zip([], [], []). 73 | zip([H1|T1], [H2|T2], [pair(H1, H2)|Rest]) :- 74 | zip(T1, T2, Rest). 75 | 76 | % Compares using equality instead of unification 77 | clausedef(setContains, [A], [list(A), A]). 78 | setContains([H|_], Item) :- 79 | H == Item. 80 | setContains([_|T], Item) :- 81 | setContains(T, Item). 82 | 83 | clausedef(setsOverlap, [A], [list(A), list(A)]). 84 | setsOverlap(Set1, Set2) :- 85 | existsOnce(Set1, 86 | lambda([Item], 87 | setContains(Set2, Item))). 88 | 89 | clausedef(find, [A], [list(A), relation([A]), option(A)]). 90 | find([], _, none). 91 | find([H|_], Relation, some(H)) :- 92 | call(Relation, H). 93 | find([_|T], Relation, Result) :- 94 | find(T, Relation, Result). 95 | 96 | clausedef(findOnce, [A], [list(A), relation([A]), option(A)]). 97 | findOnce(List, Relation, Result) :- 98 | once(lambda([], find(List, Relation, Result))). 99 | 100 | clausedef(once, [], [relation([])]). 101 | once(Relation) :- 102 | call(Relation), 103 | !. 104 | 105 | % compares using unification 106 | clausedef(beginsWith, [A], [list(A), list(A)]). 107 | beginsWith(_, []). 108 | beginsWith([H|T1], [H|T2]) :- 109 | beginsWith(T1, T2). 110 | 111 | clausedef(contains, [A], [list(A), list(A)]). 112 | contains(List, Probe) :- 113 | beginsWith(List, Probe). 114 | contains([_|T], Probe) :- 115 | contains(T, Probe). 116 | 117 | clausedef(notMember, [A], [A, list(A)]). 118 | notMember(A, List) :- 119 | forall(List, lambda([L], A \= L)). 120 | 121 | clausedef(atomContains, [], [atom, atom]). 122 | atomContains(Original, Probe) :- 123 | atom_codes(Original, OriginalList), 124 | atom_codes(Probe, ProbeList), 125 | contains(OriginalList, ProbeList). 126 | 127 | clausedef(appendDiffList, [A], [list(A), list(A), list(A)]). 128 | appendDiffList([], List, List). 129 | appendDiffList([H|T], [H|Rest], Output) :- 130 | appendDiffList(T, Rest, Output). 131 | 132 | clausedef(makeSetFromList, [A], [list(A), list(A)]). 133 | makeSetFromList(List, Set) :- 134 | foldLeft(List, [], 135 | lambda([Accum, CurElement, NewAccum], 136 | (setContains(Accum, CurElement) -> 137 | (Accum = NewAccum); 138 | (NewAccum = [CurElement|Accum]))), 139 | Set). 140 | 141 | % uses == for comparison 142 | clausedef(setUnion, [A], [list(A), list(A), list(A)]). 143 | setUnion(Set1, Set2, FinalSet) :- 144 | append(Set1, Set2, List), 145 | makeSetFromList(List, FinalSet). 146 | 147 | clausedef(setDifference, [A], [list(A), list(A), list(A)]). 148 | setDifference(SetSource, SetMinus, FinalSet) :- 149 | foldLeft(SetSource, [], 150 | lambda([Accum, Cur, NewAccum], 151 | (setContains(SetMinus, Cur) -> 152 | (Accum = NewAccum); 153 | (NewAccum = [Cur|Accum]))), 154 | FinalSet). 155 | 156 | % inserts an item into a sorted list 157 | clausedef(insertItem, [A], [list(A), relation([A, A]), A, list(A)]). 158 | insertItem([], _, A, [A]) :- !. 159 | insertItem([H|T], Comparer, A, [H|Rest]) :- 160 | call(Comparer, A, H), 161 | insertItem(T, Comparer, A, Rest), 162 | !. 163 | insertItem([H|T], _, A, [A, H|T]). 164 | 165 | clausedef(sortItems, [A, B], [list(A), % items to sort 166 | relation([A, B]), % map them to this domain first 167 | relation([B, B]), % compare in the other domain 168 | list(A)]). % sorted according to B 169 | sortItems(Items, Mapper, Comparer, SortedItems) :- 170 | map(Items, 171 | lambda([A, pair(A, B)], call(Mapper, A, B)), 172 | ItemPairs), 173 | PairComparer = lambda([pair(_, B1), pair(_, B2)], call(Comparer, B1, B2)), 174 | foldLeft(ItemPairs, [], 175 | lambda([Accum, Pair, NewAccum], 176 | insertItem(Accum, PairComparer, Pair, NewAccum)), 177 | SortedPairs), 178 | map(SortedPairs, 179 | lambda([pair(A, _), A], true), 180 | SortedItems). 181 | 182 | % If rel1 fails, then rel2 is called. If rel1 succeeds, no backtracking will 183 | % occur beyond this point, so rel2 will never be called. If rel2 is called, failure 184 | % will be propagated upwards. 185 | clausedef(onFailure, [], [relation([]), relation([])]). 186 | onFailure(Rel1, _) :- 187 | call(Rel1), 188 | !. 189 | onFailure(_, Rel2) :- 190 | call(Rel2), 191 | !, 192 | fail. 193 | 194 | clausedef(yolo_UNSAFE_format_shim, [A], [atom, list(A)]). 195 | yolo_UNSAFE_format_shim(Atom, List) :- 196 | format(Atom, List). 197 | 198 | % gets the elements that are duplicates, using == for comparison 199 | clausedef(duplicates, [A], [list(A), list(A)]). 200 | duplicates(Items, Duplicates) :- 201 | foldLeft(Items, pair([], []), 202 | lambda([pair(Seen, Duplicated), 203 | Item, 204 | pair(NewSeen, NewDuplicated)], 205 | ((setContains(Seen, Item) -> 206 | ((setContains(Duplicated, Item) -> 207 | (NewDuplicated = Duplicated); 208 | (NewDuplicated = [Item|Duplicated])), 209 | NewSeen = Seen); 210 | (NewSeen = [Item|Seen], 211 | NewDuplicated = Duplicated)))), 212 | pair(_, Duplicates)). 213 | -------------------------------------------------------------------------------- /src/typechecker.pl: -------------------------------------------------------------------------------- 1 | module(typechecker, [typecheckClauses/4], []). 2 | 3 | use_module('syntax.pl', [], 4 | [op, exp, expLhs, term, body, type, defclause, 5 | typeConstructor, defdata, clauseclause, defglobalvar, 6 | defmodule, def_use_module, loadedFile]). 7 | use_module('common.pl', [map/3, flatMap/3, zip/3, foldLeft/4, find/3, 8 | atomContains/2, forall/2, onFailure/2, 9 | yolo_UNSAFE_format_shim/2, duplicates/2], 10 | [pair, option]). 11 | 12 | clausedef(builtinDataDefs, [], [list(defdata)]). 13 | builtinDataDefs( 14 | [defdata(list, [A], [typeConstructor('.', [A, constructorType(list, [A])]), 15 | typeConstructor([], [])])]). 16 | 17 | % Even though these all are technically working with the same type variable, 18 | % given that we'll copy terms this doesn't hurt anything 19 | clausedef(builtinClauseDefs, [], [list(defclause)]). 20 | builtinClauseDefs( 21 | [defclause(true, [], []), 22 | defclause(false, [], []), 23 | defclause(fail, [], []), 24 | defclause('!', [], []), 25 | defclause(var, [A], [A]), 26 | defclause(nonvar, [A], [A]), 27 | defclause(ground, [A], [A]), 28 | defclause(@>, [A], [A, A]), 29 | defclause(@<, [A], [A, A]), 30 | defclause(@=<, [A], [A, A]), 31 | defclause(@>=, [A], [A, A]), 32 | defclause(=, [A], [A, A]), 33 | defclause(unify_with_occurs_check, [A], [A, A]), 34 | defclause(\=, [A], [A, A]), 35 | defclause(fd_labeling, [], [constructorType(list, [intType])]), 36 | defclause(==, [A], [A, A]), 37 | defclause(\==, [A], [A, A]), 38 | defclause(is_set, [A], [constructorType(list, [A])]), 39 | defclause(member, [A], [A, constructorType(list, [A])]), 40 | defclause(reverse, [A], [constructorType(list, [A]), constructorType(list, [A])]), 41 | defclause(copy_term, [A], [A, A]), 42 | defclause(append, [A], [constructorType(list, [A]), 43 | constructorType(list, [A]), 44 | constructorType(list, [A])]), 45 | defclause(length, [A], [constructorType(list, [A]), intType]), 46 | defclause(atom_codes, [], [atomType, constructorType(list, [intType])]), 47 | defclause(atom_number, [], [atomType, intType]), 48 | defclause(atom_concat, [], [atomType, atomType, atomType]) 49 | ]). 50 | 51 | clausedef(keys, [A, B], [list(pair(A, B)), list(A)]). 52 | keys(Pairs, Keys) :- 53 | map(Pairs, lambda([pair(Key, _), Key], true), Keys). 54 | 55 | clausedef(ensureUnique, [A], [list(A), % items 56 | atom]). % error message if not 57 | ensureUnique(Items, ErrorMessage) :- 58 | duplicates(Items, Duplicates), 59 | onFailure( 60 | lambda([], Duplicates = []), 61 | lambda([], yolo_UNSAFE_format_shim(ErrorMessage, [Duplicates]))). 62 | 63 | % succeeds if the provided mapping is unique 64 | clausedef(mappingUnique, [A, B], [list(pair(A, B)), % mapping 65 | atom]). % error message if not 66 | mappingUnique(Pairs, ErrorMessage) :- 67 | keys(Pairs, Keys), 68 | ensureUnique(Keys, ErrorMessage). 69 | 70 | % gets a mapping of constructor names to their corresponding data defs 71 | clausedef(constructorToDataDefMapping, [], [list(defdata), list(pair(atom, defdata))]). 72 | constructorToDataDefMapping(DefDatas, Mapping) :- 73 | flatMap( 74 | DefDatas, 75 | lambda([DefData, DefDataResult], 76 | (DefData = defdata(_, _, TypeConstructors), 77 | map(TypeConstructors, 78 | lambda([typeConstructor(Name, _), pair(Name, DefData)], true), 79 | DefDataResult))), 80 | Mapping), 81 | % NOTE: this does not appear in practice as module rewriting 82 | % catches this first. 83 | mappingUnique(Mapping, 'Duplicate locally-defined constructor names: ~w~n~n'). 84 | 85 | % gets a mapping of clauses with a given name and arity to their 86 | % corresponding definitions 87 | clausedef(clauseToClauseDefMapping, [], [list(defclause), 88 | list(pair(pair(atom, int), defclause))]). 89 | clauseToClauseDefMapping(DefClauses, Mapping) :- 90 | map(DefClauses, 91 | lambda([DefClause, pair(pair(Name, Arity), DefClause)], 92 | (DefClause = defclause(Name, _, FormalParams), 93 | length(FormalParams, Arity))), 94 | Mapping), 95 | % TODO: should this test be moved to module rewriting? 96 | % A similar test for constructors is already handled there 97 | % (see `constructorToDataDefMapping` for details) 98 | mappingUnique(Mapping, 'Duplicate clausedefs for: ~w~n~n'). 99 | 100 | % holds data def mapping, clausedef mapping, and global var defs 101 | datadef(state, [], [state(list(pair(atom, defdata)), 102 | list(pair(pair(atom, int), defclause)), 103 | list(defglobalvar))]). 104 | 105 | clausedef(ensureTypeNamesUnique, [], [list(defdata)]). 106 | ensureTypeNamesUnique(DataDefs) :- 107 | map(DataDefs, 108 | lambda([defdata(Name, _, _), Name], true), 109 | TypeNames), 110 | ensureUnique(TypeNames, 'Duplicate type names: ~w~n~n'). 111 | 112 | clausedef(makeState, [], [list(defdata), list(defclause), 113 | list(defglobalvar), state]). 114 | makeState(DataDefs, ClauseDefs, GlobalVarDefs, 115 | state(DataDefMapping, ClauseDefMapping, GlobalVarDefs)) :- 116 | ensureTypeNamesUnique(DataDefs), 117 | constructorToDataDefMapping(DataDefs, DataDefMapping), 118 | clauseToClauseDefMapping(ClauseDefs, ClauseDefMapping). 119 | 120 | clausedef(expectedFormalParamTypes, [], [state, % current type state 121 | atom, % name of the clause 122 | int, % arity of the clause 123 | list(type), % generics involved in the 124 | % expected types 125 | list(type)]). % expected types 126 | expectedFormalParamTypes(state(_, Mapping, _), Name, Arity, Generics, Expected) :- 127 | member(pair(pair(Name, Arity), RawClause), Mapping), 128 | copy_term(RawClause, defclause(_, Generics, Expected)). 129 | 130 | % just ignores the generics 131 | clausedef(expectedFormalParamTypes, [], [state, atom, int, list(type)]). 132 | expectedFormalParamTypes(State, Name, Arity, Expected) :- 133 | expectedFormalParamTypes(State, Name, Arity, _, Expected). 134 | 135 | % int is an uninstantiated variable 136 | clausedef(envVariableType, [], [list(pair(int, type)), % input type environment 137 | int, % variable 138 | type, % variable's type 139 | list(pair(int, type))]). % output type environment 140 | envVariableType(TypeEnv, Variable, Type, NewTypeEnv) :- 141 | find(TypeEnv, 142 | lambda([pair(EnvVariable, _)], Variable == EnvVariable), 143 | FindResult), 144 | !, % if we were to backtrack, we'd always be able to add a new 145 | % variable 146 | (FindResult = some(pair(_, EnvType)) -> 147 | (Type = EnvType, 148 | TypeEnv = NewTypeEnv); 149 | (NewTypeEnv = [pair(Variable, Type)|TypeEnv])). 150 | 151 | clausedef(typecheckLhs, [], [list(pair(int, type)), % input type environment, 152 | expLhs, 153 | list(pair(int, type))]). % output type environment 154 | typecheckLhs(TypeEnv, lhs_num(_), TypeEnv) :- !. 155 | typecheckLhs(TypeEnv, lhs_var(Variable), NewTypeEnv) :- 156 | !, 157 | envVariableType(TypeEnv, Variable, intType, NewTypeEnv). 158 | 159 | clausedef(typecheckExp, [], [list(pair(int, type)), % input type environment, 160 | exp, 161 | list(pair(int, type))]). % output type environment 162 | typecheckExp(TypeEnv, exp_var(Variable), NewTypeEnv) :- 163 | !, 164 | envVariableType(TypeEnv, Variable, intType, NewTypeEnv). 165 | typecheckExp(TypeEnv, exp_num(_), TypeEnv) :- !. 166 | typecheckExp(TypeEnv, binop(E1, _, E2), NewTypeEnv) :- 167 | !, 168 | typecheckExp(TypeEnv, E1, TempTypeEnv), !, 169 | typecheckExp(TempTypeEnv, E2, NewTypeEnv). 170 | typecheckExp(TypeEnv, unaryop(_, E), NewTypeEnv) :- 171 | !, 172 | typecheckExp(TypeEnv, E, NewTypeEnv). 173 | 174 | clausedef(typecheckVarUse, [], [state, 175 | list(pair(int, type)), % input type environment, 176 | atom, % variable name 177 | term, % setting / getting 178 | list(pair(int, type))]). % output type environment 179 | typecheckVarUse(State, TypeEnv, VarName, Term, NewTypeEnv) :- 180 | % determine what the expected type is 181 | State = state(_, _, GlobalVarDefs), 182 | member(defglobalvar(VarName, _, ExpectedType), GlobalVarDefs), 183 | 184 | % Ensure they line up. We intentionally don't freshen type variables, 185 | % as all uses must be of matching types. 186 | typeofTerm(State, TypeEnv, Term, ExpectedType, NewTypeEnv). 187 | 188 | clausedef(typecheckBody, [], [state, 189 | list(pair(int, type)), % input type environment, 190 | body, 191 | list(pair(int, type))]). % output type environment 192 | typecheckBody(State, TypeEnv, Body, NewTypeEnv) :- 193 | onFailure( 194 | lambda([], rawTypecheckBody(State, TypeEnv, Body, NewTypeEnv)), 195 | lambda([], yolo_UNSAFE_format_shim('Type error at body ~w~n~n', [Body]))). 196 | 197 | clausedef(rawTypecheckBody, [], [state, 198 | list(pair(int, type)), % input type environment, 199 | body, 200 | list(pair(int, type))]). % output type environment 201 | rawTypecheckBody(_, TypeEnv, body_is(Lhs, Exp), NewTypeEnv) :- 202 | !, 203 | typecheckLhs(TypeEnv, Lhs, TempTypeEnv), !, 204 | typecheckExp(TempTypeEnv, Exp, NewTypeEnv), !. 205 | rawTypecheckBody(_, TypeEnv, bodyComparison(Exp1, _, Exp2), NewTypeEnv) :- 206 | !, 207 | typecheckExp(TypeEnv, Exp1, TempTypeEnv), !, 208 | typecheckExp(TempTypeEnv, Exp2, NewTypeEnv), !. 209 | rawTypecheckBody(State, TypeEnv, body_setvar(VarName, Term), NewTypeEnv) :- 210 | !, 211 | typecheckVarUse(State, TypeEnv, VarName, Term, NewTypeEnv), !. 212 | rawTypecheckBody(State, TypeEnv, body_getvar(VarName, Term), NewTypeEnv) :- 213 | !, 214 | typecheckVarUse(State, TypeEnv, VarName, Term, NewTypeEnv), !. 215 | rawTypecheckBody(State, TypeEnv, bodyUnary(_, Body), NewTypeEnv) :- 216 | !, 217 | typecheckBody(State, TypeEnv, Body, NewTypeEnv), !. 218 | rawTypecheckBody(State, TypeEnv, bodyPair(B1, _, B2), NewTypeEnv) :- 219 | !, 220 | typecheckBody(State, TypeEnv, B1, TempTypeEnv), !, 221 | typecheckBody(State, TempTypeEnv, B2, NewTypeEnv), !. 222 | rawTypecheckBody(State, TypeEnv, higherOrderCall(What, ActualParams), NewTypeEnv) :- 223 | !, 224 | typeofTerm(State, TypeEnv, What, relationType(FormalParams), TempTypeEnv), !, 225 | typeofTerms(State, TempTypeEnv, ActualParams, FormalParams, NewTypeEnv), !. 226 | rawTypecheckBody(State, TypeEnv, firstOrderCall(Name, ActualParams), NewTypeEnv) :- 227 | length(ActualParams, Arity), 228 | FormalParams = _, % introduce variable 229 | onFailure( 230 | lambda([], expectedFormalParamTypes(State, Name, Arity, FormalParams)), 231 | lambda([], yolo_UNSAFE_format_shim('Unknown clause: ~w~n~n', [pair(Name, Arity)]))), 232 | typeofTerms(State, TypeEnv, ActualParams, FormalParams, NewTypeEnv), !. 233 | 234 | clausedef(typeofTerm, [], [state, 235 | list(pair(int, type)), % input type environment 236 | term, type, 237 | list(pair(int, type))]). % output type environment 238 | typeofTerm(State, TypeEnv, Term, ExpectedType, NewTypeEnv) :- 239 | onFailure( 240 | lambda([], rawTypeofTerm(State, TypeEnv, Term, ExpectedType, NewTypeEnv)), 241 | lambda([], 242 | (% try to see what type it actually was 243 | yolo_UNSAFE_format_shim('Type error at term ~w~n', [Term]), 244 | onFailure( 245 | lambda([], 246 | (rawTypeofTerm(State, TypeEnv, Term, ActualType, _), 247 | yolo_UNSAFE_format_shim('\tFound: ~w~n\tExpected: ~w~n~n', [ActualType, ExpectedType]))), 248 | lambda([], 249 | (yolo_UNSAFE_format_shim('\tFound: UNKNOWN~n\tExpected: ~w~n~n', [ExpectedType]))))))). 250 | 251 | clausedef(rawTypeofTerm, [], [state, 252 | list(pair(int, type)), % input type environment 253 | term, type, 254 | list(pair(int, type))]). % output type environment 255 | rawTypeofTerm(_, TypeEnv, term_var(Variable), Type, NewTypeEnv) :- 256 | envVariableType(TypeEnv, Variable, Type, NewTypeEnv). 257 | rawTypeofTerm(_, TypeEnv, term_num(_), intType, TypeEnv). 258 | rawTypeofTerm(State, TypeEnv, term_lambda(Params, Body), relationType(Types), TypeEnv) :- 259 | !, 260 | typeofTerms(State, TypeEnv, Params, Types, TempTypeEnv), 261 | typecheckBody(State, TempTypeEnv, Body, _). 262 | rawTypeofTerm(State, TypeEnv, 263 | term_constructor(ConstructorName, ConstructorActualParams), 264 | constructorType(TypeName, TypeParams), 265 | NewTypeEnv) :- 266 | 267 | % figure out which datadef is in play 268 | State = state(Mapping, _, _), 269 | member(pair(ConstructorName, RawDefData), Mapping), 270 | copy_term(RawDefData, defdata(TypeName, TypeParams, Constructors)), 271 | 272 | % figure out which constructor is in play 273 | member(typeConstructor(ConstructorName, ConstructorFormalParams), Constructors), 274 | 275 | % make sure the types line up 276 | !, % we found one - no going back to treating it like an atom 277 | typeofTerms(State, TypeEnv, 278 | ConstructorActualParams, 279 | ConstructorFormalParams, 280 | NewTypeEnv), !. 281 | rawTypeofTerm(_, TypeEnv, term_constructor(_, []), atomType, TypeEnv). 282 | 283 | % int is really an uninstantiated variable 284 | clausedef(typeofTerms, [], [state, 285 | list(pair(int, type)), % input type environment 286 | list(term), 287 | list(type), 288 | list(pair(int, type))]). % output type environment 289 | typeofTerms(State, TypeEnv, Terms, Types, NewTypeEnv) :- 290 | zip(Terms, Types, Zipped), 291 | foldLeft(Zipped, TypeEnv, 292 | lambda([Accum, pair(Term, Type), NewAccum], 293 | typeofTerm(State, Accum, Term, Type, NewAccum)), 294 | NewTypeEnv), !. 295 | 296 | % succeeds if the given clause has been marked unsafe 297 | clausedef(markedUnsafe, [], [atom]). 298 | markedUnsafe(Name) :- 299 | atomContains(Name, 'yolo_UNSAFE_'). 300 | 301 | clausedef(typecheckClauseWithErrorMessage, [], [state, clauseclause]). 302 | typecheckClauseWithErrorMessage(State, Clause) :- 303 | onFailure( 304 | lambda([], typecheckClause(State, Clause)), 305 | lambda([], yolo_UNSAFE_format_shim('Type error at clause ~w~n~n', [Clause]))). 306 | 307 | clausedef(typecheckClause, [], [state, clauseclause]). 308 | typecheckClause(State, clauseclause(Name, FormalParams, Body)) :- 309 | length(FormalParams, Arity), 310 | expectedFormalParamTypes(State, Name, Arity, Generics, Expected), 311 | 312 | % Instantiate all the generics to type variables. These exist only 313 | % while typechecking clauses. They are in place so we don't try 314 | % to unify them with something that assumes we know something about 315 | % the type, as with: 316 | % 317 | % clausedef(test, [A], [A]). 318 | % test(1). 319 | % 320 | foldLeft(Generics, 0, 321 | lambda([Accum, typevar(Accum), NewAccum], 322 | NewAccum is Accum), 323 | _), 324 | 325 | typeofTerms(State, [], FormalParams, Expected, TypeEnv), 326 | (markedUnsafe(Name) -> 327 | true; 328 | typecheckBody(State, TypeEnv, Body, _)), 329 | !. 330 | 331 | % will add in builtins itself 332 | clausedef(typecheckClauses, [], [list(defdata), list(defclause), 333 | list(defglobalvar), list(clauseclause)]). 334 | typecheckClauses(UserDataDefs, UserClauseDefs, UserDefGlobalVars, Clauses) :- 335 | % add in builtins 336 | builtinDataDefs(BuiltinDataDefs), 337 | builtinClauseDefs(BuiltinClauseDefs), 338 | append(BuiltinDataDefs, UserDataDefs, DataDefs), 339 | append(BuiltinClauseDefs, UserClauseDefs, ClauseDefs), 340 | 341 | % perform typechecking 342 | makeState(DataDefs, ClauseDefs, UserDefGlobalVars, State), 343 | forall(Clauses, lambda([Clause], typecheckClauseWithErrorMessage(State, Clause))). 344 | -------------------------------------------------------------------------------- /src/translator.pl: -------------------------------------------------------------------------------- 1 | module(translator, [translateClauses/3], [engine_type]). 2 | 3 | use_module('common.pl', [setUnion/3, setDifference/3, filter/3, setContains/2, 4 | makeSetFromList/2, map/3, foldLeft/4, sortItems/4, 5 | flatMap/3, beginsWith/2, makeSetFromList/2, notMember/2, 6 | setsOverlap/2, existsOnce/2], 7 | [pair, option]). 8 | use_module('syntax.pl', [], 9 | [op, exp, expLhs, term, body, type, defclause, 10 | typeConstructor, defdata, clauseclause, defglobalvar, 11 | defmodule, def_use_module, loadedFile, compareOp]). 12 | 13 | datadef(engine_type, [], [swipl, gnuprolog]). 14 | 15 | globalvardef(counter, [], int). 16 | globalvardef(engine, [], engine_type). 17 | 18 | clausedef(freshInt, [], [int]). 19 | freshInt(N) :- 20 | getvar(counter, N), 21 | NewN is N + 1, 22 | setvar(counter, NewN). 23 | 24 | clausedef(yolo_UNSAFE_call_lambda_label, [], [int, atom]). 25 | yolo_UNSAFE_call_lambda_label(Arity, Label) :- 26 | format(atom(Label), 'call_lambda~d', [Arity]). 27 | 28 | clausedef(yolo_UNSAFE_fresh_lambda_label, [], [int, atom]). 29 | yolo_UNSAFE_fresh_lambda_label(Arity, Label) :- 30 | freshInt(Int), 31 | format(atom(Label), 'lambda~d_~d', [Arity, Int]). 32 | 33 | % Translates out lambdas and higher-order calls into auxilliary clauses and 34 | % first-order calls, via defunctionalization. Also translates out global variables 35 | % into engine-specific forms. 36 | 37 | clausedef(engineSetVarName, [], [engine_type, atom]). 38 | engineSetVarName(swipl, nb_setval). 39 | engineSetVarName(gnuprolog, g_assign). 40 | 41 | clausedef(engineGetVarName, [], [engine_type, atom]). 42 | engineGetVarName(swipl, nb_getval). 43 | engineGetVarName(gnuprolog, g_read). 44 | 45 | clausedef(yolo_UNSAFE_term_variables, [A], [A, list(int)]). 46 | yolo_UNSAFE_term_variables(A, Variables) :- 47 | term_variables(A, Variables). 48 | 49 | clausedef(translateMulti, [A, B], [list(int), % previously seen variables 50 | list(A), % what to translate 51 | list(int), % variables used 52 | list(B), % translated form 53 | list(clauseclause), % aux clauses input 54 | list(clauseclause), % aux clauses output 55 | relation([list(int), A, list(int), B, 56 | list(clauseclause), list(clauseclause)])]). 57 | translateMulti(_, [], [], [], Defs, Defs, _). 58 | translateMulti(SeenVars, [H|T], Used, [HT|TT], Input, Output, Trans) :- 59 | call(Trans, SeenVars, H, HUsed, HT, Input, TempInput), 60 | setUnion(HUsed, SeenVars, NewSeenVars), 61 | translateMulti(NewSeenVars, T, TUsed, TT, TempInput, Output, Trans), 62 | setUnion(HUsed, TUsed, Used). 63 | 64 | clausedef(translateTerms, [], [list(int), % previously seen variables 65 | list(term), % what to translate 66 | list(int), % variables used in this term 67 | list(term), % translated term 68 | list(clauseclause), % aux clauses input 69 | list(clauseclause)]). % aux clauses output 70 | translateTerms(SeenVars, Terms, Used, NewTerms, Input, Output) :- 71 | translateMulti(SeenVars, Terms, Used, NewTerms, Input, Output, 72 | lambda([A, B, C, D, E, F], 73 | translateTerm(A, B, C, D, E, F))). 74 | 75 | clausedef(translateBodies, [], [list(int), % previously seen variables 76 | list(body), % what to translate 77 | list(int), % variables used in this term 78 | list(body), % translated term 79 | list(clauseclause), % aux clauses input 80 | list(clauseclause)]). % aux clauses output 81 | translateBodies(SeenVars, Bodies, Used, NewBodies, Input, Output) :- 82 | translateMulti(SeenVars, Bodies, Used, NewBodies, Input, Output, 83 | lambda([A, B, C, D, E, F], 84 | translateBody(A, B, C, D, E, F))). 85 | 86 | clausedef(translateBody, [], [list(int), % previously seen variables 87 | body, % what to translate 88 | list(int), % variables used in the body 89 | body, % new body 90 | list(clauseclause), % aux clauses input 91 | list(clauseclause)]). % aux clauses output 92 | translateBody(_, BodyIs, Used, BodyIs, Defs, Defs) :- 93 | BodyIs = body_is(_, _), 94 | !, 95 | % merely record which variables were used 96 | yolo_UNSAFE_term_variables(BodyIs, Used). 97 | translateBody(SeenVars, 98 | body_setvar(Name, Term), Used, 99 | firstOrderCall(VarSetName, [term_constructor(Name, []), NewTerm]), 100 | Defs1, DefsFinal) :- 101 | !, 102 | getvar(engine, Engine), 103 | engineSetVarName(Engine, VarSetName), 104 | translateTerm(SeenVars, Term, Used, NewTerm, Defs1, DefsFinal). 105 | translateBody(SeenVars, 106 | body_getvar(Name, Term), Used, 107 | firstOrderCall(VarGetName, [term_constructor(Name, []), NewTerm]), 108 | Defs1, DefsFinal) :- 109 | !, 110 | getvar(engine, Engine), 111 | engineGetVarName(Engine, VarGetName), 112 | translateTerm(SeenVars, Term, Used, NewTerm, Defs1, DefsFinal). 113 | translateBody(_, BodyComparison, Used, BodyComparison, Defs, Defs) :- 114 | BodyComparison = bodyComparison(_, _, _), 115 | !, 116 | % merely record which variables were used 117 | yolo_UNSAFE_term_variables(BodyComparison, Used). 118 | translateBody(SeenVars, 119 | bodyUnary(Op, Body), Used, 120 | bodyUnary(Op, NewBody), 121 | Defs1, DefsFinal) :- 122 | !, 123 | translateBody(SeenVars, Body, Used, NewBody, Defs1, DefsFinal). 124 | translateBody(SeenVars, 125 | bodyPair(B1, Op, B2), Used, 126 | bodyPair(NewB1, Op, NewB2), 127 | Defs1, DefsFinal) :- 128 | !, 129 | translateBodies(SeenVars, [B1, B2], Used, [NewB1, NewB2], Defs1, DefsFinal). 130 | translateBody(SeenVars, 131 | higherOrderCall(What, Terms), Used, 132 | firstOrderCall(CallName, NewTerms), Defs1, DefsFinal) :- 133 | !, 134 | 135 | % translate each of the parameters to the call 136 | translateTerms(SeenVars, [What|Terms], Used, NewTerms, Defs1, DefsFinal), 137 | 138 | % replace this with a translated call 139 | length(Terms, Arity), 140 | yolo_UNSAFE_call_lambda_label(Arity, CallName). 141 | translateBody(SeenVars, 142 | firstOrderCall(Name, Terms), Used, 143 | TranslatedCall, 144 | Defs1, DefsFinal) :- 145 | !, 146 | getvar(engine, Engine), 147 | translateTerms(SeenVars, Terms, Used, NewTerms, Defs1, DefsFinal), 148 | translateCall(Engine, Name, NewTerms, TranslatedCall). 149 | 150 | clausedef(translateCall, [], [engine_type, % what engine we're under 151 | atom, % what is called 152 | list(term), % translated terms passed to the call 153 | body]). % resulting body 154 | translateCall(swipl, fd_labeling, Terms, firstOrderCall('label', Terms)) :- !. 155 | translateCall(_, Name, Terms, firstOrderCall(Name, Terms)). 156 | 157 | clausedef(translateTerm, [], [list(int), % previously seen variables 158 | term, % what to translate 159 | list(int), % variables used in this term 160 | term, % translated term 161 | list(clauseclause), % aux clauses input 162 | list(clauseclause)]). % aux clauses output 163 | translateTerm(_, term_var(X), [X], term_var(X), Clauses, Clauses) :- !. 164 | translateTerm(_, term_num(N), [], term_num(N), Clauses, Clauses) :- !. 165 | translateTerm(SeenVars, 166 | term_lambda(Params, Body), LambdaCapturedUnique, 167 | Closure, 168 | Defs1, DefsFinal) :- 169 | Closure = term_constructor(Name, LambdaCapturedUniqueVars), 170 | !, 171 | 172 | % Translate each of the parameters to the lambda. Variables 173 | % introduced here should not bleed into the outer scope, but 174 | % they will be needed in translating the body of the lambda 175 | translateTerms(SeenVars, Params, ParamsUsed, TranslatedParams, 176 | Defs1, Defs2), 177 | setUnion(SeenVars, ParamsUsed, SeenForBody), 178 | translateBody(SeenForBody, Body, BodyUsed, TranslatedBody, 179 | Defs2, Defs3), 180 | 181 | % Introduce a lambda for this definition. First, build up 182 | % the closure we're making, starting with the name. 183 | length(Params, Arity), 184 | yolo_UNSAFE_fresh_lambda_label(Arity, Name), 185 | 186 | % The parameters to the closure are the variables which have been 187 | % closed over between the parameters and the body of the lambda. 188 | setDifference(ParamsUsed, SeenVars, LambdaIntroduces), 189 | append(ParamsUsed, BodyUsed, LambdaUsed), 190 | 191 | % variables that the lambda both captured and internally defined 192 | setDifference(LambdaUsed, LambdaIntroduces, LambdaCapturedAndUses), 193 | 194 | % only those variables which were captured from the outer scope 195 | filter(LambdaCapturedAndUses, 196 | lambda([Variable], setContains(SeenVars, Variable)), 197 | LambdaCaptured), 198 | makeSetFromList(LambdaCaptured, LambdaCapturedUnique), 199 | map(LambdaCapturedUnique, 200 | lambda([Variable, term_var(Variable)], true), 201 | LambdaCapturedUniqueVars), 202 | 203 | % The corresponding code for the closure will take the 204 | % closure, along with the passed parameters to the call. 205 | yolo_UNSAFE_call_lambda_label(Arity, CallName), 206 | NewClause = clauseclause(CallName, 207 | [Closure|TranslatedParams], 208 | TranslatedBody), 209 | Defs3 = [NewClause|DefsFinal]. 210 | translateTerm(SeenVars, 211 | term_constructor(Name, Params), Used, 212 | term_constructor(Name, TranslatedParams), 213 | Defs1, DefsFinal) :- 214 | !, 215 | translateTerms(SeenVars, Params, Used, TranslatedParams, Defs1, DefsFinal). 216 | 217 | clausedef(translateClause, [], [clauseclause, clauseclause, 218 | list(clauseclause), list(clauseclause)]). 219 | translateClause(clauseclause(Name, Params, Body), 220 | clauseclause(Name, NewParams, NewBody), 221 | InputClauses, OutputClauses) :- 222 | translateTerms([], Params, Used, NewParams, InputClauses, TempClauses), 223 | translateBody(Used, Body, _, NewBody, TempClauses, OutputClauses). 224 | 225 | % assumes that we have a purely first-order program. That is, translation 226 | % has already occurred. 227 | clausedef(bodyDirectlyCalls, [], [body, % the body to check 228 | list(pair(atom, int)), % input diff list 229 | list(pair(atom, int))]). % output diff list 230 | bodyDirectlyCalls(body_is(_, _), List, List). 231 | bodyDirectlyCalls(body_setvar(_, _), List, List). 232 | bodyDirectlyCalls(body_getvar(_, _), List, List). 233 | bodyDirectlyCalls(bodyComparison(_, _, _), List, List). 234 | bodyDirectlyCalls(bodyUnary(_, Body), Input, Output) :- 235 | bodyDirectlyCalls(Body, Input, Output). 236 | bodyDirectlyCalls(bodyPair(Body1, _, Body2), Input, Output) :- 237 | bodyDirectlyCalls(Body1, Input, Temp), 238 | bodyDirectlyCalls(Body2, Temp, Output). 239 | bodyDirectlyCalls(firstOrderCall(Name, Params), [pair(Name, Arity)|Rest], Rest) :- 240 | length(Params, Arity). 241 | 242 | clausedef(bodyDirectlyCalls, [], [body, list(pair(atom, int))]). 243 | bodyDirectlyCalls(Body, Calls) :- 244 | bodyDirectlyCalls(Body, Calls, []). 245 | 246 | clausedef(clauseNameArity, [], [clauseclause, atom, int]). 247 | clauseNameArity(clauseclause(Name, Params, _), Name, Arity) :- 248 | length(Params, Arity). 249 | 250 | clausedef(callsUnknownLambda, [], [list(pair(atom, int)), % what is called 251 | list(atom)]). % existing lambdas 252 | callsUnknownLambda(CalledClauses, ExistingLambdas) :- 253 | existsOnce(CalledClauses, 254 | lambda([pair(Name, _)], 255 | (isCallLambda(Name), 256 | notMember(Name, ExistingLambdas)))). 257 | 258 | clausedef(trimDeadClauses, [], [list(clauseclause), % input clauses 259 | list(pair(pair(atom, int), list(pair(atom, int)))), % called mapping 260 | list(atom), % called lambdas 261 | list(pair(atom, int)), % blacklist - call anything here and die 262 | list(clauseclause), % output clauses accumulator 263 | list(clauseclause)]). % output clauses 264 | trimDeadClauses([], _, _, _, Accum, RevAccum) :- 265 | reverse(Accum, RevAccum). 266 | trimDeadClauses([H|T], Mapping, CalledLambdas, Blacklist, Accum, Output) :- 267 | clauseNameArity(H, Name, Arity), 268 | Key = pair(Name, Arity), 269 | member(pair(Key, ClauseCalls), Mapping), 270 | ((setsOverlap(ClauseCalls, Blacklist); 271 | callsUnknownLambda(ClauseCalls, CalledLambdas)) -> 272 | % add it to the blacklist and restart 273 | (reverse(Accum, RevAccum), 274 | append(RevAccum, T, NewInput), 275 | trimDeadClauses(NewInput, Mapping, CalledLambdas, [Key|Blacklist], 276 | [], Output)); 277 | (trimDeadClauses(T, Mapping, CalledLambdas, Blacklist, [H|Accum], Output))). 278 | 279 | clausedef(isCallLambda, [], [atom]). 280 | isCallLambda(Name) :- 281 | atom_codes('call_lambda', CallList), 282 | atom_codes(Name, NameList), 283 | beginsWith(NameList, CallList). 284 | 285 | clausedef(clauseCallsMapping, [], [list(clauseclause), 286 | list(pair(pair(atom, int), list(pair(atom, int))))]). 287 | clauseCallsMapping(InputClauses, Mapping) :- 288 | map(InputClauses, 289 | lambda([clauseclause(Name, Params, Body), 290 | pair(pair(Name, Arity), ClauseMapping)], 291 | (length(Params, Arity), 292 | bodyDirectlyCalls(Body, ClauseMapping))), 293 | Mapping). 294 | 295 | clausedef(makeDirective, [], [term, clauseclause]). 296 | makeDirective(Term, clauseclause(':-', [Term], firstOrderCall('true', []))). 297 | 298 | clausedef(clpOperator, [], [compareOp]). 299 | clpOperator(clp_lt). 300 | clpOperator(clp_lte). 301 | clpOperator(clp_gt). 302 | clpOperator(clp_gte). 303 | clpOperator(clp_eq). 304 | clpOperator(clp_neq). 305 | 306 | clausedef(bodyUsesClp, [], [body]). 307 | bodyUsesClp(bodyUnary(_, Body)) :- 308 | bodyUsesClp(Body). 309 | bodyUsesClp(bodyPair(Body1, _, Body2)) :- 310 | (bodyUsesClp(Body1); bodyUsesClp(Body2)), 311 | !. 312 | bodyUsesClp(bodyComparison(_, Op, _)) :- 313 | clpOperator(Op). 314 | 315 | clausedef(handleClp, [], [engine_type, 316 | list(clauseclause), 317 | list(clauseclause)]). 318 | handleClp(swipl, InputClauses, OutputClauses) :- 319 | (existsOnce(InputClauses, 320 | lambda([clauseclause(_, _, Body)], bodyUsesClp(Body))) -> 321 | (makeDirective( 322 | term_constructor('use_module', 323 | [term_constructor('library', 324 | [term_constructor('clpfd', [])])]), 325 | UseClpfd), 326 | OutputClauses = [UseClpfd|InputClauses]); 327 | (InputClauses = OutputClauses)). 328 | handleClp(gnuprolog, Clauses, Clauses). 329 | 330 | % Currently, everything could be an entry point, so this is very inexact. 331 | % If we see a call to a lambda clause that doesn't exist, then we trim 332 | % out the clause. We recursively trim out things that call those. 333 | clausedef(trimDeadClauses, [], [list(pair(pair(atom, int), list(pair(atom, int)))), 334 | list(clauseclause), % input clauses 335 | list(clauseclause)]). % output clauses 336 | trimDeadClauses(Mapping, InputClauses, OutputClauses) :- 337 | % figure out which lambdas are in play 338 | flatMap(InputClauses, 339 | lambda([clauseclause(Name, _, _), Result], 340 | (isCallLambda(Name) -> 341 | (Result = [Name]); 342 | (Result = []))), 343 | RawCalledLambdas), 344 | makeSetFromList(RawCalledLambdas, CalledLambdas), 345 | 346 | % If something calls a lambda not in that list, throw it out. 347 | % We then need to throw out everything else that calls that. 348 | trimDeadClauses(InputClauses, Mapping, CalledLambdas, [], [], OutputClauses). 349 | 350 | clausedef(translateClauses, [], [list(clauseclause), 351 | engine_type, 352 | list(clauseclause)]). 353 | translateClauses(Clauses, Engine, FinalClauses) :- 354 | setvar(counter, 0), 355 | setvar(engine, Engine), 356 | foldLeft(Clauses, pair(UserClauses, AuxClauses), 357 | lambda([pair([TransClause|RestUser], CurAux), 358 | Clause, 359 | pair(RestUser, RestAux)], 360 | translateClause(Clause, TransClause, CurAux, RestAux)), 361 | pair([], [])), 362 | sortItems(AuxClauses, 363 | lambda([clauseclause(Name, _, _), Name], true), 364 | lambda([Name1, Name2], Name1 @> Name2), 365 | SortedAuxClauses), 366 | append(SortedAuxClauses, UserClauses, UntrimmedClauses), 367 | clauseCallsMapping(UntrimmedClauses, Mapping), 368 | trimDeadClauses(Mapping, UntrimmedClauses, TrimmedClauses), 369 | handleClp(Engine, TrimmedClauses, FinalClauses). 370 | -------------------------------------------------------------------------------- /src/syntax.pl: -------------------------------------------------------------------------------- 1 | module(syntax, [loadFile/2], 2 | [op, exp, expLhs, term, bodyPairOp, body, type, defclause, 3 | typeConstructor, defdata, clauseclause, defglobalvar, 4 | defmodule, def_use_module, loadedFile, bodyUnaryOp, unop, 5 | compareOp]). 6 | 7 | use_module('io.pl', [read_clauses_from_file/3], []). 8 | use_module('common.pl', [map/3, forall/2, setContains/2, onFailure/2, 9 | yolo_UNSAFE_format_shim/2], [pair]). 10 | 11 | % BEGIN AST DEFINITION 12 | % 13 | % The whole int hackery works because variables will never be instantiated. 14 | datadef(op, [], [plus, minus, mul, div, op_min, op_max, 15 | shift_left, shift_right, bitwise_and, bitwise_or, 16 | int_div, int_rem, 17 | int_mod, op_exponent]). 18 | datadef(unop, [], [op_msb, op_abs, op_truncate]). 19 | datadef(exp, [], [exp_var(int), 20 | exp_num(int), 21 | binop(exp, op, exp), 22 | unaryop(unop, exp)]). 23 | datadef(expLhs, [], [lhs_var(int), lhs_num(int)]). 24 | datadef(term, [], [term_var(int), term_num(int), 25 | term_lambda(list(term), body), 26 | term_constructor(atom, list(term))]). 27 | 28 | datadef(bodyUnaryOp, [], [not]). 29 | datadef(bodyPairOp, [], [and, or, implies]). 30 | datadef(compareOp, [], [ lt, lte, gt, gte, 31 | clp_lt, clp_lte, clp_gt, clp_gte, 32 | clp_eq, clp_neq]). 33 | datadef(body, [], [body_is(expLhs, exp), 34 | body_setvar(atom, term), body_getvar(atom, term), 35 | bodyUnary(bodyUnaryOp, body), 36 | bodyPair(body, bodyPairOp, body), 37 | bodyComparison(exp, compareOp, exp), 38 | higherOrderCall(term, list(term)), 39 | firstOrderCall(atom, list(term))]). 40 | 41 | datadef(type, [], [intType, % integers 42 | atomType, % raw atoms 43 | relationType(list(type)), % a relation (higher-order clause) 44 | constructorType(atom, list(type)), % constructor for a user-defined type 45 | typevar(int)]). % placeholder for a parametric type. Only exists 46 | % during typechecking. 47 | 48 | datadef(defclause, [], [defclause(atom, % name of the clause 49 | list(type), % generic type parameters. 50 | % Should be variables. 51 | list(type))]). % parameter types 52 | datadef(typeConstructor, [], [typeConstructor(atom, list(type))]). 53 | 54 | datadef(defdata, [], [defdata(atom, list(type), list(typeConstructor))]). 55 | datadef(clauseclause, [], [clauseclause(atom, list(term), body)]). 56 | datadef(defglobalvar, [], [defglobalvar(atom, list(type), type)]). 57 | datadef(defmodule, [], [defmodule(atom, list(pair(atom, int)), list(atom))]). 58 | datadef(def_use_module, [], [def_use_module(atom, list(pair(atom, int)), list(atom))]). 59 | datadef(loadedFile, [], [loadedFile(defmodule, list(def_use_module), 60 | list(defdata), list(defclause), list(defglobalvar), 61 | list(clauseclause))]). 62 | % END AST DEFINITION 63 | datadef(readclause, [], [readDefModule(defmodule), readDefUseModule(def_use_module), 64 | readDefData(defdata), readDefClause(defclause), 65 | readDefGlobalVar(defglobalvar), readClauseClause(clauseclause)]). 66 | 67 | clausedef(yolo_UNSAFE_translate_pairs, [A], [list(A), list(pair(atom, int))]). 68 | yolo_UNSAFE_translate_pairs(RawPairs, TranslatedPairs) :- 69 | map(RawPairs, 70 | lambda([/(Name, Arity), pair(Name, Arity)], 71 | (atom(Name), 72 | number(Arity))), 73 | TranslatedPairs). 74 | 75 | clausedef(areTypeVars, [A], [list(A)]). 76 | areTypeVars(List) :- 77 | forall(List, lambda([X], var(X))), 78 | is_set(List). 79 | 80 | % unsafe because of the use of atom 81 | clausedef(yolo_UNSAFE_allAtoms, [A], [list(A)]). 82 | yolo_UNSAFE_allAtoms(List) :- 83 | forall(List, lambda([A], atom(A))). 84 | 85 | clausedef(yolo_UNSAFE_translate_exp_lhs, [A], [A, expLhs]). 86 | yolo_UNSAFE_translate_exp_lhs(Var, lhs_var(NewVar)) :- 87 | var(Var), 88 | !, 89 | Var = NewVar. 90 | yolo_UNSAFE_translate_exp_lhs(Num, lhs_num(NewNum)) :- 91 | number(Num), 92 | !, 93 | Num = NewNum. 94 | 95 | % The Op hackery is needed to bypass the typechecker. Currently 96 | % parameters get typechecked but bodies don't. 97 | clausedef(yolo_UNSAFE_translate_op, [A], [A, op]). 98 | yolo_UNSAFE_translate_op(Op, plus) :- Op = '+', !. 99 | yolo_UNSAFE_translate_op(Op, minus) :- Op = '-', !. 100 | yolo_UNSAFE_translate_op(Op, mul) :- Op = '*', !. 101 | yolo_UNSAFE_translate_op(Op, div) :- Op = '/', !. 102 | yolo_UNSAFE_translate_op(Op, op_min) :- Op = min, !. 103 | yolo_UNSAFE_translate_op(Op, op_max) :- Op = max, !. 104 | yolo_UNSAFE_translate_op(Op, shift_left) :- Op = '<<', !. 105 | yolo_UNSAFE_translate_op(Op, shift_right) :- Op = '>>', !. 106 | yolo_UNSAFE_translate_op(Op, bitwise_and) :- Op = '/\\', !. 107 | yolo_UNSAFE_translate_op(Op, bitwise_or) :- Op = '\\/', !. 108 | yolo_UNSAFE_translate_op(Op, int_div) :- Op = '//', !. 109 | yolo_UNSAFE_translate_op(Op, int_rem) :- Op = rem, !. 110 | yolo_UNSAFE_translate_op(Op, int_mod) :- Op = mod, !. 111 | yolo_UNSAFE_translate_op(Op, op_exponent) :- Op = '^', !. 112 | 113 | clausedef(yolo_UNSAFE_translate_unop, [A], [A, unop]). 114 | yolo_UNSAFE_translate_unop(Op, op_msb) :- Op = msb, !. 115 | yolo_UNSAFE_translate_unop(Op, op_abs) :- Op = abs, !. 116 | yolo_UNSAFE_translate_unop(Op, op_truncate) :- Op = truncate, !. 117 | 118 | clausedef(yolo_UNSAFE_translate_exp, [A], [A, exp]). 119 | yolo_UNSAFE_translate_exp(Var, exp_var(NewVar)) :- 120 | var(Var), 121 | !, 122 | Var = NewVar. 123 | yolo_UNSAFE_translate_exp(Num, exp_num(NewNum)) :- 124 | number(Num), 125 | !, 126 | Num = NewNum. 127 | yolo_UNSAFE_translate_exp(Structure, binop(Exp1, Op, Exp2)) :- 128 | Structure =.. [RawOp, E1, E2], 129 | !, 130 | yolo_UNSAFE_translate_op(RawOp, Op), 131 | yolo_UNSAFE_translate_exp(E1, Exp1), 132 | yolo_UNSAFE_translate_exp(E2, Exp2). 133 | yolo_UNSAFE_translate_exp(Structure, unaryop(Op, Exp)) :- 134 | Structure =.. [RawOp, E], 135 | !, 136 | yolo_UNSAFE_translate_unop(RawOp, Op), 137 | yolo_UNSAFE_translate_exp(E, Exp). 138 | 139 | clausedef(yolo_UNSAFE_translate_body_pair_op, [A], [A, bodyPairOp]). 140 | yolo_UNSAFE_translate_body_pair_op(Op, and) :- Op = ',', !. 141 | yolo_UNSAFE_translate_body_pair_op(Op, or) :- Op = ';', !. 142 | yolo_UNSAFE_translate_body_pair_op(Op, implies) :- Op = '->', !. 143 | 144 | clausedef(yolo_UNSAFE_translate_unary_body_op, [A], [A, bodyUnaryOp]). 145 | yolo_UNSAFE_translate_unary_body_op(Op, not) :- Op = '\\+', !. 146 | 147 | clausedef(yolo_UNSAFE_translate_compare_op, [A], [A, compareOp]). 148 | yolo_UNSAFE_translate_compare_op(Op, lt) :- Op = '<', !. 149 | yolo_UNSAFE_translate_compare_op(Op, lte) :- Op = '=<', !. 150 | yolo_UNSAFE_translate_compare_op(Op, gt) :- Op = '>', !. 151 | yolo_UNSAFE_translate_compare_op(Op, gte) :- Op = '>=', !. 152 | yolo_UNSAFE_translate_compare_op(Op, clp_lt) :- Op = '#<', !. 153 | yolo_UNSAFE_translate_compare_op(Op, clp_lte) :- Op = '#=<', !. 154 | yolo_UNSAFE_translate_compare_op(Op, clp_gt) :- Op = '#>', !. 155 | yolo_UNSAFE_translate_compare_op(Op, clp_gte) :- Op = '#>=', !. 156 | yolo_UNSAFE_translate_compare_op(Op, clp_eq) :- Op = '#=', !. 157 | yolo_UNSAFE_translate_compare_op(Op, clp_neq) :- Op = '#\\=', !. 158 | 159 | clausedef(translateBody, [A], [A, body]). 160 | translateBody(Input, Output) :- 161 | onFailure( 162 | lambda([], yolo_UNSAFE_translate_body(Input, Output)), 163 | lambda([], yolo_UNSAFE_format_shim('Syntax error in body: ~w~n~n', [Input]))). 164 | 165 | clausedef(yolo_UNSAFE_translate_body, [A], [A, body]). 166 | yolo_UNSAFE_translate_body(Input, body_is(NewExpLhs, NewExp)) :- 167 | Input = is(ExpLhs, Exp), 168 | !, 169 | yolo_UNSAFE_translate_exp_lhs(ExpLhs, NewExpLhs), 170 | yolo_UNSAFE_translate_exp(Exp, NewExp). 171 | yolo_UNSAFE_translate_body(Input, bodyComparison(NewExp1, CompareOp, NewExp2)) :- 172 | Input =.. [Op, Exp1, Exp2], 173 | yolo_UNSAFE_translate_compare_op(Op, CompareOp), 174 | !, 175 | yolo_UNSAFE_translate_exp(Exp1, NewExp1), 176 | yolo_UNSAFE_translate_exp(Exp2, NewExp2). 177 | yolo_UNSAFE_translate_body(Input, body_setvar(VarName, NewTerm)) :- 178 | Input = setvar(VarName, Term), 179 | !, 180 | atom(VarName), 181 | translateTerm(Term, NewTerm). 182 | yolo_UNSAFE_translate_body(Input, body_getvar(VarName, NewTerm)) :- 183 | Input = getvar(VarName, Term), 184 | !, 185 | atom(VarName), 186 | translateTerm(Term, NewTerm). 187 | yolo_UNSAFE_translate_body(Input, bodyUnary(NewOp, NewBody)) :- 188 | Input =.. [Op, Body], 189 | yolo_UNSAFE_translate_unary_body_op(Op, NewOp), 190 | !, 191 | translateBody(Body, NewBody). 192 | yolo_UNSAFE_translate_body(Input, bodyPair(Body1, NewBodyOp, Body2)) :- 193 | Input =.. [BodyOp, B1, B2], 194 | yolo_UNSAFE_translate_body_pair_op(BodyOp, NewBodyOp), 195 | !, 196 | translateBody(B1, Body1), 197 | translateBody(B2, Body2). 198 | yolo_UNSAFE_translate_body(Input, higherOrderCall(NewWhat, NewParams)) :- 199 | Input =.. [call, What|Params], 200 | !, 201 | translateTerm(What, NewWhat), 202 | translateTerms(Params, NewParams). 203 | yolo_UNSAFE_translate_body(Input, firstOrderCall(Name, NewParams)) :- 204 | Input =.. [Name|Params], 205 | !, 206 | translateTerms(Params, NewParams). 207 | 208 | clausedef(translateTerms, [A], [list(A), list(term)]). 209 | translateTerms(Input, Output) :- 210 | map(Input, lambda([I, O], translateTerm(I, O)), Output). 211 | 212 | clausedef(translateTerm, [A], [A, term]). 213 | translateTerm(Input, Output) :- 214 | onFailure( 215 | lambda([], yolo_UNSAFE_translate_term(Input, Output)), 216 | lambda([], yolo_UNSAFE_format_shim('Syntax error in term: ~w~n~n', [Input]))). 217 | 218 | clausedef(yolo_UNSAFE_translate_term, [A], [A, term]). 219 | yolo_UNSAFE_translate_term(Var, term_var(NewVar)) :- 220 | var(Var), 221 | !, 222 | Var = NewVar. 223 | yolo_UNSAFE_translate_term(Num, term_num(NewNum)) :- 224 | number(Num), 225 | !, 226 | Num = NewNum. 227 | yolo_UNSAFE_translate_term(Input, term_lambda(NewParams, NewBody)) :- 228 | Input =.. [lambda, Params, Body], % differentiate from metalanguage lambdas 229 | !, 230 | translateTerms(Params, NewParams), 231 | translateBody(Body, NewBody). 232 | yolo_UNSAFE_translate_term(Input, term_constructor(Name, NewParams)) :- 233 | Input =.. [Name|Params], 234 | translateTerms(Params, NewParams). 235 | 236 | clausedef(yolo_UNSAFE_normalize_clause, [A, B], [A, B]). 237 | yolo_UNSAFE_normalize_clause(Input, Input) :- 238 | Input = :-(_, _), 239 | !. 240 | yolo_UNSAFE_normalize_clause(Clause, Output) :- 241 | Output = :-(Clause, true). 242 | 243 | clausedef(translateTypes, [A, B], [list(A), list(B), list(type)]). 244 | translateTypes(TypeVars, Inputs, Outputs) :- 245 | map(Inputs, lambda([I, O], translateType(TypeVars, I, O)), Outputs). 246 | 247 | clausedef(yolo_UNSAFE_translate_type, [A, B], [list(A), B, type]). 248 | yolo_UNSAFE_translate_type(TypeVars, TypeVar, Result) :- 249 | var(TypeVar), 250 | !, 251 | setContains(TypeVars, TypeVar), 252 | TypeVar = Result. 253 | yolo_UNSAFE_translate_type(_, Type, intType) :- Type = int, !. 254 | yolo_UNSAFE_translate_type(_, Type, atomType) :- Type = atom, !. 255 | yolo_UNSAFE_translate_type(TypeVars, Input, relationType(NewTypes)) :- 256 | Input = relation(Types), 257 | !, 258 | translateTypes(TypeVars, Types, NewTypes). 259 | yolo_UNSAFE_translate_type(TypeVars, Constructor, constructorType(Name, NewTypes)) :- 260 | Constructor =.. [Name|Types], 261 | !, 262 | translateTypes(TypeVars, Types, NewTypes). 263 | 264 | clausedef(translateType, [A, B], [list(A), B, type]). 265 | translateType(TypeVars, Input, Output) :- 266 | onFailure( 267 | lambda([], yolo_UNSAFE_translate_type(TypeVars, Input, Output)), 268 | lambda([], yolo_UNSAFE_format_shim('Syntax error in type: ~w~n~n', [Input]))). 269 | 270 | clausedef(translateClause, [A], [A, readclause]). 271 | translateClause(Clause, ReadClause) :- 272 | onFailure( 273 | lambda([], yolo_UNSAFE_translate_clause(Clause, ReadClause)), 274 | lambda([], yolo_UNSAFE_format_shim('Syntax error in clause: ~w~n~n', [Clause]))). 275 | 276 | clausedef(yolo_UNSAFE_translate_clause, [A], [A, readclause]). 277 | yolo_UNSAFE_translate_clause( 278 | Input, 279 | readDefModule(defmodule(Name, ProcessedExportedClauses, ExportedData))) :- 280 | Input = module(Name, RawExportedClauses, ExportedData), 281 | !, 282 | atom(Name), 283 | yolo_UNSAFE_translate_pairs(RawExportedClauses, ProcessedExportedClauses), 284 | yolo_UNSAFE_allAtoms(ExportedData). 285 | yolo_UNSAFE_translate_clause( 286 | Input, 287 | readDefUseModule(def_use_module(Name, ProcessedImportedClauses, ImportedData))) :- 288 | Input = use_module(Name, RawImportedClauses, ImportedData), 289 | !, 290 | atom(Name), 291 | yolo_UNSAFE_translate_pairs(RawImportedClauses, ProcessedImportedClauses), 292 | yolo_UNSAFE_allAtoms(ImportedData). 293 | yolo_UNSAFE_translate_clause( 294 | Input, 295 | readDefData(defdata(Name, TypeVars, ProcessedConstructors))) :- 296 | Input = datadef(Name, TypeVars, RawConstructors), 297 | !, 298 | atom(Name), 299 | areTypeVars(TypeVars), 300 | map(RawConstructors, 301 | lambda([Cons, typeConstructor(ConstructorName, NewTypes)], 302 | (Cons =.. [ConstructorName|Types], 303 | translateTypes(TypeVars, Types, NewTypes))), 304 | ProcessedConstructors). 305 | yolo_UNSAFE_translate_clause( 306 | Input, 307 | readDefClause(defclause(Name, TypeVars, NewTypes))) :- 308 | Input = clausedef(Name, TypeVars, Types), 309 | !, 310 | atom(Name), 311 | areTypeVars(TypeVars), 312 | translateTypes(TypeVars, Types, NewTypes). 313 | yolo_UNSAFE_translate_clause( 314 | Input, 315 | readDefGlobalVar(defglobalvar(Name, TypeVars, NewType))) :- 316 | Input = globalvardef(Name, TypeVars, Type), 317 | !, 318 | atom(Name), 319 | areTypeVars(TypeVars), 320 | translateType(TypeVars, Type, NewType). 321 | yolo_UNSAFE_translate_clause( 322 | RawClause, 323 | readClauseClause(clauseclause(Name, NewParams, NewBody))) :- 324 | yolo_UNSAFE_normalize_clause(RawClause, :-(Head, Body)), 325 | Head =.. [Name|Params], 326 | translateTerms(Params, NewParams), 327 | translateBody(Body, NewBody). 328 | 329 | clausedef(sortClause, [], [readclause, 330 | list(defmodule), list(defmodule), 331 | list(def_use_module), list(def_use_module), 332 | list(defdata), list(defdata), 333 | list(defclause), list(defclause), 334 | list(defglobalvar), list(defglobalvar), 335 | list(clauseclause), list(clauseclause)]). 336 | sortClause(readDefModule(DefMod), 337 | [DefMod|RestDefMod], RestDefMod, 338 | DefUse, DefUse, 339 | DefData, DefData, 340 | DefClause, DefClause, 341 | DefGlobalVar, DefGlobalVar, 342 | ClauseClause, ClauseClause). 343 | sortClause(readDefUseModule(DefUseMod), 344 | DefMod, DefMod, 345 | [DefUseMod|RestDefUse], RestDefUse, 346 | DefData, DefData, 347 | DefClause, DefClause, 348 | DefGlobalVar, DefGlobalVar, 349 | ClauseClause, ClauseClause). 350 | sortClause(readDefData(DefData), 351 | DefMod, DefMod, 352 | DefUse, DefUse, 353 | [DefData|RestDefData], RestDefData, 354 | DefClause, DefClause, 355 | DefGlobalVar, DefGlobalVar, 356 | ClauseClause, ClauseClause). 357 | sortClause(readDefClause(DefClause), 358 | DefMod, DefMod, 359 | DefUse, DefUse, 360 | DefData, DefData, 361 | [DefClause|RestDefClause], RestDefClause, 362 | DefGlobalVar, DefGlobalVar, 363 | ClauseClause, ClauseClause). 364 | sortClause(readDefGlobalVar(DefGlobalVar), 365 | DefMod, DefMod, 366 | DefUse, DefUse, 367 | DefData, DefData, 368 | DefClause, DefClause, 369 | [DefGlobalVar|RestDefGlobalVar], RestDefGlobalVar, 370 | ClauseClause, ClauseClause). 371 | sortClause(readClauseClause(ClauseClause), 372 | DefMod, DefMod, 373 | DefUse, DefUse, 374 | DefData, DefData, 375 | DefClause, DefClause, 376 | DefGlobalVar, DefGlobalVar, 377 | [ClauseClause|RestClauseClause], RestClauseClause). 378 | 379 | clausedef(sortClauses, [], [list(readclause), 380 | list(defmodule), list(defmodule), 381 | list(def_use_module), list(def_use_module), 382 | list(defdata), list(defdata), 383 | list(defclause), list(defclause), 384 | list(defglobalvar), list(defglobalvar), 385 | list(clauseclause), list(clauseclause)]). 386 | sortClauses([], 387 | DefMod, DefMod, 388 | DefUse, DefUse, 389 | DefData, DefData, 390 | DefClause, DefClause, 391 | DefGlobalVar, DefGlobalVar, 392 | ClauseClause, ClauseClause). 393 | sortClauses([H|T], 394 | DefMod, NewDefMod, 395 | DefUse, NewDefUse, 396 | DefData, NewDefData, 397 | DefClause, NewDefClause, 398 | DefGlobalVar, NewDefGlobalVar, 399 | ClauseClause, NewClauseClause) :- 400 | sortClause(H, 401 | DefMod, TempDefMod, 402 | DefUse, TempDefUse, 403 | DefData, TempDefData, 404 | DefClause, TempDefClause, 405 | DefGlobalVar, TempDefGlobalVar, 406 | ClauseClause, TempClauseClause), 407 | sortClauses(T, 408 | TempDefMod, NewDefMod, 409 | TempDefUse, NewDefUse, 410 | TempDefData, NewDefData, 411 | TempDefClause, NewDefClause, 412 | TempDefGlobalVar, NewDefGlobalVar, 413 | TempClauseClause, NewClauseClause). 414 | 415 | clausedef(loadFile, [], [atom, loadedFile]). 416 | loadFile(Filename, loadedFile(DefModule, DefUseModule, 417 | DefData, DefClause, DefGlobalVar, 418 | ClauseClause)) :- 419 | read_clauses_from_file( 420 | Filename, 421 | lambda([A, B], translateClause(A, B)), 422 | ReadClauses), 423 | sortClauses(ReadClauses, 424 | [DefModule], [], 425 | DefUseModule, [], 426 | DefData, [], 427 | DefClause, [], 428 | DefGlobalVar, [], 429 | ClauseClause, []). 430 | -------------------------------------------------------------------------------- /src/module_handler.pl: -------------------------------------------------------------------------------- 1 | module(module_handler, [handleModules/5], []). 2 | 3 | use_module('common.pl', [notMember/2, foldLeft/4, flatMap/3, map/3, forall/2, 4 | foldRight/4, appendDiffList/3, onFailure/2, existsOnce/2, 5 | yolo_UNSAFE_format_shim/2, duplicates/2, filter/3], 6 | [pair, tup3, tup4, option]). 7 | use_module('syntax.pl', [loadFile/2], 8 | [op, exp, expLhs, term, body, type, defclause, 9 | typeConstructor, defdata, clauseclause, defglobalvar, 10 | defmodule, def_use_module, loadedFile]). 11 | 12 | datadef(accessModifier, [], [mod_public, mod_private]). 13 | 14 | clausedef(yolo_UNSAFE_mangled_name, [], [accessModifier, int, atom, atom]). 15 | yolo_UNSAFE_mangled_name(AccessModifier, ModuleId, OriginalName, NewName) :- 16 | (AccessModifier == mod_public -> 17 | (WriteAccess = public); 18 | (WriteAccess = private)), 19 | format(atom(NewName), '~a_~d_~a', [WriteAccess, ModuleId, OriginalName]). 20 | 21 | globalvardef(counter, [], int). 22 | clausedef(freshModuleId, [], [int]). 23 | freshModuleId(N) :- 24 | getvar(counter, N), 25 | NewN is N + 1, 26 | setvar(counter, NewN). 27 | 28 | datadef(moduleUse, [], [moduleUse(int, % id of module used 29 | list(pair(atom, int)), % clauses used 30 | list(atom))]). % types used 31 | datadef(loadedModule, [], [loadedModule(atom, % absolute filename 32 | int, % module ID 33 | list(moduleUse), % easier to process use_module directives 34 | loadedFile)]). % file corresponding to module 35 | 36 | clausedef(yolo_UNSAFE_absolute_file_name, [], [atom, % name of file 37 | atom, % relative to another file 38 | atom]). % returned filename 39 | yolo_UNSAFE_absolute_file_name(RelativeName, RelativeTo, AbsoluteName) :- 40 | absolute_file_name(RelativeName, AbsoluteName, [relative_to(RelativeTo)]), 41 | onFailure( 42 | lambda([], access_file(AbsoluteName, read)), 43 | lambda([], yolo_UNSAFE_format_shim( 44 | 'Could not read from possibly nonexistent file: ~w~n', [AbsoluteName]))). 45 | 46 | clausedef(constructorsInDataDefs, [], [list(defdata), list(atom)]). 47 | constructorsInDataDefs(DataDefs, Constructors) :- 48 | flatMap(DataDefs, 49 | lambda([defdata(_, _, TypeConstructors), CurConstructors], 50 | map(TypeConstructors, 51 | lambda([typeConstructor(Name, _), Name], true), 52 | CurConstructors)), 53 | Constructors). 54 | 55 | clausedef(allImportedConstructors, [], [list(loadedModule), 56 | list(moduleUse), 57 | list(atom)]). 58 | allImportedConstructors(LoadedModules, UsesModules, Constructors) :- 59 | flatMap(UsesModules, 60 | lambda([moduleUse(ImportedId, _, ImportedTypes), 61 | CurConstructors], 62 | (LoadedModule = loadedModule(_, ImportedId, _, _), 63 | member(LoadedModule, LoadedModules), 64 | extractConstructors(LoadedModule, ImportedTypes, CurConstructors))), 65 | Constructors). 66 | 67 | % Assumes that all dependencies have been loaded in. 68 | clausedef(extractConstructors, [], [loadedModule, % module containing them 69 | list(atom), % extract for these types 70 | list(atom)]). % resulting constructors 71 | extractConstructors(loadedModule(_, _, _, LoadedFile), 72 | ImportedTypes, Constructors) :- 73 | LoadedFile = loadedFile(defmodule(ModuleName, _, ExportedTypes), _, DataDefs, _, _, _), 74 | 75 | % ensure the module exports the types we want 76 | filter(ImportedTypes, 77 | lambda([ImportedType], notMember(ImportedType, ExportedTypes)), 78 | MissingTypes), 79 | onFailure( 80 | lambda([], MissingTypes = []), 81 | lambda([], 82 | (yolo_UNSAFE_format_shim('Module ~w does not export the following types, which are imported elsewhere: ', [ModuleName]), 83 | yolo_UNSAFE_format_shim('~w~n', [MissingTypes])))), 84 | 85 | % get their corresponding data defs 86 | map(ImportedTypes, 87 | lambda([TypeName, Probe], 88 | (Probe = defdata(TypeName, _, _), 89 | member(Probe, DataDefs))), 90 | ImportedDataDefs), 91 | 92 | % get the corresponding constructors 93 | constructorsInDataDefs(ImportedDataDefs, Constructors). 94 | 95 | % Finds all exports that are not defined in the file. 96 | clausedef(nonexistentExports, [], [loadedFile, % the file 97 | list(pair(atom, int)), % non-defined exported clauses 98 | list(atom)]). % non-defined exported types 99 | nonexistentExports(loadedFile(defmodule(_, ExportedClauses, ExportedTypes), 100 | _, 101 | DefinedTypes, 102 | DefinedClauses, 103 | _, 104 | _), 105 | NonexistentClauses, 106 | NonexistentTypes) :- 107 | filter(ExportedClauses, 108 | lambda([pair(ClauseName, ClauseArity)], 109 | \+ existsOnce(DefinedClauses, 110 | lambda([defclause(ClauseName, _, Types)], 111 | length(Types, ClauseArity)))), 112 | NonexistentClauses), 113 | filter(ExportedTypes, 114 | lambda([TypeName], 115 | \+ existsOnce(DefinedTypes, 116 | lambda([defdata(TypeName, _, _)], true))), 117 | NonexistentTypes). 118 | 119 | clausedef(ensureEverythingExportedIsDefined, [], [atom, % filename 120 | loadedFile]). % the file that was loaded in 121 | ensureEverythingExportedIsDefined(FileName, LoadedFile) :- 122 | nonexistentExports(LoadedFile, NonexistentClauses, NonexistentTypes), 123 | onFailure( 124 | lambda([], (NonexistentClauses=[], NonexistentTypes=[])), 125 | lambda([], ( 126 | yolo_UNSAFE_format_shim('Something exported not defined in: ~w~n', [FileName]), 127 | yolo_UNSAFE_format_shim('Nonexistent clauses are: ~w~n', [NonexistentClauses]), 128 | yolo_UNSAFE_format_shim('Nonexistent types are: ~w~n', [NonexistentTypes])))). 129 | 130 | clausedef(directLoadModule, [], [atom, % absolute filename 131 | list(loadedModule), % already loaded modules 132 | list(atom), % in progress loading 133 | list(loadedModule)]). % newly loaded modules 134 | directLoadModule(FileName, AlreadyLoaded, InProgress, 135 | [loadedModule(FileName, ModuleId, ProcessedUses, LoadedFile)|RestLoaded]) :- 136 | loadFile(FileName, LoadedFile), 137 | LoadedFile = loadedFile(_, UsesModules, DataDefs, _, _, _), 138 | 139 | % make sure everything exported actually exists 140 | ensureEverythingExportedIsDefined(FileName, LoadedFile), 141 | 142 | % perform the actual loading 143 | foldLeft(UsesModules, pair(AlreadyLoaded, ProcessedUses), 144 | lambda([pair(CurLoaded, 145 | [moduleUse(OtherId, ClausesUsed, TypesUsed)|RestUsed]), 146 | def_use_module(CurFileName, ClausesUsed, TypesUsed), 147 | pair(TempLoaded, RestUsed)], 148 | (yolo_UNSAFE_absolute_file_name(CurFileName, FileName, AbsFileName), 149 | loadModule(AbsFileName, CurLoaded, InProgress, TempLoaded), 150 | member(loadedModule(AbsFileName, OtherId, _, _), TempLoaded))), 151 | pair(RestLoaded, [])), 152 | 153 | % ensure we haven't introduced any duplicate constructors 154 | allImportedConstructors(RestLoaded, ProcessedUses, ImportedConstructors), 155 | constructorsInDataDefs(DataDefs, LocalConstructors), 156 | append(ImportedConstructors, LocalConstructors, AllConstructors), 157 | 158 | onFailure( 159 | lambda([], is_set(AllConstructors)), 160 | lambda([], 161 | (duplicates(AllConstructors, DuplicateConstructors), 162 | yolo_UNSAFE_format_shim('Duplicate constructors in scope: ~w~n', [DuplicateConstructors])))), 163 | 164 | freshModuleId(ModuleId). 165 | 166 | clausedef(renamedClause, [], [renaming, atom, int, atom]). 167 | renamedClause(renaming(Mapping, _, _, _), OldName, Arity, NewName) :- 168 | member(pair(pair(OldName, Arity), NewName), Mapping), !. 169 | renamedClause(_, Name, _, Name). % TODO: this is a hack to allow us to escape to stock Prolog. 170 | 171 | clausedef(renamedType, [], [renaming, atom, atom]). 172 | renamedType(renaming(_, Mapping, _, _), OldName, NewName) :- 173 | member(pair(OldName, NewName), Mapping), !. 174 | renamedType(_, Name, Name). 175 | 176 | clausedef(renamedConstructor, [], [renaming, atom, atom]). 177 | renamedConstructor(renaming(_, _, Mapping, _), OldName, NewName) :- 178 | member(pair(OldName, NewName), Mapping), !. 179 | renamedConstructor(_, Name, Name). 180 | 181 | clausedef(renamedGlobalVariable, [], [renaming, atom, atom]). 182 | renamedGlobalVariable(renaming(_, _, _, Mapping), OldName, NewName) :- 183 | member(pair(OldName, NewName), Mapping), !. 184 | renamedGlobalVariable(_, Name, Name). 185 | 186 | datadef(renaming, [], [renaming(list(pair(pair(atom, int), atom)), % for clauses 187 | list(pair(atom, atom)), % for types 188 | list(pair(atom, atom)), % for constructors 189 | list(pair(atom, atom)))]). % for global variables 190 | % assumes that there are no duplicates 191 | clausedef(makeRenaming, [], [list(loadedModule), % all loaded modules 192 | loadedModule, 193 | renaming]). 194 | makeRenaming(LoadedModules, loadedModule(_, LocalModuleId, UsesModules, LoadedFile), 195 | renaming(ClauseRenaming, TypeRenaming, ConstructorRenaming, GlobalVarRenaming)) :- 196 | LoadedFile = loadedFile(defmodule(_, ExportedClauses, ExportedTypes), 197 | _, 198 | DataDefs, 199 | ClauseDefs, 200 | GlobalVarDefs, 201 | _), 202 | 203 | % determine renamings for external clauses, types, and constructors 204 | foldRight(UsesModules, tup3([], [], []), 205 | lambda([moduleUse(ModuleId, ImportedClauses, ImportedTypes), 206 | tup3(CurClauses, CurTypes, CurCons), 207 | tup3(NewClauses, NewTypes, NewCons)], 208 | (% determine renamings for the imported clauses 209 | map(ImportedClauses, 210 | lambda([NameArity, pair(NameArity, NewClauseName)], 211 | (NameArity = pair(ClauseName, _), 212 | yolo_UNSAFE_mangled_name(mod_public, ModuleId, 213 | ClauseName, NewClauseName))), 214 | AddClauses), 215 | append(AddClauses, CurClauses, NewClauses), 216 | 217 | % determine renamings for the imported types 218 | map(ImportedTypes, 219 | lambda([TypeName, pair(TypeName, NewTypeName)], 220 | yolo_UNSAFE_mangled_name(mod_public, ModuleId, 221 | TypeName, NewTypeName)), 222 | AddTypes), 223 | append(AddTypes, CurTypes, NewTypes), 224 | 225 | % determine renamings for the imported constructors 226 | LoadedModule = loadedModule(_, ModuleId, _, _), 227 | member(LoadedModule, LoadedModules), 228 | extractConstructors(LoadedModule, ImportedTypes, ImportedConstructors), 229 | map(ImportedConstructors, 230 | lambda([ConsName, pair(ConsName, NewConsName)], 231 | yolo_UNSAFE_mangled_name(mod_public, ModuleId, 232 | ConsName, NewConsName)), 233 | AddCons), 234 | append(AddCons, CurCons, NewCons))), 235 | tup3(ExternalClauseRenaming, ExternalTypeRenaming, ExternalConstructorRenaming)), 236 | 237 | % determine renaming for local clause defs 238 | map(ClauseDefs, 239 | lambda([defclause(Name, _, Params), pair(pair(Name, Arity), NewName)], 240 | (length(Params, Arity), 241 | (member(pair(Name, Arity), ExportedClauses) -> 242 | (AccessModifier = mod_public); 243 | (AccessModifier = mod_private)), 244 | yolo_UNSAFE_mangled_name(AccessModifier, LocalModuleId, Name, NewName))), 245 | LocalClauseRenaming), 246 | 247 | % determine renaming for local types and local constructors 248 | foldRight(DataDefs, pair([], []), 249 | lambda([defdata(TypeName, _, TypeConstructors), 250 | pair(CurTypes, CurCons), 251 | pair([pair(TypeName, NewTypeName)|CurTypes], NewCons)], 252 | (% determine the appropriate access modifier 253 | (member(TypeName, ExportedTypes) -> 254 | (AccessModifier = mod_public); 255 | (AccessModifier = mod_private)), 256 | 257 | % determine the new type name 258 | yolo_UNSAFE_mangled_name(AccessModifier, LocalModuleId, 259 | TypeName, NewTypeName), 260 | 261 | % determine the new constructor names 262 | map(TypeConstructors, 263 | lambda([typeConstructor(ConsName, _), pair(ConsName, NewConsName)], 264 | yolo_UNSAFE_mangled_name(AccessModifier, LocalModuleId, 265 | ConsName, NewConsName)), 266 | AddCons), 267 | append(AddCons, CurCons, NewCons))), 268 | pair(LocalTypeRenaming, LocalConstructorRenaming)), 269 | 270 | % determine renaming for global variables 271 | map(GlobalVarDefs, 272 | lambda([defglobalvar(Name, _, _), pair(Name, NewName)], 273 | yolo_UNSAFE_mangled_name(mod_private, LocalModuleId, Name, NewName)), 274 | GlobalVarRenaming), 275 | 276 | % put it all together 277 | append(LocalClauseRenaming, ExternalClauseRenaming, ClauseRenaming), 278 | append(LocalTypeRenaming, ExternalTypeRenaming, TypeRenaming), 279 | append(LocalConstructorRenaming, ExternalConstructorRenaming, ConstructorRenaming). 280 | 281 | clausedef(loadModule, [], [atom, % absolute filename 282 | list(loadedModule), % already loaded modules 283 | list(atom), % modules whose loading is in progress 284 | list(loadedModule)]). % newly loaded modules 285 | loadModule(FileName, AlreadyLoaded, InProgress, NewLoaded) :- 286 | % don't allow cyclic loading, which would put us in an infinite loop 287 | notMember(FileName, InProgress), 288 | 289 | % if we've already loaded this module, we're done 290 | (member(loadedModule(FileName, _, _, _), AlreadyLoaded) -> 291 | (NewLoaded = AlreadyLoaded); 292 | (directLoadModule(FileName, AlreadyLoaded, 293 | [FileName|InProgress], 294 | NewLoaded))). 295 | 296 | clausedef(translateVarUse, [], [renaming, atom, term, atom, term]). 297 | translateVarUse(Renaming, VarUsed, Term, NewVarUsed, NewTerm) :- 298 | renamedGlobalVariable(Renaming, VarUsed, NewVarUsed), 299 | translateTerm(Renaming, Term, NewTerm). 300 | 301 | clausedef(translateBody, [], [renaming, body, body]). 302 | translateBody(_, body_is(Lhs, Exp), body_is(Lhs, Exp)). 303 | translateBody(_, bodyComparison(Exp1, Op, Exp2), bodyComparison(Exp1, Op, Exp2)). 304 | translateBody(Renaming, body_setvar(VarName, Term), body_setvar(NewVarName, NewTerm)) :- 305 | translateVarUse(Renaming, VarName, Term, NewVarName, NewTerm). 306 | translateBody(Renaming, body_getvar(VarName, Term), body_getvar(NewVarName, NewTerm)) :- 307 | translateVarUse(Renaming, VarName, Term, NewVarName, NewTerm). 308 | translateBody(Renaming, bodyUnary(Op, Body), bodyUnary(Op, NewBody)) :- 309 | translateBody(Renaming, Body, NewBody). 310 | translateBody(Renaming, bodyPair(B1, Op, B2), bodyPair(NewB1, Op, NewB2)) :- 311 | translateBody(Renaming, B1, NewB1), 312 | translateBody(Renaming, B2, NewB2). 313 | translateBody(Renaming, higherOrderCall(What, Params), higherOrderCall(NewWhat, NewParams)) :- 314 | translateTerm(Renaming, What, NewWhat), 315 | translateTerms(Renaming, Params, NewParams). 316 | translateBody(Renaming, firstOrderCall(Name, Params), firstOrderCall(NewName, NewParams)) :- 317 | length(Params, Arity), 318 | renamedClause(Renaming, Name, Arity, NewName), 319 | translateTerms(Renaming, Params, NewParams). 320 | 321 | clausedef(translateTerms, [], [renaming, list(term), list(term)]). 322 | translateTerms(Renaming, Terms, NewTerms) :- 323 | map(Terms, lambda([Term, NewTerm], translateTerm(Renaming, Term, NewTerm)), NewTerms). 324 | 325 | clausedef(translateTerm, [], [renaming, term, term]). 326 | translateTerm(_, term_var(Variable), term_var(Variable)). 327 | translateTerm(_, term_num(N), term_num(N)). 328 | translateTerm(Renaming, term_lambda(Params, Body), term_lambda(NewParams, NewBody)) :- 329 | translateTerms(Renaming, Params, NewParams), 330 | translateBody(Renaming, Body, NewBody). 331 | translateTerm(Renaming, 332 | term_constructor(ConsName, Params), 333 | term_constructor(NewConsName, NewParams)) :- 334 | renamedConstructor(Renaming, ConsName, NewConsName), 335 | translateTerms(Renaming, Params, NewParams). 336 | 337 | clausedef(translateTypes, [], [renaming, list(type), list(type)]). 338 | translateTypes(Renaming, Types, NewTypes) :- 339 | map(Types, lambda([Type, NewType], translateType(Renaming, Type, NewType)), NewTypes). 340 | 341 | clausedef(translateType, [], [renaming, type, type]). 342 | translateType(_, Variable, NewVariable) :- 343 | var(Variable), 344 | !, 345 | Variable = NewVariable. 346 | translateType(_, intType, intType) :- !. 347 | translateType(_, atomType, atomType) :- !. 348 | translateType(Renaming, relationType(Types), relationType(NewTypes)) :- 349 | !, 350 | translateTypes(Renaming, Types, NewTypes). 351 | translateType(Renaming, constructorType(Name, Types), constructorType(NewName, NewTypes)) :- 352 | !, 353 | renamedType(Renaming, Name, NewName), 354 | translateTypes(Renaming, Types, NewTypes). 355 | 356 | clausedef(translateDataDef, [], [renaming, defdata, defdata]). 357 | translateDataDef(Renaming, 358 | defdata(Name, TypeParams, Constructors), 359 | defdata(NewName, TypeParams, NewConstructors)) :- 360 | renamedType(Renaming, Name, NewName), 361 | map(Constructors, 362 | lambda([typeConstructor(ConstructorName, Types), 363 | typeConstructor(NewConstructorName, NewTypes)], 364 | (renamedConstructor(Renaming, ConstructorName, NewConstructorName), 365 | translateTypes(Renaming, Types, NewTypes))), 366 | NewConstructors). 367 | 368 | clausedef(translateLoadedFile, [], [renaming, 369 | loadedFile, 370 | list(defdata), % diff list 371 | list(defdata), 372 | list(defclause), % diff list 373 | list(defclause), 374 | list(defglobalvar), % diff list 375 | list(defglobalvar), 376 | list(clauseclause), % diff list 377 | list(clauseclause)]). 378 | translateLoadedFile(Renaming, 379 | loadedFile(_, _, DataDefs, ClauseDefs, GlobalVarDefs, Clauses), 380 | DataDefInput, DataDefOutput, 381 | ClauseDefInput, ClauseDefOutput, 382 | GlobalVarInput, GlobalVarOutput, 383 | ClauseInput, ClauseOutput) :- 384 | % handle the data defs 385 | map(DataDefs, 386 | lambda([DataDef, NewDataDef], translateDataDef(Renaming, DataDef, NewDataDef)), 387 | NewDataDefs), 388 | appendDiffList(NewDataDefs, DataDefInput, DataDefOutput), 389 | 390 | % handle the clause defs 391 | map(ClauseDefs, 392 | lambda([defclause(Name, TypeParams, Types), 393 | defclause(NewName, TypeParams, NewTypes)], 394 | (length(Types, Arity), 395 | renamedClause(Renaming, Name, Arity, NewName), 396 | translateTypes(Renaming, Types, NewTypes))), 397 | NewClauseDefs), 398 | appendDiffList(NewClauseDefs, ClauseDefInput, ClauseDefOutput), 399 | 400 | % handle the global var defs 401 | map(GlobalVarDefs, 402 | lambda([defglobalvar(Name, TypeParams, Type), 403 | defglobalvar(NewName, TypeParams, NewType)], 404 | (renamedGlobalVariable(Renaming, Name, NewName), 405 | translateType(Renaming, Type, NewType))), 406 | NewGlobalVarDefs), 407 | appendDiffList(NewGlobalVarDefs, GlobalVarInput, GlobalVarOutput), 408 | 409 | % handle the clauses 410 | map(Clauses, 411 | lambda([clauseclause(Name, Params, Body), 412 | clauseclause(NewName, NewParams, NewBody)], 413 | (length(Params, Arity), 414 | renamedClause(Renaming, Name, Arity, NewName), 415 | translateTerms(Renaming, Params, NewParams), 416 | translateBody(Renaming, Body, NewBody))), 417 | NewClauses), 418 | appendDiffList(NewClauses, ClauseInput, ClauseOutput). 419 | 420 | clausedef(translateModule, [], [list(loadedModule), % all loaded modules 421 | loadedModule, % what to translate 422 | list(defdata), % diff list 423 | list(defdata), 424 | list(defclause), % diff list 425 | list(defclause), 426 | list(defglobalvar), % diff list 427 | list(defglobalvar), 428 | list(clauseclause), % diff list 429 | list(clauseclause)]). 430 | translateModule(AllModules, LoadedModule, 431 | DataDefInput, DataDefOutput, 432 | ClauseDefInput, ClauseDefOutput, 433 | GlobalVarInput, GlobalVarOutput, 434 | ClauseInput, ClauseOutput) :- 435 | LoadedModule = loadedModule(_, _, _, LoadedFile), 436 | makeRenaming(AllModules, LoadedModule, Renaming), 437 | translateLoadedFile(Renaming, LoadedFile, 438 | DataDefInput, DataDefOutput, 439 | ClauseDefInput, ClauseDefOutput, 440 | GlobalVarInput, GlobalVarOutput, 441 | ClauseInput, ClauseOutput), !. 442 | 443 | clausedef(handleModules, [], [atom, % Entry point possibly relative filename 444 | list(defdata), list(defclause), 445 | list(defglobalvar), list(clauseclause)]). 446 | handleModules(Filename, DataDefs, ClauseDefs, GlobalVarDefs, Clauses) :- 447 | setvar(counter, 0), 448 | yolo_UNSAFE_absolute_file_name(Filename, './', AbsFilename), 449 | directLoadModule(AbsFilename, [], [AbsFilename], LoadedModules), !, 450 | foldLeft(LoadedModules, tup4(DataDefs, ClauseDefs, GlobalVarDefs, Clauses), 451 | lambda([tup4(CurDataDefs, CurClauseDefs, CurGlobalVarDefs, CurClauses), 452 | LoadedModule, 453 | tup4(NewDataDefs, NewClauseDefs, NewGlobalVarDefs, NewClauses)], 454 | translateModule(LoadedModules, LoadedModule, 455 | CurDataDefs, NewDataDefs, 456 | CurClauseDefs, NewClauseDefs, 457 | CurGlobalVarDefs, NewGlobalVarDefs, 458 | CurClauses, NewClauses)), 459 | tup4([], [], [], [])). 460 | -------------------------------------------------------------------------------- /src/compiler.pl: -------------------------------------------------------------------------------- 1 | :-use_module(library(clpfd)). 2 | call_lambda0(lambda0_89(B,C,A)):-public_0_find(A,B,C). 3 | call_lambda0(lambda0_80(A)):-public_0_yolo_UNSAFE_format_shim('Syntax error in clause: ~w~n~n',[A]). 4 | call_lambda0(lambda0_79(B,A)):-private_2_yolo_UNSAFE_translate_clause(A,B). 5 | call_lambda0(lambda0_78(A)):-public_0_yolo_UNSAFE_format_shim('Syntax error in type: ~w~n~n',[A]). 6 | call_lambda0(lambda0_77(B,C,A)):-private_2_yolo_UNSAFE_translate_type(A,B,C). 7 | call_lambda0(lambda0_75(A)):-public_0_yolo_UNSAFE_format_shim('Syntax error in term: ~w~n~n',[A]). 8 | call_lambda0(lambda0_74(B,A)):-private_2_yolo_UNSAFE_translate_term(A,B). 9 | call_lambda0(lambda0_72(A)):-public_0_yolo_UNSAFE_format_shim('Syntax error in body: ~w~n~n',[A]). 10 | call_lambda0(lambda0_71(B,A)):-private_2_yolo_UNSAFE_translate_body(A,B). 11 | call_lambda0(lambda0_51(A)):-public_0_duplicates(A,B),public_0_yolo_UNSAFE_format_shim('Duplicate constructors in scope: ~w~n',[B]). 12 | call_lambda0(lambda0_50(A)):-is_set(A). 13 | call_lambda0(lambda0_48(C,B,A)):-public_0_yolo_UNSAFE_format_shim('Something exported not defined in: ~w~n',[A]),public_0_yolo_UNSAFE_format_shim('Nonexistent clauses are: ~w~n',[B]),public_0_yolo_UNSAFE_format_shim('Nonexistent types are: ~w~n',[C]). 14 | call_lambda0(lambda0_47(B,A)):-A=[],B=[]. 15 | call_lambda0(lambda0_41(B,A)):-public_0_yolo_UNSAFE_format_shim('Module ~w does not export the following types, which are imported elsewhere: ',[A]),public_0_yolo_UNSAFE_format_shim('~w~n',[B]). 16 | call_lambda0(lambda0_40(A)):-A=[]. 17 | call_lambda0(lambda0_35(A)):-public_0_yolo_UNSAFE_format_shim('Could not read from possibly nonexistent file: ~w~n',[A]). 18 | call_lambda0(lambda0_34(A)):-access_file(A,read). 19 | call_lambda0(lambda0_31(A)):-public_0_yolo_UNSAFE_format_shim('Type error at clause ~w~n~n',[A]). 20 | call_lambda0(lambda0_30(B,A)):-private_4_typecheckClause(A,B). 21 | call_lambda0(lambda0_28(D,C,B,A)):-public_0_yolo_UNSAFE_format_shim('Type error at term ~w~n',[A]),public_0_onFailure(lambda0_26(B,C,A,D),lambda0_27(B)). 22 | call_lambda0(lambda0_27(A)):-public_0_yolo_UNSAFE_format_shim('\tFound: UNKNOWN~n\tExpected: ~w~n~n',[A]). 23 | call_lambda0(lambda0_26(E,A,C,B)):-private_4_rawTypeofTerm(A,B,C,D,_),public_0_yolo_UNSAFE_format_shim('\tFound: ~w~n\tExpected: ~w~n~n',[D,E]). 24 | call_lambda0(lambda0_25(B,D,E,C,A)):-private_4_rawTypeofTerm(A,B,C,D,E). 25 | call_lambda0(lambda0_24(A,B)):-public_0_yolo_UNSAFE_format_shim('Unknown clause: ~w~n~n',[public_0_pair(A,B)]). 26 | call_lambda0(lambda0_23(B,D,C,A)):-private_4_expectedFormalParamTypes(A,B,C,D). 27 | call_lambda0(lambda0_22(A)):-public_0_yolo_UNSAFE_format_shim('Type error at body ~w~n~n',[A]). 28 | call_lambda0(lambda0_21(B,D,C,A)):-private_4_rawTypecheckBody(A,B,C,D). 29 | call_lambda0(lambda0_15(B,A)):-public_0_yolo_UNSAFE_format_shim(A,[B]). 30 | call_lambda0(lambda0_14(A)):-A=[]. 31 | call_lambda1(lambda1_90(A),B):-A\=B. 32 | call_lambda1(lambda1_88(A),B):-public_0_setContains(A,B). 33 | call_lambda1(lambda1_86(A),B):-public_0_forall(A,lambda1_85(B)). 34 | call_lambda1(lambda1_85(B),A):-private_1_yolo_UNSAFE_write_clause(A,B). 35 | call_lambda1(lambda1_84(B,C),A):-private_1_read_clauses_from_stream(A,B,C). 36 | call_lambda1(lambda1_83(F,A,B),D):-private_1_yolo_UNSAFE_read_clause(A,B,C), (C=public_0_some(E)->D=[E|G],call_lambda1(F,G);D=[]). 37 | call_lambda1(lambda1_70,A):-atom(A). 38 | call_lambda1(lambda1_69,A):-var(A). 39 | call_lambda1(lambda1_46(A),B):- \+public_0_existsOnce(A,lambda1_45(B)). 40 | call_lambda1(lambda1_45(A),public_2_defdata(A,_,_)). 41 | call_lambda1(lambda1_44(A),public_0_pair(B,C)):- \+public_0_existsOnce(A,lambda1_43(B,C)). 42 | call_lambda1(lambda1_43(A,C),public_2_defclause(A,_,B)):-length(B,C). 43 | call_lambda1(lambda1_39(B),A):-public_0_notMember(A,B). 44 | call_lambda1(lambda1_33(A),B):-private_4_typecheckClauseWithErrorMessage(A,B). 45 | call_lambda1(lambda1_20(A),public_0_pair(B,_)):-A==B. 46 | call_lambda1(lambda1_8,public_2_clauseclause(_,_,A)):-private_5_bodyUsesClp(A). 47 | call_lambda1(lambda1_6(B),public_0_pair(A,_)):-private_5_isCallLambda(A),public_0_notMember(A,B). 48 | call_lambda1(lambda1_4(A),B):-public_0_setContains(A,B). 49 | call_lambda2(lambda2_96,public_0_pair(A,_),A). 50 | call_lambda2(lambda2_94(A),public_0_pair(_,B),public_0_pair(_,C)):-call_lambda2(A,B,C). 51 | call_lambda2(lambda2_93(B),A,public_0_pair(A,C)):-call_lambda2(B,A,C). 52 | call_lambda2(lambda2_82,A,B):-private_2_translateClause(A,B). 53 | call_lambda2(lambda2_81(C),A,public_2_typeConstructor(B,E)):-A=..[B|D],private_2_translateTypes(C,D,E). 54 | call_lambda2(lambda2_76(A),B,C):-private_2_translateType(A,B,C). 55 | call_lambda2(lambda2_73,A,B):-private_2_translateTerm(A,B). 56 | call_lambda2(lambda2_68,A/B,public_0_pair(A,B)):-atom(A),number(B). 57 | call_lambda2(lambda2_66(B),public_2_clauseclause(C,A,G),public_2_clauseclause(E,F,H)):-length(A,D),private_3_renamedClause(B,C,D,E),private_3_translateTerms(B,A,F),private_3_translateBody(B,G,H). 58 | call_lambda2(lambda2_65(B),public_2_defglobalvar(C,A,E),public_2_defglobalvar(D,A,F)):-private_3_renamedGlobalVariable(B,C,D),private_3_translateType(B,E,F). 59 | call_lambda2(lambda2_64(C),public_2_defclause(D,A,B),public_2_defclause(F,A,G)):-length(B,E),private_3_renamedClause(C,D,E,F),private_3_translateTypes(C,B,G). 60 | call_lambda2(lambda2_63(A),B,C):-private_3_translateDataDef(A,B,C). 61 | call_lambda2(lambda2_62(A),public_2_typeConstructor(B,D),public_2_typeConstructor(C,E)):-private_3_renamedConstructor(A,B,C),private_3_translateTypes(A,D,E). 62 | call_lambda2(lambda2_61(A),B,C):-private_3_translateType(A,B,C). 63 | call_lambda2(lambda2_60(A),B,C):-private_3_translateTerm(A,B,C). 64 | call_lambda2(lambda2_59(B),public_2_defglobalvar(A,_,_),public_0_pair(A,C)):-private_3_yolo_UNSAFE_mangled_name(private_3_mod_private,B,A,C). 65 | call_lambda2(lambda2_57(C,B),public_2_typeConstructor(A,_),public_0_pair(A,D)):-private_3_yolo_UNSAFE_mangled_name(B,C,A,D). 66 | call_lambda2(lambda2_56(F,D),public_2_defclause(A,_,B),public_0_pair(public_0_pair(A,C),G)):-length(B,C), (member(public_0_pair(A,C),D)->E=private_3_mod_public;E=private_3_mod_private),private_3_yolo_UNSAFE_mangled_name(E,F,A,G). 67 | call_lambda2(lambda2_54(B),A,public_0_pair(A,C)):-private_3_yolo_UNSAFE_mangled_name(private_3_mod_public,B,A,C). 68 | call_lambda2(lambda2_53(B),A,public_0_pair(A,C)):-private_3_yolo_UNSAFE_mangled_name(private_3_mod_public,B,A,C). 69 | call_lambda2(lambda2_52(B),A,public_0_pair(A,D)):-A=public_0_pair(C,_),private_3_yolo_UNSAFE_mangled_name(private_3_mod_public,B,C,D). 70 | call_lambda2(lambda2_42(C),B,A):-A=public_2_defdata(B,_,_),member(A,C). 71 | call_lambda2(lambda2_38(C),private_3_moduleUse(A,_,D),E):-B=private_3_loadedModule(_,A,_,_),member(B,C),private_3_extractConstructors(B,D,E). 72 | call_lambda2(lambda2_37,public_2_defdata(_,_,A),B):-public_0_map(A,lambda2_36,B). 73 | call_lambda2(lambda2_36,public_2_typeConstructor(A,_),A). 74 | call_lambda2(lambda2_19,public_2_defdata(A,_,_),A). 75 | call_lambda2(lambda2_18,A,public_0_pair(public_0_pair(B,D),A)):-A=public_2_defclause(B,_,C),length(C,D). 76 | call_lambda2(lambda2_17,A,C):-A=public_2_defdata(_,_,B),public_0_map(B,lambda2_16(A),C). 77 | call_lambda2(lambda2_16(B),public_2_typeConstructor(A,_),public_0_pair(A,B)). 78 | call_lambda2(lambda2_13,public_0_pair(A,_),A). 79 | call_lambda2(lambda2_12,A,B):-A@>B. 80 | call_lambda2(lambda2_11,public_2_clauseclause(A,_,_),A). 81 | call_lambda2(lambda2_9,public_2_clauseclause(A,_,_),B):-private_5_isCallLambda(A)->B=[A];B=[]. 82 | call_lambda2(lambda2_7,public_2_clauseclause(A,B,D),public_0_pair(public_0_pair(A,C),E)):-length(B,C),private_5_bodyDirectlyCalls(D,E). 83 | call_lambda2(lambda2_5,A,public_2_term_var(A)). 84 | call_lambda2(lambda2_1,A,B):-private_6_yolo_UNSAFE_translate_clause(A,B). 85 | call_lambda2(lambda2_0,A,B):-private_6_yolo_UNSAFE_translate_term(A,B). 86 | call_lambda3(lambda3_97,public_0_pair(A,C),B,public_0_pair(E,D)):-public_0_setContains(A,B)-> (public_0_setContains(C,B)->D=C;D=[B|C]),E=A;E=[B|A],D=C. 87 | call_lambda3(lambda3_95(B),A,C,D):-private_0_insertItem(A,B,C,D). 88 | call_lambda3(lambda3_92(A),C,B,D):-public_0_setContains(A,B)->C=D;D=[B|C]. 89 | call_lambda3(lambda3_91,A,B,C):-public_0_setContains(A,B)->A=C;C=[B|A]. 90 | call_lambda3(lambda3_87(A),B,D,E):-call_lambda2(A,B,C),append(C,D,E). 91 | call_lambda3(lambda3_67(A),public_0_tup4(C,E,G,I),B,public_0_tup4(D,F,H,J)):-private_3_translateModule(A,B,C,D,E,F,G,H,I,J). 92 | call_lambda3(lambda3_58(E,C),public_2_defdata(A,_,G),public_0_pair(B,I),public_0_pair([public_0_pair(A,F)|B],J)):- (member(A,C)->D=private_3_mod_public;D=private_3_mod_private),private_3_yolo_UNSAFE_mangled_name(D,E,A,F),public_0_map(G,lambda2_57(E,D),H),append(H,I,J). 93 | call_lambda3(lambda3_55(K),private_3_moduleUse(B,A,F),public_0_tup3(D,H,N),public_0_tup3(E,I,O)):-public_0_map(A,lambda2_52(B),C),append(C,D,E),public_0_map(F,lambda2_53(B),G),append(G,H,I),J=private_3_loadedModule(_,B,_,_),member(J,K),private_3_extractConstructors(J,F,L),public_0_map(L,lambda2_54(B),M),append(M,N,O). 94 | call_lambda3(lambda3_49(H,E),public_0_pair(G,[private_3_moduleUse(J,A,B)|C]),public_2_def_use_module(D,A,B),public_0_pair(I,C)):-private_3_yolo_UNSAFE_absolute_file_name(D,E,F),private_3_loadModule(F,G,H,I),member(private_3_loadedModule(F,J,_,_),I). 95 | call_lambda3(lambda3_32,A,public_2_typevar(A),B):-B is A. 96 | call_lambda3(lambda3_29(A),B,public_0_pair(C,D),E):-private_4_typeofTerm(A,B,C,D,E). 97 | call_lambda3(lambda3_10,public_0_pair([C|A],D),B,public_0_pair(A,E)):-private_5_translateClause(B,C,D,E). 98 | call_lambda6(lambda6_3,A,B,C,D,E,F):-private_5_translateBody(A,B,C,D,E,F). 99 | call_lambda6(lambda6_2,A,B,C,D,E,F):-private_5_translateTerm(A,B,C,D,E,F). 100 | private_7_useClp:-A#=A. 101 | private_7_processFile(A,F,H):-public_3_handleModules(A,B,C,D,E),!,public_4_typecheckClauses(B,C,D,E),!,public_5_translateClauses(E,F,G),!,public_6_writeTranslatedClauses(G,H),!. 102 | public_7_processFileForSwipl(A,B):-private_7_processFile(A,public_5_swipl,B). 103 | public_7_processFileForGnuProlog(A,B):-private_7_processFile(A,public_5_gnuprolog,B). 104 | private_6_translateOp(public_2_plus,+). 105 | private_6_translateOp(public_2_minus,-). 106 | private_6_translateOp(public_2_mul,*). 107 | private_6_translateOp(public_2_div,/). 108 | private_6_translateOp(public_2_op_min,min). 109 | private_6_translateOp(public_2_op_max,max). 110 | private_6_translateOp(public_2_shift_left,<<). 111 | private_6_translateOp(public_2_shift_right,>>). 112 | private_6_translateOp(public_2_bitwise_and,/\). 113 | private_6_translateOp(public_2_bitwise_or,\/). 114 | private_6_translateOp(public_2_int_div,//). 115 | private_6_translateOp(public_2_int_rem,rem). 116 | private_6_translateOp(public_2_int_mod,mod). 117 | private_6_translateOp(public_2_op_exponent,^). 118 | private_6_translateCompareOp(public_2_lt,<). 119 | private_6_translateCompareOp(public_2_lte,=<). 120 | private_6_translateCompareOp(public_2_gt,>). 121 | private_6_translateCompareOp(public_2_gte,>=). 122 | private_6_translateCompareOp(public_2_clp_lt,#<). 123 | private_6_translateCompareOp(public_2_clp_lte,#=<). 124 | private_6_translateCompareOp(public_2_clp_gt,#>). 125 | private_6_translateCompareOp(public_2_clp_gte,#>=). 126 | private_6_translateCompareOp(public_2_clp_eq,#=). 127 | private_6_translateCompareOp(public_2_clp_neq,#\=). 128 | private_6_translateUnop(public_2_op_msb,msb). 129 | private_6_translateUnop(public_2_op_abs,abs). 130 | private_6_translateUnop(public_2_op_truncate,truncate). 131 | private_6_translateBodyUnaryOp(public_2_not,\+). 132 | private_6_translateBodyPairOp(public_2_and,','). 133 | private_6_translateBodyPairOp(public_2_or,;). 134 | private_6_translateBodyPairOp(public_2_implies,->). 135 | private_6_yolo_UNSAFE_translate_exp(public_2_exp_var(A),B):-A=B. 136 | private_6_yolo_UNSAFE_translate_exp(public_2_exp_num(A),B):-A=B. 137 | private_6_yolo_UNSAFE_translate_exp(public_2_binop(B,A,C),D):-private_6_translateOp(A,E),private_6_yolo_UNSAFE_translate_exp(B,F),private_6_yolo_UNSAFE_translate_exp(C,G),D=..[E,F,G]. 138 | private_6_yolo_UNSAFE_translate_exp(public_2_unaryop(A,B),C):-private_6_translateUnop(A,D),private_6_yolo_UNSAFE_translate_exp(B,E),C=..[D,E]. 139 | private_6_yolo_UNSAFE_translate_exp_lhs(public_2_lhs_var(A),B):-A=B. 140 | private_6_yolo_UNSAFE_translate_exp_lhs(public_2_lhs_num(A),B):-A=B. 141 | private_6_translateTerms(A,B):-public_0_map(A,lambda2_0,B). 142 | private_6_yolo_UNSAFE_translate_term(public_2_term_var(A),B):-A=B. 143 | private_6_yolo_UNSAFE_translate_term(public_2_term_num(A),B):-A=B. 144 | private_6_yolo_UNSAFE_translate_term(public_2_term_constructor(C,A),B):-private_6_translateTerms(A,D),B=..[C|D]. 145 | private_6_yolo_UNSAFE_translate_body(public_2_body_is(A,B),C):-private_6_yolo_UNSAFE_translate_exp_lhs(A,D),private_6_yolo_UNSAFE_translate_exp(B,E),C=..[is,D,E]. 146 | private_6_yolo_UNSAFE_translate_body(public_2_bodyComparison(A,C,B),D):-private_6_yolo_UNSAFE_translate_exp(A,F),private_6_yolo_UNSAFE_translate_exp(B,G),private_6_translateCompareOp(C,E),D=..[E,F,G]. 147 | private_6_yolo_UNSAFE_translate_body(public_2_bodyUnary(A,B),C):-private_6_translateBodyUnaryOp(A,D),private_6_yolo_UNSAFE_translate_body(B,E),C=..[D,E]. 148 | private_6_yolo_UNSAFE_translate_body(public_2_bodyPair(B,A,C),D):-private_6_translateBodyPairOp(A,E),private_6_yolo_UNSAFE_translate_body(B,F),private_6_yolo_UNSAFE_translate_body(C,G),D=..[E,F,G]. 149 | private_6_yolo_UNSAFE_translate_body(public_2_firstOrderCall(C,A),B):-private_6_translateTerms(A,D),B=..[C|D]. 150 | private_6_yolo_UNSAFE_translate_clause(public_2_clauseclause(C,A,B),F):-private_6_translateTerms(A,D),private_6_yolo_UNSAFE_translate_body(B,E),G=..[C|D], (E==true->F=G;F=..[:-,G,E]). 151 | public_6_writeTranslatedClauses(A,C):-public_0_map(A,lambda2_1,B),public_1_writeClauses(B,C). 152 | private_5_freshInt(A):-nb_getval(private_5_counter,A),B is A+1,nb_setval(private_5_counter,B). 153 | private_5_yolo_UNSAFE_call_lambda_label(B,A):-format(atom(A),'call_lambda~d',[B]). 154 | private_5_yolo_UNSAFE_fresh_lambda_label(B,A):-private_5_freshInt(C),format(atom(A),'lambda~d_~d',[B,C]). 155 | private_5_engineSetVarName(public_5_swipl,nb_setval). 156 | private_5_engineSetVarName(public_5_gnuprolog,g_assign). 157 | private_5_engineGetVarName(public_5_swipl,nb_getval). 158 | private_5_engineGetVarName(public_5_gnuprolog,g_read). 159 | private_5_yolo_UNSAFE_term_variables(A,B):-term_variables(A,B). 160 | private_5_translateMulti(_,[],[],[],A,A,_). 161 | private_5_translateMulti(B,[C|H],M,[D|I],E,K,A):-call_lambda6(A,B,C,F,D,E,J),public_0_setUnion(F,B,G),private_5_translateMulti(G,H,L,I,J,K,A),public_0_setUnion(F,L,M). 162 | private_5_translateTerms(A,B,C,D,E,F):-private_5_translateMulti(A,B,C,D,E,F,lambda6_2). 163 | private_5_translateBodies(A,B,C,D,E,F):-private_5_translateMulti(A,B,C,D,E,F,lambda6_3). 164 | private_5_translateBody(_,A,C,A,B,B):-A=public_2_body_is(_,_),!,private_5_yolo_UNSAFE_term_variables(A,C). 165 | private_5_translateBody(D,public_2_body_setvar(A,E),F,public_2_firstOrderCall(C,[public_2_term_constructor(A,[]),G]),H,I):-!,nb_getval(private_5_engine,B),private_5_engineSetVarName(B,C),private_5_translateTerm(D,E,F,G,H,I). 166 | private_5_translateBody(D,public_2_body_getvar(A,E),F,public_2_firstOrderCall(C,[public_2_term_constructor(A,[]),G]),H,I):-!,nb_getval(private_5_engine,B),private_5_engineGetVarName(B,C),private_5_translateTerm(D,E,F,G,H,I). 167 | private_5_translateBody(_,A,C,A,B,B):-A=public_2_bodyComparison(_,_,_),!,private_5_yolo_UNSAFE_term_variables(A,C). 168 | private_5_translateBody(B,public_2_bodyUnary(A,C),D,public_2_bodyUnary(A,E),F,G):-!,private_5_translateBody(B,C,D,E,F,G). 169 | private_5_translateBody(B,public_2_bodyPair(C,A,D),E,public_2_bodyPair(F,A,G),H,I):-!,private_5_translateBodies(B,[C,D],E,[F,G],H,I). 170 | private_5_translateBody(A,public_2_higherOrderCall(B,C),D,public_2_firstOrderCall(I,E),F,G):-!,private_5_translateTerms(A,[B|C],D,E,F,G),length(C,H),private_5_yolo_UNSAFE_call_lambda_label(H,I). 171 | private_5_translateBody(A,public_2_firstOrderCall(G,B),C,I,D,E):-!,nb_getval(private_5_engine,F),private_5_translateTerms(A,B,C,H,D,E),private_5_translateCall(F,G,H,I). 172 | private_5_translateCall(public_5_swipl,fd_labeling,A,public_2_firstOrderCall(label,A)):-!. 173 | private_5_translateCall(_,A,B,public_2_firstOrderCall(A,B)). 174 | private_5_translateTerm(_,public_2_term_var(A),[A],public_2_term_var(A),B,B):-!. 175 | private_5_translateTerm(_,public_2_term_num(A),[],public_2_term_num(A),B,B):-!. 176 | private_5_translateTerm(B,public_2_term_lambda(C,G),P,A,D,W):-A=public_2_term_constructor(J,Q),!,private_5_translateTerms(B,C,E,S,D,H),public_0_setUnion(B,E,F),private_5_translateBody(F,G,K,T,H,U),length(C,I),private_5_yolo_UNSAFE_fresh_lambda_label(I,J),public_0_setDifference(E,B,M),append(E,K,L),public_0_setDifference(L,M,N),public_0_filter(N,lambda1_4(B),O),public_0_makeSetFromList(O,P),public_0_map(P,lambda2_5,Q),private_5_yolo_UNSAFE_call_lambda_label(I,R),V=public_2_clauseclause(R,[A|S],T),U=[V|W]. 177 | private_5_translateTerm(B,public_2_term_constructor(A,C),D,public_2_term_constructor(A,E),F,G):-!,private_5_translateTerms(B,C,D,E,F,G). 178 | private_5_translateClause(public_2_clauseclause(A,B,F),public_2_clauseclause(A,C,G),D,I):-private_5_translateTerms([],B,E,C,D,H),private_5_translateBody(E,F,_,G,H,I). 179 | private_5_bodyDirectlyCalls(public_2_body_is(_,_),A,A). 180 | private_5_bodyDirectlyCalls(public_2_body_setvar(_,_),A,A). 181 | private_5_bodyDirectlyCalls(public_2_body_getvar(_,_),A,A). 182 | private_5_bodyDirectlyCalls(public_2_bodyComparison(_,_,_),A,A). 183 | private_5_bodyDirectlyCalls(public_2_bodyUnary(_,A),B,C):-private_5_bodyDirectlyCalls(A,B,C). 184 | private_5_bodyDirectlyCalls(public_2_bodyPair(A,_,C),B,E):-private_5_bodyDirectlyCalls(A,B,D),private_5_bodyDirectlyCalls(C,D,E). 185 | private_5_bodyDirectlyCalls(public_2_firstOrderCall(A,C),[public_0_pair(A,D)|B],B):-length(C,D). 186 | private_5_bodyDirectlyCalls(A,B):-private_5_bodyDirectlyCalls(A,B,[]). 187 | private_5_clauseNameArity(public_2_clauseclause(A,B,_),A,C):-length(B,C). 188 | private_5_callsUnknownLambda(A,B):-public_0_existsOnce(A,lambda1_6(B)). 189 | private_5_trimDeadClauses([],_,_,_,A,B):-reverse(A,B). 190 | private_5_trimDeadClauses([A|K],E,H,G,I,M):-private_5_clauseNameArity(A,B,C),D=public_0_pair(B,C),member(public_0_pair(D,F),E), ((public_0_setsOverlap(F,G);private_5_callsUnknownLambda(F,H))->reverse(I,J),append(J,K,L),private_5_trimDeadClauses(L,E,H,[D|G],[],M);private_5_trimDeadClauses(K,E,H,G,[A|I],M)). 191 | private_5_isCallLambda(A):-atom_codes(call_lambda,C),atom_codes(A,B),public_0_beginsWith(B,C). 192 | private_5_clauseCallsMapping(A,B):-public_0_map(A,lambda2_7,B). 193 | private_5_makeDirective(A,public_2_clauseclause(:-,[A],public_2_firstOrderCall(true,[]))). 194 | private_5_clpOperator(public_2_clp_lt). 195 | private_5_clpOperator(public_2_clp_lte). 196 | private_5_clpOperator(public_2_clp_gt). 197 | private_5_clpOperator(public_2_clp_gte). 198 | private_5_clpOperator(public_2_clp_eq). 199 | private_5_clpOperator(public_2_clp_neq). 200 | private_5_bodyUsesClp(public_2_bodyUnary(_,A)):-private_5_bodyUsesClp(A). 201 | private_5_bodyUsesClp(public_2_bodyPair(A,_,B)):- (private_5_bodyUsesClp(A);private_5_bodyUsesClp(B)),!. 202 | private_5_bodyUsesClp(public_2_bodyComparison(_,A,_)):-private_5_clpOperator(A). 203 | private_5_handleClp(public_5_swipl,A,B):-public_0_existsOnce(A,lambda1_8)->private_5_makeDirective(public_2_term_constructor(use_module,[public_2_term_constructor(library,[public_2_term_constructor(clpfd,[])])]),C),B=[C|A];A=B. 204 | private_5_handleClp(public_5_gnuprolog,A,A). 205 | private_5_trimDeadClauses(C,A,E):-public_0_flatMap(A,lambda2_9,B),public_0_makeSetFromList(B,D),private_5_trimDeadClauses(A,C,D,[],[],E). 206 | public_5_translateClauses(B,A,I):-nb_setval(private_5_counter,0),nb_setval(private_5_engine,A),public_0_foldLeft(B,public_0_pair(E,C),lambda3_10,public_0_pair([],[])),public_0_sortItems(C,lambda2_11,lambda2_12,D),append(D,E,F),private_5_clauseCallsMapping(F,G),private_5_trimDeadClauses(G,F,H),private_5_handleClp(A,H,I). 207 | private_4_builtinDataDefs([public_2_defdata(list,[A],[public_2_typeConstructor('.',[A,public_2_constructorType(list,[A])]),public_2_typeConstructor([],[])])]). 208 | private_4_builtinClauseDefs([public_2_defclause(true,[],[]),public_2_defclause(false,[],[]),public_2_defclause(fail,[],[]),public_2_defclause(!,[],[]),public_2_defclause(var,[A],[A]),public_2_defclause(nonvar,[A],[A]),public_2_defclause(ground,[A],[A]),public_2_defclause(@>,[A],[A,A]),public_2_defclause(@<,[A],[A,A]),public_2_defclause(@=<,[A],[A,A]),public_2_defclause(@>=,[A],[A,A]),public_2_defclause(=,[A],[A,A]),public_2_defclause(unify_with_occurs_check,[A],[A,A]),public_2_defclause(\=,[A],[A,A]),public_2_defclause(fd_labeling,[],[public_2_constructorType(list,[public_2_intType])]),public_2_defclause(==,[A],[A,A]),public_2_defclause(\==,[A],[A,A]),public_2_defclause(is_set,[A],[public_2_constructorType(list,[A])]),public_2_defclause(member,[A],[A,public_2_constructorType(list,[A])]),public_2_defclause(reverse,[A],[public_2_constructorType(list,[A]),public_2_constructorType(list,[A])]),public_2_defclause(copy_term,[A],[A,A]),public_2_defclause(append,[A],[public_2_constructorType(list,[A]),public_2_constructorType(list,[A]),public_2_constructorType(list,[A])]),public_2_defclause(length,[A],[public_2_constructorType(list,[A]),public_2_intType]),public_2_defclause(atom_codes,[],[public_2_atomType,public_2_constructorType(list,[public_2_intType])]),public_2_defclause(atom_number,[],[public_2_atomType,public_2_intType]),public_2_defclause(atom_concat,[],[public_2_atomType,public_2_atomType,public_2_atomType])]). 209 | private_4_keys(A,B):-public_0_map(A,lambda2_13,B). 210 | private_4_ensureUnique(A,C):-public_0_duplicates(A,B),public_0_onFailure(lambda0_14(B),lambda0_15(B,C)). 211 | private_4_mappingUnique(A,C):-private_4_keys(A,B),private_4_ensureUnique(B,C). 212 | private_4_constructorToDataDefMapping(A,B):-public_0_flatMap(A,lambda2_17,B),private_4_mappingUnique(B,'Duplicate locally-defined constructor names: ~w~n~n'). 213 | private_4_clauseToClauseDefMapping(A,B):-public_0_map(A,lambda2_18,B),private_4_mappingUnique(B,'Duplicate clausedefs for: ~w~n~n'). 214 | private_4_ensureTypeNamesUnique(A):-public_0_map(A,lambda2_19,B),private_4_ensureUnique(B,'Duplicate type names: ~w~n~n'). 215 | private_4_makeState(B,D,A,private_4_state(C,E,A)):-private_4_ensureTypeNamesUnique(B),private_4_constructorToDataDefMapping(B,C),private_4_clauseToClauseDefMapping(D,E). 216 | private_4_expectedFormalParamTypes(private_4_state(_,C,_),A,B,E,F):-member(public_0_pair(public_0_pair(A,B),D),C),copy_term(D,public_2_defclause(_,E,F)). 217 | private_4_expectedFormalParamTypes(A,B,C,D):-private_4_expectedFormalParamTypes(A,B,C,_,D). 218 | private_4_envVariableType(A,B,D,F):-public_0_find(A,lambda1_20(B),C),!, (C=public_0_some(public_0_pair(_,E))->D=E,A=F;F=[public_0_pair(B,D)|A]). 219 | private_4_typecheckLhs(A,public_2_lhs_num(_),A):-!. 220 | private_4_typecheckLhs(A,public_2_lhs_var(B),C):-!,private_4_envVariableType(A,B,public_2_intType,C). 221 | private_4_typecheckExp(A,public_2_exp_var(B),C):-!,private_4_envVariableType(A,B,public_2_intType,C). 222 | private_4_typecheckExp(A,public_2_exp_num(_),A):-!. 223 | private_4_typecheckExp(A,public_2_binop(B,_,D),E):-!,private_4_typecheckExp(A,B,C),!,private_4_typecheckExp(C,D,E). 224 | private_4_typecheckExp(A,public_2_unaryop(_,B),C):-!,private_4_typecheckExp(A,B,C). 225 | private_4_typecheckVarUse(A,D,B,E,G):-A=private_4_state(_,_,C),member(public_2_defglobalvar(B,_,F),C),private_4_typeofTerm(A,D,E,F,G). 226 | private_4_typecheckBody(D,A,C,B):-public_0_onFailure(lambda0_21(A,B,C,D),lambda0_22(C)). 227 | private_4_rawTypecheckBody(_,A,public_2_body_is(B,D),E):-!,private_4_typecheckLhs(A,B,C),!,private_4_typecheckExp(C,D,E),!. 228 | private_4_rawTypecheckBody(_,A,public_2_bodyComparison(B,_,D),E):-!,private_4_typecheckExp(A,B,C),!,private_4_typecheckExp(C,D,E),!. 229 | private_4_rawTypecheckBody(A,B,public_2_body_setvar(C,D),E):-!,private_4_typecheckVarUse(A,B,C,D,E),!. 230 | private_4_rawTypecheckBody(A,B,public_2_body_getvar(C,D),E):-!,private_4_typecheckVarUse(A,B,C,D,E),!. 231 | private_4_rawTypecheckBody(A,B,public_2_bodyUnary(_,C),D):-!,private_4_typecheckBody(A,B,C,D),!. 232 | private_4_rawTypecheckBody(A,B,public_2_bodyPair(C,_,E),F):-!,private_4_typecheckBody(A,B,C,D),!,private_4_typecheckBody(A,D,E,F),!. 233 | private_4_rawTypecheckBody(A,B,public_2_higherOrderCall(C,E),G):-!,private_4_typeofTerm(A,B,C,public_2_relationType(F),D),!,private_4_typeofTerms(A,D,E,F,G),!. 234 | private_4_rawTypecheckBody(E,F,public_2_firstOrderCall(B,A),G):-length(A,D),C=_,public_0_onFailure(lambda0_23(B,C,D,E),lambda0_24(B,D)),private_4_typeofTerms(E,F,A,C,G),!. 235 | private_4_typeofTerm(E,A,D,B,C):-public_0_onFailure(lambda0_25(A,B,C,D,E),lambda0_28(A,E,B,D)). 236 | private_4_rawTypeofTerm(_,A,public_2_term_var(B),C,D):-private_4_envVariableType(A,B,C,D). 237 | private_4_rawTypeofTerm(_,A,public_2_term_num(_),public_2_intType,A). 238 | private_4_rawTypeofTerm(B,A,public_2_term_lambda(C,F),public_2_relationType(D),A):-!,private_4_typeofTerms(B,A,C,D,E),private_4_typecheckBody(B,E,F,_). 239 | private_4_rawTypeofTerm(A,H,public_2_term_constructor(B,I),public_2_constructorType(E,F),K):-A=private_4_state(C,_,_),member(public_0_pair(B,D),C),copy_term(D,public_2_defdata(E,F,G)),member(public_2_typeConstructor(B,J),G),!,private_4_typeofTerms(A,H,I,J,K),!. 240 | private_4_rawTypeofTerm(_,A,public_2_term_constructor(_,[]),public_2_atomType,A). 241 | private_4_typeofTerms(E,D,A,B,F):-public_0_zip(A,B,C),public_0_foldLeft(C,D,lambda3_29(E),F),!. 242 | private_4_markedUnsafe(A):-public_0_atomContains(A,yolo_UNSAFE_). 243 | private_4_typecheckClauseWithErrorMessage(B,A):-public_0_onFailure(lambda0_30(A,B),lambda0_31(A)). 244 | private_4_typecheckClause(B,public_2_clauseclause(C,A,H)):-length(A,D),private_4_expectedFormalParamTypes(B,C,D,E,F),public_0_foldLeft(E,0,lambda3_32,_),private_4_typeofTerms(B,[],A,F,G), (private_4_markedUnsafe(C)->true;private_4_typecheckBody(B,G,H,_)),!. 245 | public_4_typecheckClauses(B,D,G,H):-private_4_builtinDataDefs(A),private_4_builtinClauseDefs(C),append(A,B,E),append(C,D,F),private_4_makeState(E,F,G,I),public_0_forall(H,lambda1_33(I)). 246 | private_3_yolo_UNSAFE_mangled_name(A,D,E,C):- (A==private_3_mod_public->B= (public);B=private),format(atom(C),'~a_~d_~a',[B,D,E]). 247 | private_3_freshModuleId(A):-nb_getval(private_3_counter,A),B is A+1,nb_setval(private_3_counter,B). 248 | private_3_yolo_UNSAFE_absolute_file_name(A,C,B):-absolute_file_name(A,B,[relative_to(C)]),public_0_onFailure(lambda0_34(B),lambda0_35(B)). 249 | private_3_constructorsInDataDefs(A,B):-public_0_flatMap(A,lambda2_37,B). 250 | private_3_allImportedConstructors(B,A,C):-public_0_flatMap(A,lambda2_38(B),C). 251 | private_3_extractConstructors(private_3_loadedModule(_,_,_,A),B,H):-A=public_2_loadedFile(public_2_defmodule(E,_,C),_,F,_,_,_),public_0_filter(B,lambda1_39(C),D),public_0_onFailure(lambda0_40(D),lambda0_41(D,E)),public_0_map(B,lambda2_42(F),G),private_3_constructorsInDataDefs(G,H). 252 | private_3_nonexistentExports(public_2_loadedFile(public_2_defmodule(_,A,D),_,E,B,_,_),C,F):-public_0_filter(A,lambda1_44(B),C),public_0_filter(D,lambda1_46(E),F). 253 | private_3_ensureEverythingExportedIsDefined(D,A):-private_3_nonexistentExports(A,C,B),public_0_onFailure(lambda0_47(B,C),lambda0_48(B,C,D)). 254 | private_3_directLoadModule(A,D,F,[private_3_loadedModule(A,L,E,B)|G]):-public_2_loadFile(A,B),B=public_2_loadedFile(_,C,H,_,_,_),private_3_ensureEverythingExportedIsDefined(A,B),public_0_foldLeft(C,public_0_pair(D,E),lambda3_49(F,A),public_0_pair(G,[])),private_3_allImportedConstructors(G,E,I),private_3_constructorsInDataDefs(H,J),append(I,J,K),public_0_onFailure(lambda0_50(K),lambda0_51(K)),private_3_freshModuleId(L). 255 | private_3_renamedClause(private_3_renaming(D,_,_,_),A,B,C):-member(public_0_pair(public_0_pair(A,B),C),D),!. 256 | private_3_renamedClause(_,A,_,A). 257 | private_3_renamedType(private_3_renaming(_,C,_,_),A,B):-member(public_0_pair(A,B),C),!. 258 | private_3_renamedType(_,A,A). 259 | private_3_renamedConstructor(private_3_renaming(_,_,C,_),A,B):-member(public_0_pair(A,B),C),!. 260 | private_3_renamedConstructor(_,A,A). 261 | private_3_renamedGlobalVariable(private_3_renaming(_,_,_,C),A,B):-member(public_0_pair(A,B),C),!. 262 | private_3_renamedGlobalVariable(_,A,A). 263 | private_3_makeRenaming(C,private_3_loadedModule(_,E,B,A),private_3_renaming(M,P,S,J)):-A=public_2_loadedFile(public_2_defmodule(_,F,H),_,G,D,I,_),public_0_foldRight(B,public_0_tup3([],[],[]),lambda3_55(C),public_0_tup3(L,O,R)),public_0_map(D,lambda2_56(E,F),K),public_0_foldRight(G,public_0_pair([],[]),lambda3_58(E,H),public_0_pair(N,Q)),public_0_map(I,lambda2_59(E),J),append(K,L,M),append(N,O,P),append(Q,R,S). 264 | private_3_loadModule(A,C,B,D):-public_0_notMember(A,B), (member(private_3_loadedModule(A,_,_,_),C)->D=C;private_3_directLoadModule(A,C,[A|B],D)). 265 | private_3_translateVarUse(A,B,D,C,E):-private_3_renamedGlobalVariable(A,B,C),private_3_translateTerm(A,D,E). 266 | private_3_translateBody(_,public_2_body_is(A,B),public_2_body_is(A,B)). 267 | private_3_translateBody(_,public_2_bodyComparison(A,B,C),public_2_bodyComparison(A,B,C)). 268 | private_3_translateBody(A,public_2_body_setvar(B,C),public_2_body_setvar(D,E)):-private_3_translateVarUse(A,B,C,D,E). 269 | private_3_translateBody(A,public_2_body_getvar(B,C),public_2_body_getvar(D,E)):-private_3_translateVarUse(A,B,C,D,E). 270 | private_3_translateBody(B,public_2_bodyUnary(A,C),public_2_bodyUnary(A,D)):-private_3_translateBody(B,C,D). 271 | private_3_translateBody(B,public_2_bodyPair(C,A,E),public_2_bodyPair(D,A,F)):-private_3_translateBody(B,C,D),private_3_translateBody(B,E,F). 272 | private_3_translateBody(A,public_2_higherOrderCall(B,D),public_2_higherOrderCall(C,E)):-private_3_translateTerm(A,B,C),private_3_translateTerms(A,D,E). 273 | private_3_translateBody(B,public_2_firstOrderCall(C,A),public_2_firstOrderCall(E,F)):-length(A,D),private_3_renamedClause(B,C,D,E),private_3_translateTerms(B,A,F). 274 | private_3_translateTerms(B,A,C):-public_0_map(A,lambda2_60(B),C). 275 | private_3_translateTerm(_,public_2_term_var(A),public_2_term_var(A)). 276 | private_3_translateTerm(_,public_2_term_num(A),public_2_term_num(A)). 277 | private_3_translateTerm(A,public_2_term_lambda(B,D),public_2_term_lambda(C,E)):-private_3_translateTerms(A,B,C),private_3_translateBody(A,D,E). 278 | private_3_translateTerm(A,public_2_term_constructor(B,D),public_2_term_constructor(C,E)):-private_3_renamedConstructor(A,B,C),private_3_translateTerms(A,D,E). 279 | private_3_translateTypes(B,A,C):-public_0_map(A,lambda2_61(B),C). 280 | private_3_translateType(_,A,B):-var(A),!,A=B. 281 | private_3_translateType(_,public_2_intType,public_2_intType):-!. 282 | private_3_translateType(_,public_2_atomType,public_2_atomType):-!. 283 | private_3_translateType(A,public_2_relationType(B),public_2_relationType(C)):-!,private_3_translateTypes(A,B,C). 284 | private_3_translateType(A,public_2_constructorType(B,D),public_2_constructorType(C,E)):-!,private_3_renamedType(A,B,C),private_3_translateTypes(A,D,E). 285 | private_3_translateDataDef(B,public_2_defdata(C,A,E),public_2_defdata(D,A,F)):-private_3_renamedType(B,C,D),public_0_map(E,lambda2_62(B),F). 286 | private_3_translateLoadedFile(B,public_2_loadedFile(_,_,A,F,J,N),D,E,H,I,L,M,P,Q):-public_0_map(A,lambda2_63(B),C),public_0_appendDiffList(C,D,E),public_0_map(F,lambda2_64(B),G),public_0_appendDiffList(G,H,I),public_0_map(J,lambda2_65(B),K),public_0_appendDiffList(K,L,M),public_0_map(N,lambda2_66(B),O),public_0_appendDiffList(O,P,Q). 287 | private_3_translateModule(B,A,E,F,G,H,I,J,K,L):-A=private_3_loadedModule(_,_,_,D),private_3_makeRenaming(B,A,C),private_3_translateLoadedFile(C,D,E,F,G,H,I,J,K,L),!. 288 | public_3_handleModules(A,D,E,F,G):-nb_setval(private_3_counter,0),private_3_yolo_UNSAFE_absolute_file_name(A,./,B),private_3_directLoadModule(B,[],[B],C),!,public_0_foldLeft(C,public_0_tup4(D,E,F,G),lambda3_67(C),public_0_tup4([],[],[],[])). 289 | private_2_yolo_UNSAFE_translate_pairs(A,B):-public_0_map(A,lambda2_68,B). 290 | private_2_areTypeVars(A):-public_0_forall(A,lambda1_69),is_set(A). 291 | private_2_yolo_UNSAFE_allAtoms(A):-public_0_forall(A,lambda1_70). 292 | private_2_yolo_UNSAFE_translate_exp_lhs(A,public_2_lhs_var(B)):-var(A),!,A=B. 293 | private_2_yolo_UNSAFE_translate_exp_lhs(A,public_2_lhs_num(B)):-number(A),!,A=B. 294 | private_2_yolo_UNSAFE_translate_op(A,public_2_plus):-A= (+),!. 295 | private_2_yolo_UNSAFE_translate_op(A,public_2_minus):-A= (-),!. 296 | private_2_yolo_UNSAFE_translate_op(A,public_2_mul):-A= (*),!. 297 | private_2_yolo_UNSAFE_translate_op(A,public_2_div):-A= (/),!. 298 | private_2_yolo_UNSAFE_translate_op(A,public_2_op_min):-A=min,!. 299 | private_2_yolo_UNSAFE_translate_op(A,public_2_op_max):-A=max,!. 300 | private_2_yolo_UNSAFE_translate_op(A,public_2_shift_left):-A= (<<),!. 301 | private_2_yolo_UNSAFE_translate_op(A,public_2_shift_right):-A= (>>),!. 302 | private_2_yolo_UNSAFE_translate_op(A,public_2_bitwise_and):-A= (/\),!. 303 | private_2_yolo_UNSAFE_translate_op(A,public_2_bitwise_or):-A= (\/),!. 304 | private_2_yolo_UNSAFE_translate_op(A,public_2_int_div):-A= (//),!. 305 | private_2_yolo_UNSAFE_translate_op(A,public_2_int_rem):-A= (rem),!. 306 | private_2_yolo_UNSAFE_translate_op(A,public_2_int_mod):-A= (mod),!. 307 | private_2_yolo_UNSAFE_translate_op(A,public_2_op_exponent):-A= (^),!. 308 | private_2_yolo_UNSAFE_translate_unop(A,public_2_op_msb):-A=msb,!. 309 | private_2_yolo_UNSAFE_translate_unop(A,public_2_op_abs):-A=abs,!. 310 | private_2_yolo_UNSAFE_translate_unop(A,public_2_op_truncate):-A=truncate,!. 311 | private_2_yolo_UNSAFE_translate_exp(A,public_2_exp_var(B)):-var(A),!,A=B. 312 | private_2_yolo_UNSAFE_translate_exp(A,public_2_exp_num(B)):-number(A),!,A=B. 313 | private_2_yolo_UNSAFE_translate_exp(A,public_2_binop(E,C,G)):-A=..[B,D,F],!,private_2_yolo_UNSAFE_translate_op(B,C),private_2_yolo_UNSAFE_translate_exp(D,E),private_2_yolo_UNSAFE_translate_exp(F,G). 314 | private_2_yolo_UNSAFE_translate_exp(A,public_2_unaryop(C,E)):-A=..[B,D],!,private_2_yolo_UNSAFE_translate_unop(B,C),private_2_yolo_UNSAFE_translate_exp(D,E). 315 | private_2_yolo_UNSAFE_translate_body_pair_op(A,public_2_and):-A= (','),!. 316 | private_2_yolo_UNSAFE_translate_body_pair_op(A,public_2_or):-A= (;),!. 317 | private_2_yolo_UNSAFE_translate_body_pair_op(A,public_2_implies):-A= (->),!. 318 | private_2_yolo_UNSAFE_translate_unary_body_op(A,public_2_not):-A= (\+),!. 319 | private_2_yolo_UNSAFE_translate_compare_op(A,public_2_lt):-A= (<),!. 320 | private_2_yolo_UNSAFE_translate_compare_op(A,public_2_lte):-A= (=<),!. 321 | private_2_yolo_UNSAFE_translate_compare_op(A,public_2_gt):-A= (>),!. 322 | private_2_yolo_UNSAFE_translate_compare_op(A,public_2_gte):-A= (>=),!. 323 | private_2_yolo_UNSAFE_translate_compare_op(A,public_2_clp_lt):-A= (#<),!. 324 | private_2_yolo_UNSAFE_translate_compare_op(A,public_2_clp_lte):-A= (#=<),!. 325 | private_2_yolo_UNSAFE_translate_compare_op(A,public_2_clp_gt):-A= (#>),!. 326 | private_2_yolo_UNSAFE_translate_compare_op(A,public_2_clp_gte):-A= (#>=),!. 327 | private_2_yolo_UNSAFE_translate_compare_op(A,public_2_clp_eq):-A= (#=),!. 328 | private_2_yolo_UNSAFE_translate_compare_op(A,public_2_clp_neq):-A= (#\=),!. 329 | private_2_translateBody(B,A):-public_0_onFailure(lambda0_71(A,B),lambda0_72(B)). 330 | private_2_yolo_UNSAFE_translate_body(A,public_2_body_is(C,E)):-A= (B is D),!,private_2_yolo_UNSAFE_translate_exp_lhs(B,C),private_2_yolo_UNSAFE_translate_exp(D,E). 331 | private_2_yolo_UNSAFE_translate_body(A,public_2_bodyComparison(E,C,G)):-A=..[B,D,F],private_2_yolo_UNSAFE_translate_compare_op(B,C),!,private_2_yolo_UNSAFE_translate_exp(D,E),private_2_yolo_UNSAFE_translate_exp(F,G). 332 | private_2_yolo_UNSAFE_translate_body(A,public_2_body_setvar(B,D)):-A=setvar(B,C),!,atom(B),private_2_translateTerm(C,D). 333 | private_2_yolo_UNSAFE_translate_body(A,public_2_body_getvar(B,D)):-A=getvar(B,C),!,atom(B),private_2_translateTerm(C,D). 334 | private_2_yolo_UNSAFE_translate_body(A,public_2_bodyUnary(C,E)):-A=..[B,D],private_2_yolo_UNSAFE_translate_unary_body_op(B,C),!,private_2_translateBody(D,E). 335 | private_2_yolo_UNSAFE_translate_body(A,public_2_bodyPair(E,C,G)):-A=..[B,D,F],private_2_yolo_UNSAFE_translate_body_pair_op(B,C),!,private_2_translateBody(D,E),private_2_translateBody(F,G). 336 | private_2_yolo_UNSAFE_translate_body(A,public_2_higherOrderCall(C,E)):-A=..[call,B|D],!,private_2_translateTerm(B,C),private_2_translateTerms(D,E). 337 | private_2_yolo_UNSAFE_translate_body(A,public_2_firstOrderCall(B,D)):-A=..[B|C],!,private_2_translateTerms(C,D). 338 | private_2_translateTerms(A,B):-public_0_map(A,lambda2_73,B). 339 | private_2_translateTerm(B,A):-public_0_onFailure(lambda0_74(A,B),lambda0_75(B)). 340 | private_2_yolo_UNSAFE_translate_term(A,public_2_term_var(B)):-var(A),!,A=B. 341 | private_2_yolo_UNSAFE_translate_term(A,public_2_term_num(B)):-number(A),!,A=B. 342 | private_2_yolo_UNSAFE_translate_term(A,public_2_term_lambda(C,E)):-A=..[lambda,B,D],!,private_2_translateTerms(B,C),private_2_translateBody(D,E). 343 | private_2_yolo_UNSAFE_translate_term(A,public_2_term_constructor(B,D)):-A=..[B|C],private_2_translateTerms(C,D). 344 | private_2_yolo_UNSAFE_normalize_clause(A,A):-A= (_:-_),!. 345 | private_2_yolo_UNSAFE_normalize_clause(B,A):-A= (B:-true). 346 | private_2_translateTypes(B,A,C):-public_0_map(A,lambda2_76(B),C). 347 | private_2_yolo_UNSAFE_translate_type(B,A,C):-var(A),!,public_0_setContains(B,A),A=C. 348 | private_2_yolo_UNSAFE_translate_type(_,A,public_2_intType):-A=int,!. 349 | private_2_yolo_UNSAFE_translate_type(_,A,public_2_atomType):-A=atom,!. 350 | private_2_yolo_UNSAFE_translate_type(B,A,public_2_relationType(D)):-A=relation(C),!,private_2_translateTypes(B,C,D). 351 | private_2_yolo_UNSAFE_translate_type(C,A,public_2_constructorType(B,E)):-A=..[B|D],!,private_2_translateTypes(C,D,E). 352 | private_2_translateType(C,A,B):-public_0_onFailure(lambda0_77(A,B,C),lambda0_78(A)). 353 | private_2_translateClause(B,A):-public_0_onFailure(lambda0_79(A,B),lambda0_80(B)). 354 | private_2_yolo_UNSAFE_translate_clause(A,private_2_readDefModule(public_2_defmodule(B,E,C))):-A=module(B,D,C),!,atom(B),private_2_yolo_UNSAFE_translate_pairs(D,E),private_2_yolo_UNSAFE_allAtoms(C). 355 | private_2_yolo_UNSAFE_translate_clause(A,private_2_readDefUseModule(public_2_def_use_module(B,E,C))):-A=use_module(B,D,C),!,atom(B),private_2_yolo_UNSAFE_translate_pairs(D,E),private_2_yolo_UNSAFE_allAtoms(C). 356 | private_2_yolo_UNSAFE_translate_clause(A,private_2_readDefData(public_2_defdata(B,C,E))):-A=datadef(B,C,D),!,atom(B),private_2_areTypeVars(C),public_0_map(D,lambda2_81(C),E). 357 | private_2_yolo_UNSAFE_translate_clause(A,private_2_readDefClause(public_2_defclause(B,C,E))):-A=clausedef(B,C,D),!,atom(B),private_2_areTypeVars(C),private_2_translateTypes(C,D,E). 358 | private_2_yolo_UNSAFE_translate_clause(A,private_2_readDefGlobalVar(public_2_defglobalvar(B,C,E))):-A=globalvardef(B,C,D),!,atom(B),private_2_areTypeVars(C),private_2_translateType(C,D,E). 359 | private_2_yolo_UNSAFE_translate_clause(A,private_2_readClauseClause(public_2_clauseclause(C,E,G))):-private_2_yolo_UNSAFE_normalize_clause(A, (B:-F)),B=..[C|D],private_2_translateTerms(D,E),private_2_translateBody(F,G). 360 | private_2_sortClause(private_2_readDefModule(A),[A|B],B,C,C,D,D,E,E,F,F,G,G). 361 | private_2_sortClause(private_2_readDefUseModule(B),A,A,[B|C],C,D,D,E,E,F,F,G,G). 362 | private_2_sortClause(private_2_readDefData(C),A,A,B,B,[C|D],D,E,E,F,F,G,G). 363 | private_2_sortClause(private_2_readDefClause(D),A,A,B,B,C,C,[D|E],E,F,F,G,G). 364 | private_2_sortClause(private_2_readDefGlobalVar(E),A,A,B,B,C,C,D,D,[E|F],F,G,G). 365 | private_2_sortClause(private_2_readClauseClause(F),A,A,B,B,C,C,D,D,E,E,[F|G],G). 366 | private_2_sortClauses([],A,A,B,B,C,C,D,D,E,E,F,F). 367 | private_2_sortClauses([A|H],B,J,C,L,D,N,E,P,F,R,G,T):-private_2_sortClause(A,B,I,C,K,D,M,E,O,F,Q,G,S),private_2_sortClauses(H,I,J,K,L,M,N,O,P,Q,R,S,T). 368 | public_2_loadFile(A,public_2_loadedFile(C,D,E,F,G,H)):-public_1_read_clauses_from_file(A,lambda2_82,B),private_2_sortClauses(B,[C],[],D,[],E,[],F,[],G,[],H,[]). 369 | private_1_yolo_UNSAFE_translate_mode(private_1_read_mode,A):-A=read,!. 370 | private_1_yolo_UNSAFE_translate_mode(private_1_write_mode,A):-A=write,!. 371 | private_1_yolo_UNSAFE_open_file(B,A,private_1_stream(D)):-private_1_yolo_UNSAFE_translate_mode(A,C),open(B,C,D). 372 | private_1_yolo_UNSAFE_close_file(private_1_stream(A)):-close(A). 373 | private_1_withOpenStream(A,B,C):-private_1_yolo_UNSAFE_open_file(A,B,D), (call_lambda1(C,D),private_1_yolo_UNSAFE_close_file(D),!;private_1_yolo_UNSAFE_close_file(D),fail). 374 | private_1_yolo_UNSAFE_read_clause(private_1_stream(A),D,C):-read_clause(A,B,[]), (B==end_of_file->C=public_0_none;call_lambda2(D,B,E),C=public_0_some(E)). 375 | private_1_read_clauses_from_stream(B,C,D):-A=lambda1_83(A,B,C),call_lambda1(A,D). 376 | public_1_read_clauses_from_file(A,B,C):-private_1_withOpenStream(A,private_1_read_mode,lambda1_84(B,C)). 377 | private_1_yolo_UNSAFE_write_clause(A,private_1_stream(C)):-copy_term(A,B),numbervars(B,0,_,[singletons(true)]),write_term(C,B,[numbervars(true),quoted(true)]),format(C,' .~n',[]). 378 | public_1_writeClauses(B,A):-private_1_withOpenStream(A,private_1_write_mode,lambda1_86(B)). 379 | public_0_map([],_,[]). 380 | public_0_map([B|D],A,[C|E]):-call_lambda2(A,B,C),public_0_map(D,A,E). 381 | public_0_flatMap(A,B,C):-public_0_foldRight(A,[],lambda3_87(B),C). 382 | public_0_filter([],_,[]). 383 | public_0_filter([B|E],A,C):- (call_lambda1(A,B)->C=[B|D];C=D),public_0_filter(E,A,D). 384 | public_0_foldRight([],A,_,A). 385 | public_0_foldRight([D|A],B,C,F):-public_0_foldRight(A,B,C,E),call_lambda3(C,D,E,F). 386 | public_0_foldLeft([],A,_,A). 387 | public_0_foldLeft([C|D],B,A,F):-call_lambda3(A,B,C,E),public_0_foldLeft(D,E,A,F). 388 | public_0_forall([],_). 389 | public_0_forall([B|C],A):-call_lambda1(A,B),public_0_forall(C,A). 390 | public_0_exists(A,B):-public_0_find(A,B,public_0_some(_)). 391 | public_0_existsOnce(A,B):-private_0_findOnce(A,B,public_0_some(_)). 392 | public_0_zip([],[],[]). 393 | public_0_zip([A|C],[B|D],[public_0_pair(A,B)|E]):-public_0_zip(C,D,E). 394 | public_0_setContains([A|_],B):-A==B. 395 | public_0_setContains([_|A],B):-public_0_setContains(A,B). 396 | public_0_setsOverlap(A,B):-public_0_existsOnce(A,lambda1_88(B)). 397 | public_0_find([],_,public_0_none). 398 | public_0_find([A|_],B,public_0_some(A)):-call_lambda1(B,A). 399 | public_0_find([_|A],B,C):-public_0_find(A,B,C). 400 | private_0_findOnce(C,A,B):-public_0_once(lambda0_89(A,B,C)). 401 | public_0_once(A):-call_lambda0(A),!. 402 | public_0_beginsWith(_,[]). 403 | public_0_beginsWith([A|B],[A|C]):-public_0_beginsWith(B,C). 404 | public_0_contains(A,B):-public_0_beginsWith(A,B). 405 | public_0_contains([_|A],B):-public_0_contains(A,B). 406 | public_0_notMember(B,A):-public_0_forall(A,lambda1_90(B)). 407 | public_0_atomContains(A,B):-atom_codes(A,C),atom_codes(B,D),public_0_contains(C,D). 408 | public_0_appendDiffList([],A,A). 409 | public_0_appendDiffList([A|B],[A|C],D):-public_0_appendDiffList(B,C,D). 410 | public_0_makeSetFromList(A,B):-public_0_foldLeft(A,[],lambda3_91,B). 411 | public_0_setUnion(A,B,D):-append(A,B,C),public_0_makeSetFromList(C,D). 412 | public_0_setDifference(A,B,C):-public_0_foldLeft(A,[],lambda3_92(B),C). 413 | private_0_insertItem([],_,A,[A]):-!. 414 | private_0_insertItem([A|D],B,C,[A|E]):-call_lambda2(B,C,A),private_0_insertItem(D,B,C,E),!. 415 | private_0_insertItem([B|C],_,A,[A,B|C]). 416 | public_0_sortItems(A,B,C,G):-public_0_map(A,lambda2_93(B),D),E=lambda2_94(C),public_0_foldLeft(D,[],lambda3_95(E),F),public_0_map(F,lambda2_96,G). 417 | public_0_onFailure(A,_):-call_lambda0(A),!. 418 | public_0_onFailure(_,A):-call_lambda0(A),!,fail. 419 | public_0_yolo_UNSAFE_format_shim(A,B):-format(A,B). 420 | public_0_duplicates(A,B):-public_0_foldLeft(A,public_0_pair([],[]),lambda3_97,public_0_pair(_,B)). 421 | --------------------------------------------------------------------------------