├── Emakefile ├── rebar.config ├── .gitignore ├── test ├── erlog_halt_tests.erl ├── erlog_test.hrl └── records_test.erl ├── examples ├── test.pl ├── timer.pl ├── et.pl ├── listing.pl ├── family.pl ├── fleck.pl ├── t1.pl ├── homer.pl └── trees.pl ├── .travis.yml ├── ebin └── erlog.app ├── bin └── erlog ├── src ├── erlog.app.src ├── ChangeLog ├── erlog_boot.erl ├── erlog_int.hrl ├── Elixir.Erlog.erl ├── erlog_demo.erl ├── erlog_file.erl ├── erlog_shell.erl ├── erlog_server.erl ├── erlog_db_dict.erl ├── erlog_db_ets.erl ├── erlog_scan.xrl ├── erlog.erl ├── erlog_ets.erl ├── erlog_lib_dcg.erl ├── erlog_lib_lists.erl ├── erlog_io.erl ├── erlog_parse.erl └── erlog_bips.erl ├── doc ├── erlog_shell.txt ├── erlog_io.txt ├── erlog_ets.txt ├── erlog_server.txt ├── erlog.txt └── user_guide.txt ├── stdlib └── erlang.pl ├── Makefile ├── include └── erlog_assert.hrl ├── get_comp_opts.escript ├── rebar.config.script ├── README.md └── LICENSE /Emakefile: -------------------------------------------------------------------------------- 1 | %% -*- erlang -*- 2 | 3 | {'src/*',[{outdir,ebin}]}. 4 | -------------------------------------------------------------------------------- /rebar.config: -------------------------------------------------------------------------------- 1 | % -*- mode: erlang -*- 2 | 3 | {erl_opts, [debug_info]}. 4 | {cover_enabled, true}. 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.beam 2 | *.o 3 | *~ 4 | .DS_Store 5 | .rebar 6 | .rebar3 7 | _build/ 8 | comp_opts.mk 9 | erl_crash.dump 10 | -------------------------------------------------------------------------------- /test/erlog_halt_tests.erl: -------------------------------------------------------------------------------- 1 | -module(erlog_halt_tests). 2 | -include_lib("eqc/include/eqc.hrl"). 3 | -include_lib("eunit/include/eunit.hrl"). 4 | -compile(export_all). 5 | 6 | erlog_halt_test() -> 7 | {Pid,Ref} = spawn_monitor(fun() -> 8 | {ok,Erlog} = erlog:new(), 9 | erlog:prove({halt, test}, Erlog), 10 | timer:sleep(300), 11 | ok 12 | end), 13 | receive 14 | {'DOWN', Ref, process, Pid, R} -> 15 | ?assertEqual(test, R), 16 | ok 17 | after 20 -> 18 | ?debugVal("No Halt"), 19 | ?assert(false) 20 | end. 21 | -------------------------------------------------------------------------------- /examples/test.pl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: prolog -*- 2 | 3 | :- dynamic(a/0). 4 | %:- dynamic b/0. 5 | %:- dynamic c/0. 6 | %:- dynamic d/0. 7 | 8 | a :- write(a(1)), nl. 9 | a :- write(a(2)), nl. 10 | a :- write(a(3)), nl. 11 | 12 | b :- write(b(1)), nl. 13 | b :- write(b(2)), nl. 14 | b :- write(b(3)), nl. 15 | 16 | c :- write(c(1)), nl. 17 | c :- write(c(2)), nl. 18 | c :- write(c(3)), nl. 19 | 20 | d :- write(d(1)), nl. 21 | 22 | t1 :- a, !, b , c. 23 | t1 :- d. 24 | 25 | t2 :- (a, b; c). 26 | t2 :- d. 27 | 28 | t3 :- (a, !, b; c). 29 | t3 :- d. 30 | 31 | t4 :- (a ; b, c). 32 | t4 :- d. 33 | 34 | t5 :- (a ; b, !, c). 35 | t5 :- d. 36 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: erlang 2 | 3 | notifications: 4 | disabled: true 5 | 6 | install: 7 | - sudo apt-get update 8 | - sudo apt-get install swi-prolog 9 | - wget https://www.dropbox.com/s/o1nj06v49mm7fs7/eqcmini.zip 10 | - unzip eqcmini.zip 11 | - export ERL_LIBS=eqcmini 12 | 13 | 14 | script: 15 | - rebar get-deps 16 | - rebar compile 17 | - rebar eunit 18 | - | 19 | if [ $TRAVIS_OTP_RELEASE == 17.1 ] 20 | then 21 | make dialyzer 22 | else 23 | true 24 | fi 25 | 26 | 27 | 28 | otp_release: 29 | - 17.1 30 | - 17.0 31 | - R16B03-1 32 | - R16B02 33 | - R16B01 34 | -------------------------------------------------------------------------------- /examples/timer.pl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: prolog -*- 2 | %%% Some simple timer procedures. 3 | 4 | cpu_time(Time) :- 5 | ecall(erlog_demo:efunc(erlang:statistics(runtime)), R), 6 | R =.. [T|_], 7 | Time is T * 0.001. 8 | 9 | cpu_time(Goal, Duration) :- 10 | cpu_time(Before), 11 | ( Goal -> true ; true ), 12 | cpu_time(After), 13 | Duration is After - Before. 14 | 15 | wall_clock(Time) :- 16 | ecall(erlog_demo:efunc(erlang:statistics(wall_clock)), R), 17 | R =.. [T|_], 18 | Time is T * 0.001. 19 | 20 | wall_clock(Goal, Duration) :- 21 | wall_clock(Before), 22 | ( Goal -> true ; true ), 23 | wall_clock(After), 24 | Duration is After - Before. 25 | -------------------------------------------------------------------------------- /ebin/erlog.app: -------------------------------------------------------------------------------- 1 | {application,erlog, 2 | [{description,"Erlog - an implementation of Prolog on Erlang"}, 3 | {vsn,"0.7"}, 4 | {modules,['Elixir.Erlog',erlog,erlog_bips,erlog_boot, 5 | erlog_db_dict,erlog_db_ets,erlog_demo,erlog_ets, 6 | erlog_file,erlog_init,erlog_int,erlog_io, 7 | erlog_lib_dcg,erlog_lib_lists,erlog_parse,erlog_scan, 8 | erlog_server,erlog_shell]}, 9 | {registered,[]}, 10 | {applications,[kernel,stdlib]}, 11 | {env,[]}, 12 | {licenses,["Apache"]}, 13 | {links,[{"Github","https://github.com/rvirding/erlog"}]}]}. 14 | -------------------------------------------------------------------------------- /bin/erlog: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | # Copyright (c) 2013 Robert Virding 3 | # 4 | # Licensed under the Apache License, Version 2.0 (the "License"); 5 | # you may not use this file except in compliance with the License. 6 | # You may obtain a copy of the License at 7 | # 8 | # http://www.apache.org/licenses/LICENSE-2.0 9 | # 10 | # Unless required by applicable law or agreed to in writing, software 11 | # distributed under the License is distributed on an "AS IS" BASIS, 12 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | # See the License for the specific language governing permissions and 14 | # limitations under the License. 15 | 16 | # Run Erlog shell by default. Can add -pa if necessary. 17 | erl "$@" -noshell -noinput -s erlog_boot start 18 | -------------------------------------------------------------------------------- /examples/et.pl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: prolog -*- 2 | 3 | et((H0 --> B0), (H1 :- B1)) :- 4 | et(H0, H1, V1, V2), 5 | et(B0, B1, V1, V2). 6 | et(T, T). 7 | 8 | et(T, E, V1, V2) :- var(T), E = phrase(T, V1, V2). 9 | et(!, !, V1, V2) :- V1 = V2. 10 | et(\+ T, \+ E, V1, V2) :- et(T, E, V1, V3), V1 = V2. 11 | et((L0,R0), (L1,R1), V1, V2) :- 12 | et(L0, L1, V1, V3), 13 | et(R0, R1, V3, V2). 14 | et((L0->R0), (L1->R1), V1, V2) :- 15 | et(L0, L1, V1, V3), 16 | et(R0, R1, V3, V2). 17 | et((L0;R0), (L1;R1), V1, V2) :- 18 | et(L0, L1, V1, V2), 19 | et(R0, R1, V1, V2). 20 | et([], V1 = V2, V1, V2). 21 | et([T], 'C'(V1, T, V2), V1, V2). 22 | et([T|Ts], ('C'(V1, T, V3),Et), V1, V2) :- 23 | et(Ts, Et, V3, V2). 24 | et(F0, F1, V1, V2) :- 25 | F0 =.. L0, 26 | append(L0, [V1,V2], L1), 27 | F1 =.. L1. 28 | -------------------------------------------------------------------------------- /examples/listing.pl: -------------------------------------------------------------------------------- 1 | %% -*- mode: prolog -*- 2 | %% Copyright (c) 2008-2017 Robert Virding 3 | %% 4 | %% A very simple listing library. 5 | 6 | listing(P/Ar) :- !, listing(P, Ar). 7 | listing(P) :- listing(P, 0). 8 | 9 | listing(P, Ar) :- 10 | length(As, Ar), 11 | H =.. [P|As], 12 | clause(H, B), 13 | numbervars((H,B), 0, _), 14 | '$print_clause'(H, B), 15 | fail. 16 | 17 | '$print_clause'(H, true) :- 18 | !, writeq(H), put_char('.'), nl. 19 | '$print_clause'(H, B) :- 20 | writeq(H), put_char(' '), write((:-)), nl, 21 | '$print_body'(B). 22 | 23 | '$print_body'((G, Gs)) :- 24 | !, 25 | '$print_goal'(G), 26 | '$print_body'(Gs). 27 | '$print_body'(G) :- 28 | '$print_goal'(G). 29 | 30 | '$print_goal'(G) :- 31 | write(' '), writeq(G), put_char('.'), nl. 32 | -------------------------------------------------------------------------------- /test/erlog_test.hrl: -------------------------------------------------------------------------------- 1 | -include("../src/erlog_int.hrl"). 2 | 3 | get_quickcheck_properties() -> 4 | Funs = ?MODULE:module_info(functions), 5 | Funs1 = [P || {P, 0} <- Funs], 6 | Props = lists:filter(fun(Fun) -> 7 | FnName = atom_to_list(Fun), 8 | "prop_" =:= string:sub_string(FnName, 1,5) 9 | end, Funs1), 10 | Props. 11 | 12 | run_quickcheck_properties_test_() -> 13 | run_quickcheck(get_quickcheck_properties()). 14 | 15 | run_quickcheck(Tests) -> 16 | run_quickcheck(Tests,100). 17 | 18 | run_quickcheck(Tests, _Count) -> 19 | begin 20 | [begin 21 | P1 = ?MODULE:Prop(), 22 | P2 = out(P1), 23 | ?_assert(eqc:quickcheck(P2)) 24 | end || Prop<-Tests] 25 | end. 26 | 27 | %------------------------------------------------------------------------------- 28 | 29 | out(P) -> 30 | on_output(fun(S,F) -> io:format(user, S, F) end,P). 31 | -------------------------------------------------------------------------------- /examples/family.pl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: prolog -*- 2 | %%% File : family.pl 3 | %%% Purpose : Family tree example from Bratko 4 | %%% 5 | %%% This is the family tree example in ch 1 of Bratko. 6 | 7 | parent(pam, bob). 8 | parent(tom, bob). 9 | parent(tom, liz). 10 | parent(bob, ann). 11 | parent(bob, pat). 12 | parent(pat, jim). 13 | 14 | female(pam). 15 | male(tom). 16 | male(bob). 17 | female(liz). 18 | female(ann). 19 | female(pat). 20 | male(jim). 21 | 22 | offspring(X, Y) :- parent(Y, X). 23 | 24 | mother(X, Y) :- 25 | parent(X, Y), 26 | female(X). 27 | 28 | father(X, Y) :- 29 | parent(X, Y), 30 | male(X). 31 | 32 | grandparent(X, Y) :- 33 | parent(X, Z), 34 | parent(Z, Y). 35 | 36 | sister(X, Y):- 37 | parent(Z, X), 38 | parent(Z, Y), 39 | female(X), 40 | X \= Y. 41 | 42 | brother(X, Y) :- 43 | parent(Z, X), 44 | parent(Z, Y), 45 | male(X), 46 | X \= Y. 47 | 48 | predecessor(X, Y) :- parent(X, Y). 49 | predecessor(X, Y) :- 50 | parent(X, Z), 51 | predecessor(Z, Y). 52 | -------------------------------------------------------------------------------- /src/erlog.app.src: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2008-2019 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | % -*- Erlang -*- 16 | 17 | {application, erlog, 18 | [{description, "Erlog - an implementation of Prolog on Erlang"}, 19 | {vsn, "0.7"}, 20 | {modules, []}, 21 | {registered, []}, 22 | {applications, [kernel,stdlib]}, 23 | {env, []}, 24 | {licenses, ["Apache"]}, 25 | {links, [{"Github", "https://github.com/rvirding/erlog"}]} 26 | ]}. 27 | -------------------------------------------------------------------------------- /src/ChangeLog: -------------------------------------------------------------------------------- 1 | 2009-08-23 Robert Virding 2 | 3 | * erlog_io.erl (write1_tail): Fixed missing '|' in improper lists. 4 | 5 | * erlog_int.erl (prove_arg, prove_functor, prove_univ): Broke code 6 | out of prove_goal. 7 | 8 | 2009-08-22 Robert Virding 9 | 10 | * erlog_int.erl (check_goal): Cleaned up doc and args in calls. 11 | 12 | * erlog.erl, erlog_int.erl: Define IS_CONSTANT macro to replace 13 | now defunct type test. 14 | 15 | * erlog.erl, erlog_int.erl: Upgraded old style type tests in 16 | guards. 17 | 18 | 2008-08-22 19 | 20 | * erlog_parse.erl (term): Better line numbers on errors. 21 | 22 | * erlog_io.erl: New file containing all io functions. 23 | 24 | * All files: Added new copyright. 25 | 26 | 2008-08-02 27 | 28 | * erlog_parse.erl (term): Does better job of reporting the right 29 | error and giving good line number. Back-tracking still means that 30 | best error is not always reported. 31 | 32 | 2006-09-01 33 | 34 | * All files: Released erlog v5. 35 | -------------------------------------------------------------------------------- /src/erlog_boot.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2008-2013 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog_boot.erl 16 | %% Author : Robert Virding 17 | %% Purpose : Erlog boot module. 18 | 19 | %% This little beauty allows you to start Erlang with the Erlog shell 20 | %% running and still has ^G and user_drv enabled. Use it as follows: 21 | %% 22 | %% erl -noshell -noinput -s erlog_boot start 23 | %% 24 | %% NOTE order of commands important, must be -noshell -noinput! Add 25 | %% -pa to find modules if necessary. 26 | %% 27 | %% Thanks to Attila Babo for showing me how to do this. 28 | 29 | -module(erlog_boot). 30 | 31 | -export([start/0]). 32 | 33 | start() -> user_drv:start(['tty_sl -c -e',{erlog_shell,start,[]}]). 34 | -------------------------------------------------------------------------------- /doc/erlog_shell.txt: -------------------------------------------------------------------------------- 1 | MODULE 2 | 3 | erlog_shell 4 | 5 | MODULE SUMMARY 6 | 7 | Erlog shell 8 | 9 | DESCRIPTION 10 | 11 | Erlog is a Prolog interpreter implemented in Erlang and 12 | integrated with the Erlang runtime system. This is a simple 13 | prolog like shell to run Erlog. 14 | 15 | The database is initialised by calling DbModule(DbInitArg). If 16 | DbModule and DbInitArg are not given then the default database 17 | will be used. 18 | 19 | EXPORTS 20 | 21 | start() -> ShellPid. 22 | start(DbModule, DbInitArg) -> ShellPid. 23 | 24 | Start a simple Erlog shell in a new process. Goals can be 25 | entered at the "?-" prompt. When the goal succeeds the 26 | variables and their values will be printed and the user 27 | prompted. If a line containing a ";" is entered the system 28 | will attempt to find the next solution, otherwise the system 29 | will return to the "?-" prompt. 30 | 31 | server() -> ok. 32 | server(DbModule, DbInitArg) -> ok. 33 | 34 | Start a simple Erlog shell in the current process. 35 | 36 | AUTHOR 37 | 38 | Robert Virding - rvirding@gmail.com 39 | (with thanks to Richard O'Keefe for explaining some finer 40 | points of the Prolog standard) 41 | -------------------------------------------------------------------------------- /stdlib/erlang.pl: -------------------------------------------------------------------------------- 1 | % -*- mode: prolog -*- 2 | % erlog standard lib, code for working with erlang 3 | % 4 | % Copyright 2014 Zachary Kessin 5 | % 6 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 7 | % 8 | % Code for handling erlang records 9 | % 10 | % erlog:prove(State, {record, RecordName, record_info(fields,RecordName)}) 11 | % will define erlog predicates to access that record by field name 12 | % and to modify them 13 | % 14 | % person(Field, Record, Value). 15 | % person(Field, Record, NewValue, NewRecord). 16 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 17 | record(_,[]):- !. 18 | record(RecordName,Fields) :- 19 | get_record(RecordName, Fields, 1), 20 | set_record(RecordName, Fields, 1). 21 | 22 | swap_place(New,[_Head|Tail],0,Acc) :- 23 | Acc = [New|Tail]. 24 | swap_place(New,[Head|Tail],N,Acc) :- 25 | Next is N - 1, 26 | Acc = [Head|R], 27 | swap_place(New, Tail, Next, R). 28 | 29 | set_record(_, [], _) :- !. 30 | set_record(RecordName, [Field|Rest], Place) :- 31 | SetRule =.. [RecordName, Field, Record, NewValue, NData], 32 | N is Place + 1, 33 | set_record(RecordName, Rest, N), 34 | asserta((SetRule :- 35 | Record =.. Data, 36 | Pivot is N - 1, 37 | swap_place(NewValue,Data, Pivot,NewRecord), 38 | NData =.. NewRecord 39 | 40 | )). 41 | 42 | get_record(_, [], _) :-!. 43 | get_record(RecordName, [Field|Rest], Place) :- 44 | GetRule =.. [RecordName, Field, Record, Value], 45 | asserta((GetRule :- arg(Place, Record, Value))), 46 | N is Place + 1, 47 | get_record(RecordName, Rest, N). 48 | 49 | -------------------------------------------------------------------------------- /examples/fleck.pl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: prolog -*- 2 | 3 | mt([], [], []). 4 | mt([X|Xs], [Y|Ys], [Z|Zs]) :- 5 | m(X, Y, Z), 6 | mt(Xs, Ys, Zs). 7 | 8 | m(0, _, 0). 9 | m(1, X, Y) :- m1(X, Y). 10 | m(2, X, Y) :- m2(X, Y). 11 | 12 | m1(0, 0). 13 | m1(1, 0). 14 | m1(2, 1). 15 | 16 | m2(0, 0). 17 | m2(1, 2). 18 | m2(2, 2). 19 | 20 | g1([0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2]). 21 | g2([0,0,0,1,1,1,2,2,2,0,0,0,1,1,1,2,2,2,0,0,0,1,1,1,2,2,2]). 22 | g3([0,1,2,0,1,2,0,1,2,0,1,2,0,1,2,0,1,2,0,1,2,0,1,2,0,1,2]). 23 | 24 | solution(Sol) :- 25 | g1(G1), 26 | g2(G2), 27 | g3(G3), 28 | solution([], [G1,G2,G3], Sol). 29 | 30 | solution(State, New, Sol) :- 31 | once((union(New, State, State1), %Add new elements to state 32 | subtract(New, State, New1))), %subtract old elements 33 | solution(New1, State, State1, Sol). 34 | 35 | solution([], State, _, State). 36 | solution([New|News], Old, State, Sol) :- 37 | once(products(Old, [New|News], Prods)), 38 | solution(State, Prods, Sol). 39 | 40 | products(Old, New, Prods) :- 41 | products(Old, New, Prods0, Prods1), 42 | products(New, Old, Prods1, Prods2), 43 | products(New, New, Prods2, []), 44 | sort(Prods0, Prods). 45 | 46 | products([], _, P, P). 47 | products([X|Xs], Ys, P0, P) :- 48 | once(products1(Ys, X, P0, P1)), 49 | products(Xs, Ys, P1, P). 50 | 51 | products1([], _, P, P). 52 | products1([Y|Ys], X, [Z|P0], P) :- 53 | once(mt(X, Y, Z)), 54 | products1(Ys, X, P0, P). 55 | 56 | union([], U, U). 57 | union([X|Xs], Ys, U) :- 58 | ( member(X, Ys) -> 59 | union(Xs, Ys, U) 60 | ; U = [X|U1], 61 | union(Xs, Ys, U1) 62 | ). 63 | 64 | subtract([], _, []). 65 | subtract([X|Xs], Ys, Sub) :- 66 | ( member(X, Ys) -> 67 | subtract(Xs, Ys, Sub) 68 | ; Sub = [X|Sub1], 69 | subtract(Xs, Ys, Sub1) 70 | ). 71 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Copyright (c) 2019 Robert Virding 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | # Makefile for Erlog 16 | # Building from .xrl, .yrl and .erl 17 | 18 | EBINDIR = ./ebin 19 | SRCDIR = ./src 20 | INCDIR = ./include 21 | DOC_DIR = ./doc 22 | 23 | ERLCFLAGS = -W1 24 | ERLC = erlc 25 | 26 | ## The .erl, .xrl and .beam files 27 | ESRCS = $(notdir $(wildcard $(SRCDIR)/*.erl)) 28 | XSRCS = $(notdir $(wildcard $(SRCDIR)/*.xrl)) 29 | EBINS = $(ESRCS:.erl=.beam) $(XSRCS:.xrl=.beam) 30 | 31 | .SUFFIXES: .erl .beam 32 | 33 | $(EBINDIR)/%.beam: $(SRCDIR)/%.erl 34 | $(ERLC) -I $(INCDIR) -o $(EBINDIR) $(COMP_OPTS) $(ERLCFLAGS) $< 35 | 36 | .SECONDARY: $(XSRCS:.xrl=.erl) 37 | 38 | %.erl: %.xrl 39 | $(ERLC) -o $(SRCDIR) $< 40 | 41 | .PHONY: all compile doc clean distclean pdf 42 | 43 | all: compile 44 | 45 | compile: comp_opts.mk $(addprefix $(EBINDIR)/, $(EBINS)) 46 | 47 | comp_opts.mk: 48 | escript get_comp_opts.escript 49 | 50 | -include comp_opts.mk 51 | 52 | doc: 53 | 54 | start: compile 55 | erl -pa ebin 56 | 57 | pdf: 58 | pandoc README.md -o README.pdf 59 | 60 | clean: 61 | - rm -f test/*.beam 62 | - rm -f $(EBINDIR)/*.beam 63 | - rm -f *.beam 64 | - rm -f erl_crash.dump 65 | - rm -f comp_opts.mk 66 | 67 | distclean: clean 68 | 69 | rebuild: distclean compile 70 | -------------------------------------------------------------------------------- /examples/t1.pl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: prolog -*- 2 | 3 | a(1). 4 | a(2). 5 | a(3). 6 | 7 | b(1). 8 | b(2). 9 | b(3). 10 | 11 | c(1). 12 | c(2). 13 | c(3). 14 | 15 | d(4). 16 | d(5). 17 | d(6). 18 | 19 | e(4). 20 | e(5). 21 | e(6). 22 | 23 | f(4). 24 | f(5). 25 | f(6). 26 | 27 | d(X,d(X)). 28 | 29 | e(X, Y) :- a(X), !, b(Y). 30 | e(a, b). 31 | 32 | %%f(X) :- X = 'abc\x111\def'. 33 | %%f(X) :- :- a(X). 34 | 35 | perm([], []). 36 | perm([X|Xs], Ys1) :- perm(Xs, Ys), insert(Ys, X, Ys1). 37 | 38 | nrev([], []). 39 | nrev([H|T], L1) :- nrev(T, L), append(L, [H], L1). 40 | 41 | testnrev(0, _). 42 | testnrev(N, L) :- 43 | nrev(L, _), 44 | !, 45 | N1 is N - 1, 46 | testnrev(N1, L). 47 | 48 | for(0, L) :- fail. 49 | for(N, L) :- nrev(L, _), fail. 50 | for(N, L) :- N1 is N-1, for(N1, L). 51 | 52 | x(X) --> [x], {X = 1}. 53 | x(X) --> [y,z], {X = 2}. 54 | 55 | %% For testing cuts. 56 | 57 | ct1(X, Y) :- a(X), b(Y), Y \= X. 58 | ct1(X, Y) :- a(X), !, b(Y), Y \= X. 59 | ct1(X, Y) :- a(X), b(Y). 60 | 61 | ct2(X, Y, Z) :- a(X), b(Y), c(Z), Z \= X, Z \= Y. 62 | ct2(X, Y, Z) :- a(X), !, b(Y), !, c(Z), Z \= X, Z \= Y. 63 | ct2(X, Y, Z) :- a(X), b(Y), c(Z), Z \= X, Z \= Y. 64 | 65 | ct3(X, Y, Z) :- ( a(X) -> b(Y), Y \= X ), c(Z), Z \= X, Z \= Y. 66 | ct3(X, Y, Z) :- ( a(X) -> b(Y), Y \= X ), !, c(Z), Z \= X, Z \= Y. 67 | ct3(X, Y, Z) :- a(X), b(Y), Y \= X, c(Z), Z \= X, Z \= Y. 68 | 69 | ct4(X, Y, Z) :- a(X), ( b(Y), display(Y), Y \= X, c(Z), Z \= X, Z \= Y -> true ). 70 | ct4(X, Y, Z) :- a(X), ( b(Y), display(Y), !, Y \= X, c(Z), Z \= X, Z \= Y -> true ). 71 | ct4(X, Y, Z) :- a(X), ( b(Y), Y \= X, c(Z), Z \= X, Z \= Y -> true ). 72 | 73 | ac(1). 74 | ac(2) :- !. 75 | ac(3). 76 | 77 | bc(1). 78 | bc(2) :- !. 79 | bc(3). 80 | 81 | cc(1). 82 | cc(2) :- !. 83 | cc(3). 84 | 85 | dc1(X, Y, Z) :- ac(X), bc(Y), cc(Z). 86 | dc1(X, Y, Z) :- ac(X), bc(Y), !, cc(Z). 87 | dc1(X, Y, Z) :- ac(X), bc(Y), cc(Z). 88 | 89 | %% End of file 90 | -------------------------------------------------------------------------------- /src/erlog_int.hrl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2008-2013 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog_int.erl 16 | %% Author : Robert Virding 17 | %% Purpose : Basic interpreter of a Prolog definitions. 18 | 19 | %% Some standard type macros. 20 | 21 | %% The old is_constant/1 ? 22 | -define(IS_CONSTANT(T), (not (is_tuple(T) orelse is_list(T)))). 23 | 24 | %% -define(IS_ATOMIC(T), (is_atom(T) orelse is_number(T) orelse (T == []))). 25 | -define(IS_ATOMIC(T), (not (is_tuple(T) orelse (is_list(T) andalso T /= [])))). 26 | -define(IS_FUNCTOR(T), (is_tuple(T) andalso (tuple_size(T) >= 2) andalso is_atom(element(1, T)))). 27 | 28 | %% Define the interpreter state record. 29 | -record(est, {cps, %Choice points 30 | bs, %Bindings 31 | vn, %Var num 32 | db, %Database 33 | fs %Flags 34 | }). 35 | -record(db, {mod, %Database module 36 | ref, %Database reference 37 | loc %Local database 38 | }). 39 | 40 | %% Define the choice point record. 41 | -record(cp, {type,label,data,next,bs,vn}). 42 | -record(cut, {label,next}). 43 | 44 | %% Default prolog flags (sorted), {Flag,DefaultValue,SettableValues}. 45 | -define(PROLOG_FLAGS, [{bounded,false,none}, 46 | {debug,off,[off,on]}, 47 | {dialect,erlog,none}, 48 | {double_quotes,codes,none}, 49 | {iso,true,none}, %Optimistic 50 | {max_arity,250,none}, 51 | {unknown,error,[error,fail,warning]}]). 52 | -------------------------------------------------------------------------------- /src/Elixir.Erlog.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2022 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog.erl 16 | %% Author : Robert Virding 17 | %% Purpose : Elixir style wrappers for erlog.erl 18 | %% 19 | %% This module just contains functions that forward to erlog.erl, but 20 | %% place the Erlog State arguments in the first position rather than 21 | %% the last. This better matches Elixir conventions and allows for 22 | %% using the Elixir pipe operator '|>' to chain Erlog function calls. 23 | 24 | -module('Elixir.Erlog'). 25 | 26 | %% Basic evaluator interface. 27 | -export([new/0,new/2, 28 | prove/2,next_solution/1, 29 | consult/2,reconsult/2,load/2, 30 | get_db/1,set_db/2,set_db/3]). 31 | 32 | %% User utilities. 33 | -export([is_legal_term/1,vars_in/1]). 34 | 35 | new() -> 36 | erlog:new(). 37 | 38 | new(DbMod, DbArg) -> 39 | erlog:new(DbMod, DbArg). 40 | 41 | prove(Erl, Goal) -> 42 | erlog:prove(Goal, Erl). 43 | 44 | next_solution(Erl) -> 45 | erlog:next_solution(Erl). 46 | 47 | consult(Erl, File) -> 48 | erlog:consult(File, Erl). 49 | 50 | reconsult(Erl, File) -> 51 | erlog:reconsult(File, Erl). 52 | 53 | load(Erl, Module) -> 54 | erlog:load(Module, Erl). 55 | 56 | get_db(Erl) -> 57 | erlog:get_db(Erl). 58 | 59 | set_db(Erl, Ref) -> 60 | erlog:set_db(Ref, Erl). 61 | 62 | set_db(Erl, Mod, Ref) -> 63 | erlog:set_db(Mod, Ref, Erl). 64 | 65 | is_legal_term(Goal) -> 66 | erlog:is_legal_term(Goal). 67 | 68 | vars_in(Term) -> 69 | erlog:vars_in(Term). 70 | -------------------------------------------------------------------------------- /doc/erlog_io.txt: -------------------------------------------------------------------------------- 1 | MODULE 2 | 3 | erlog_io 4 | 5 | MODULE SUMMARY 6 | 7 | I/O functions for Erlog 8 | 9 | DESCRIPTION 10 | 11 | Erlog is a Prolog interpreter implemented in Erlang and 12 | integrated with the Erlang runtime system. 13 | 14 | EXPORTS 15 | 16 | erlog_io:read([IoDevice,] Prompt) -> 17 | {ok,Term} | {ok,end_of_file} | {error,Error}. 18 | 19 | erlog_io:write([IoDevice,] Term) -> ok. 20 | 21 | The same as calling write_term(Term, [numbervars]). 22 | 23 | erlog_io:writeq([IoDevice,] Term) -> ok. 24 | 25 | The same as calling write_term(Term, [numbervars,quoted]). 26 | 27 | erlog_io:write_canonical([IoDevice,] Term) -> ok. 28 | 29 | The same as calling write_term(Term, [ignore_ops,quoted]). 30 | 31 | erlog_io:write_term([IoDevice,] Term, Options) -> ok. 32 | 33 | The options are numbervars, quoted and ignore_ops. These have 34 | the same meaning as in the standard. By default all are false. 35 | 36 | erlog_io:read_string(String) -> {ok,Term} | {error,ErrorDescriptor}. 37 | 38 | erlog_parse:term([Token]) -> {ok,Term} | {error,ErrorDescriptor}. 39 | erlog_parse:term([Token], LineNo) -> {ok,Term} | {error,ErrorDescriptor}. 40 | 41 | Parse a list of Erlang tokens as a Prolog term. The line 42 | number (default 1) is used when returning errors. 43 | ErrorDescriptor has the format: 44 | 45 | {LineNo,ModuleName,Error} 46 | 47 | erlog_scan:string(String) -> {ok,[Token],Line} | {error,Error,LineNo}. 48 | erlog_scan:string(String, Line) -> {ok,[Token],Line} | {error,Error,Line}. 49 | 50 | Scan String and return a list of tokens. 51 | 52 | erlog_scan:token(Continuation, Chars, Line) -> 53 | {more,Continuation} | {done,ReturnVal,RestChars}. 54 | 55 | Re-entrant scanner to scan one token. Compatible with io system. 56 | 57 | erlog_scan:tokens(Continuation, Chars, Line) -> 58 | {more,Continuation} | {done,ReturnVal,RestChars}. 59 | 60 | Re-entrant scanner to scan tokens upto an end token. 61 | Compatible with io system. 62 | 63 | AUTHOR 64 | 65 | Robert Virding - rvirding@gmail.com 66 | (with thanks to Richard O'Keefe for explaining some finer 67 | points of the Prolog standard) 68 | -------------------------------------------------------------------------------- /doc/erlog_ets.txt: -------------------------------------------------------------------------------- 1 | MODULE 2 | 3 | erlog_ets 4 | 5 | MODULE SUMMARY 6 | 7 | Provide Erlog predicates for directly interfacing ETS tables 8 | 9 | DESCRIPTION 10 | 11 | This module provides a basic interface to ETS tables with some 12 | predicates which can access the tables. Currently it cannot 13 | manage tables and their contents but only access the objects. 14 | 15 | TYPES 16 | 17 | erlog_database() 18 | Internal Erlog database reference. 19 | 20 | EXPORTS 21 | 22 | erlog_ets:load(Database) -> Database. 23 | 24 | Types 25 | Database = erlog_database() 26 | 27 | Asserts the ETS interface predicates into the Erlog 28 | database. This function is automatically called when the 29 | module is loaded with 'erlog:load/2' and is seldom explicitly 30 | called by code. All the predicates are compiled code so the 31 | assertion is done using 'erlog_int:add_compiled_proc/4' 32 | function. 33 | 34 | ETS INTERFACE 35 | 36 | The following predicates are currently provided to inteface ETS tables: 37 | 38 | ets_all(Tables) 39 | 40 | Unifies Tables with a list of all the ETS tables currently in 41 | the Erlang system. 42 | 43 | ets_key(TableName, Key) 44 | 45 | Unifies Key with a key in the ETS table. This will predicate 46 | will backtrack over the keys. 47 | 48 | ets_match(TableName, Pattern) 49 | 50 | Will unify Pattern with an object in the table Table. It will 51 | backtrack over all objects in the table which can unify with 52 | Pattern. 53 | 54 | EXAMPLE 55 | 56 | Suppose we have the ETS table 'test_tab' which is of type 57 | 'duplicate_bag' and contains the following objects: 58 | 59 | {bert,15,yesterday} 60 | {bert,20,today} 61 | {bert,20,today,null} 62 | {bert,25,tomorrow} 63 | 64 | then calling ets_match(test_tab, bert(What, When)) will 65 | backtrack and succeed with: 66 | 67 | What = 15 68 | When = yesterday 69 | 70 | What = 20 71 | When = today 72 | 73 | What = 25 74 | When = yesterday 75 | 76 | AUTHOR 77 | 78 | Robert Virding - rvirding@gmail.com 79 | (with thanks to Richard O'Keefe for explaining some finer 80 | points of the Prolog standard) 81 | -------------------------------------------------------------------------------- /include/erlog_assert.hrl: -------------------------------------------------------------------------------- 1 | 2 | %% Copyright (c) 2016 Zachary Kessin 3 | %% 4 | %% Licensed under the Apache License, Version 2.0 (the "License"); 5 | %% you may not use this file except in compliance with the License. 6 | %% You may obtain a copy of the License at 7 | %% 8 | %% http://www.apache.org/licenses/LICENSE-2.0 9 | %% 10 | %% Unless required by applicable law or agreed to in writing, software 11 | %% distributed under the License is distributed on an "AS IS" BASIS, 12 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | %% See the License for the specific language governing permissions and 14 | %% limitation 15 | 16 | -define(assertProlog(PrologExp, Erlog), 17 | begin 18 | ((fun() -> 19 | case (erlog:prove(PrologExp,Erlog)) of 20 | {{succeed,_}, E1} -> 21 | {ok,E1}; 22 | {fail, E1} -> 23 | erlang:error({assertProlog, [ 24 | [{module, ?MODULE}, 25 | {line, ?LINE}, 26 | {expression, PrologExp}, 27 | {expected, true}, 28 | {erlog_state, E1} 29 | ]]}) 30 | end 31 | end)()) 32 | end). 33 | 34 | 35 | -define(assertPrologFail(PrologExp, Erlog), 36 | begin 37 | ((fun() -> 38 | case (erlog:prove(PrologExp,Erlog)) of 39 | {fail, E1} -> 40 | {ok,E1}; 41 | {_, E1} -> 42 | erlang:error({assertProlog, [ 43 | [{module, ?MODULE}, 44 | {line, ?LINE}, 45 | {expression, PrologExp}, 46 | {expected, true}, 47 | {erlog_state, E1} 48 | ]]}) 49 | end 50 | end)()) 51 | end). 52 | 53 | -------------------------------------------------------------------------------- /test/records_test.erl: -------------------------------------------------------------------------------- 1 | -module(records_test). 2 | -include_lib("eqc/include/eqc.hrl"). 3 | -include_lib("eunit/include/eunit.hrl"). 4 | -include("erlog_test.hrl"). 5 | -compile(export_all). 6 | 7 | 8 | -record(person, {name, phone, address, comments}). 9 | name() -> 10 | elements(["Adam", "Bob", "Charlie"]). 11 | 12 | person() -> 13 | #person{name = name(), 14 | phone = vector(1, choose(48,57)), 15 | address = list(char()), 16 | comments = binary()}. 17 | 18 | 19 | prop_prolog_records_get() -> 20 | ?FORALL(Person, 21 | person(), 22 | begin 23 | application:set_env(erlog, consult_path, [".", "stdlib"]), 24 | {ok,E} = erlog:new(), 25 | {ok, E1} = erlog:consult("erlang.pl", E), 26 | Fields = record_info(fields, person), 27 | {{succeed,_}, E2} = erlog:prove({record, person, Fields}, E1), 28 | 29 | 30 | {{succeed,[{'Name', Name}]}, _ } = erlog:prove({person, name, Person, {'Name'}}, E2), 31 | ?assertEqual(Person#person.name, Name), 32 | {{succeed,[{'Phone', Phone}]}, _} = erlog:prove({person, phone, Person, {'Phone'}}, E2), 33 | ?assertEqual(Person#person.phone, Phone), 34 | {{succeed,[{'Address', Address}]}, _} = erlog:prove({person, address, Person, {'Address'}}, E2), 35 | ?assertEqual(Person#person.address, Address), 36 | {{succeed,[{'Comments', Comments}]}, _} = erlog:prove({person, comments, Person, {'Comments'}}, E2), 37 | ?assertEqual(Person#person.comments, Comments), 38 | true 39 | end). 40 | 41 | prop_prolog_records_set() -> 42 | ?FORALL({Person,NewName}, 43 | {person(),name()}, 44 | begin 45 | {ok,E} = erlog:new(), 46 | {ok, E1} = erlog:consult("stdlib/erlang.pl", E), 47 | Fields = record_info(fields, person), 48 | {{succeed,_}, E2} = erlog:prove({record, person, Fields}, E1), 49 | 50 | {{succeed,[{'Person', NewPerson }]},_} = 51 | erlog:prove({person, name, Person, NewName, {'Person'}}, E2), 52 | ?assert(is_record(NewPerson, person)), 53 | ?assertEqual(NewPerson#person.name , NewName), 54 | 55 | {{succeed,[{'Person', NewPerson1 }]},_} = 56 | erlog:prove({person, address, Person, NewName, {'Person'}}, E2), 57 | ?assertEqual(NewPerson1#person.address , NewName), 58 | true 59 | end). 60 | -------------------------------------------------------------------------------- /get_comp_opts.escript: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env escript 2 | %% -*- mode: erlang; indent-tabs-mode: nil -*- 3 | %% Define a number of compiler options. We first work out the current 4 | %% Erlang version and from the we can define the various options. 5 | 6 | %% Define the makefile variables HAS_MAPS, HAS_FULL_KEYS, 7 | %% NEW_REC_CORE, NEW_RAND, HAS_FLOOR, HAS_CEIL and NEW_STACKTRACE 8 | %% depending on version of Erlang. 9 | 10 | main(_) -> 11 | Version = otp_release(), 12 | CompOpts = comp_opts(Version), 13 | file:write_file("comp_opts.mk", "COMP_OPTS = " ++ CompOpts ++ "\n"). 14 | 15 | %% Get the release number. 16 | %% We have stolen the idea and most of the code from rebar3. 17 | 18 | otp_release() -> 19 | case erlang:system_info(otp_release) of 20 | [$R,N1|Rest] when is_integer(N1) -> 21 | %% If OTP <= R16, take the digits. 22 | [N1|Rest]; 23 | Rel -> 24 | %% If OTP >= 17.x, erlang:system_info(otp_release) returns 25 | %% just the major version number. 26 | File = filename:join([code:root_dir(),"releases",Rel,"OTP_VERSION"]), 27 | case file:read_file(File) of 28 | {error, _} -> Rel; 29 | {ok, Vsn} -> 30 | Size = byte_size(Vsn), 31 | %% The shortest vsn string consists of at least 32 | %% two digits followed by "\n". Therefore, it's 33 | %% safe to assume Size >= 3. 34 | case binary:part(Vsn, {Size, -3}) of 35 | <<"**\n">> -> 36 | binary:bin_to_list(Vsn, {0, Size - 3}); 37 | _ -> 38 | binary:bin_to_list(Vsn, {0, Size - 1}) 39 | end 40 | end 41 | end. 42 | 43 | comp_opts(Version) -> 44 | Copts0 = "-DERLANG_VERSION=\\\"" ++ Version ++ "\\\"" ++ " ", 45 | Copts0 ++ append_copts(Version, [{"17","HAS_MAPS"}, 46 | {"18","HAS_FULL_KEYS"}, 47 | {"19","NEW_REC_CORE"}, 48 | {"19","NEW_RAND"}, 49 | {"20","NEW_BOOL_GUARD"}, 50 | {"20","HAS_FLOOR"}, 51 | {"20","HAS_CEIL"}, 52 | {"21","NEW_STACKTRACE"}, 53 | {"23","EEP48"}]). 54 | 55 | append_copts(Version, [{Ver,Opt}|Opts]) -> 56 | Rest = append_copts(Version, Opts), 57 | if Version >= Ver -> 58 | "-D" ++ Opt ++ "=true" ++ " " ++ Rest; 59 | true -> Rest 60 | end; 61 | append_copts(_Version, []) -> []. 62 | -------------------------------------------------------------------------------- /src/erlog_demo.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2013 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog_demo.erl 16 | %% Author : Robert Virding 17 | %% Purpose : Demo functions for Erlang interface of Erlog system. 18 | 19 | -module(erlog_demo). 20 | 21 | -export([efunc/1,ets_keys/1,get_list/1]). 22 | 23 | %% efunc(Fcall) -> {succeed_last,Val}. 24 | %% ets_keys(Table) -> {succeed,Val,Cont} | {succeed_last,Val} | fail. 25 | %% get_list(ListGenerator) -> {succeed,Val,Cont} | {succeed_last,Val} | fail. 26 | %% Test/demo functions for ecall predicate. Examples of different ways 27 | %% of generating solutions. 28 | 29 | efunc(Fcall) -> 30 | %% Call an erlang function and return the value. 31 | %% This is what the operators will generate. 32 | Val = case Fcall of 33 | {':',M,F} when is_atom(M), is_atom(F) -> M:F(); 34 | {':',M,{F,A}} when is_atom(M), is_atom(F) -> M:F(A); 35 | {':',M,T} when is_atom(M), is_tuple(T), size(T) >= 2, 36 | is_atom(element(1, T)) -> 37 | apply(M,element(1, T),tl(tuple_to_list(T))) 38 | end, 39 | {succeed_last,Val}. %Optimisation 40 | 41 | ets_keys(Tab) -> 42 | %% Ets table keys back-trackable. 43 | %% Solution with no look-ahead, get keys when requested. 44 | %% This fun returns next key and itself for continuation. 45 | F = fun (F1, Tab1, Last1) -> 46 | case ets:next(Tab1, Last1) of 47 | '$end_of_table' -> fail; %No more elements 48 | Key1 -> {succeed,Key1, fun () -> F1(F1, Tab1, Key1) end} 49 | end 50 | end, 51 | case ets:first(Tab) of 52 | '$end_of_table' -> fail; %No elements 53 | Key -> {succeed,Key, fun () -> F(F, Tab, Key) end} 54 | end. 55 | 56 | get_list(ListGen) -> 57 | %% List as back-trackable generator. 58 | %% This is what the operators will generate. 59 | Vals = case ListGen of 60 | {':',M,F} when is_atom(M), is_atom(F) -> M:F(); 61 | {':',M,{F,A}} when is_atom(M), is_atom(F) -> 62 | M:F(A); 63 | {':',M,T} when is_atom(M), is_tuple(T), size(T) >= 2, 64 | is_atom(element(1, T)) -> 65 | apply(M,element(1, T),tl(tuple_to_list(T))) 66 | end, 67 | %% This fun will return head and itself for continuation. 68 | Fun = fun (F1, Es0) -> 69 | case Es0 of 70 | [E] -> {succeed_last,E}; %Optimisation for last one 71 | [E|Es] -> {succeed,E,fun () -> F1(F1, Es) end}; 72 | [] -> fail %No more elements 73 | end 74 | end, 75 | Fun(Fun, Vals). %Call with list of values 76 | -------------------------------------------------------------------------------- /doc/erlog_server.txt: -------------------------------------------------------------------------------- 1 | MODULE 2 | 3 | erlog_server 4 | 5 | MODULE SUMMARY 6 | 7 | A simple Erlog server. 8 | 9 | DESCRIPTION 10 | 11 | Erlog is a Prolog interpreter implemented in Erlang and 12 | integrated with the Erlang runtime system. This is a simple 13 | server implementing the same basic interface as in the erlog 14 | module. 15 | 16 | It is implemented as a generic server. 17 | 18 | TYPES 19 | 20 | erlog_server() = pid() 21 | 22 | solution() = {succeed,Bindings} 23 | | fail 24 | | {error,Error} 25 | | {'EXIT',Error} 26 | 27 | eterm() 28 | Erlog term. 29 | 30 | EXPORTS 31 | 32 | start_link() -> {ok,Server}. 33 | start_link(DbMod, DbArg) -> {ok,Server}. 34 | start() -> {ok,Server}. 35 | start(DbMod, DbArg) -> {ok,Server}. 36 | 37 | Types 38 | DbModule = atom() 39 | DbInitArg = term() 40 | Server = erlog_server() 41 | 42 | Initialise the erlog gen_server with either start_link or 43 | start. The database is initialised by calling 44 | DbModule(DbInitArg). If DbModule and DbInitArg are not given 45 | then the default database will be used. 46 | 47 | prove(Server, Goal) -> Solution. 48 | 49 | Types 50 | Server = erlog_server() 51 | Goal = eterm() 52 | Solution = solution() 53 | 54 | Try to prove Goal, if this can be done return the first 55 | solution. This will reset the interpreter and completely 56 | replace any existing goal, except of course for operations on 57 | the database. 58 | 59 | next_solution(Server) -> Solution. 60 | 61 | Types 62 | Server = erlog_server() 63 | Solution = solution() 64 | 65 | Try to find the next solution of the last goal. 66 | 67 | consult(Server, FileName) -> ok | {error,Error}. 68 | reconsult(Server, FileName) -> ok | {error,Error}. 69 | 70 | Types 71 | Server = erlog_server() 72 | FileName = string() 73 | 74 | load(Server, Module) -> ok. 75 | 76 | Types 77 | Server = erlog_server() 78 | Module = atom() 79 | 80 | get_db(Server) -> Database. 81 | 82 | Types 83 | Server = erlog_server() 84 | Database = term() 85 | 86 | Return the current Erlog database. 87 | 88 | set_db(Server, Database) -> ok. 89 | set_db(Server, DbModule, Database) -> ok. 90 | 91 | Types 92 | Server = erlog_server() 93 | DbModule = atom() 94 | Database = term() 95 | 96 | Set the Erlog database. 97 | 98 | DATABASE INTERFACE 99 | 100 | The database interface is described in the documentation of 101 | erlog. 102 | 103 | AUTHOR 104 | 105 | Robert Virding - rvirding@gmail.com 106 | (with thanks to Richard O'Keefe for explaining some finer 107 | points of the Prolog standard) 108 | -------------------------------------------------------------------------------- /src/erlog_file.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2008-2013 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog_file.erl 16 | %% Author : Robert Virding 17 | %% Purpose : The Erlog file consulter. 18 | 19 | -module(erlog_file). 20 | 21 | -include("erlog_int.hrl"). 22 | 23 | %% Main interface functions. 24 | -export([consult/2,reconsult/2]). 25 | 26 | %% consult(File, DatabaseState) -> 27 | %% {ok,NewState} | {error,Error} | {erlog_error,Error}. 28 | %% reconsult(File, State) -> 29 | %% {ok,NewState} | {error,Error} | {erlog_error,Error}. 30 | %% Load/reload an Erlog file into the interpreter. Reloading will 31 | %% abolish old definitons of clauses. 32 | 33 | consult(File, St) -> 34 | case erlog_io:read_file(File) of 35 | {ok,Terms} -> 36 | consult_terms(fun consult_assert/2, St, Terms); 37 | Error -> Error 38 | end. 39 | 40 | consult_assert(Term0, #est{db=Db0}=St) -> 41 | Term1 = erlog_lib_dcg:expand_term(Term0), 42 | Db1 = erlog_int:assertz_clause(Term1, Db0), 43 | {ok,St#est{db=Db1}}. 44 | 45 | reconsult(File, St0) -> 46 | case erlog_io:read_file(File) of 47 | {ok,Terms} -> 48 | case consult_terms(fun reconsult_assert/2, {St0,[]}, Terms) of 49 | {ok,{St1,_Seen1}} -> {ok,St1}; 50 | Error -> Error 51 | end; 52 | Error -> Error 53 | end. 54 | 55 | reconsult_assert(Term0, {#est{db=Db0}=St,Seen}) -> 56 | Term1 = erlog_lib_dcg:expand_term(Term0), 57 | Func = functor(Term1), 58 | case lists:member(Func, Seen) of 59 | true -> 60 | Db1 = erlog_int:assertz_clause(Term1, Db0), 61 | {ok,{St#est{db=Db1}, Seen}}; 62 | false -> 63 | Db1 = erlog_int:abolish_clauses(Func, Db0), 64 | Db2 = erlog_int:assertz_clause(Term1, Db1), 65 | {ok,{St#est{db=Db2},[Func|Seen]}} 66 | end. 67 | 68 | %% consult_terms(InsertFun, Database, Terms) -> 69 | %% {ok,NewDatabase} | {erlog_error,Error}. 70 | %% Add terms to the database using InsertFun. Ignore directives and 71 | %% queries. 72 | 73 | consult_terms(Ifun, Db, [{':-',_}|Ts]) -> 74 | consult_terms(Ifun, Db, Ts); 75 | consult_terms(Ifun, Db, [{'?-',_}|Ts]) -> 76 | consult_terms(Ifun, Db, Ts); 77 | consult_terms(Ifun, Db0, [T|Ts]) -> 78 | case catch Ifun(T, Db0) of 79 | {ok,Db1} -> consult_terms(Ifun, Db1, Ts); 80 | {erlog_error,E,_Db1} -> {erlog_error,E}; 81 | {erlog_error,E} -> {erlog_error,E} 82 | end; 83 | consult_terms(_Ifun, Db, []) -> {ok,Db}. 84 | 85 | functor({':-',H,_B}) -> erlog_int:functor(H); 86 | functor(T) -> erlog_int:functor(T). 87 | -------------------------------------------------------------------------------- /examples/homer.pl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: prolog -*- 2 | %% Homer Simpson, after a stop at Moe's, went to the Springfield Mall 3 | %% to buy Marge, Lisa, Bart and Maggie a gift in anticipation that 4 | %% they will be upset with him when he gets home. He bought 4 gifts: a 5 | %% green dress for Marge, a saxophone book for Lisa, a slingshot for 6 | %% Bart and a pacifier for Maggie. He recalls buying the gifts at: The 7 | %% Leftorium, Sprawl-Mart, Try-N-Save, and King Toots. Somewhere along 8 | %% the way, Homer lost his car keys and had to walk home carrying the 9 | %% gifts. Wanting to retrace his steps and find his lost car keys, the 10 | %% family asks Homer where he bought the gifts and the order in which 11 | %% he bought the gifts. Being partly inebriated however, Homer 12 | %% couldn't remember which stores he bought the gifts at and in which 13 | %% order he visited the stores. 14 | %% 15 | %% After some interrogation, Homer does remember: 16 | %% 17 | %% · He bought the saxophone book at King Toot's 18 | %% · The store he visited just after buying the slingshot was not Sprawl-Mart 19 | %% · The Leftorium was his second stop 20 | %% · Two stops after leaving Try-N-Save, he bought the pacifier 21 | %% 22 | %% Can you help drunken Homer and the Simpson family figure out the order that 23 | %% Homer bought the gifts and where he bought them? 24 | 25 | %% All stores and presents. (Not really used) 26 | 27 | store(leftorium). 28 | store(sprawl_mart). 29 | store(try_n_save). 30 | store(king_toots). 31 | 32 | present(green_dress). 33 | present(saxophone_book). 34 | present(slingshot). 35 | present(pacifier). 36 | 37 | solve(Solution) :- 38 | %% Generate all possible combinations. 39 | perm([leftorium,sprawl_mart,try_n_save,king_toots], [S1,S2,S3,S4]), 40 | perm([green_dress,saxophone_book,slingshot,pacifier], [P1,P2,P3,P4]), 41 | %% This is the solution. 42 | S = [bought(P1, S1),bought(P2, S2),bought(P3, S3),bought(P4, S4)], 43 | %% Now add facts. 44 | %% He bought the saxophone book at King Toot’s. 45 | member(bought(saxophone_book, king_toots), S), 46 | %% The store he visited just after buying the slingshot was 47 | %% not Sprawl-Mart. 48 | index(bought(slingshot, _), S, I21), 49 | index(bought(_, Sa), S, I22), 50 | I22 is I21 + 1, 51 | Sa \= sprawl_mart, 52 | %% The Leftorium was his second stop. 53 | index(bought(_, leftorium), S, 2), 54 | %% Two stops after leaving Try-N-Save, he bought the pacifier. 55 | index(bought(_, try_n_save), S, I41), 56 | index(bought(pacifier, _), S, I42), 57 | I42 is I41 + 2, 58 | %% We have our solution, now export it. 59 | Solution = S. 60 | 61 | %% Utilities. 62 | 63 | %% index(Term, List, -Index). 64 | %% Find the index of Term in List, backtracking finds all possible ones. 65 | 66 | index(X, L, I) :- index(X, L, 1, I). 67 | 68 | index(X, [X|_], I, I). 69 | index(X, [_|L], I, R) :- I1 is I+1, index(X, L, I1, R). 70 | 71 | %% perm(+List, ?Perm). 72 | %% Generate permutations of List, backtracking generates all. 73 | 74 | %% perm([], []). 75 | %% perm([X|Xs], Ys1) :- perm(Xs, Ys), insert(Ys, X, Ys1). 76 | 77 | %% insert(X, Y, [Y|X]). 78 | %% insert([A|B], C, [A|D]) :- insert(B, C, D). 79 | -------------------------------------------------------------------------------- /src/erlog_shell.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2008-2013 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog_shell.erl 16 | %% Author : Robert Virding 17 | %% Purpose : A simple Erlog shell. 18 | 19 | -module(erlog_shell). 20 | 21 | -export([start/0,start/2,server/0,server/2]). 22 | 23 | -import(lists, [foldl/3,foreach/2]). 24 | 25 | start() -> spawn(fun () -> server() end). 26 | 27 | start(M, A) -> spawn(fun () -> server(M, A) end). 28 | 29 | server() -> server(erlog_db_dict, null). 30 | 31 | server(M, A) -> 32 | io:fwrite("Erlog Shell V~s (abort with ^G)\n", 33 | [erlang:system_info(version)]), 34 | {ok,Erl} = erlog:new(M, A), 35 | server_loop(Erl). 36 | 37 | %% A simple Erlog shell similar to a "normal" Prolog shell. It allows 38 | %% user to enter goals, see resulting bindings and request next 39 | %% solution. 40 | 41 | server_loop(Erl0) -> 42 | case erlog_io:read('| ?- ') of 43 | {ok,halt} -> ok; 44 | {ok,Files} when is_list(Files) -> 45 | case reconsult_files(Files, Erl0) of 46 | {ok,Erl1} -> 47 | io:fwrite("Yes\n"), 48 | server_loop(Erl1); 49 | {erlog_error,Error} -> 50 | io:fwrite("Error: ~s\n", [erlog_io:write1(Error)]), 51 | server_loop(Erl0); 52 | %% {error,{L,Pm,Pe}} -> 53 | %% io:fwrite("Error: ~w: ~s\n", [L,Pm:format_error(Pe)]), 54 | %% server_loop(Erl0); 55 | {error,Error} -> 56 | io:fwrite("Error: ~p\n", [Error]), 57 | server_loop(Erl0) 58 | end; 59 | {ok,{load,Mod}} -> 60 | case erlog:load(Mod, Erl0) of 61 | {ok,Erl1} -> show_bindings([], Erl1); 62 | {error,Error} -> 63 | io:fwrite("Error: ~s\n", [erlog_io:write1(Error)]), 64 | server_loop(Erl0) 65 | end; 66 | {ok,Goal} -> 67 | shell_prove_result(erlog:prove(Goal, Erl0)); 68 | {error,{_,Em,E}} -> 69 | io:fwrite("Error: ~s\n", [Em:format_error(E)]), 70 | server_loop(Erl0) 71 | end. 72 | 73 | reconsult_files([F|Fs], Erl0) -> 74 | case erlog:reconsult(F, Erl0) of 75 | {ok,Erl1} -> reconsult_files(Fs, Erl1); 76 | {error,Error} -> {error,Error} 77 | end; 78 | reconsult_files([], Erl) -> {ok,Erl}; 79 | reconsult_files(Other, _Db) -> {error,{type_error,list,Other}}. 80 | 81 | shell_prove_result({{succeed,Vs},Erl}) -> show_bindings(Vs, Erl); 82 | shell_prove_result({fail,Erl}) -> 83 | io:fwrite("No\n"), 84 | server_loop(Erl); 85 | shell_prove_result({{error,Error},Erl}) -> 86 | %% Errors from the Erlog interpreters. 87 | io:fwrite("Error: ~s\n", [erlog_io:write1(Error)]), 88 | server_loop(Erl); 89 | shell_prove_result({{'EXIT',Error},Erl}) -> %No new database here 90 | %% Errors and exits from user code. 91 | io:fwrite("EXIT: ~p\n", [Error]), 92 | server_loop(Erl). 93 | 94 | %% show_bindings(VarList, Estate) 95 | %% Show the bindings and query user for next solution. 96 | 97 | show_bindings([], Erl) -> 98 | io:fwrite("Yes\n"), 99 | server_loop(Erl); 100 | show_bindings(Vs, Erl) -> 101 | foreach(fun ({Name,Val}) -> 102 | Out = erlog_io:writeq1({'=',{Name},Val}), 103 | io:fwrite("~s\n", [Out]) 104 | end, Vs), 105 | Line = io:get_line(': '), 106 | case string:chr(Line, $;) of 107 | 0 -> 108 | io:fwrite("Yes\n"), 109 | server_loop(Erl); 110 | _ -> 111 | shell_prove_result(erlog:next_solution(Erl)) 112 | end. 113 | -------------------------------------------------------------------------------- /rebar.config.script: -------------------------------------------------------------------------------- 1 | %% -*- mode: erlang; indent-tabs-mode: nil -*- 2 | 3 | Conf0 = CONFIG, %The original config 4 | 5 | %% Do a deep set stepping down a list of keys replacing/adding last 6 | %% with value. Named funs would be nicer but not always available. 7 | 8 | SetConf = fun ([K], Val, Ps, _F) -> 9 | %% Replace the whole K field with Val. 10 | [Val|proplists:delete(K, Ps)]; 11 | ([K|Ks], Val, Ps, F) -> 12 | %% Step down and build coming up. 13 | case lists:keyfind(K, 1, Ps) of 14 | {K,Kps} -> 15 | lists:keyreplace(K, 1, Ps, {K,F(Ks, Val, Kps, F)}); 16 | false -> Ps ++ [{K,F(Ks, Val, [], F)}] 17 | end 18 | end, 19 | 20 | %% Get the release number. 21 | %% We have stolen the idea and most of the code from rebar3. 22 | 23 | OTPRelease = 24 | fun () -> 25 | case erlang:system_info(otp_release) of 26 | [$R,N1|Rest] when is_integer(N1) -> 27 | %% If OTP <= R16, take the digits. 28 | [N1|Rest]; 29 | Rel -> 30 | File = filename:join([code:root_dir(),"releases",Rel,"OTP_VERSION"]), 31 | case file:read_file(File) of 32 | {error, _} -> Rel; 33 | {ok, Vsn} -> 34 | Size = byte_size(Vsn), 35 | %% The shortest vsn string consists of at least 36 | %% two digits followed by "\n". Therefore, it's 37 | %% safe to assume Size >= 3. 38 | case binary:part(Vsn, {Size, -3}) of 39 | <<"**\n">> -> 40 | binary:bin_to_list(Vsn, {0, Size - 3}); 41 | _ -> 42 | binary:bin_to_list(Vsn, {0, Size - 1}) 43 | end 44 | end 45 | end 46 | end, 47 | 48 | Version = OTPRelease(), 49 | 50 | %% Collect the macro definitions we will add to the compiler options. 51 | %% Named funs would be nicer but not always available. 52 | 53 | AppendCopts = fun (Version, [{Ver,Opt}|Opts], F) -> 54 | Rest = F(Version, Opts, F), 55 | if Version >= Ver -> 56 | [{d,Opt,true}|Rest]; 57 | true -> 58 | Rest 59 | end; 60 | (_Version, [], _F) -> [] 61 | end, 62 | 63 | Copts0 = [{d,'ERLANG_VERSION',Version}], 64 | Copts = Copts0 ++ AppendCopts(Version, 65 | [{"17",'HAS_MAPS'}, 66 | {"18",'HAS_FULL_KEYS'}, 67 | {"19",'NEW_REC_CORE'}, 68 | {"19",'NEW_RAND'}, 69 | {"20",'NEW_BOOL_GUARD'}, 70 | {"20",'HAS_FLOOR'}, 71 | {"20",'HAS_CEIL'}, 72 | {"21",'NEW_STACKTRACE'}, 73 | {"23",'EEP48'}], 74 | AppendCopts), 75 | 76 | %% Ensure they are in erl_opts. 77 | 78 | Conf1 = case lists:keyfind(erl_opts, 1, Conf0) of 79 | {erl_opts,Opts} -> %Existing erl_opts 80 | NewOpts = {erl_opts,Opts ++ Copts}, 81 | lists:keyreplace(erl_opts, 1, Conf0, NewOpts); 82 | false -> %No erl_opts 83 | Conf0 ++ [{erl_opts,Copts}] 84 | end, 85 | 86 | %% Get the proper dep we will add to profiles-test-deps. 87 | 88 | Prop = if 89 | Version =< "17" -> {proper, "1.1.1-beta"}; 90 | Version =< "21" -> {proper, "1.3.0"}; 91 | Version =< "23" -> {proper, "1.4.0"}; 92 | true -> proper 93 | end, 94 | 95 | %% Ensure we have set the right value of proper dep. 96 | 97 | Conf2 = SetConf([profiles,test,deps,proper], Prop, Conf1, SetConf), 98 | 99 | Conf2. 100 | -------------------------------------------------------------------------------- /src/erlog_server.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2015 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog_server.erl 16 | %% Author : Robert Virding 17 | %% Purpose : Simple example of an Erlog server process. 18 | 19 | %% This is a simple gen_server which implements all the interface 20 | %% functions in the erlog modules as calls to a server. 21 | 22 | -module(erlog_server). 23 | 24 | -behaviour(gen_server). 25 | 26 | %% Management API. 27 | -export([start/0,start_link/0,start/2,start_link/2,stop/1]). 28 | 29 | %% User API. 30 | -export([prove/2,next_solution/1,consult/2,reconsult/2,load/2, 31 | get_db/1,set_db/2,set_db/3]). 32 | 33 | %% The behaviour callbacks. 34 | -export([init/1,terminate/2,code_change/3, 35 | handle_call/3,handle_cast/2,handle_info/2]). 36 | 37 | %% Management API. 38 | %% We can start/start_link with either the Erlog default database or 39 | %% we can specify the database module and initial argument to use. 40 | 41 | start_link() -> 42 | gen_server:start_link(?MODULE, none, []). 43 | 44 | start() -> 45 | gen_server:start(?MODULE, none, []). 46 | 47 | start_link(DbMod, DbArg) -> 48 | gen_server:start_link(?MODULE, {DbMod,DbArg}, []). 49 | 50 | start(DbMod, DbArg) -> 51 | gen_server:start(?MODULE, {DbMod,DbArg}, []). 52 | 53 | stop(Pid) -> 54 | gen_server:call(Pid, stop). 55 | 56 | %% User API. 57 | %% These are all the basic calls in the erlog module. 58 | 59 | prove(Pid, Goal) -> 60 | gen_server:call(Pid, {prove,Goal}). 61 | 62 | next_solution(Pid) -> 63 | gen_server:call(Pid, next_solution). 64 | 65 | consult(Pid, File) -> 66 | gen_server:call(Pid, {consult,File}). 67 | 68 | reconsult(Pid, File) -> 69 | gen_server:call(Pid, {reconsult,File}). 70 | 71 | load(Pid, Module) -> 72 | gen_server:call(Pid, {load,Module}). 73 | 74 | get_db(Pid) -> 75 | gen_server:call(Pid, get_db). 76 | 77 | set_db(Pid, DbRef) -> 78 | gen_server:call(Pid, {set_db,DbRef}). 79 | 80 | set_db(Pid, DbMod, DbRef) -> 81 | gen_server:call(Pid, {set_db,DbMod,DbRef}). 82 | 83 | %% Behaviour callbacks. 84 | 85 | -record(state, {erlog}). %Only the erlog state so far 86 | 87 | init(none) -> %Use default database 88 | {ok,Erlog} = erlog:new(), 89 | {ok,#state{erlog=Erlog}}; 90 | init({DbMod,DbArg}) -> %We specify database 91 | {ok,Erlog} = erlog:new(DbMod, DbArg), 92 | {ok,#state{erlog=Erlog}}. 93 | 94 | terminate(_, _) -> ok. %No need to do anything 95 | 96 | handle_call({prove,Goal}, _, #state{erlog=E0}=State) -> 97 | {Res,E1} = erlog:prove(Goal, E0), 98 | {reply,Res,State#state{erlog=E1}}; 99 | handle_call(next_solution, _, #state{erlog=E0}=State) -> 100 | {Res,E1} = erlog:next_solution(E0), 101 | {reply,Res,State#state{erlog=E1}}; 102 | handle_call({consult,File}, _, #state{erlog=E0}=State) -> 103 | case erlog:consult(File, E0) of 104 | {ok,E1} -> 105 | {reply,ok,State#state{erlog=E1}}; 106 | {error,Error} -> 107 | {reply,{error,Error},State} 108 | end; 109 | handle_call({reconsult,File}, _, #state{erlog=E0}=State) -> 110 | case erlog:reconsult(File, E0) of 111 | {ok,E1} -> 112 | {reply,ok,State#state{erlog=E1}}; 113 | {error,Error} -> 114 | {reply,{error,Error},State} 115 | end; 116 | handle_call({load,Module}, _, #state{erlog=E0}=State) -> 117 | {ok,E1} = erlog:load(Module, E0), 118 | {reply,ok,State#state{erlog=E1}}; 119 | handle_call(get_db, _, #state{erlog=E}=State) -> 120 | {reply,erlog:get_db(E),State}; 121 | handle_call({set_db,DbRef}, _, #state{erlog=E0}=State) -> 122 | E1 = erlog:set_db(DbRef, E0), 123 | {reply,ok,State#state{erlog=E1}}; 124 | handle_call({set_db,DbMod,DbRef}, _, #state{erlog=E0}=State) -> 125 | E1 = erlog:set_db(DbMod, DbRef, E0), 126 | {reply,ok,State#state{erlog=E1}}; 127 | handle_call(stop, _, State) -> 128 | {stop,normal,ok,State}; 129 | handle_call(_Other, _, State) -> %Ignore unknown requests 130 | {noreply,State}. %Let them timeout 131 | 132 | %% Unused callbacks. 133 | 134 | handle_cast(_, State) -> 135 | {noreply,State}. 136 | 137 | handle_info(_, State) -> 138 | {noreply,State}. 139 | 140 | code_change(_, State, _) -> 141 | {ok,State}. 142 | -------------------------------------------------------------------------------- /src/erlog_db_dict.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2014 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog_db_dict.erl 16 | %% Author : Robert Virding 17 | %% Purpose : Interface to an erlog database built with dict. 18 | 19 | %% The database is a dict where the key is the functor pair {Name,Arity}. 20 | %% The value is: built_in | 21 | %% {clauses,NextTag,[{Tag,Head,Body}]} | 22 | %% {code,{Module,Function}}. 23 | %% Built-ins are defined by the system and cannot manipulated by user 24 | %% code. 25 | 26 | -module(erlog_db_dict). 27 | 28 | -export([new/1]). 29 | -export([add_built_in/2,add_compiled_proc/4,asserta_clause/4,assertz_clause/4]). 30 | -export([retract_clause/3,abolish_clauses/2]). 31 | -export([get_procedure/2,get_procedure_type/2]). 32 | -export([get_interpreted_functors/1]). 33 | 34 | %% Return {ok,E} or catch thrown error and just return it. 35 | -define(RET_CATCH(E), try 36 | {ok,E} 37 | catch 38 | throw:Error -> Error 39 | end). 40 | 41 | %% new(InitArgs) -> Db. 42 | 43 | new(_Args) -> 44 | dict:new(). 45 | 46 | %% add_built_in(Db, Functor) -> Db. 47 | %% Add functor as a built-in in the database. 48 | 49 | add_built_in(Db, Functor) -> 50 | dict:store(Functor, built_in, Db). 51 | 52 | %% add_compiled_code(Db, Functor, Module, Function) -> {ok,Db} | error. 53 | %% Add functor as a compiled procedure with code in M:F in the 54 | %% database. Check that it is not a built-in, if so return error. 55 | 56 | add_compiled_proc(Db, Functor, M, F) -> 57 | Code = {code,{M,F}}, 58 | Fun = fun (built_in) -> throw(error); 59 | (_) -> Code 60 | end, 61 | ?RET_CATCH(dict:update(Functor, Fun, Code, Db)). 62 | 63 | %% asserta_clause(Db, Functor, Head, Body) -> {ok,NewDb} | error. 64 | %% assertz_clause(Db, Functor, Head, Body) -> {ok,NewDb} | error. 65 | %% We DON'T check format and just put it straight into the database. 66 | 67 | asserta_clause(Db, Functor, Head, Body) -> 68 | Fun = fun ({clauses,T,Cs}) -> 69 | {clauses,T+1,[{T,Head,Body}|Cs]}; 70 | (_) -> throw(error) 71 | end, 72 | ?RET_CATCH(dict:update(Functor, Fun, {clauses,1,[{0,Head,Body}]}, Db)). 73 | 74 | assertz_clause(Db, Functor, Head, Body) -> 75 | Fun = fun ({clauses,T,Cs}) -> 76 | {clauses,T+1,Cs ++ [{T,Head,Body}]}; 77 | (_) -> throw(error) 78 | end, 79 | ?RET_CATCH(dict:update(Functor, Fun, {clauses,1,[{0,Head,Body}]}, Db)). 80 | 81 | %% retract_clause(Db, Functor, ClauseTag) -> {ok,NewDb} | error. 82 | %% Retract (remove) the clause with tag ClauseTag from the list of 83 | %% clauses of Functor. 84 | 85 | retract_clause(Db, Functor, Tag) -> 86 | case dict:find(Functor, Db) of 87 | {ok,{clauses,Nt,Cs}} -> %We can retract here 88 | Db1 = dict:store(Functor, 89 | {clauses,Nt,lists:keydelete(Tag, 1, Cs)}, Db), 90 | {ok,Db1}; 91 | {ok,_} -> error; %We can't retract here 92 | error -> {ok,Db} %Do nothing 93 | end. 94 | 95 | %% abolish_clause(Db, Functor) -> {ok,NewDb} | error. 96 | 97 | abolish_clauses(Db, Functor) -> 98 | case dict:find(Functor, Db) of 99 | {ok,built_in} -> error; %Can't abolish here 100 | {ok,{code,_}} -> {ok,dict:erase(Functor, Db)}; 101 | {ok,{clauses,_,_}} -> {ok,dict:erase(Functor, Db)}; 102 | error -> {ok,Db} %Do nothing 103 | end. 104 | 105 | %% get_procedure(Db, Functor) -> 106 | %% built_in | {code,{Mod,Func}} | {clauses,[Clause]} | undefined. 107 | %% Return the procedure type and data for a functor. 108 | 109 | get_procedure(Db, Functor) -> 110 | case dict:find(Functor, Db) of 111 | {ok,built_in} -> built_in; 112 | {ok,{code,_}=P} -> P; 113 | {ok,{clauses,_,Cs}} -> {clauses,Cs}; 114 | error -> undefined 115 | end. 116 | 117 | %% get_procedure(Db, Functor) -> 118 | %% built_in | compiled | interpreted | undefined. 119 | %% Return the procedure type for a functor. 120 | 121 | get_procedure_type(Db, Functor) -> 122 | case dict:find(Functor, Db) of 123 | {ok,built_in} -> built_in; 124 | {ok,{code,_}} -> compiled; 125 | {ok,{clauses,_,_}} -> interpreted; 126 | error -> undefined 127 | end. 128 | 129 | %% get_intepreted_functors(Db) -> [Functor]. 130 | 131 | get_interpreted_functors(Db) -> 132 | dict:fold(fun (Func, {clauses,_,_}, Fs) -> [Func|Fs]; 133 | (_, _, Fs) -> Fs 134 | end, [], Db). 135 | -------------------------------------------------------------------------------- /src/erlog_db_ets.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2014-2018 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog_db_ets.erl 16 | %% Author : Robert Virding 17 | %% Purpose : Interface to an erlog database built with ETS. 18 | 19 | %% The database is an ets table where the key is the functor pair {Name,Arity}. 20 | %% The value is: {Functor,built_in} | 21 | %% {Functor,clauses,NextTag,[{Tag,Head,Body}]} | 22 | %% {Functor,code,{Module,Function}}. 23 | %% Built-ins are defined by the system and cannot manipulated by user 24 | %% code. 25 | 26 | -module(erlog_db_ets). 27 | 28 | 29 | -export([new/1]). 30 | -export([add_built_in/2,add_compiled_proc/4,asserta_clause/4,assertz_clause/4]). 31 | -export([retract_clause/3,abolish_clauses/2]). 32 | -export([get_procedure/2,get_procedure_type/2]). 33 | -export([get_interpreted_functors/1]). 34 | 35 | %% new(InitArgs) -> Db. 36 | 37 | new(Name) -> 38 | ets:new(Name, [named_table,set,protected,{keypos,1}]). 39 | 40 | %% add_built_in(Db, Functor) -> NewDb. 41 | %% Add Functor as a built-in in the database. 42 | 43 | add_built_in(Db, Functor) -> 44 | ets:insert(Db, {Functor,built_in}), 45 | Db. 46 | 47 | %% add_compiled_proc(Db, Functor, Module, Function) -> {ok,NewDb} | error. 48 | %% Add functor as a compiled procedure with code in M:F in the 49 | %% database. Check that it is not a built-in, if so return error. 50 | 51 | add_compiled_proc(Db, Functor, M, F) -> 52 | case ets:lookup(Db, Functor) of 53 | [{_,built_in}] -> error; 54 | _ -> 55 | ets:insert(Db, {Functor,code,{M,F}}), 56 | {ok,Db} 57 | end. 58 | 59 | %% asserta_clause(Db, Functor, Head, Body) -> {ok,NewDb} | error. 60 | %% assertz_clause(Db, Functor, Head, Body) -> {ok,NewDb} | error. 61 | %% We DON'T check format and just put it straight into the database. 62 | 63 | asserta_clause(Db, Functor, Head, Body) -> 64 | case ets:lookup(Db, Functor) of 65 | [{_,built_in}] -> error; 66 | [{_,code,_}] -> error; 67 | [{_,clauses,Tag,Cs}] -> 68 | ets:insert(Db, {Functor,clauses,Tag+1,[{Tag,Head,Body}|Cs]}), 69 | {ok,Db}; 70 | [] -> 71 | ets:insert(Db, {Functor,clauses,1,[{0,Head,Body}]}), 72 | {ok,Db} 73 | end. 74 | 75 | assertz_clause(Db, Functor, Head, Body) -> 76 | case ets:lookup(Db, Functor) of 77 | [{_,built_in}] -> error; 78 | [{_,code,_}] -> error; 79 | [{_,clauses,Tag,Cs}] -> 80 | ets:insert(Db, {Functor,clauses,Tag+1,Cs ++ [{Tag,Head,Body}]}), 81 | {ok,Db}; 82 | [] -> 83 | ets:insert(Db, {Functor,clauses,1,[{0,Head,Body}]}), 84 | {ok,Db} 85 | end. 86 | 87 | %% retract_clause(Db, Functor, ClauseTag) -> {ok,NewDb} | error. 88 | %% Retract (remove) the clause with tag ClauseTag from the list of 89 | %% clauses of Functor. 90 | 91 | retract_clause(Db, Functor, Tag) -> 92 | case ets:lookup(Db, Functor) of 93 | [{_,built_in}] -> error; %Can't retract here 94 | [{_,code,_}] -> error; %Can't retract here 95 | [{_,clauses,Nt,Cs}] -> 96 | ets:insert(Db, {Functor,clauses,Nt,lists:keydelete(Tag, 1, Cs)}), 97 | {ok,Db}; 98 | [] -> {ok,Db} %Do nothing 99 | end. 100 | 101 | %% abolish_clauses(Db, Functor) -> NewDatabase. 102 | 103 | abolish_clauses(Db, Functor) -> 104 | case ets:lookup(Db, Functor) of 105 | [{_,built_in}] -> error; %Can't abolish here 106 | [{_,code,_}] -> 107 | ets:delete(Db, Functor), 108 | {ok,Db}; 109 | [{_,clauses,_,_}] -> 110 | ets:delete(Db, Functor), 111 | {ok,Db}; 112 | [] -> {ok,Db} %Do nothing 113 | end. 114 | 115 | %% get_procedure(Db, Functor) -> 116 | %% built_in | {code,{Mod,Func}} | {clauses,[Clause]} | undefined. 117 | %% Return the procedure type and data for a functor. 118 | 119 | get_procedure(Db, Functor) -> 120 | case ets:lookup(Db, Functor) of 121 | [{_,built_in}] -> built_in; 122 | [{_,code,C}] -> {code,C}; 123 | [{_,clauses,_,Cs}] -> {clauses,Cs}; 124 | [] -> undefined 125 | end. 126 | 127 | %% get_procedure_type(Db, Functor) -> 128 | %% built_in | compiled | interpreted | undefined. 129 | %% Return the procedure type for a functor. 130 | 131 | get_procedure_type(Db, Functor) -> 132 | case ets:lookup(Db, Functor) of 133 | [{_,built_in}] -> built_in; %A built-in 134 | [{_,code,_}] -> compiled; %Compiled (perhaps someday) 135 | [{_,clauses,_,_}] -> interpreted; %Interpreted clauses 136 | [] -> undefined %Undefined 137 | end. 138 | 139 | %% get_interp_functors(Db) -> [Functor]. 140 | 141 | get_interpreted_functors(Db) -> 142 | ets:foldl(fun ({Func,clauses,_,_}, Fs) -> [Func|Fs]; 143 | (_, Fs) -> Fs 144 | end, [], Db). 145 | -------------------------------------------------------------------------------- /examples/trees.pl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: prolog -*- 2 | % File : TREES.PL 3 | % Author : R.A.O'Keefe 4 | % Updated: 25 November 1983 5 | % Purpose: Updatable binary trees. 6 | 7 | % /* These are the routines I meant to describe in DAI-WP-150, but the 8 | % wrong version went in. We have 9 | % list_to_tree : O(N) 10 | % tree_to_list : O(N) 11 | % tree_size : O(N) 12 | % map_tree : O(N) 13 | % get_label : O(lg N) 14 | % put_label : O(lg N) 15 | % where N is the number of elements in the tree. The way get_label 16 | % and put_label work is worth noting: they build up a pattern which 17 | % is matched against the whole tree when the position number finally 18 | % reaches 1. In effect they start out from the desired node and 19 | % build up a path to the root. They still cost O(lg N) time rather 20 | % than O(N) because the patterns contain O(lg N) distinct variables, 21 | % with no duplications. put_label simultaneously builds up a pattern 22 | % to match the old tree and a pattern to match the new tree. 23 | % */ 24 | 25 | % :- public 26 | % get_label/3, 27 | % list_to_tree/2, 28 | % map_tree/3, 29 | % put_label/4, 30 | % tree_size/2, 31 | % tree_to_list/2. 32 | 33 | % :- mode 34 | % get_label(+, +, ?), 35 | % find_node(+, +, +), 36 | % list_to_tree(+, -), 37 | % list_to_tree(+, +, -), 38 | % list_to_tree(+), 39 | % map_tree(+, +, -), 40 | % put_label(+, +, +, -), 41 | % find_node(+, +, +, -, +), 42 | % tree_size(+, ?), 43 | % tree_size(+, +, -), 44 | % tree_to_list(+, -), 45 | % tree_to_list(+, -, -). 46 | 47 | 48 | % get_label(Index, Tree, Label) 49 | % treats the tree as an array of N elements and returns the Index-th. 50 | % If Index < 1 or > N it simply fails, there is no such element. 51 | 52 | get_label(N, Tree, Label) :- 53 | find_node(N, Tree, t(Label,_,_)). 54 | 55 | 56 | find_node(1, Tree, Tree) :- !. 57 | find_node(N, Tree, Node) :- 58 | N > 1, 59 | 0 is N mod 2, 60 | M is N // 2, !, 61 | find_node(M, Tree, t(_,Node,_)). 62 | find_node(N, Tree, Node) :- 63 | N > 2, 64 | 1 is N mod 2, 65 | M is N // 2, !, 66 | find_node(M, Tree, t(_,_,Node)). 67 | 68 | 69 | 70 | % list_to_tree(List, Tree) 71 | % takes a given List of N elements and constructs a binary Tree 72 | % where get_label(K, Tree, Lab) <=> Lab is the Kth element of List. 73 | 74 | list_to_tree(List, Tree) :- 75 | list_to_tree(List, [Tree|Tail], Tail). 76 | 77 | 78 | list_to_tree([Head|Tail], [t(Head,Left,Right)|Qhead], [Left,Right|Qtail]) :- 79 | list_to_tree(Tail, Qhead, Qtail). 80 | list_to_tree([], Qhead, []) :- 81 | list_to_tree(Qhead). 82 | 83 | 84 | list_to_tree([t|Qhead]) :- 85 | list_to_tree(Qhead). 86 | list_to_tree([]). 87 | 88 | 89 | 90 | % map_tree(Pred, OldTree, NewTree) 91 | % is true when OldTree and NewTree are binary trees of the same shape 92 | % and Pred(Old,New) is true for corresponding elements of the two trees. 93 | % In fact this routine is perfectly happy constructing either tree given 94 | % the other, I have given it the mode I have for that bogus reason 95 | % "efficiency" and because it is normally used this way round. This is 96 | % really meant more as an illustration of how to map over trees than as 97 | % a tool for everyday use. 98 | 99 | map_tree(Pred, t(Old,OLeft,ORight), t(New,NLeft,NRight)) :- 100 | apply(Pred, [Old,New]), 101 | map_tree(Pred, OLeft, NLeft), 102 | map_tree(Pred, ORight, NRight). 103 | map_tree(_, t, t). 104 | 105 | 106 | 107 | % put_label(Index, OldTree, Label, NewTree) 108 | % constructs a new tree the same shape as the old which moreover has the 109 | % same elements except that the Index-th one is Label. Unlike the 110 | % "arrays" of Arrays.Pl, OldTree is not modified and you can hang on to 111 | % it as long as you please. Note that O(lg N) new space is needed. 112 | 113 | put_label(N, Old, Label, New) :- 114 | find_node(N, Old, t(_,Left,Right), New, t(Label,Left,Right)). 115 | 116 | 117 | find_node(1, Old, Old, New, New) :- !. 118 | find_node(N, Old, OldSub, New, NewSub) :- 119 | N > 1, 120 | 0 is N mod 2, 121 | M is N // 2, !, 122 | find_node(M, Old, t(Label,OldSub,Right), New, t(Label,NewSub,Right)). 123 | find_node(N, Old, OldSub, New, NewSub) :- 124 | N > 2, 125 | 1 is N mod 2, 126 | M is N // 2, !, 127 | find_node(M, Old, t(Label,Left,OldSub), New, t(Label,Left,NewSub)). 128 | 129 | 130 | 131 | % tree_size(Tree, Size) 132 | % calculates the number of elements in the Tree. All trees made by 133 | % list_to_tree that are the same size have the same shape. 134 | 135 | tree_size(Tree, Size) :- 136 | tree_size(Tree, 0, Total), !, 137 | Size = Total. 138 | 139 | 140 | tree_size(t(_,Left,Right), SoFar, Total) :- 141 | tree_size(Right, SoFar, M), 142 | N is M+1, !, 143 | tree_size(Left, N, Total). 144 | tree_size(t, Accum, Accum). 145 | 146 | 147 | 148 | % tree_to_list(Tree, List) 149 | % is the converse operation to list_to_tree. Any mapping or checking 150 | % operation can be done by converting the tree to a list, mapping or 151 | % checking the list, and converting the result, if any, back to a tree. 152 | % It is also easier for a human to read a list than a tree, as the 153 | % order in the tree goes all over the place. 154 | 155 | tree_to_list(Tree, List) :- 156 | tree_to_list([Tree|Tail], Tail, List). 157 | 158 | 159 | tree_to_list([], [], []) :- !. 160 | tree_to_list([t|_], _, []) :- !. 161 | tree_to_list([t(Head,Left,Right)|Qhead], [Left,Right|Qtail], [Head|Tail]) :- 162 | tree_to_list(Qhead, Qtail, Tail). 163 | 164 | 165 | -------------------------------------------------------------------------------- /src/erlog_scan.xrl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2008-2013 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog_scan.xrl 16 | %% Author : Robert Virding 17 | %% Purpose : Token definitions for Erlog. 18 | 19 | Definitions. 20 | B = (0|1) 21 | O = [0-7] 22 | D = [0-9] 23 | H = [0-9a-fA-F] 24 | U = [A-Z] 25 | L = [a-z] 26 | A = ({U}|{L}|{D}|_) 27 | G = [-#$&*+./\\:<=>?@^~] 28 | S = [](),[}{|] 29 | LC = (%.*) 30 | BC = (/\*([^*]|\*+[^*/])*\*+/) 31 | WS = ([\000-\s]|{LC}|{BC}) 32 | 33 | Rules. 34 | %% We need whitespace first so /**/ is interpreted as comment. 35 | %% Must separate ( preceded by white space from those that aren't. 36 | {WS}+\( : {token,{' (',TokenLine}}. 37 | \.{WS} : {end_token,{'.',TokenLine}}. 38 | {WS}+ : skip_token. 39 | 40 | %% Numbers. 41 | {D}+\.{D}+((E|e)(\+|\-)?{D}+)? : 42 | {token,{number,TokenLine,list_to_float(TokenChars)}}. 43 | {D}+ : {token,{number,TokenLine,list_to_integer(TokenChars)}}. 44 | 0b{B}+ : base(TokenLine, string:substr(TokenChars, 3), 2). 45 | 0o{O}+ : base(TokenLine, string:substr(TokenChars, 3), 8). 46 | 0x{H}+ : base(TokenLine, string:substr(TokenChars, 3), 16). 47 | 0'(\\{O}+\\|\\x{H}+\\|\\.|.) : 48 | {token,{number,TokenLine,hd(chars(string:substr(TokenChars, 3)))}}. 49 | 50 | %% Atoms. 51 | {L}{A}* : {token,{atom,TokenLine,list_to_atom(TokenChars)}}. 52 | ! : {token,{atom,TokenLine,'!'}}. 53 | ; : {token,{atom,TokenLine,';'}}. 54 | {G}+ : {token,{atom,TokenLine,list_to_atom(TokenChars)}}. 55 | '(\\{O}+\\|\\x{H}+\\|\\.|[^'])*' : 56 | %% Strip quotes. 57 | S = string:substr(TokenChars, 2, TokenLen - 2), 58 | case catch list_to_atom(chars(S)) of 59 | {'EXIT',_} -> {error,"illegal atom " ++ TokenChars}; 60 | Atom -> {token,{atom,TokenLine,Atom}} 61 | end. 62 | 63 | %% Variables. 64 | ({U}|_){A}* : {token,{var,TokenLine,list_to_atom(TokenChars)}}. 65 | 66 | %% Strings. 67 | "(\\{O}+\\|\\x{H}+\\|\\.|[^"])*" : 68 | %% Strip quotes. 69 | S = string:substr(TokenChars, 2, TokenLen - 2), 70 | {token,{string,TokenLine,chars(S)}}. 71 | 72 | %% Separators. 73 | {S} : {token,{list_to_atom(TokenChars),TokenLine}}. 74 | 75 | Erlang code. 76 | 77 | %% Copyright (c) 2008-2013 Robert Virding 78 | %% 79 | %% Licensed under the Apache License, Version 2.0 (the "License"); 80 | %% you may not use this file except in compliance with the License. 81 | %% You may obtain a copy of the License at 82 | %% 83 | %% http://www.apache.org/licenses/LICENSE-2.0 84 | %% 85 | %% Unless required by applicable law or agreed to in writing, software 86 | %% distributed under the License is distributed on an "AS IS" BASIS, 87 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 88 | %% See the License for the specific language governing permissions and 89 | %% limitations under the License. 90 | 91 | %% File : erlog_scan.erl 92 | %% Author : Robert Virding 93 | %% Purpose : Token definitions for Erlog. 94 | 95 | -import(string, [substr/2,substr/3]). 96 | 97 | %% base(Line, Chars, Base) -> Integer. 98 | %% Convert a string of Base characters into a number. We know that 99 | %% the strings only contain the correct character. 100 | 101 | base(L, Cs, B) -> 102 | case base1(Cs, B, 0) of 103 | {N,[]} -> {token,{number,L,N}}; 104 | {_,_} -> {error,"illegal based number"} 105 | end. 106 | 107 | base1([C|Cs], Base, SoFar) when C >= $0, C =< $9, C < Base + $0 -> 108 | Next = SoFar * Base + (C - $0), 109 | base1(Cs, Base, Next); 110 | base1([C|Cs], Base, SoFar) when C >= $a, C =< $f, C < Base + $a - 10 -> 111 | Next = SoFar * Base + (C - $a + 10), 112 | base1(Cs, Base, Next); 113 | base1([C|Cs], Base, SoFar) when C >= $A, C =< $F, C < Base + $A - 10 -> 114 | Next = SoFar * Base + (C - $A + 10), 115 | base1(Cs, Base, Next); 116 | base1([C|Cs], _Base, SoFar) -> {SoFar,[C|Cs]}; 117 | base1([], _Base, N) -> {N,[]}. 118 | 119 | %% chars(InputChars) -> Chars. 120 | %% Convert an input string into the corresponding string 121 | %% characters. We know that the input string is correct. 122 | 123 | chars([$\\,$x,C|Cs0]) -> 124 | case hex_char(C) of 125 | true -> 126 | case base1([C|Cs0], 16, 0) of 127 | {N,[$\\|Cs1]} -> [N|chars(Cs1)]; 128 | _Other -> [escape_char($x)|chars([C|Cs0])] 129 | end; 130 | false -> [escape_char($x)|chars([C|Cs0])] 131 | end; 132 | chars([$\\,C|Cs0]) when C >= $0, C =< $7 -> 133 | case base1(Cs0, 8, C - $0) of 134 | {N,[$\\|Cs1]} -> [N|chars(Cs1)]; 135 | _Other -> [escape_char(C)|chars(Cs0)] 136 | end; 137 | chars([$\\,C|Cs]) -> [escape_char(C)|chars(Cs)]; 138 | chars([C|Cs]) -> [C|chars(Cs)]; 139 | chars([]) -> []. 140 | 141 | hex_char(C) when C >= $0, C =< $9 -> true; 142 | hex_char(C) when C >= $a, C =< $f -> true; 143 | hex_char(C) when C >= $A, C =< $F -> true; 144 | hex_char(_) -> false. 145 | 146 | escape_char($n) -> $\n; %\n = LF 147 | escape_char($r) -> $\r; %\r = CR 148 | escape_char($t) -> $\t; %\t = TAB 149 | escape_char($v) -> $\v; %\v = VT 150 | escape_char($b) -> $\b; %\b = BS 151 | escape_char($f) -> $\f; %\f = FF 152 | escape_char($e) -> $\e; %\e = ESC 153 | escape_char($s) -> $\s; %\s = SPC 154 | escape_char($d) -> $\d; %\d = DEL 155 | escape_char(C) -> C. 156 | -------------------------------------------------------------------------------- /src/erlog.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2008-2014 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog.erl 16 | %% Author : Robert Virding 17 | %% Purpose : Main interface to the Erlog interpreter. 18 | %% 19 | %% Structures - {Functor,arg1, Arg2,...} where Functor is an atom 20 | %% Variables - {Name} where Name is an atom or integer 21 | %% Lists - Erlang lists 22 | %% Atomic - Erlang constants 23 | %% 24 | %% There is no problem with the representation of variables as Prolog 25 | %% functors of arity 0 are atoms. This representation is much easier 26 | %% to test for, and create new variables with than using funny atom 27 | %% names like '$1' (yuch!), and we need LOTS of variables. 28 | 29 | -module(erlog). 30 | 31 | -include("erlog_int.hrl"). 32 | 33 | %% Top level erlog state. 34 | -record(erlog, {vs=[],est}). 35 | 36 | %% Basic evaluator interface. 37 | -export([new/0,new/2, 38 | prove/2,next_solution/1, 39 | consult/2,reconsult/2,load/2, 40 | get_db/1,set_db/2,set_db/3]). 41 | %% User utilities. 42 | -export([is_legal_term/1,vars_in/1]). 43 | 44 | -import(lists, [foldl/3,foreach/2]). 45 | 46 | %% -compile(export_all). 47 | 48 | %% new() -> {ok,ErlogState}. 49 | %% new(DbModule, DbInitArgs) -> {ok,ErlogState}. 50 | %% Initialise a new erlog state. 51 | 52 | new() -> new(erlog_db_dict, null). %The default 53 | 54 | new(DbMod, DbArg) -> 55 | {ok,St} = erlog_int:new(DbMod, DbArg), 56 | Db1 = foldl(fun (M, Db) -> M:load(Db) end, St#est.db, 57 | [erlog_bips, 58 | erlog_lib_dcg, 59 | erlog_lib_lists 60 | ]), 61 | {ok,#erlog{vs=[],est=St#est{db=Db1}}}. 62 | 63 | prove(Goal, #erlog{}=Erl) -> 64 | prove_goal(Goal, Erl). 65 | 66 | next_solution(#erlog{vs=Vs,est=St}=Erl) -> 67 | %% This generates a completely new #est{}. 68 | prove_result(catch erlog_int:fail(St), Vs, Erl). 69 | 70 | consult(File, #erlog{est=St0}=Erl) -> 71 | case erlog_file:consult(File, St0) of 72 | {ok,St1} -> {ok,Erl#erlog{est=St1}}; 73 | {erlog_error,Error} -> {error,Error}; 74 | {error,Error} -> {error,Error} 75 | end. 76 | 77 | reconsult(File, #erlog{est=St0}=Erl) -> 78 | case erlog_file:reconsult(File, St0) of 79 | {ok,St1} -> {ok,Erl#erlog{est=St1}}; 80 | {erlog_error,Error} -> {error,Error}; 81 | {error,Error} -> {error,Error} 82 | end. 83 | 84 | load(Mod, #erlog{est=St}=Erl) -> 85 | Db1 = Mod:load(St#est.db), 86 | {ok,Erl#erlog{est=St#est{db=Db1}}}. 87 | 88 | get_db(#erlog{est=St}) -> 89 | (St#est.db)#db.ref. 90 | 91 | set_db(Ref, #erlog{est=St}=Erl) -> 92 | #est{db=Db0} = St, 93 | Db1 = Db0#db{ref=Ref}, 94 | Erl#erlog{est=St#est{db=Db1}}. 95 | 96 | set_db(Mod, Ref, #erlog{est=St}=Erl) -> 97 | #est{db=Db0} = St, 98 | Db1 = Db0#db{mod=Mod,ref=Ref}, 99 | Erl#erlog{est=St#est{db=Db1}}. 100 | 101 | %% Internal functions. 102 | 103 | prove_goal(Goal0, #erlog{est=St}=Erl) -> 104 | Vs = vars_in(Goal0), 105 | %% Goal may be a list of goals, ensure proper goal. 106 | Goal1 = unlistify(Goal0), 107 | %% Must use 'catch' here as 'try' does not do last-call 108 | %% optimisation. 109 | %% This generates a completely new #est{}. 110 | Result = (catch erlog_int:prove_goal(Goal1, St)), 111 | prove_result(Result, Vs, Erl). 112 | 113 | unlistify([G]) -> G; 114 | unlistify([G|Gs]) -> {',',G,unlistify(Gs)}; 115 | unlistify([]) -> true; 116 | unlistify(G) -> G. %In case it wasn't a list. 117 | 118 | prove_result({succeed,#est{bs=Bs}=St}, Vs, Erl) -> 119 | {{succeed,erlog_int:dderef(Vs, Bs)}, 120 | Erl#erlog{vs=Vs,est=St}}; 121 | prove_result({fail,St}, _Vs, Erl) -> 122 | {fail,Erl#erlog{vs=[],est=St}}; 123 | prove_result({erlog_error,Error,St}, _Vs, Erl) -> 124 | {{error,Error},Erl#erlog{vs=[],est=St}}; 125 | prove_result({erlog_error,Error}, _Vs, Erl) -> %No new state 126 | {{error,Error},Erl#erlog{vs=[]}}; % keep old state 127 | prove_result({'EXIT',Error}, _Vs, Erl) -> 128 | {{'EXIT',Error},Erl#erlog{vs=[]}}. %Keep old state 129 | 130 | %% vars_in(Term) -> [{Name,Var}]. 131 | %% Returns an ordered list of {VarName,Variable} pairs. 132 | 133 | vars_in(Term) -> vars_in(Term, orddict:new()). 134 | 135 | vars_in({'_'}, Vs) -> Vs; %Never in! 136 | vars_in({Name}=Var, Vs) -> orddict:store(Name, Var, Vs); 137 | vars_in(Struct, Vs) when is_tuple(Struct) -> 138 | vars_in_struct(Struct, 2, tuple_size(Struct), Vs); 139 | vars_in([H|T], Vs) -> 140 | vars_in(T, vars_in(H, Vs)); 141 | vars_in(_, Vs) -> Vs. 142 | 143 | vars_in_struct(_Str, I, S, Vs) when I > S -> Vs; 144 | vars_in_struct(Str, I, S, Vs) -> 145 | vars_in_struct(Str, I+1, S, vars_in(element(I, Str), Vs)). 146 | 147 | %% is_legal_term(Goal) -> true | false. 148 | %% Test if a goal is a legal Erlog term. Basically just check if 149 | %% tuples are used correctly as structures and variables. 150 | 151 | is_legal_term({V}) -> is_atom(V); 152 | is_legal_term([H|T]) -> 153 | is_legal_term(H) andalso is_legal_term(T); 154 | is_legal_term(T) when ?IS_FUNCTOR(T) -> 155 | are_legal_args(T, 2, tuple_size(T)); 156 | is_legal_term(T) when ?IS_ATOMIC(T) -> true; %All constants, including [] 157 | is_legal_term(_T) -> false. 158 | 159 | are_legal_args(_T, I, S) when I > S -> true; 160 | are_legal_args(T, I, S) -> 161 | is_legal_term(element(I, T)) andalso are_legal_args(T, I+1, S). 162 | -------------------------------------------------------------------------------- /src/erlog_ets.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2008-2014 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog_ets.erl 16 | %% Author : Robert Virding 17 | %% Purpose : ETS interface for Erlog. 18 | 19 | -module(erlog_ets). 20 | 21 | -include("erlog_int.hrl"). 22 | 23 | -compile(export_all). 24 | 25 | -export([load/1,all_1/3,key_2/3,match_2/3]). 26 | 27 | -import(lists, [foldl/3]). 28 | -import(erlog_int, [add_compiled_proc/4,dderef/2,unify/3, 29 | prove_body/2,unify_prove_body/4,fail/1]). 30 | 31 | %% load(Database) -> Database. 32 | %% Assert predicates into the database. 33 | 34 | load(Db0) -> 35 | Db1 = foldl(fun ({Head,M,F}, LDb) -> 36 | add_compiled_proc(Head, M, F, LDb) end, Db0, 37 | [ 38 | {{ets_all,1},?MODULE,all_1}, 39 | {{ets_key,2},?MODULE,key_2}, 40 | {{ets_match,2},?MODULE,match_2} 41 | ]), 42 | Db1. 43 | 44 | %% all_1(Head, NextGoal, State) -> void(). 45 | %% Goal = {ets_all,Tables}. 46 | %% Return all the ETS databases. 47 | 48 | all_1({ets_all,Var}, Next, St) -> 49 | Tabs = ets:all(), 50 | unify_prove_body(Var, Tabs, Next, St). 51 | 52 | %% key_2(Head, NextGoal, State) -> void(). 53 | %% Goal = {ets_key,Table,Key}. 54 | %% Return the key in an ETS database one at a time over backtracking. 55 | 56 | key_2({ets_key,Tab0,KeyVar}, Next, #est{bs=Bs}=St) -> 57 | Tab1 = dderef(Tab0, Bs), 58 | %% io:format("kf: ~p ~p\n", [Tab1,ets:first(Tab1)]), 59 | Key = ets:first(Tab1), 60 | key_2_loop(Tab1, Key, KeyVar, Next, St). 61 | 62 | key_2_loop(_Tab, '$end_of_table', _KeyVar, _Next, St) -> 63 | fail(St); 64 | key_2_loop(Tab, Key, KeyVar, Next, #est{cps=Cps,bs=Bs,vn=Vn}=St) -> 65 | FailFun = fun(LCp, LCps, Lst) -> 66 | key_2_fail(LCp, LCps, Lst, Tab, Key, KeyVar) 67 | end, 68 | Cp = #cp{type=compiled,data=FailFun,next=Next,bs=Bs,vn=Vn}, 69 | unify_prove_body(KeyVar, Key, Next, St#est{cps=[Cp|Cps]}). 70 | 71 | key_2_fail(#cp{next=Next,bs=Bs,vn=Vn}, Cps, St, Tab, PrevKey, KeyVar) -> 72 | %% io:format("kn: ~p ~p\n", [PrevKey,ets:next(Tab,PrevKey)]), 73 | NextKey = ets:next(Tab, PrevKey), 74 | key_2_loop(Tab, NextKey, KeyVar, Next, St#est{cps=Cps,bs=Bs,vn=Vn}). 75 | 76 | %% match_2(Head, Next, State) -> void(). 77 | %% Head = {ets_match,Table,Pattern}. 78 | %% Match objects in an ETS database one at a time over backtracking 79 | %% using Pattern in goal. Variables in Pattern are bound for each 80 | %% object matched. 81 | 82 | match_2({ets_match,Tab0,Pat0}, Next, #est{bs=Bs}=St) -> 83 | Tab1 = dderef(Tab0, Bs), 84 | Pat1 = dderef(Pat0, Bs), 85 | {Epat,Vs} = ets_pat(Pat1), 86 | %% io:format("Pat1: ~p\nEpat: ~p\nVs: ~p\n", [Pat1,Epat,Vs]), 87 | match_2_loop(ets:match(Tab1, Epat, 10), Next, St, Epat, Vs). 88 | 89 | match_2_loop({[M|Ms],Cont}, Next, #est{cps=Cps,bs=Bs,vn=Vn}=St, Epat, Vs) -> 90 | %% io:format("m2l: ~p\n ~p\n",[M,Vs]), 91 | FailFun = fun (LCp, LCps, Lst) -> 92 | match_2_fail(LCp, LCps, Lst, Epat, Vs, {Ms,Cont}) 93 | end, 94 | Cp = #cp{type=compiled,data=FailFun,next=Next,bs=Bs,vn=Vn}, 95 | unify_prove_body(Vs, M, Next, St#est{cps=[Cp|Cps]}); 96 | match_2_loop({[],Cont}, Next, St, Epat, Vs) -> 97 | match_2_loop(ets:match(Cont), Next, St, Epat, Vs); 98 | match_2_loop('$end_of_table', _Next, St, _Epat, _Vs) -> 99 | fail(St). 100 | 101 | match_2_fail(#cp{next=Next,bs=Bs,vn=Vn}, Cps, St, Epat, Vs, Ms) -> 102 | match_2_loop(Ms, Next, St#est{cps=Cps,bs=Bs,vn=Vn}, Epat, Vs). 103 | 104 | %% ets_pat(Term) -> {EtsPattern,VarList}. 105 | 106 | %% Convert a term into an ETS pattern replacing variables with the ETS 107 | %% pattern variables. Also return a list of pattern variable/erlog 108 | %% variable in the same order as ETS will return the list of 109 | %% values. We do this by strictly building backwards and adding the 110 | %% '$N' variables form the back incrementing the index. They will then 111 | %% be in reverse order. 112 | 113 | ets_pat(Pat) -> 114 | {Epat,_Vn,Vs0} = ets_pat(Pat, 0, []), 115 | Evs = [ V || {V,_Ec} <- lists:reverse(Vs0) ], 116 | {Epat,Evs}. 117 | 118 | ets_pat({'_'}, Vn, Vs) -> %_ variable passed on as is 119 | {'_',Vn, Vs}; 120 | ets_pat({_}=V, Vn, Vs) -> 121 | case find(V, Vs) of 122 | {yes,Ev} -> {Ev,Vn,Vs}; 123 | no -> 124 | Ev = ets_var(Vn), 125 | {Ev,Vn+1,[{V,Ev}|Vs]} 126 | end; 127 | ets_pat([H|T], Vn0, Vs0) -> 128 | {Et,Vn1,Vs1} = ets_pat(T, Vn0, Vs0), 129 | {Eh,Vn2,Vs2} = ets_pat(H, Vn1, Vs1), 130 | {[Eh|Et],Vn2,Vs2}; 131 | ets_pat(T, Vn0, Vs0) when is_tuple(T), tuple_size(T) >= 2 -> 132 | {Ees,Vn1,Vs1} = ets_pat_elements(T, tuple_size(T), [], Vn0, Vs0), 133 | {list_to_tuple(Ees),Vn1,Vs1}; 134 | ets_pat(C, Vn, Vs) -> {C,Vn,Vs}. %Constant for erlog 135 | 136 | ets_pat_elements(_T, 0, Ees, Vn, Vs) -> {Ees,Vn,Vs}; 137 | ets_pat_elements(T, I, Ees, Vn0, Vs0) -> 138 | {Ee,Vn1,Vs1} = ets_pat(element(I, T), Vn0, Vs0), 139 | ets_pat_elements(T, I-1, [Ee|Ees], Vn1, Vs1). 140 | 141 | find(V, [{V,Ev}|_Vs]) -> {yes,Ev}; 142 | find(V, [_P|Vs]) -> find(V, Vs); 143 | find(_V, []) -> no. 144 | 145 | ets_var(1) -> '$1'; 146 | ets_var(2) -> '$2'; 147 | ets_var(3) -> '$3'; 148 | ets_var(4) -> '$4'; 149 | ets_var(5) -> '$5'; 150 | ets_var(6) -> '$6'; 151 | ets_var(7) -> '$7'; 152 | ets_var(8) -> '$8'; 153 | ets_var(9) -> '$9'; 154 | ets_var(10) -> '$10'; 155 | ets_var(11) -> '$11'; 156 | ets_var(12) -> '$12'; 157 | ets_var(13) -> '$13'; 158 | ets_var(14) -> '$14'; 159 | ets_var(15) -> '$15'; 160 | ets_var(16) -> '$16'; 161 | ets_var(N) -> %Do the rest less efficiently 162 | list_to_atom([$$|integer_to_list(N)]). 163 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | [![Build Status](https://travis-ci.org/zkessin/erlog.svg?branch=master)](https://travis-ci.org/zkessin/erlog) 3 | 4 | ## Erlog - Prolog for an Erlang Application 5 | 6 | Erlog is a Prolog interpreter implemented in Erlang and integrated 7 | with the Erlang runtime system. It is a subset of the Prolog standard. 8 | An Erlog shell (REPL) is also included. 9 | 10 | You should use this if you want to include some Prolog or logic 11 | programming functionality in a larger Erlang system (Including Elixir, 12 | LFE, Joxa etc). If you want a stand alone Prolog you are probably 13 | better off using a package like SWI Prolog. 14 | 15 | 16 | ## The Function interface 17 | 18 | This is a low level interface, which is meant to built upon as much as used directly. 19 | 20 | To create an Erlog instance in a closure use `erlog:new()` this will 21 | return `{ok, State}` Where state is the current state of the Erlog 22 | system. You should treat it as an opaque data structure. To prove a 23 | clause or run Prolog code you can then run `erlog:prove(State, {...})` 24 | This will return a new closure and a return of type 25 | `erlog_return()`. To consult a file you can run `erlog:consult(State, 26 | FILE)` which will return a new closure and 'ok' or an error. 27 | 28 | For example take this code: 29 | We start by creating a new instance of the Erlog engine, then we 30 | it starts with an append statement which ask it to append lists `A` 31 | and `B`. The return value is designated with a 1 tuple with an atom 32 | value for the return variable, in this case `{'Z'}`. 33 | 34 | If the Prolog code works correctly it will return the tuple `{{succeed, 35 | [{'Z', Value}]}, NewState}`. 36 | 37 | 38 | 39 | ````erlang 40 | {ok,Erlog} = erlog:new(), 41 | case erlog:prove({append,A,B,{'Z'}}, Erlog) of 42 | {{succeed, [{'Z', Z}]}, E1} when is_record(E1,est) -> 43 | Z =:= lists:append(A,B); 44 | fail -> 45 | false 46 | end 47 | ```` 48 | 49 | The dialyzer types of some of Erlog's functions are as such 50 | 51 | ````erlang 52 | -opaque erlog_state() :: #est{}. 53 | -type functor() :: tuple(). 54 | -type erlog_return(Value) :: {Value,erlog_state()}. 55 | -spec prove(erlog_state(), functor()) -> erlog_return({succeed, [{atom(), any()}]}|fail). 56 | -spec prove(erlog_state(), file()) -> erlog_return(ok|{error, atom()}). 57 | 58 | 59 | ```` 60 | 61 | If you want to build a gen_server out of your Prolog code checkout the Erlog server project https://github.com/zkessin/erlog-server 62 | 63 | If you have questions about Erlog post them tagged with Erlog on Stack Overflow http://stackoverflow.com/questions/tagged/erlog 64 | 65 | ## Passing Data between Erlang and Prolog 66 | 67 | If you want to pass data between Erlang and Prolog it is pretty easy 68 | to do so. Data types map pretty cleanly between the two languages due 69 | to the fact that Erlang evolved from Prolog. 70 | 71 | ### Atoms 72 | Atoms are the same in Erlang and Prolog, and can be passed back and 73 | forth without problem. 74 | 75 | ### Numeric Data 76 | Integer and floating point numbers similarly can be passed back and 77 | forth. 78 | 79 | ### Opaque data 80 | 81 | Erlog does not understand references, ports and pids. They can be 82 | passed through Erlog but Erlog won't be able to do more than basic 83 | comparisons on them. 84 | 85 | ### Structured Data 86 | 87 | It is possible to send structured Erlang data to Prolog, and this is 88 | often very useful. Lists can be sent directly back and forth. Maps are 89 | not (Yet) supported, we will be looking into how to support them in 90 | the future. 91 | 92 | Erlog understands Erlang tuples to be facts. So the Erlang tuple 93 | `{foo, 1, 2, 3}` would show up in Erlog as the fact `foo(1,2,3)`. The 94 | upshot of this is that all tuples that are passed to Erlog must have 95 | an atom as the first element and must have more than 1 element. The 96 | tuple `{atom()}` will be understood to be a Prolog variable. 97 | 98 | Records in Erlang are just tuples with an initial atom. So it is 99 | possible to pass records between Erlog and Erlang. The record 100 | definition here and the Prolog fact are equivalent. 101 | 102 | ````erlang 103 | -record(person, {name, phone, address}). 104 | ```` 105 | 106 | ````prolog 107 | person(Name, Phone, Address). 108 | ```` 109 | 110 | You can access fields in an Erlang record by position by using the 111 | standard prolog arg/3 predicate. If you want to create functors that 112 | can access fields in an Erlang record by name, you can create functors 113 | for that Automaticly with the code in the file 114 | https://github.com/zkessin/erlog/blob/master/priv/records.pl. just 115 | call `erlog:prove(State, {record, person, record_info(fields, 116 | person)})`. Note that the record fields must be created in Erlang at 117 | compile time. 118 | 119 | ## Using ETS 120 | 121 | Erlog can also share data with an Erlang program by way of an ETS 122 | table. Erlog includes commands to unify a goal with the contents of an 123 | ETS table. It should also be possible to work with mnesia tables, but 124 | this has not yet been done. 125 | 126 | If you want to use Erlog with ETS you need to load the erlog_ets 127 | module into Erlog. To do that you call `erlog:load(PID,erlog_ets)` or 128 | `E({load,erlog_ets})`. You can match on an ETS table with 129 | `ets_match(TableId, Value)`. 130 | 131 | ## Including with rebar 132 | 133 | You can include Erlog in your application with rebar, by adding it to 134 | the deps section of your rebar config file. 135 | 136 | ## Testing 137 | 138 | Erlog is tested to work with Erlang versions R14B02 - 17, the tests 139 | are both eunit tests and quick-check properties, if you do not have 140 | quickcheck don't worry you can still use Erlog, you just won't be able 141 | to run the properties. 142 | 143 | If you want to run the tests you will need to install quickcheck mini 144 | (Or the full quickcheck) you can do this with these commands: 145 | 146 | ````bash 147 | wget http://www.quviq.com/downloads/eqcmini.zip 148 | unzip eqcmini.zip 149 | export ERL_LIBS=eqcmini:$ERL_LIBS 150 | ```` 151 | 152 | to run the tests then run `rebar eunit` 153 | 154 | ## Licence 155 | 156 | Erlog was created by Robert Virding and can be used under the 157 | Apache 2.0 Licence. 158 | 159 | -------------------------------------------------------------------------------- /src/erlog_lib_dcg.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2008-2013 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog_lib_dcg.erl 16 | %% Author : Robert Virding 17 | %% Purpose : DCG conversion and procedures. 18 | 19 | -module(erlog_lib_dcg). 20 | 21 | -include("erlog_int.hrl"). 22 | 23 | -export([expand_term/1,expand_term/2]). 24 | -export([expand_term_2/3,phrase_3/3]). 25 | -export([load/1]). 26 | 27 | -import(lists, [foldl/3]). 28 | 29 | %% We use these a lot so we import them for cleaner code. 30 | -import(erlog_int, [prove_body/2,unify_prove_body/4,unify_prove_body/6,fail/1, 31 | add_binding/3,make_var_list/2, 32 | deref/2,dderef/2,dderef_list/2,unify/3, 33 | term_instance/2, 34 | add_built_in/2,add_compiled_proc/4, 35 | asserta_clause/2,assertz_clause/2]). 36 | 37 | load(Db0) -> 38 | %% Compiled DCG predicates. 39 | Db1 = foldl(fun ({Head,M,F}, Db) -> add_compiled_proc(Head, M, F, Db) end, 40 | Db0, 41 | [ 42 | {{expand_term,2},?MODULE,expand_term_2}, 43 | {{phrase,3},?MODULE,phrase_3} 44 | ]), 45 | %% Interpreted DCG predicates. 46 | foldl(fun (Clause, Db) -> assertz_clause(Clause, Db) end, Db1, 47 | [ 48 | %% 'C'([H|T], H, T). 49 | %% {'C',[{1}|{2}],{1},{2}}, %For DCGs 50 | %% phrase(V, L) :- phrase(V, L, []). 51 | {':-',{phrase,{1},{2}},{phrase,{1},{2},[]}} 52 | %% phrase(V, L, R) :- 53 | %% V =.. Z, append(Z, [L,R], G), C =.. G, C. 54 | %% {':-',{phrase,{1},{2},{3}}, 55 | %% {',',{'=..',{1},{4}},{',',{append,{4},[{2},{3}],{5}}, 56 | %% {',',{'=..',{6},{5}},{6}}}}} 57 | ]). 58 | 59 | %% expand_term_2(Goal, NextGoal, State) -> 60 | %% void 61 | %% Call the expand_term/2 predicate. 62 | 63 | expand_term_2(Goal, Next, #est{bs=Bs,vn=Vn0}=St) -> 64 | {expand_term,DCGRule,A2} = dderef(Goal, Bs), 65 | {Exp,Vn1} = expand_term(DCGRule, Vn0), 66 | unify_prove_body(A2, Exp, Next, St#est{vn=Vn1}). 67 | 68 | %% phrase_3(Goal, NextGoal, State) -> void. 69 | %% Call the phrase/3 preidicate. We could easily do this in prolog 70 | %% except for that it calls dcg_body/4 which is not exported. 71 | %% 72 | %% phrase(GRBody, S0, S) -> dcg_body(GRBody, S0, S, Goal), call(Goal). 73 | 74 | phrase_3(Goal, Next0, #est{bs=Bs,vn=Vn0}=St) -> 75 | {phrase,GRBody,S0,S} = dderef(Goal, Bs), 76 | {Body,Vn1} = dcg_body(GRBody, S0, S, Vn0), 77 | %% io:format("~p\n", [Body]), 78 | Next1 = [{call,Body}|Next0], %Evaluate body 79 | prove_body(Next1, St#est{vn=Vn1}). 80 | 81 | %% expand_term(Term) -> {ExpTerm}. 82 | %% expand_term(Term, VarNum) -> {ExpTerm,NewVarNum}. 83 | %% Handle DCG expansion. We do NOT work backwards. 84 | 85 | expand_term(Term) -> 86 | {Exp,_} = expand_term(Term, 0), 87 | Exp. 88 | 89 | expand_term({'-->',_,_}=Term, Vn) -> 90 | dcg_rule(Term, Vn); 91 | expand_term(Term, Vn) -> {Term,Vn}. 92 | 93 | %% dcg_rule(Term, VarNum) -> {ExpTerm,NewVarNum}. 94 | %% dcg_rule(DCGRule, VarIn, VarOout, VarNum) -> {ExpTerm,NewVarNum}. 95 | %% dcg_non_term(NonTerminal, VarIn, VarOut) -> ExpTerm. 96 | %% dcg_body(BodyTerm, VarIn, VarOut, VarNum) -> {ExpBody,NewVarOut,NewVarNum}. 97 | %% dcg_goal(BodyGoal, VarIn, VarOut, VarNum) -> {ExpGaol,NewVarOut,NewVarNum}. 98 | %% dcg_terminal(Terminals, VarIn, VarOut, VarNum) -> 99 | %% {ExpTerms,NewVarOut,NewVarNum}. 100 | %% dcg_body and dcg_goal do smae the thing except the dcg_body 101 | %% guarantees the output variable is the one we specify. It may 102 | %% insert an explicit '=' to get this. 103 | 104 | dcg_rule(DCGRule, Vn0) -> 105 | S0 = {Vn0}, 106 | S = {Vn0+1}, 107 | dcg_rule(DCGRule, S0, S, Vn0+2). 108 | 109 | dcg_rule({'-->',{',',H,RHC},B}, S0, S, Vn0) -> 110 | S1 = {Vn0}, 111 | Head = dcg_non_term(H, S0, S), 112 | {Goal1,S2,Vn1} = dcg_goal(B, S0, S1, Vn0+1), 113 | {Goal2,Vn2} = dcg_terminals(RHC, S, S2, Vn1), 114 | {{':-',Head,{',',Goal1,Goal2}},Vn2}; 115 | dcg_rule({'-->',H,B}, S0, S, Vn0) -> 116 | Head = dcg_non_term(H, S0, S), 117 | {Body,Vn1} = dcg_body(B, S0, S, Vn0), 118 | {{':-',Head,Body},Vn1}. 119 | 120 | dcg_non_term(A, S0, S) when is_atom(A) -> {A,S0,S}; 121 | dcg_non_term(T, S0, S) when ?IS_FUNCTOR(T) -> 122 | list_to_tuple(tuple_to_list(T) ++ [S0,S]); 123 | dcg_non_term(Other, _, _) -> erlog_int:type_error(callable, Other). 124 | 125 | dcg_body({',',G0,B0}, S0, S, Vn0) -> 126 | S1 = {Vn0}, 127 | {G1,S2,Vn1} = dcg_goal(G0, S0, S1, Vn0+1), 128 | {B1,Vn2} = dcg_body(B0, S2, S, Vn1), 129 | {{',',G1,B1},Vn2}; 130 | dcg_body(G0, S0, S, Vn0) -> 131 | case dcg_goal(G0, S0, S, Vn0) of 132 | {G1,S,Vn1} -> {G1,Vn1}; %Already uses S 133 | {G1,S1,Vn1} -> %So we get S! 134 | %% io:format("~p\n", [{G1,S0,S1,S}]), 135 | {{',',G1,{'=',S1,S}},Vn1} 136 | end. 137 | 138 | dcg_goal('!', S0, _, Vn) -> {'!',S0,Vn}; 139 | dcg_goal({_}=V, S0, S, Vn) -> 140 | {{phrase,V,S0,S},S,Vn}; 141 | dcg_goal({'{}',G}, S0, _, Vn) -> {G,S0,Vn}; 142 | dcg_goal({',',L0,R0}, S0, S, Vn0) -> 143 | S1 = {Vn0}, 144 | {L1,S2,Vn1} = dcg_goal(L0, S0, S1, Vn0+1), 145 | {R1,S3,Vn2} = dcg_goal(R0, S2, S, Vn1), 146 | {{',',L1,R1},S3,Vn2}; 147 | dcg_goal({';',L0,R0}, S0, S, Vn0) -> 148 | {L1,Vn1} = dcg_body(L0, S0, S, Vn0), 149 | {R1,Vn2} = dcg_body(R0, S0, S, Vn1), 150 | {{';',L1,R1},S,Vn2}; 151 | dcg_goal({'->',GRIf,GRThen}, S0, S, Vn0) -> 152 | S1 = {Vn0}, 153 | {If,S2,Vn1} = dcg_goal(GRIf, S0, S1, Vn0+1), 154 | {Then,S3,Vn2} = dcg_goal(GRThen, S2, S, Vn1), 155 | {{'->',If,Then},S3,Vn2}; 156 | dcg_goal({'\\+',G0}, S0, S, Vn) -> 157 | {G1,_,_} = dcg_goal(G0, S0, S, Vn), 158 | {{'\\+',G1},S0,Vn}; 159 | dcg_goal(Lits, S0, S, Vn0) when is_list(Lits) -> 160 | {ELits,Vn1} = dcg_terminals(Lits, S0, S, Vn0), 161 | {ELits,S,Vn1}; 162 | dcg_goal(NonT, S0, S, Vn) -> 163 | Goal = dcg_non_term(NonT, S0, S), 164 | {Goal,S,Vn}. 165 | 166 | dcg_terminals(Lits, S0, S, Vn) -> %Without 'C'/3 167 | {{'=',S0,Lits ++ S},Vn}. 168 | -------------------------------------------------------------------------------- /doc/erlog.txt: -------------------------------------------------------------------------------- 1 | MODULE 2 | 3 | erlog 4 | 5 | MODULE SUMMARY 6 | 7 | Interpreter for sub-set of Prolog 8 | 9 | DESCRIPTION 10 | 11 | Erlog is a Prolog interpreter implemented in Erlang and 12 | integrated with the Erlang runtime system. 13 | 14 | TYPES 15 | 16 | erlog() 17 | State of the Erlog interpreter. 18 | 19 | solution() = {succeed,Bindings} 20 | | fail 21 | | {error,Error} 22 | | {'EXIT',Error} 23 | 24 | eterm() 25 | Erlog term. 26 | 27 | EXPORTS 28 | 29 | new() -> {ok,Estate}. 30 | new(DbModule, DbInitArg) -> {ok,Estate}. 31 | 32 | Types 33 | DbModule = atom() 34 | DbInitArg = term() 35 | Estate = erlog() 36 | 37 | Initialise the erlog interpreter. The database is initialised 38 | by calling DbModule(DbInitArg). If DbModule and DbInitArg are 39 | not given then the default database will be used. 40 | 41 | prove(Goal, Estate1) -> {Solution,Estate2}. 42 | 43 | Types 44 | Estate1 = Estate2 = erlog() 45 | Goal = eterm() 46 | Solution = solution() 47 | 48 | Try to prove Goal, if this can be done return the first 49 | solution. This will reset the interpreter and completely 50 | replace any existing goal, except of course for operations on 51 | the database. 52 | 53 | next_solution(Estate1) -> {Solution,Estate2}. 54 | 55 | Types 56 | Estate1 = Estate2 = erlog() 57 | Solution = solution() 58 | 59 | Try to find the next solution of the last goal. 60 | 61 | consult(FileName, Estate1) -> {ok,Estate2} | {error,Error}. 62 | reconsult(FileName, Estate1) -> {ok,Estate2} | {error,Error}. 63 | 64 | Types 65 | Estate1 = Estate2 = erlog() 66 | FileName = string() 67 | 68 | Consult/reconsult a file into Erlog. 69 | 70 | load(Module, Estate1) -> {ok,Estate2}. 71 | 72 | Types 73 | Estate1 = Estate2 = erlog() 74 | Module = atom() 75 | 76 | Load the predicates in Module into Erlog. 77 | 78 | get_db(Estate) -> Database. 79 | 80 | Types 81 | Estate = erlog() 82 | Database = term() 83 | 84 | Return the current Erlog database. 85 | 86 | set_db(Database, Estate1) -> Estate2. 87 | set_db(DbModule, Database, Estate1) -> Estate2. 88 | 89 | Types 90 | Estate1 = Estate2 = erlog() 91 | DbModule = atom() 92 | Database = term() 93 | 94 | Set the Erlog database. 95 | 96 | is_legal_term(Term) -> bool(). 97 | 98 | Test if Term is a well-formed (legal) Erlog structure. 99 | 100 | vars_in(Term) -> [{VarName,Variable}]. 101 | 102 | Returns a list of {VariableName,Variable} pairs. 103 | 104 | DATABASE INTERFACE 105 | 106 | The following functions must be exported from the database 107 | module. 108 | 109 | Most of these datatypes are opaque, so for example the 110 | interpreter will never inspect the a dbref() but just chain it 111 | through the database calls. When intepreted clauses are added 112 | to the database the body argument {Body,HasCut} must be 113 | returned as is when return a clause tuple. 114 | 115 | The tag in a clause is some unique identifier for the clause 116 | within that functor, it need not be global for the whole 117 | database. It is used when retracting a clause to indicate 118 | which clause of the procedure is to be removed. 119 | 120 | TYPES 121 | 122 | dbref() An internal reference to the database. The interpreter will 123 | never directly access this. 124 | 125 | functor() = {atom(),integer()} 126 | The functor of a procedure which is used to reference functor 127 | data. This is used as an opaque reference to a procedure. 128 | 129 | clause() = {Tag,Head,{Body,HasCut}} 130 | Head = Body = eterm() 131 | 132 | The structure of a clause as it is returned from the database. 133 | 134 | dbret() = {ok,dbref()} 135 | | error 136 | 137 | EXPORTS 138 | 139 | DbModule:new(DbInitArg) -> DbRef. 140 | 141 | DbModule:add_built_in(DbRef1, Functor) -> DbRef2. 142 | 143 | Types 144 | DbRef1 = DbRef2 = dbref() 145 | Functor = functor() 146 | 147 | DbModule:add_compiled_proc(DbRef, Functor, Module, Function) -> DbRet. 148 | 149 | Types 150 | DbRef = dbref() 151 | Functor = functor() 152 | Module = Function = atom() 153 | 154 | Add a compiled procedure to the database. This should return 155 | 'error' if the procedure has been defined as built in. 156 | 157 | DbModule:asserta_clause(DbRef, Functor, Head, {Body,HasCut}) -> DbRet. 158 | DbModule:assertz_clause(DbRef, Functor, Head, {Body,HasCut}) -> DbRet. 159 | 160 | Types 161 | DbRef = dbref() 162 | Functor = functor() 163 | Head = Body = eterm() 164 | HasCut = boolean() 165 | DbRet = dbret() 166 | 167 | Add a clause to an interpreted procedure in the database. This 168 | should return 'error' if the procedure has been defined as 169 | built in or compiled. 170 | 171 | DbModule:retract_clause(DbRef, Functor, Tag) -> DbRet. 172 | 173 | Types 174 | DbRef = dbref() 175 | Functor = functor() 176 | Tag = term() 177 | DbRet = dbret() 178 | 179 | This will return 'error' if trying to retract clauses from a 180 | built in or compiled procedure. 181 | 182 | DbModule:abolish_clauses(DbRef, Functor) -> DbRet. 183 | 184 | Types 185 | DbRef = dbref() 186 | Functor = functor() 187 | DbRet = dbret() 188 | 189 | This will return 'error' if trying to abolish a built in 190 | procedure. 191 | 192 | DbModule:get_procedure(DbRef, Functor) -> Procedure. 193 | 194 | Types 195 | DbRef = dbref() 196 | Functor = functor() 197 | Procedure = built_in 198 | | {code,{Module,Function}} 199 | | {clauses,[clause()]} 200 | | undefined 201 | 202 | DbModule:get_procedure_type(DbRef, Functor) -> Procedure. 203 | 204 | Types 205 | DbRef = dbref() 206 | Functor = functor() 207 | Procedure = built_in 208 | | compiled 209 | | interpreted 210 | | undefined 211 | 212 | DbModule:get_interpreted_functors(DbRef) -> Functors. 213 | 214 | Types 215 | DbRef = dbref() 216 | Functors = [functor()] 217 | 218 | AUTHOR 219 | 220 | Robert Virding - rvirding@gmail.com 221 | (with thanks to Richard O'Keefe for explaining some finer 222 | points of the Prolog standard) 223 | -------------------------------------------------------------------------------- /doc/user_guide.txt: -------------------------------------------------------------------------------- 1 | Erlog 2 | ===== 3 | 4 | DESCRIPTION 5 | 6 | Erlog is a Prolog interpreter implemented in Erlang and integrated 7 | with the Erlang runtime system. It follows the Prolog standard and the 8 | following subset of the built-ins have been implemented: 9 | 10 | Logic and control 11 | call/1, ','/2, '!'/0, ';'/2, fail/0, false/0, '->'/2 (if-then), 12 | ( -> ; )(if-then-else), '\\+'/1, once/1, repeat/0, true/0 13 | 14 | Term creation and decomposition 15 | arg/3, copy_term/2, functor/3, '=..'/2, term_variables/2, numbervars/3 16 | 17 | Clause creation and destruction 18 | abolish/1, assert/1, asserta/1, assertz/1, retract/1, retractall/1. 19 | 20 | Clause retrieval and information 21 | clause/2, current_predicate/1, predicate_property/2 22 | 23 | Term unification and comparison 24 | '@>'/2, '@>='/2, '=='/2, '\\=='/2, '@<'/2, '@=<'/2, '='/2, '\\='/2 25 | 26 | Arithmetic evaluation and comparison 27 | '>'/2, '>='/2, '=:='/2, '=\\='/2, '<'/2, '=<'/2, is/2 28 | 29 | Type testing 30 | atom/1, atomic/1, compound/1, integer/1, float/1, number/1, nonvar/1, 31 | var/1 32 | 33 | Atom processing 34 | atom_chars/2, atom_codes/2, atom_length/2 35 | 36 | All solutions 37 | findall/3 38 | 39 | Prolog flags 40 | current_prolog_flag/2, set_prolog_flag/2 41 | 42 | Standard I/O 43 | nl/0, put_char/1, put_code/1, read/1, write/1, writeq/1, 44 | write_canonical/1, write_term/2 45 | 46 | Erlang interface 47 | ecall/2 48 | 49 | Common lists library 50 | append/3, delete/3, insert/3, last/2, length/2, member/2, memberchk/2, 51 | reverse/2, perm/2, sort/2 52 | 53 | The following arithmetic operators are implemented: 54 | 55 | +/1, -/1, +/2, -/2, */2, //2, **/2, ///2, mod/2, abs/1, 56 | float/1, truncate/1 57 | 58 | DCGs 59 | expand_term/2, phrase/2, phrase/3 60 | 61 | INTERNAL REPRESENTATION 62 | 63 | Prolog terms in Erlog have a very direct representation in Erlang: 64 | 65 | Prolog Erlang 66 | ------ ------ 67 | Structures Tuples where the first element 68 | is the functor name (an atom) 69 | Lists Lists 70 | Variables Tuple {VariableName} where VariableName 71 | is an atom 72 | Atomic Atomic 73 | 74 | Note there is no problem with this representation of variables as 75 | structures without arguments, a(), are illegal in Prolog. For example 76 | the Prolog term: 77 | 78 | Goal = insert([1,2,3], atom, Es), call(Goal) 79 | 80 | is represented in Erlang by: 81 | 82 | {',',{'=',{'Goal'},{insert,[1,2,3],atom,{'Es'}}},{call,{'Goal'}}} 83 | 84 | The clauses of the standard append/3 defined by 85 | 86 | append([], L, L). 87 | append([H|T], L, [H|T1]) :- 88 | append(T, L, T1). 89 | 90 | are represented in Erlang by the terms: 91 | 92 | {append,[],{'L'},{'L'}}. 93 | {':-',{append,[{'H'}|{'T'}],{'L'},[{'H'}|{'T1'}]}, 94 | {append,{'T'},{'L'},{'T1'}}}. 95 | 96 | Limited checking is done at run-time, basically only of input terms. 97 | Currently this is done for the top level when clauses are added to the 98 | database and a goal is entered. 99 | 100 | ERLANG INTERFACE 101 | 102 | The interface to Erlang is through the ecall/2 predicate, which 103 | provides a back-trackable interface to Erlang. It has the form: 104 | 105 | ecall(ErlangFunctionCall, ReturnValue) 106 | 107 | It calls the Erlang function and unifies the result with ReturnValue. 108 | For example 109 | 110 | ecall(mymod:onefunc(A1, A2), Ret) 111 | ecall(mymod:otherfunc, Ret) 112 | 113 | where the second form calls a function of no arguments 114 | (funcname() is illegal syntax in Prolog). 115 | 116 | The Erlang function must return: 117 | 118 | {succeed,Value,Continuation} 119 | 120 | The function has succeeded and returns Value which is unified 121 | with the output argument of ecall/2. Continuation will be 122 | called on backtracking to generate the next value. 123 | 124 | {succeed_last,Value} 125 | 126 | This is the last time the function will succeed so no 127 | continuation is returned. It is an optimisation of returning a 128 | continuation which will fail the next time. 129 | 130 | fail 131 | 132 | The function cannot generate more solutions and fails. 133 | 134 | The first example is a simple function which calls an Erlang function 135 | and returns the value: 136 | 137 | efunc(Fcall) -> 138 | %% This is what the operators will generate. 139 | Val = case Fcall of 140 | {':',M,F} when is_atom(M), is_atom(F) -> M:F(); 141 | {':',M,{F,A}} when is_atom(M), is_atom(F) -> M:F(A); 142 | {':',M,T} when is_atom(M), is_tuple(T), size(T) >= 2, 143 | is_atom(element(1, T)) -> 144 | apply(M,element(1, T),tl(tuple_to_list(T))) 145 | end, 146 | {succeed_last,Val}. %Optimisation 147 | 148 | The second example is a function which returns the keys in an Ets 149 | table on backtracking: 150 | 151 | ets_keys(Tab) -> 152 | %% Solution with no look-ahead, get keys when requested. 153 | %% This fun returns next key and itself for continuation. 154 | F = fun (F1, Tab1, Last1) -> 155 | case ets:next(Tab1, Last1) of 156 | '$end_of_table' -> fail; %No more elements 157 | Key1 -> {succeed,Key1, 158 | fun () -> F1(F1, Tab1, Key1) end} 159 | end 160 | end, 161 | case ets:first(Tab) of 162 | '$end_of_table' -> fail; %No elements 163 | Key -> {succeed,Key, fun () -> F(F, Tab, Key) end} 164 | end. 165 | 166 | The third example calls a function which returns a list and returns 167 | elements from this list on backtracking. I KNOW we could just return 168 | the whole list and use member/2 to generate elements from it, but this 169 | is more fun. 170 | 171 | get_list(ListGen) -> 172 | %% This is what the operators will generate. 173 | Vals = case ListGen of 174 | {':',M,F} when is_atom(M), is_atom(F) -> M:F(); 175 | {':',M,{F,A}} when is_atom(M), is_atom(F) -> M:F(A); 176 | {':',M,T} when is_atom(M), is_tuple(T), size(T) >= 2, 177 | is_atom(element(1, T)) -> 178 | apply(M,element(1, T),tl(tuple_to_list(T))) 179 | end, 180 | %% This fun will return head and itself for continuation. 181 | Fun = fun (F1, Es0) -> 182 | case Es0 of 183 | [E] -> {succeed_last,E}; %Optimisation 184 | [E|Es] -> {succeed,E,fun () -> F1(F1, Es) end}; 185 | [] -> fail %No more elements 186 | end 187 | end, 188 | %Call with list of values to return first element. 189 | Fun(Fun, Vals). 190 | 191 | 192 | For example the Erlog goal: 193 | 194 | ecall(erlog_demo:get_list(ets:all),Tab), 195 | ecall(erlog_demo:ets_keys(Tab),Key). 196 | 197 | will on backtracking generate the names of all ETS tables which have 198 | keys and their keys. 199 | 200 | It is a great pity that the implementation of ETS loses greatly if you 201 | want to do more complex selection of elements that just simple 202 | matching. 203 | 204 | DEFINTE CLAUSE GRAMMERS (DCGs) 205 | 206 | Erlog supports DCGs. Expansion of -->/2 terms is done through the 207 | procedure expand_term/2 which can be called explicitly and is called 208 | automatically when consulting files. At present there is no support 209 | for a user defined term_expansion/2 procedure. The expansion uses 210 | phrase/3 to handle variable terms. This is defined by: 211 | 212 | phrase(Term, S0, S1) :- 213 | Term =.. L, append(L, [S0,S1], L1), Call =.. L1, Call. 214 | 215 | PROLOG SYNTAX 216 | 217 | There is a simple Prolog parser, based on a Leex scanner and a 218 | Standard Prolog parser, which will parse most Prolog terms. It 219 | recognises all the standard operators, which have the default 220 | priorities, but does not allow adding new operators. 221 | 222 | Files containing Prolog predicates can be consulted, however 223 | directives and queries in the file are ignored. 224 | 225 | NOTES 226 | 227 | This is only a simple interpreter without a true garbage collector so 228 | for larger evaluations you should adopt a failure driven style. 229 | 230 | There is no smart clause indexing on the first argument in a procedure 231 | in Erlog. 232 | 233 | Yes, there are no file I/O predicates provided. 234 | 235 | There is partial support for the equivalence of list notation and 236 | '.'/2 terms, but it might go away later. 237 | 238 | We use the standard Erlang ordering of terms which means that 239 | variables do not have the lowest ordering as they should. 240 | 241 | We use the Erlang definition of arithmetic operators, not standard 242 | Prolog. 243 | 244 | Sometimes the description of the error returned from the parser can be 245 | a little "cryptic". 246 | 247 | AUTHOR 248 | 249 | Robert Virding - rvirding@gmail.com 250 | (with thanks to Richard O'Keefe for explaining some finer points of 251 | the Prolog standard) 252 | -------------------------------------------------------------------------------- /src/erlog_lib_lists.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2013 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog_lib_lists.erl 16 | %% Author : Robert Virding 17 | %% Purpose : Standard Erlog lists library. 18 | %% 19 | %% This is a standard lists library for Erlog. Everything here is 20 | %% pretty basic and common to most Prologs. We are experimenting here 21 | %% and some predicates are compiled. We only get a small benefit when 22 | %% only implementing indexing on the first argument. 23 | 24 | -module(erlog_lib_lists). 25 | 26 | -include("erlog_int.hrl"). 27 | 28 | %% Main interface functions. 29 | -export([load/1]). 30 | 31 | %% Library functions. 32 | -export([length_2/3,append_3/3,insert_3/3,member_2/3,memberchk_2/3, 33 | reverse_2/3,sort_2/3]). 34 | 35 | %%-compile(export_all). 36 | 37 | -import(lists, [map/2,foldl/3]). 38 | 39 | %% We use these a lot so we import them for cleaner code. 40 | -import(erlog_int, [prove_body/2,unify_prove_body/4,unify_prove_body/6,fail/1, 41 | add_binding/3,make_var_list/2, 42 | deref/2,dderef/2,dderef_list/2,unify/3, 43 | term_instance/2, 44 | add_built_in/2,add_compiled_proc/4, 45 | asserta_clause/2,assertz_clause/2]). 46 | 47 | %% load(Database) -> Database. 48 | %% Assert predicates into the database. 49 | 50 | load(Db0) -> 51 | %% Compiled common list library. 52 | Db1 = foldl(fun ({Head,M,F}, Db) -> 53 | add_compiled_proc(Head, M, F, Db) end, Db0, 54 | [ 55 | {{length,2},?MODULE,length_2}, 56 | {{append,3},?MODULE,append_3}, 57 | {{insert,3},?MODULE,insert_3}, 58 | {{member,2},?MODULE,member_2}, 59 | {{memberchk,2},?MODULE,memberchk_2}, 60 | {{reverse,2},?MODULE,reverse_2}, 61 | {{sort,2},?MODULE,sort_2} 62 | ]), 63 | %% Finally interpreted common list library. 64 | foldl(fun (Clause, Db) -> assertz_clause(Clause, Db) end, Db1, 65 | [ 66 | %% insert(L, X, [X|L]). insert([H|L], X, [H|L1]) :- insert(L, X, L1). 67 | %% delete([X|L], X, L). delete([H|L], X, [H|L1]) :- delete(L, X, L1). 68 | {':-',{delete,{1},{2},{3}},{insert,{3},{2},{1}}}, 69 | %% last(List, Last) :- append(_, [Last], List). 70 | {':-',{last,{1},{2}},{append,{3},[{2}],{1}}}, 71 | %% perm([], []). 72 | %% perm([X|Xs], Ys1) :- perm(Xs, Ys), insert(Ys, X, Ys1). 73 | {perm,[],[]}, 74 | {':-',{perm,[{1}|{2}],{3}},{',',{perm,{2},{4}},{insert,{4},{1},{3}}}} 75 | ]). 76 | 77 | %% length_2(Head, NextGoal, State) -> void. 78 | %% length(L, N) :- integer(N), !, N >= 0, '$make_list'(N, L). 79 | %% length(L, N) :- '$length'(L, 0, N). 80 | %% '$length'([], N, N). 81 | %% '$length'([_|L], M, N) :- M1 is M + 1, '$length'(L, M1, N). 82 | %% '$make_list'(0, []) :- !. 83 | %% '$make_list'(N, [_|L]) :- N1 is N - 1, '$make_list'(N1, L). 84 | 85 | length_2({length,L,N0}, Next, #est{bs=Bs}=St) -> 86 | case deref(N0, Bs) of %Export N1 87 | N1 when is_integer(N1) -> 88 | if N1 >= 0 -> make_list(N1, L, Next, St); 89 | true -> fail(St) 90 | end; 91 | {_}=N1 -> 92 | length_3(L, 0, N1, Next, St); 93 | N1 -> 94 | erlog_int:type_error(integer, N1, St) 95 | end. 96 | 97 | length_3(L0, M, N, Next, #est{cps=Cps,bs=Bs0,vn=Vn}=St) -> 98 | case deref(L0, Bs0) of 99 | [] -> unify_prove_body(N, M, Next, St); 100 | [_|T] -> length_3(T, M+1, N, Next, St); 101 | {_}=L1 -> 102 | FailFun = fun (Lcp, Lcps, Lst) -> 103 | fail_length_3(Lcp, Lcps, Lst, L1, M, N) 104 | end, 105 | Cp = #cp{type=compiled,data=FailFun,next=Next,bs=Bs0,vn=Vn}, 106 | Bs1 = add_binding(L1, [], Bs0), 107 | unify_prove_body(N, M, Next, St#est{cps=[Cp|Cps],bs=Bs1}); 108 | Other -> 109 | erlog_int:type_error(list, Other, St) 110 | end. 111 | 112 | fail_length_3(#cp{next=Next,bs=Bs0,vn=Vn}, Cps, St, L, M, N) -> 113 | H = {Vn}, 114 | T = {Vn+1}, 115 | Bs1 = add_binding(L, [H|T], Bs0), 116 | length_3(T, M+1, N, Next, St#est{cps=Cps,bs=Bs1,vn=Vn+2}). 117 | 118 | make_list(0, L, Next, St) -> 119 | unify_prove_body(L, [], Next, St); 120 | make_list(N, L0, Next, #est{bs=Bs0,vn=Vn}=St) -> 121 | case deref(L0, Bs0) of 122 | [] -> fail(St); %We know N /= 0 123 | [_|T] -> %Keep stepping down the list 124 | make_list(N-1, T, Next, St); 125 | {_}=L1 -> %Just make a list of the rest 126 | List = make_var_list(N, Vn), 127 | Bs1 = add_binding(L1, List, Bs0), 128 | prove_body(Next, St#est{bs=Bs1,vn=Vn+N}); 129 | Other -> 130 | erlog_int:type_error(list, Other, St) 131 | end. 132 | 133 | %% append_3(Head, NextGoal, State) -> void. 134 | %% append([], L, L). 135 | %% append([H|T], L, [H|L1]) :- append(T, L, L1). 136 | %% Here we attempt to compile indexing in the first argument. 137 | 138 | append_3({append,A1,L,A3}, Next0, #est{cps=Cps,bs=Bs0,vn=Vn}=St) -> 139 | case deref(A1, Bs0) of 140 | [] -> %Cannot backtrack 141 | unify_prove_body(L, A3, Next0, St); 142 | [H|T] -> %Cannot backtrack 143 | L1 = {Vn}, 144 | Next1 = [{append,T,L,L1}|Next0], 145 | unify_prove_body(A3, [H|L1], Next1, St#est{vn=Vn+1}); 146 | {_}=Var -> %This can backtrack 147 | FailFun = fun (LCp, LCps, Lst) -> 148 | fail_append_3(LCp, LCps, Lst, Var, L, A3) 149 | end, 150 | Cp = #cp{type=compiled,data=FailFun,next=Next0,bs=Bs0,vn=Vn}, 151 | Bs1 = add_binding(Var, [], Bs0), 152 | unify_prove_body(L, A3, Next0, St#est{cps=[Cp|Cps],bs=Bs1}); 153 | _ -> fail(St) %Will fail here! 154 | end. 155 | 156 | fail_append_3(#cp{next=Next0,bs=Bs0,vn=Vn}, Cps, St, A1, L, A3) -> 157 | H = {Vn}, 158 | T = {Vn+1}, 159 | L1 = {Vn+2}, 160 | Bs1 = add_binding(A1, [H|T], Bs0), %A1 always a variable here. 161 | Next1 = [{append,T,L,L1}|Next0], 162 | unify_prove_body(A3, [H|L1], Next1, St#est{cps=Cps,bs=Bs1,vn=Vn+3}). 163 | 164 | %% insert_3(Head, NextGoal, State) -> void. 165 | %% insert(L, X, [X|L]). 166 | %% insert([H|L], X, [H|L1]) :- insert(L, X, L1). 167 | 168 | insert_3({insert,A1,A2,A3}, Next, #est{cps=Cps,bs=Bs,vn=Vn}=St) -> 169 | FailFun = fun (LCp, LCps, Lst) -> 170 | fail_insert_3(LCp, LCps, Lst, A1, A2, A3) 171 | end, 172 | Cp = #cp{type=compiled,data=FailFun,next=Next,bs=Bs,vn=Vn}, 173 | unify_prove_body(A3, [A2|A1], Next, St#est{cps=[Cp|Cps]}). 174 | 175 | fail_insert_3(#cp{next=Next0,bs=Bs,vn=Vn}, Cps, St, A1, X, A3) -> 176 | H = {Vn}, 177 | L = {Vn+1}, 178 | L1 = {Vn+2}, 179 | Next1 = [{insert,L,X,L1}|Next0], 180 | unify_prove_body(A1, [H|L], A3, [H|L1], Next1, St#est{cps=Cps,bs=Bs,vn=Vn+3}). 181 | 182 | %% member_2(Head, NextGoal, State) -> void. 183 | %% member(X, [X|_]). 184 | %% member(X, [_|T]) :- member(X, T). 185 | 186 | member_2({member,A1,A2}, Next, #est{cps=Cps,bs=Bs,vn=Vn}=St) -> 187 | FailFun = fun (LCp, LCps, Lst) -> 188 | fail_member_2(LCp, LCps, Lst, A1, A2) 189 | end, 190 | Cp = #cp{type=compiled,data=FailFun,next=Next,bs=Bs,vn=Vn}, 191 | T = {Vn}, 192 | unify_prove_body(A2, [A1|T], Next, St#est{cps=[Cp|Cps],vn=Vn+1}). 193 | 194 | fail_member_2(#cp{next=Next0,bs=Bs,vn=Vn}, Cps, St, A1, A2) -> 195 | H = {Vn}, 196 | T = {Vn+1}, 197 | Next1 = [{member,A1,T}|Next0], 198 | unify_prove_body(A2, [H|T], Next1, St#est{cps=Cps,bs=Bs,vn=Vn+2}). 199 | 200 | %% memberchk_2(Head, NextGoal, State) -> void. 201 | %% memberchk(X, [X|_]) :- !. 202 | %% memberchk(X, [_|T]) :- memberchk(X, T). 203 | %% We don't build the list and we never backtrack so we can be smart 204 | %% and match directly. Should we give a type error? 205 | 206 | memberchk_2({memberchk,A1,A2}, Next, #est{bs=Bs0}=St) -> 207 | case deref(A2, Bs0) of 208 | [H|T] -> 209 | case unify(A1, H, Bs0) of 210 | {succeed,Bs1} -> 211 | prove_body(Next, St#est{bs=Bs1}); 212 | fail -> 213 | memberchk_2({memberchk,A1,T}, Next, St) 214 | end; 215 | {_} -> erlog_int:instantiation_error(St); 216 | _ -> fail(St) 217 | end. 218 | 219 | %% reverse_2(Head, NextGoal, State) -> void. 220 | %% reverse([], []). 221 | %% reverse([H|L1], L) :- reverse(L1, L2), append(L2, [H], L). 222 | %% Here we attempt to compile indexing in the first argument. 223 | 224 | reverse_2({reverse,A1,A2}, Next0, #est{cps=Cps,bs=Bs0,vn=Vn}=St) -> 225 | case deref(A1, Bs0) of 226 | [] -> 227 | unify_prove_body(A2, [], Next0, St); 228 | [H|T] -> 229 | L = {Vn}, 230 | L1 = A2, 231 | %% Naive straight expansion of body. 232 | %%Next1 = [{reverse,T,L},{append,L,[H],L1}|Next0], 233 | %%prove_body(Next1, Cps, Bs0, Vn+1, Db); 234 | %% Smarter direct calling of local function. 235 | Next1 = [{append,L,[H],L1}|Next0], 236 | reverse_2({reverse,T,L}, Next1, St#est{vn=Vn+1}); 237 | {_}=Var -> 238 | FailFun = fun (LCp, LCps, Lst) -> 239 | fail_reverse_2(LCp, LCps, Lst, Var, A2) 240 | end, 241 | Cp = #cp{type=compiled,data=FailFun,next=Next0,bs=Bs0,vn=Vn}, 242 | Bs1 = add_binding(Var, [], Bs0), 243 | unify_prove_body(A2, [], Next0, St#est{cps=[Cp|Cps],bs=Bs1}); 244 | _ -> fail(St) %Will fail here! 245 | end. 246 | 247 | fail_reverse_2(#cp{next=Next,bs=Bs0,vn=Vn}, Cps, St, A1, A2) -> 248 | H = {Vn}, 249 | T = {Vn+1}, 250 | L1 = A2, 251 | L = {Vn+2}, 252 | Bs1 = add_binding(A1, [H|T], Bs0), 253 | %%Next1 = [{reverse,T,L},{apperse,L,[H],L1}|Next], 254 | %%prove_body(Next1, Cps, Bs1, Vn+3, Db). 255 | Next1 = [{append,L,[H],L1}|Next], 256 | reverse_2({reverse,T,L}, Next1, St#est{cps=Cps,bs=Bs1,vn=Vn+3}). 257 | 258 | %% sort_2(Head, NextGoal, State) -> void. 259 | %% sort(List, SortedList). 260 | 261 | sort_2({sort,L0,S}, Next, #est{bs=Bs}=St) -> 262 | %% This may throw an erlog error, we don't catch it here. 263 | L1 = lists:usort(dderef_list(L0, Bs)), 264 | unify_prove_body(S, L1, Next, St). 265 | -------------------------------------------------------------------------------- /src/erlog_io.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2008-2015 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog_io.erl 16 | %% Author : Robert Virding 17 | %% Purpose : Some basic i/o functions for Erlog. 18 | %% 19 | %% Structures - {Functor,arg1, Arg2,...} where Functor is an atom 20 | %% Variables - {Name} where Name is an atom or integer 21 | %% Lists - Erlang lists 22 | %% Atomic - Erlang constants 23 | %% 24 | %% There is no problem with the representation of variables as Prolog 25 | %% functors of arity 0 are atoms. This representation is much easier 26 | %% to test for, and create new variables with than using funny atom 27 | %% names like '$1' (yuch!), and we need LOTS of variables. 28 | 29 | -module(erlog_io). 30 | 31 | -export([scan_file/1,read_file/1,read/1,read/2,read_string/1, 32 | write_term/2,write_term/3,write_term1/2, 33 | write/1,write/2,write1/1,writeq/1,writeq/2,writeq1/1, 34 | write_canonical/1,write_canonical/2,write_canonical1/1]). 35 | 36 | scan_file(File) -> 37 | case file:open(File, [read]) of 38 | {ok,Fd} -> 39 | try 40 | {ok,scan_stream(Fd, 1)} 41 | catch 42 | throw:Term -> Term; 43 | error:Error -> {error,einval,Error}; 44 | exit:Exit -> {exit,einval,Exit} 45 | after 46 | file:close(Fd) 47 | end; 48 | Error -> Error 49 | end. 50 | 51 | scan_stream(Fd, L0) -> 52 | case scan_erlog_term(Fd, '', L0) of 53 | {ok,Toks,L1} -> [Toks|scan_stream(Fd, L1)]; 54 | {error,Error,_} -> throw({error,Error}); 55 | {eof,_}=Eof -> Eof 56 | end. 57 | 58 | %% read_file(FileName) -> {ok,[Term]} | {error,Error}. 59 | %% Read a file containing Prolog terms. This has been taken from 'io' 60 | %% but cleaned up using try. 61 | 62 | get_path() -> 63 | application:get_env(erlog, consult_path, ["."]). 64 | 65 | read_file(File) -> 66 | Path = get_path(), 67 | case file:path_open(Path, File, [read]) of 68 | {ok,Fd, _} -> 69 | try 70 | {ok,read_stream(Fd, 1)} 71 | catch 72 | throw:Term -> Term; 73 | error:Error -> {error,einval,Error}; 74 | exit:Exit -> {exit,einval,Exit} 75 | after 76 | file:close(Fd) 77 | end; 78 | Error -> Error 79 | end. 80 | 81 | read_stream(Fd, L0) -> 82 | case scan_erlog_term(Fd, '', L0) of 83 | {ok,Toks,L1} -> 84 | case erlog_parse:term(Toks, L0) of 85 | {ok,end_of_file} -> []; %Prolog does this. 86 | {ok,Term} -> 87 | [Term|read_stream(Fd, L1)]; 88 | {error,What} -> throw({error,What}) 89 | end; 90 | {error,Error,_} -> throw({error,Error}); 91 | {eof,_} -> [] 92 | end. 93 | 94 | %% read([IoDevice,] Prompt) -> {ok,Term} | {error,Error}. 95 | %% A very simple read function. Returns the direct representation of 96 | %% the term without variable processing. 97 | 98 | read(P) -> read(standard_io, P). 99 | 100 | read(Io, P) -> 101 | case scan_erlog_term(Io, P, 1) of 102 | {ok,Ts,_} -> 103 | case erlog_parse:term(Ts) of 104 | {ok,T} -> {ok,T}; 105 | {error,Pe} -> {error,Pe} 106 | end; 107 | {error,Se,_} -> {error,Se}; 108 | {eof,_} -> {ok,end_of_file} %Prolog does this 109 | end. 110 | 111 | scan_erlog_term(Io, Prompt, Line) -> 112 | io:request(Io, {get_until,Prompt,erlog_scan,tokens,[Line]}). 113 | 114 | %% read_string(String) -> {ok,Term} | {error,Error}. 115 | %% Read a string. We add an extra space to be kind. 116 | 117 | read_string(Cs) -> 118 | case erlog_scan:string(Cs ++ " ", 1) of %Ensure ending space 119 | {ok,Ts,_} -> 120 | case erlog_parse:term(Ts) of 121 | {ok,T} -> {ok,T}; 122 | {error,Pe} -> {error,Pe} 123 | end; 124 | {error,Se,_} -> {error,Se} 125 | end. 126 | 127 | %% write_term([IoDevice,] Term, WriteOptions) -> ok. 128 | %% write([IoDevice,] Term) -> ok. 129 | %% writeq([IoDevice,] Term) -> ok. 130 | %% write_canonical([IoDevice,] Term) -> ok. 131 | %% A very simple write function. Does not pretty-print but can handle 132 | %% operators. The xxx1 verions return an iolist of the characters. 133 | 134 | %% The default is that all the options are false. 135 | -record(ops, {ignore_ops=false,numbervars=false,quoted=false}). 136 | 137 | write_term(T, Opts) -> write_term(standard_io, T, Opts). 138 | 139 | write_term(Io, T, Opts) -> 140 | io:put_chars(Io, write_term1(T, Opts)). 141 | 142 | write_term1(T, Opts) -> 143 | Ops = #ops{ignore_ops=lists:member(ignore_ops, Opts), 144 | numbervars=lists:member(numbervars, Opts), 145 | quoted=lists:member(quoted, Opts)}, 146 | write_term1(T, 1200, Ops). 147 | 148 | write(T) -> write_term(T, [numbervars]). 149 | 150 | write(Io, T) -> write_term(Io, T, [numbervars]). 151 | 152 | write1(T) -> write_term1(T, [numbervars]). 153 | 154 | writeq(T) -> write_term(T, [numbervars,quoted]). 155 | 156 | writeq(Io, T) -> write_term(Io, T, [numbervars,quoted]). 157 | 158 | writeq1(T) -> write_term1(T, [numbervars,quoted]). 159 | 160 | write_canonical(T) -> write_term(T, [ignore_ops,quoted]). 161 | 162 | write_canonical(Io, T) -> write_term(Io, T, [ignore_ops,quoted]). 163 | 164 | write_canonical1(T) -> write_term1(T, [ignore_ops,quoted]). 165 | 166 | %% write_term1(Term, Precedence, Ops) -> iolist(). 167 | %% The function which does the actual writing. 168 | 169 | write_term1(T, Prec, Ops) when is_atom(T) -> write_atom1(T, Prec, Ops); 170 | write_term1(T, _, _) when is_number(T) -> io_lib:write(T); 171 | write_term1({V}, _, _) when is_integer(V) -> "_" ++ integer_to_list(V); 172 | write_term1({V}, _, _) -> atom_to_list(V); %Variable 173 | write_term1([H|T], Prec, #ops{ignore_ops=true}=Ops) -> 174 | write_term1({'.',H,T}, Prec, Ops); 175 | write_term1([H|T], _, Ops) -> 176 | [$[,write_term1(H, 999, Ops),write_tail1(T, Ops),$]]; 177 | write_term1([], _, _) -> "[]"; 178 | write_term1({'{}',A}, _, #ops{ignore_ops=false}=Ops) -> 179 | [${,write_term1(A, 1200, Ops),$}]; 180 | write_term1({'$VAR',N}, _, #ops{numbervars=true}=Ops) 181 | when is_integer(N), N >= 0 -> 182 | %% Write as a variable name. 183 | U = $A + (N rem 26), %First uppercase 184 | if N < 26 -> [U]; 185 | true -> [U|integer_to_list(N div 26)] 186 | end; 187 | write_term1({F,A}, Prec, #ops{ignore_ops=false}=Ops) -> 188 | case erlog_parse:prefix_op(F) of 189 | {yes,OpP,ArgP} -> 190 | Out = [write_term1(F, 1200, Ops),$\s,write_term1(A, ArgP, Ops)], 191 | write_prec1(Out, OpP, Prec); 192 | no -> 193 | case erlog_parse:postfix_op(F) of 194 | {yes,ArgP,OpP} -> 195 | Out = [write_term1(A, ArgP, Ops),$\s, 196 | write_term1(F, 1200, Ops)], 197 | write_prec1(Out, OpP, Prec); 198 | no -> 199 | [write_term1(F, 1200, Ops),$(,write_term1(A, 999, Ops),$)] 200 | end 201 | end; 202 | write_term1({',',A1,A2}, Prec, #ops{ignore_ops=false}=Ops) -> 203 | %% Must special case , here. 204 | Out = [write_term1(A1, 999, Ops),", ",write_term1(A2, 1000, Ops)], 205 | write_prec1(Out, 1000, Prec); 206 | write_term1({F,A1,A2}, Prec, #ops{ignore_ops=false}=Ops) -> 207 | case erlog_parse:infix_op(F) of 208 | {yes,Lp,OpP,Rp} -> 209 | Out = [write_term1(A1, Lp, Ops),$\s,write_term1(F, 1200, Ops), 210 | $\s,write_term1(A2, Rp,Ops)], 211 | write_prec1(Out, OpP, Prec); 212 | no -> 213 | [write_term1(F, 1200, Ops),$(,write_term1(A1, 999, Ops), 214 | $,,write_term1(A2, 999, Ops),$)] 215 | end; 216 | write_term1(T, _, Ops) when is_tuple(T) -> 217 | [F,A1|As] = tuple_to_list(T), 218 | [write_term1(F, 1200, Ops), 219 | $(,write_term1(A1, 999, Ops),write_tail1(As, Ops),$)]; 220 | write_term1(T, _, _) -> %Else use default Erlang. 221 | io_lib:write(T). 222 | 223 | %% write_prec1(OutString, OpPrecedence, Precedence) -> iolist(). 224 | %% Encase OutString with (..) if op precedence higher than 225 | %% precedence. 226 | 227 | write_prec1(Out, OpP, Prec) when OpP > Prec -> [$(,Out,$)]; 228 | write_prec1(Out, _, _) -> Out. 229 | 230 | write_tail1([T|Ts], Ops) -> 231 | [$,,write_term1(T, 999, Ops)|write_tail1(Ts, Ops)]; 232 | write_tail1([], _) -> []; 233 | write_tail1(T, Ops) -> [$|,write_term1(T, 999, Ops)]. 234 | 235 | write_atom1(A, Prec, #ops{quoted=false}) -> %No quoting 236 | do_write_atom1(A, atom_to_list(A), Prec); 237 | write_atom1(A, Prec, _) when A == '!'; A == ';' -> %Special atoms 238 | do_write_atom1(A, atom_to_list(A), Prec); 239 | write_atom1(A, Prec, _) -> 240 | case atom_to_list(A) of 241 | [C|Cs]=Acs -> 242 | case (lower_case(C) andalso alpha_chars(Cs)) 243 | orelse symbol_chars(Acs) of 244 | true -> do_write_atom1(A, Acs, Prec); 245 | false -> 246 | Qcs = quote_atom(Acs), 247 | do_write_atom1(A, Qcs, Prec) 248 | end; 249 | [] -> do_write_atom1(A, "''", Prec) 250 | end. 251 | 252 | do_write_atom1(A, Acs, Prec) -> 253 | case erlog_parse:prefix_op(A) of 254 | {yes,OpP,_} when OpP > Prec -> [$(,Acs,$)]; 255 | _ -> 256 | case erlog_parse:postfix_op(A) of 257 | {yes,_,OpP} when OpP > Prec -> [$(,Acs,$)]; 258 | _ -> Acs 259 | end 260 | end. 261 | 262 | quote_atom(Acs) -> [$',Acs,$']. %Very naive as yet. 263 | 264 | symbol_chars(Cs) -> lists:all(fun symbol_char/1, Cs). 265 | 266 | symbol_char($-) -> true; 267 | symbol_char($#) -> true; 268 | symbol_char($$) -> true; 269 | symbol_char($&) -> true; 270 | symbol_char($*) -> true; 271 | symbol_char($+) -> true; 272 | symbol_char($.) -> true; 273 | symbol_char($/) -> true; 274 | symbol_char($\\) -> true; 275 | symbol_char($:) -> true; 276 | symbol_char($<) -> true; 277 | symbol_char($=) -> true; 278 | symbol_char($>) -> true; 279 | symbol_char($?) -> true; 280 | symbol_char($@) -> true; 281 | symbol_char($^) -> true; 282 | symbol_char($~) -> true; 283 | symbol_char(_) -> false. 284 | 285 | lower_case(C) -> (C >= $a) and (C =< $z). 286 | 287 | alpha_chars(Cs) -> lists:all(fun alpha_char/1, Cs). 288 | 289 | alpha_char($_) -> true; 290 | alpha_char(C) when C >= $A, C =< $Z -> true; 291 | alpha_char(C) when C >= $0, C =< $9 -> true; 292 | alpha_char(C) -> lower_case(C). 293 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 22 | outstanding shares, or (iii) beneficial ownership of such entity. 23 | 24 | "You" (or "Your") shall mean an individual or Legal Entity 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | 179 | APPENDIX: How to apply the Apache License to your work. 180 | 181 | To apply the Apache License to your work, attach the following 182 | boilerplate notice, with the fields enclosed by brackets "[]" 183 | replaced with your own identifying information. (Don't include 184 | the brackets!) The text should be enclosed in the appropriate 185 | comment syntax for the file format. We also recommend that a 186 | file or class name and description of purpose be included on the 187 | same "printed page" as the copyright notice for easier 188 | identification within third-party archives. 189 | 190 | Copyright [yyyy] [name of copyright owner] 191 | 192 | Licensed under the Apache License, Version 2.0 (the "License"); 193 | you may not use this file except in compliance with the License. 194 | You may obtain a copy of the License at 195 | 196 | http://www.apache.org/licenses/LICENSE-2.0 197 | 198 | Unless required by applicable law or agreed to in writing, software 199 | distributed under the License is distributed on an "AS IS" BASIS, 200 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 201 | See the License for the specific language governing permissions and 202 | limitations under the License. 203 | -------------------------------------------------------------------------------- /src/erlog_parse.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2008-2013 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog_parse.erl 16 | %% Author : Robert Virding 17 | %% Purpose : Erlog parser 18 | %% 19 | %% Parses Erlog tokens into Erlog terms. Based on the Standard prolog 20 | %% parser and directly coded from the parser description. To handle 21 | %% back-tracking in the parser we use a continuation style using funs 22 | %% where each fun handles one step of what follows. This allows 23 | %% back-tracking. This may not be a specially efficient way of 24 | %% parsing but it is simple and easy to derive from the 25 | %%% description. No logical variables are necessary here. 26 | 27 | -module(erlog_parse). 28 | 29 | -export([term/1,term/2,format_error/1]). 30 | -export([prefix_op/1,infix_op/1,postfix_op/1]). 31 | 32 | -compile({nowarn_unused_function,[type/1,line/1,val/1]}). 33 | %% -compile(export_all). 34 | 35 | term(Toks) -> term(Toks, 1). 36 | 37 | term(Toks, _) -> 38 | case term(Toks, 1200, fun(Ts, T) -> all_read(Ts, T) end) of 39 | {succeed,Term} -> {ok,Term}; 40 | {fail,{Line,Error}} -> {error,{Line,?MODULE,Error}} 41 | end. 42 | 43 | all_read([{'.',_}], Term) -> {succeed,Term}; 44 | all_read([{T,L}|_], _) -> syntax_error(L, {operator_expected,T}); 45 | all_read([{_,L,V}|_], _) -> syntax_error(L, {operator_expected,V}); 46 | all_read([], _) -> syntax_error(9999, premature_end). 47 | 48 | syntax_error(Line, Error) -> {fail,{Line,Error}}. 49 | %% syntax_error(Line, Error) -> 50 | %% io:fwrite("se: ~p\n", [{Line,Error}]), {fail,{Line,Error}}. 51 | 52 | format_error(premature_end) -> "premature end"; 53 | format_error({operator_expected,T}) -> 54 | io_lib:fwrite("operator expected before: ~w", [T]); 55 | format_error({illegal,T}) -> 56 | io_lib:fwrite("illegal token: ~w", [T]); 57 | format_error(no_term) -> "missing term"; 58 | format_error({op_priority,Op}) -> 59 | io_lib:fwrite("operator priority clash: ~w", [Op]); 60 | format_error({expected,T}) -> 61 | io_lib:fwrite("~w or operator expected", [T]). 62 | 63 | %% term(Tokens, Precedence, Next) -> {succeed,Term} | {fail,Error}. 64 | 65 | term([{number,_,N}|Toks], Prec, Next) -> rest_term(Toks, N, 0, Prec, Next); 66 | term([{string,_,S}|Toks], Prec, Next) -> rest_term(Toks, S, 0, Prec, Next); 67 | term([{'(',_}|Toks], Prec, Next) -> 68 | bracket_term(Toks, Prec, Next); 69 | term([{' (',_}|Toks], Prec, Next) -> 70 | bracket_term(Toks, Prec, Next); 71 | term([{'{',L},{'}',_}|Toks], Prec, Next) -> 72 | term([{atom,L,'{}'}|Toks], Prec, Next); 73 | term([{'{',_}|Toks0], Prec, Next) -> 74 | term(Toks0, 1200, 75 | fun (Toks1, Term) -> 76 | expect(Toks1, '}', Term, 77 | fun (Toks2, Term1) -> 78 | rest_term(Toks2, {'{}',Term1}, 0, Prec, Next) 79 | end) 80 | end); 81 | term([{'[',_},{']',_}|Toks], Prec, Next) -> 82 | rest_term(Toks, [], 0, Prec, Next); 83 | term([{'[',_}|Toks0], Prec, Next) -> 84 | term(Toks0, 999, 85 | fun (Toks1, E) -> 86 | list_elems(Toks1, [E], 87 | fun (Toks2, List) -> 88 | rest_term(Toks2, List, 0, Prec, Next) 89 | end) 90 | end); 91 | term([{var,_,V}|Toks], Prec, Next) -> rest_term(Toks, {V}, 0, Prec, Next); 92 | term([{atom,_,F},{'(',_}|Toks0], Prec, Next) -> 93 | %% Compound term in functional syntax. 94 | term(Toks0, 999, 95 | fun (Toks1, A) -> 96 | arg_list(Toks1, [A], 97 | fun (Toks2, Args) -> 98 | %% Equivalence of '.'/2 and lists. 99 | Term = case {F,Args} of 100 | {'.',[H,T]} -> [H|T]; 101 | _ -> list_to_tuple([F|Args]) 102 | end, 103 | rest_term(Toks2, Term, 0, Prec, Next) 104 | end) 105 | end); 106 | term([{atom,L,Op}|Toks0], Prec, Next) -> 107 | case prefix_op(Op) of 108 | {yes,OpP,ArgP} when Prec >= OpP -> 109 | case possible_right_operand(Toks0) of 110 | true -> 111 | %% First try as prefix op, then as atom. 112 | Next1 = fun (Toks1, Arg) -> 113 | rest_term(Toks1, {Op,Arg}, OpP, Prec, Next) 114 | end, 115 | cp([fun () -> term(Toks0, ArgP, Next1) end, 116 | fun () -> rest_term(Toks0, Op, 0, Prec, Next) end]); 117 | false -> rest_term(Toks0, Op, 0, Prec, Next) 118 | end; 119 | {yes,_,_} -> 120 | syntax_error(L, {op_priority,Op}); 121 | no -> rest_term(Toks0, Op, 0, Prec, Next) 122 | end; 123 | term([{T,L}|_], _, _) -> syntax_error(L, {illegal,T}); 124 | term([{_,L,V}|_], _, _) -> syntax_error(L, {illegal,V}); 125 | term([], _, _) -> syntax_error(9999, no_term). 126 | 127 | %% possible_right_operand(Tokens) -> true | false. 128 | %% Test if there maybe a possible right operand. 129 | 130 | possible_right_operand([{')',_}|_]) -> false; 131 | possible_right_operand([{'}',_}|_]) -> false; 132 | possible_right_operand([{']',_}|_]) -> false; 133 | possible_right_operand([{',',_}|_]) -> false; 134 | possible_right_operand([{'|',_}|_]) -> false; 135 | possible_right_operand(_) -> true. 136 | 137 | %% bracket_term(Tokens, Precedence, Next) -> 138 | %% {succeed,Term} | {fail,Error}. 139 | 140 | bracket_term(Toks0, Prec, Next) -> 141 | term(Toks0, 1200, 142 | fun (Toks1, Term) -> 143 | expect(Toks1, ')', Term, 144 | fun (Toks2, Term1) -> 145 | rest_term(Toks2, Term1, 0, Prec, Next) 146 | end) 147 | end). 148 | 149 | %% rest_term(Tokens, Term, LeftPrec, Precedence, Next) -> 150 | %% {succeed,Term} | {fail,Error}. 151 | %% Have a term to the left, test if operator follows or just go on. 152 | 153 | rest_term([{atom,L,Op}|Toks0], Term, Left, Prec, Next) -> 154 | cp([fun () -> infix_term(Op, L, Toks0, Term, Left, Prec, Next) end, 155 | fun () -> postfix_term(Op, L, Toks0, Term, Left, Prec, Next) end, 156 | fun () -> Next([{atom,L,Op}|Toks0], Term) end]); 157 | rest_term([{',',L}|Toks0], Term, Left, Prec, Next) -> 158 | %% , is an operator as well as a separator. 159 | if Prec >= 1000, Left < 1000 -> 160 | term(Toks0, 1000, 161 | fun (Toks1, RArg) -> 162 | rest_term(Toks1, {',',Term,RArg}, 1000, Prec, Next) 163 | end); 164 | true -> Next([{',',L}|Toks0], Term) 165 | end; 166 | rest_term(Toks, Term, _, _, Next) -> 167 | Next(Toks, Term). 168 | 169 | %% infix_term(Operator, Line, Tokens, Term, LeftPrec, Prec, Next) -> 170 | %% {succeed,Term} | {fail,Error}. 171 | %% Test if infix operator of correct priority, fail with 172 | %% operator_expected if not an operator to have some error. 173 | 174 | infix_term(Op, L, Toks0, Term, Left, Prec, Next) -> 175 | case infix_op(Op) of 176 | {yes,LAP,OpP,RAP} when Prec >= OpP, Left =< LAP -> 177 | term(Toks0, RAP, 178 | fun (Toks1, Arg2) -> 179 | rest_term(Toks1, {Op,Term,Arg2}, OpP, Prec, Next) 180 | end); 181 | {yes,_,_,_} -> syntax_error(L, {op_priority,Op}); 182 | no -> fail 183 | end. 184 | 185 | %% postfix_term(Operator, Line, Tokens, Term, LeftPrec, Prec, Next) -> 186 | %% {succeed,Term} | {fail,Error}. 187 | %% Test if postfix operator of correct priority, fail with 188 | %% operator_expected if not an operator to have some error. 189 | 190 | postfix_term(Op, L, Toks0, Term, Left, Prec, Next) -> 191 | case postfix_op(Op) of 192 | {yes,ArgP,OpP} when Prec >= OpP, Left =< ArgP -> 193 | rest_term(Toks0, {Op,Term}, OpP, Prec, Next); 194 | {yes,_,_} -> syntax_error(L, {op_priority,Op}); 195 | no -> fail 196 | end. 197 | 198 | %% list_elems(Tokens, RevElems, Next) -> 199 | %% {succeed,Term} | {fail,Error}. 200 | 201 | list_elems([{',',_}|Toks0], REs, Next) -> 202 | term(Toks0, 999, 203 | fun (Toks1, E) -> 204 | list_elems(Toks1, [E|REs], Next) 205 | end); 206 | list_elems([{'|',_}|Toks0], REs, Next) -> 207 | term(Toks0, 999, 208 | fun (Toks1, E) -> 209 | expect(Toks1, ']', lists:reverse(REs, E), Next) 210 | end); 211 | list_elems(Toks, REs, Next) -> 212 | expect(Toks, ']', lists:reverse(REs), Next). 213 | 214 | %% arg_list(Tokens, RevArgs, Next) -> {succeed,Term} | {fail,Error}. 215 | 216 | arg_list([{',',_}|Toks0], RAs, Next) -> 217 | term(Toks0, 999, 218 | fun (Toks1, Arg) -> 219 | arg_list(Toks1, [Arg|RAs], Next) 220 | end); 221 | arg_list(Toks, RAs, Next) -> 222 | expect(Toks, ')', lists:reverse(RAs), Next). 223 | 224 | %% expect(Tokens, TokenType, Term, Next) -> {succeed,Term} | {fail,Error}. 225 | 226 | expect([T|Toks], Tok, Term, Next) -> 227 | case type(T) of 228 | Tok -> Next(Toks, Term); 229 | _ -> syntax_error(line(T), {expected,Tok}) 230 | end; 231 | expect([], Tok, _, _) -> syntax_error(9999, {expected,Tok}). 232 | 233 | %% cp(Choices) -> {succeed,Term} | {fail,_} | fail. 234 | %% Special choice point handler for parser. If all clauses fail then 235 | %% fail with first fail value, this usually gives better error report. 236 | 237 | cp([C|Cs]) -> 238 | case C() of 239 | {succeed,Res} -> {succeed,Res}; 240 | {fail,_}=Fail -> cp(Cs, Fail); %Try rest with first fail 241 | fail -> cp(Cs) %Stay till we get reason 242 | end. 243 | 244 | cp([C|Cs], Fail) -> 245 | case C() of 246 | {succeed,Res} -> {succeed,Res}; 247 | {fail,_} -> cp(Cs, Fail); %Drop this fail, use first 248 | fail -> cp(Cs, Fail) 249 | end; 250 | cp([], Fail) -> Fail. 251 | 252 | %% type(Tok) -> Line. 253 | %% line(Tok) -> Line. 254 | %% val(Tok) -> Value. 255 | 256 | type(Tok) -> element(1, Tok). 257 | line(Tok) -> element(2, Tok). 258 | val(Tok) -> element(3, Tok). 259 | 260 | %% prefix_op(Op) -> {yes,Prec,ArgPrec} | no. 261 | 262 | prefix_op('?-') -> {yes,1200,1199}; %fx 1200 263 | prefix_op(':-') -> {yes,1200,1199}; %fx 1200 264 | prefix_op('\\+') -> {yes,900,900}; %fy 900 265 | prefix_op('+') -> {yes,200,200}; %fy 200 266 | prefix_op('-') -> {yes,200,200}; %fy 200 267 | prefix_op('\\') -> {yes,200,200}; %fy 200 268 | prefix_op(_Op) -> no. %The rest 269 | 270 | %% postfix_op(Op) -> {yes,ArgPrec,Prec} | no. 271 | 272 | postfix_op('+') -> {yes,500,500}; 273 | postfix_op('*') -> {yes,400,400}; 274 | postfix_op(_Op) -> no. 275 | 276 | %% infix_op(Op) -> {yes,LeftArgPrec,Prec,RightArgPrec} | no. 277 | 278 | infix_op(':-') -> {yes,1199,1200,1199}; %xfx 1200 279 | infix_op('-->') -> {yes,1199,1200,1199}; %xfx 1200 280 | infix_op(';') -> {yes,1099,1100,1100}; %xfy 1100 281 | infix_op('->') -> {yes,1049,1050,1050}; %xfy 1050 282 | infix_op(',') -> {yes,999,1000,1000}; %xfy 1000 283 | infix_op('=') -> {yes,699,700,699}; %xfx 700 284 | infix_op('\\=') -> {yes,699,700,699}; %xfx 700 285 | infix_op('\\==') -> {yes,699,700,699}; %xfx 700 286 | infix_op('==') -> {yes,699,700,699}; %xfx 700 287 | infix_op('@<') -> {yes,699,700,699}; %xfx 700 288 | infix_op('@=<') -> {yes,699,700,699}; %xfx 700 289 | infix_op('@>') -> {yes,699,700,699}; %xfx 700 290 | infix_op('@>=') -> {yes,699,700,699}; %xfx 700 291 | infix_op('=..') -> {yes,699,700,699}; %xfx 700 292 | infix_op('is') -> {yes,699,700,699}; %xfx 700 293 | infix_op('=:=') -> {yes,699,700,699}; %xfx 700 294 | infix_op('=\\=') -> {yes,699,700,699}; %xfx 700 295 | infix_op('<') -> {yes,699,700,699}; %xfx 700 296 | infix_op('=<') -> {yes,699,700,699}; %xfx 700 297 | infix_op('>') -> {yes,699,700,699}; %xfx 700 298 | infix_op('>=') -> {yes,699,700,699}; %xfx 700 299 | infix_op(':') -> {yes,599,600,600}; %xfy 600 300 | infix_op('+') -> {yes,500,500,499}; %yfx 500 301 | infix_op('-') -> {yes,500,500,499}; %yfx 500 302 | infix_op('/\\') -> {yes,500,500,499}; %yfx 500 303 | infix_op('\\/') -> {yes,500,500,499}; %yfx 500 304 | infix_op('*') -> {yes,400,400,399}; %yfx 400 305 | infix_op('/') -> {yes,400,400,399}; %yfx 400 306 | infix_op('//') -> {yes,400,400,399}; %yfx 400 307 | infix_op('rem') -> {yes,400,400,399}; %yfx 400 308 | infix_op('mod') -> {yes,400,400,399}; %yfx 400 309 | infix_op('<<') -> {yes,400,400,399}; %yfx 400 310 | infix_op('>>') -> {yes,400,400,399}; %yfx 400 311 | infix_op('**') -> {yes,199,200,199}; %xfx 200 312 | infix_op('^') -> {yes,199,200,200}; %xfy 200 313 | infix_op(_Op) -> no. 314 | -------------------------------------------------------------------------------- /src/erlog_bips.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2008-2013 Robert Virding 2 | %% 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %% you may not use this file except in compliance with the License. 5 | %% You may obtain a copy of the License at 6 | %% 7 | %% http://www.apache.org/licenses/LICENSE-2.0 8 | %% 9 | %% Unless required by applicable law or agreed to in writing, software 10 | %% distributed under the License is distributed on an "AS IS" BASIS, 11 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %% See the License for the specific language governing permissions and 13 | %% limitations under the License. 14 | 15 | %% File : erlog_bips.erl 16 | %% Author : Robert Virding 17 | %% Purpose : Built-in predicates of Erlog interpreter. 18 | %% 19 | %% These are the built-in predicates of the Prolog interpreter which 20 | %% are not control predicates or database predicates. 21 | 22 | -module(erlog_bips). 23 | 24 | -include("erlog_int.hrl"). 25 | 26 | %% Main interface functions. 27 | -export([load/1]). 28 | -export([prove_goal/3]). 29 | 30 | %%-compile(export_all). 31 | 32 | -import(lists, [map/2,foldl/3]). 33 | 34 | %% We use these a lot so we import them for cleaner code. 35 | -import(erlog_int, [prove_body/2,unify_prove_body/4,unify_prove_body/6,fail/1, 36 | get_binding/2,add_binding/3,make_var_list/2, 37 | deref/2,dderef/2,dderef_list/2,unify/3, 38 | term_instance/2, 39 | add_built_in/2,add_compiled_proc/4, 40 | asserta_clause/2,assertz_clause/2]). 41 | 42 | %% load(Database) -> Database. 43 | %% Assert predicates into the database. 44 | 45 | load(Db0) -> 46 | foldl(fun (Head, Db) -> add_built_in(Head, Db) end, Db0, 47 | [ 48 | %% Term unification and comparison 49 | {'=',2}, 50 | {'\\=',2}, 51 | {'@>',2}, 52 | {'@>=',2}, 53 | {'==',2}, 54 | {'\\==',2}, 55 | {'@<',2}, 56 | {'@=<',2}, 57 | %% Term creation and decomposition. 58 | {arg,3}, 59 | {copy_term,2}, 60 | {functor,3}, 61 | {numbervars,3}, %Not part of ISO standard 62 | {term_variables,2}, 63 | {term_variables,3}, 64 | {'=..',2}, 65 | %% Type testing. 66 | {atom,1}, 67 | {atomic,1}, 68 | {compound,1}, 69 | {integer,1}, 70 | {float,1}, 71 | {number,1}, 72 | {nonvar,1}, 73 | {var,1}, 74 | %% Atom processing. 75 | {atom_chars,2}, 76 | {atom_codes,2}, 77 | {atom_length,2}, 78 | %% Arithmetic evaluation and comparison 79 | {'is',2}, 80 | {'>',2}, 81 | {'>=',2}, 82 | {'=:=',2}, 83 | {'=\\=',2}, 84 | {'<',2}, 85 | {'=<',2}, 86 | %% I/O 87 | {nl,0}, 88 | {put_char,1}, 89 | {put_code,1}, 90 | {read,1}, 91 | {write,1}, 92 | {writeq,1}, 93 | {write_canonical,1}, 94 | {write_term,2} 95 | ]). 96 | 97 | %% prove_goal(Goal, NextGoal, State) -> 98 | %% {succeed,State} | 99 | %% {fail,State}. 100 | %% Prove one goal. We seldom return succeed here but usually go directly to 101 | %% to NextGoal. 102 | 103 | %% Term unification and comparison 104 | prove_goal({'=',L,R}, Next, St) -> 105 | unify_prove_body(L, R, Next, St); 106 | prove_goal({'\\=',L,R}, Next, #est{bs=Bs}=St) -> 107 | case unify(L, R, Bs) of 108 | {succeed,_} -> fail(St); 109 | fail -> prove_body(Next, St) 110 | end; 111 | prove_goal({'@>',L,R}, Next, St) -> 112 | term_test_prove_body('>', L, R, Next, St); 113 | prove_goal({'@>=',L,R}, Next, St) -> 114 | term_test_prove_body('>=', L, R, Next, St); 115 | prove_goal({'==',L,R}, Next, St) -> 116 | term_test_prove_body('==', L, R, Next, St); 117 | prove_goal({'\\==',L,R}, Next, St) -> 118 | term_test_prove_body('/=', L, R, Next, St); 119 | prove_goal({'@<',L,R}, Next, St) -> 120 | term_test_prove_body('<', L, R, Next, St); 121 | prove_goal({'@=<',L,R}, Next, St) -> 122 | term_test_prove_body('=<', L, R, Next, St); 123 | %% Term creation and decomposition. 124 | prove_goal({arg,I,Term,A}, Next, #est{bs=Bs}=St) -> 125 | prove_arg(deref(I, Bs), deref(Term, Bs), A, Next, St); 126 | prove_goal({copy_term,T0,C}, Next, #est{bs=Bs,vn=Vn0}=St) -> 127 | %% Use term_instance to create the copy, can ignore orddict it creates. 128 | {T,_Nbs,Vn1} = term_instance(dderef(T0, Bs), Vn0), 129 | unify_prove_body(T, C, Next, St#est{vn=Vn1}); 130 | prove_goal({functor,T,F,A}, Next, #est{bs=Bs}=St) -> 131 | prove_functor(deref(T, Bs), F, A, Next, St); 132 | prove_goal({numbervars,Term,S,E}, Next, St) -> 133 | prove_numbervars(Term, S, E, Next, St); 134 | prove_goal({term_variables,Term,List}, Next, St) -> 135 | prove_body([{term_variables,Term,List,[]}|Next], St); 136 | prove_goal({term_variables,Term,List,Tail}, Next, St) -> 137 | prove_term_variables(Term, List, Tail, Next, St); 138 | prove_goal({'=..',T,L}, Next, #est{bs=Bs}=St) -> 139 | prove_univ(dderef(T, Bs), L, Next, St); 140 | %% Type testing. 141 | prove_goal({atom,T0}, Next, #est{bs=Bs}=St) -> 142 | case deref(T0, Bs) of 143 | T when is_atom(T) -> prove_body(Next, St); 144 | _Other -> fail(St) 145 | end; 146 | prove_goal({atomic,T0}, Next, #est{bs=Bs}=St) -> 147 | case deref(T0, Bs) of 148 | T when ?IS_ATOMIC(T) -> prove_body(Next, St); 149 | _Other -> fail(St) 150 | end; 151 | prove_goal({compound,T0}, Next, #est{bs=Bs}=St) -> 152 | case deref(T0, Bs) of 153 | T when ?IS_ATOMIC(T) -> fail(St); 154 | _Other -> prove_body(Next, St) 155 | end; 156 | prove_goal({integer,T0}, Next, #est{bs=Bs}=St) -> 157 | case deref(T0, Bs) of 158 | T when is_integer(T) -> prove_body(Next, St); 159 | _Other -> fail(St) 160 | end; 161 | prove_goal({float,T0}, Next, #est{bs=Bs}=St) -> 162 | case deref(T0, Bs) of 163 | T when is_float(T) -> prove_body(Next, St); 164 | _Other -> fail(St) 165 | end; 166 | prove_goal({number,T0}, Next, #est{bs=Bs}=St) -> 167 | case deref(T0, Bs) of 168 | T when is_number(T) -> prove_body(Next, St); 169 | _Other -> fail(St) 170 | end; 171 | prove_goal({nonvar,T0}, Next, #est{bs=Bs}=St) -> 172 | case deref(T0, Bs) of 173 | {_} -> fail(St); 174 | _Other -> prove_body(Next, St) 175 | end; 176 | prove_goal({var,T0}, Next, #est{bs=Bs}=St) -> 177 | case deref(T0, Bs) of 178 | {_} -> prove_body(Next, St); 179 | _Other -> fail(St) 180 | end; 181 | %% Atom processing. 182 | prove_goal({atom_chars,A,L}, Next, St) -> 183 | prove_atom_chars(A, L, Next, St); 184 | prove_goal({atom_codes,A,L}, Next, St) -> 185 | prove_atom_codes(A, L, Next, St); 186 | prove_goal({atom_length,A0,L0}, Next, #est{bs=Bs}=St) -> 187 | case deref(A0, Bs) of 188 | A when is_atom(A) -> 189 | Alen = length(atom_to_list(A)), %No of chars in atom 190 | case dderef(L0, Bs) of 191 | L when is_integer(L) -> 192 | unify_prove_body (Alen, L, Next, St); 193 | {_}=Var -> 194 | unify_prove_body (Alen, Var, Next, St); 195 | Other -> erlog_int:type_error(integer, Other, St) 196 | end; 197 | {_} -> erlog_int:instantiation_error(St); 198 | Other -> erlog_int:type_error(atom, Other, St) 199 | end; 200 | %% Arithmetic evalution and comparison. 201 | prove_goal({is,N,E0}, Next, #est{bs=Bs}=St) -> 202 | E = eval_arith(deref(E0, Bs), Bs, St), 203 | unify_prove_body(N, E, Next, St); 204 | prove_goal({'>',L,R}, Next, St) -> 205 | arith_test_prove_body('>', L, R, Next, St); 206 | prove_goal({'>=',L,R}, Next, St) -> 207 | arith_test_prove_body('>=', L, R, Next, St); 208 | prove_goal({'=:=',L,R}, Next, St) -> 209 | arith_test_prove_body('==', L, R, Next, St); 210 | prove_goal({'=\\=',L,R}, Next, St) -> 211 | arith_test_prove_body('/=', L, R, Next, St); 212 | prove_goal({'<',L,R}, Next, St) -> 213 | arith_test_prove_body('<', L, R, Next, St); 214 | prove_goal({'=<',L,R}, Next, St) -> 215 | arith_test_prove_body('=<', L, R, Next, St); 216 | %% I/O. 217 | prove_goal(nl, Next, St) -> 218 | prove_nl_0(Next, St); 219 | prove_goal({put_char,C}, Next, St) -> 220 | prove_put_char_1(C, Next, St); 221 | prove_goal({put_code,C}, Next, St) -> 222 | prove_put_code_1(C, Next, St); 223 | prove_goal({read,Var}, Next, St) -> 224 | prove_read_1(Var, Next, St); 225 | prove_goal({write,T}, Next, St) -> 226 | prove_write_1(T, Next, St); 227 | prove_goal({writeq,T}, Next, St) -> 228 | prove_writeq_1(T, Next, St); 229 | prove_goal({write_canonical,T}, Next, St) -> 230 | prove_write_canonical_1(T, Next, St); 231 | prove_goal({write_term,T,Opts}, Next, St) -> 232 | prove_write_term_2(T, Opts, Next, St); 233 | %% This error should never occur! 234 | prove_goal(Goal, _, _) -> 235 | error({illegal_bip,Goal}). 236 | 237 | %% term_test_prove_body(Test, Left, Right, Next, State) -> void. 238 | 239 | term_test_prove_body(Test, L, R, Next, #est{bs=Bs}=St) -> 240 | case erlang:Test(dderef(L, Bs), dderef(R, Bs)) of 241 | true -> prove_body(Next, St); 242 | false -> fail(St) 243 | end. 244 | 245 | %% prove_arg(Index, Term, Arg, Next, St) -> void. 246 | %% Prove the goal arg(I, Ct, Arg). Index and Term have been dereferenced. 247 | 248 | prove_arg(I, T, A, Next, St) when is_integer(I) -> 249 | prove_arg_int(I, T, A, Next, St); 250 | prove_arg({_}=I, T, A, Next, St) -> 251 | prove_arg_var(I, T, A, Next, St); 252 | prove_arg(I, _, _, _, St) -> 253 | erlog_int:type_error(integer, I, St). 254 | 255 | prove_arg_int(I, [H|T], A, Next, St) -> 256 | %% He, he, he! 257 | if I == 1 -> unify_prove_body(A, H, Next, St); 258 | I == 2 -> unify_prove_body(A, T, Next, St); 259 | true -> fail(St) 260 | end; 261 | prove_arg_int(I, Ct, A, Next, St) when tuple_size(Ct) >= 2 -> 262 | if I >= 1, I =< tuple_size(Ct) - 1 -> 263 | Arg = element(I+1, Ct), 264 | unify_prove_body(A, Arg, Next, St); 265 | true -> fail(St) 266 | end; 267 | prove_arg_int(_, Ct, _, _, St) -> 268 | erlog_int:type_error(compound, Ct, St). 269 | 270 | prove_arg_var(I, [H|T], A, Next, St) -> 271 | %% He, he, he! 272 | prove_arg_list(I, 1, [H,T], A, Next, St); 273 | prove_arg_var(I, Ct, A, Next, St) when tuple_size(Ct) >= 2 -> 274 | Args = tl(tuple_to_list(Ct)), 275 | prove_arg_list(I, 1, Args, A, Next, St); 276 | prove_arg_var(_, Ct, _, _, St) -> 277 | erlog_int:type_error(compound, Ct, St). 278 | 279 | prove_arg_list(V, I, [H], A, Next, #est{bs=Bs0}=St) -> 280 | Bs1 = add_binding(V, I, Bs0), 281 | unify_prove_body(A, H, Next, St#est{bs=Bs1}); 282 | prove_arg_list(V, I, [H|T], A, Next, #est{cps=Cps,bs=Bs0,vn=Vn}=St) -> 283 | FailFun = fun (Lcp, Lcps, Lst) -> 284 | fail_arg_3(Lcp, Lcps, Lst, V, I+1, T, A) 285 | end, 286 | Cp = #cp{type=compiled,data=FailFun,next=Next,bs=Bs0,vn=Vn}, 287 | Bs1 = add_binding(V, I, Bs0), 288 | unify_prove_body(A, H, Next, St#est{cps=[Cp|Cps],bs=Bs1}). 289 | 290 | fail_arg_3(#cp{next=Next,bs=Bs,vn=Vn}, Cps, St, V, I, List, A) -> 291 | prove_arg_list(V, I, List, A, Next, St#est{cps=Cps,bs=Bs,vn=Vn}). 292 | 293 | %% prove_functor(Term, Functor, Arity, Next, State) -> void. 294 | %% Prove the call functor(T, F, A), Term has been dereferenced. 295 | 296 | prove_functor(T, F, A, Next, St) when tuple_size(T) >= 2 -> 297 | unify_prove_body(F, element(1, T), A, tuple_size(T)-1, Next, St); 298 | prove_functor(T, F, A, Next, St) when ?IS_ATOMIC(T) -> 299 | unify_prove_body(F, T, A, 0, Next, St); 300 | prove_functor([_|_], F, A, Next, St) -> 301 | %% Just the top level here. 302 | unify_prove_body(F, '.', A, 2, Next, St); 303 | prove_functor({_}=Var, F0, A0, Next, #est{bs=Bs0,vn=Vn0}=St) -> 304 | case {deref(F0, Bs0),deref(A0, Bs0)} of 305 | {'.',2} -> %He, he, he! 306 | Bs1 = add_binding(Var, [{Vn0}|{Vn0+1}], Bs0), 307 | prove_body(Next, St#est{bs=Bs1,vn=Vn0+2}); 308 | {F1,0} when ?IS_ATOMIC(F1) -> 309 | Bs1 = add_binding(Var, F1, Bs0), 310 | prove_body(Next, St#est{bs=Bs1}); 311 | {F1,A1} when is_atom(F1), is_integer(A1), A1 > 0 -> 312 | As = make_var_list(A1, Vn0), 313 | Bs1 = add_binding(Var, list_to_tuple([F1|As]), Bs0), 314 | prove_body(Next, St#est{bs=Bs1,vn=Vn0+A1}); %!!! 315 | %% Now the error cases. 316 | {{_},_} -> erlog_int:instantiation_error(St); 317 | {F1,A1} when is_atom(F1) -> erlog_int:type_error(integer, A1, St); 318 | {F1,_} -> erlog_int:type_error(atom, F1, St) 319 | end. 320 | 321 | %% prove_numbervars(Term, Start, E, Next, State) -> void. 322 | %% Unify the free variables in Term with a term $VAR(N), where N is 323 | %% the number of the variable. This is predicate is not part of the 324 | %% ISO standard. 325 | 326 | prove_numbervars(T, S0, E, Next, #est{bs=Bs0}=St) -> 327 | case deref(S0, Bs0) of 328 | {_} -> erlog_int:instantiation_error(St); 329 | S1 when is_integer(S1) -> 330 | {N,Bs1} = numbervars(T, S1, Bs0), 331 | unify_prove_body(N, E, Next, St#est{bs=Bs1}); 332 | S1 -> erlog_int:type_error(integer, S1, St) 333 | end. 334 | 335 | numbervars(A, I, Bs) when ?IS_CONSTANT(A) -> {I,Bs}; 336 | numbervars([], I, Bs) -> {I,Bs}; 337 | numbervars([H|T], I0, Bs0) -> 338 | {I1,Bs1} = numbervars(H, I0, Bs0), 339 | numbervars(T, I1, Bs1); 340 | numbervars({_}=Var, I, Bs0) -> 341 | case get_binding(Var, Bs0) of 342 | {ok,T} -> numbervars(T, I, Bs0); 343 | error -> 344 | Bs1 = add_binding(Var, {'$VAR',I}, Bs0), 345 | {I+1,Bs1} 346 | end; 347 | numbervars(T, I0, Bs0) -> 348 | foldl(fun (E, {I,Bs}) -> numbervars(E, I, Bs) end, 349 | {I0,Bs0}, tl(tuple_to_list(T))). 350 | 351 | %% prove_term_variables(Term, List, Tail, Next, State) -> void. 352 | %% Unify List with a list of all the variables in Term with tail 353 | %% Tail. The variables are in depth-first and left-to-right of how 354 | %% they occur in Term. 355 | 356 | prove_term_variables(T, L, Tail, Next, #est{bs=Bs}=St) -> 357 | Tvs = term_variables(T, Tail, Bs), 358 | unify_prove_body(Tvs, L, Next, St). 359 | 360 | %% term_variables(Term, Tail, Bindings) -> TermVariables. 361 | %% This is like dderef but we never rebuild Term just get the variables. 362 | 363 | term_variables(A, Vars, _) when ?IS_CONSTANT(A) -> Vars; 364 | term_variables([], Vars, _) -> Vars; 365 | term_variables([H|T], Vars0, Bs) -> 366 | Vars1 = term_variables(H, Vars0, Bs), 367 | term_variables(T, Vars1, Bs); 368 | term_variables({_}=Var, Vars, Bs) -> 369 | case get_binding(Var, Bs) of 370 | {ok,T} -> term_variables(T, Vars, Bs); 371 | error -> 372 | case lists:member(Var, Vars) of %Add to the end if not there 373 | true -> Vars; 374 | false -> Vars ++ [Var] 375 | end 376 | end; 377 | term_variables(T, Vars, Bs) -> 378 | foldl(fun (E, Vs) -> term_variables(E, Vs, Bs) end, 379 | Vars, tl(tuple_to_list(T))). 380 | 381 | %% prove_univ(Term, List, Next, State) -> void. 382 | %% Prove the goal Term =.. List, Term has already been dereferenced. 383 | 384 | prove_univ(T, L, Next, St) when tuple_size(T) >= 2 -> 385 | Es = tuple_to_list(T), 386 | unify_prove_body(Es, L, Next, St); 387 | prove_univ(T, L, Next, St) when ?IS_ATOMIC(T) -> 388 | unify_prove_body([T], L, Next, St); 389 | prove_univ([Lh|Lt], L, Next, St) -> 390 | %% He, he, he! 391 | unify_prove_body(['.',Lh,Lt], L, Next, St); 392 | prove_univ({_}=Var, L, Next, #est{bs=Bs0}=St) -> 393 | case dderef(L, Bs0) of 394 | ['.',Lh,Lt] -> %He, he, he! 395 | Bs1 = add_binding(Var, [Lh|Lt], Bs0), 396 | prove_body(Next, St#est{bs=Bs1}); 397 | [A] when ?IS_ATOMIC(A) -> 398 | Bs1 = add_binding(Var, A, Bs0), 399 | prove_body(Next, St#est{bs=Bs1}); 400 | [F|As] when is_atom(F), length(As) > 0 -> 401 | Bs1 = add_binding(Var, list_to_tuple([F|As]), Bs0), 402 | prove_body(Next, St#est{bs=Bs1}); 403 | %% Now the error cases. 404 | [{_}|_] -> erlog_int:instantiation_error(St); 405 | {_} -> erlog_int:instantiation_error(St); 406 | Other -> erlog_int:type_error(list, Other, St) 407 | end. 408 | 409 | %% prove_atom_chars(Atom, List, Next, State) -> void. 410 | %% Prove the atom_chars(Atom, List). 411 | 412 | prove_atom_chars(A, L, Next, #est{bs=Bs}=St) -> 413 | %% After a suggestion by Sean Cribbs. 414 | case deref(A, Bs) of 415 | Atom when is_atom(Atom) -> 416 | AtomList = [ list_to_atom([C]) || C <- atom_to_list(Atom) ], 417 | unify_prove_body(L, AtomList, Next, St); 418 | {_}=Var -> 419 | %% Error #3: List is neither a list nor a partial list. 420 | %% Handled in dderef_list/2. 421 | List = dderef_list(L, Bs), 422 | %% Error #1, #4: List is a list or partial list with an 423 | %% element which is a variable or not one char atom. 424 | Fun = fun ({_}) -> erlog_int:instantiation_error(St); 425 | (Atom) -> 426 | case is_atom(Atom) andalso atom_to_list(Atom) of 427 | [C] -> C; 428 | _ -> erlog_int:type_error(character, Atom, St) 429 | end 430 | end, 431 | Chars = lists:map(Fun, List), 432 | Atom = list_to_atom(Chars), %This should not crash 433 | unify_prove_body(Var, Atom, Next, St); 434 | Other -> 435 | %% Error #2: Atom is neither a variable nor an atom 436 | erlog_int:type_error(atom, Other, St) 437 | end. 438 | 439 | %% prove_atom_codes(Atom, List, Next, State) -> void. 440 | %% Prove the atom_codes(Atom, List). 441 | 442 | prove_atom_codes(A, L, Next, #est{bs=Bs}=St) -> 443 | case deref(A, Bs) of 444 | Atom when is_atom(Atom) -> 445 | AtomList = atom_to_list(Atom), 446 | unify_prove_body(L, AtomList, Next, St); 447 | {_}=Var -> 448 | %% Error #3: List is neither a list nor a partial list. 449 | %% Handled in dderef_list/2. 450 | List = dderef_list(L, Bs), 451 | %% Error #1, #4: List is a list or partial list with an 452 | %% element which is a variable or not one char atom. 453 | Fun = fun ({_}) -> erlog_int:instantiation_error(St); 454 | (C) when is_integer(C), C >= 0, C < 255 -> C; 455 | (C) -> erlog_int:type_error(character_code, C, St) 456 | end, 457 | Chars = lists:map(Fun, List), 458 | Atom = list_to_atom(Chars), %This should not crash 459 | unify_prove_body(Var, Atom, Next, St); 460 | Other -> 461 | %% Error #2: Atom is neither a variable nor an atom 462 | erlog_int:type_error(atom, Other, St) 463 | end. 464 | 465 | %% arith_test_prove_body(Test, Left, Right, Next, State) -> void. 466 | 467 | arith_test_prove_body(Test, L, R, Next, #est{bs=Bs}=St) -> 468 | case erlang:Test(eval_arith(deref(L, Bs), Bs, St), 469 | eval_arith(deref(R, Bs), Bs, St)) of 470 | true -> prove_body(Next, St); 471 | false -> fail(St) 472 | end. 473 | 474 | %% eval_arith(ArithExpr, Bindings, State) -> Number. 475 | %% Evaluate an arithmetic expression, include the state for errors. 476 | %% Dereference each level as we go, might fail so save some work. 477 | %% Must be called deferenced. 478 | 479 | eval_arith({'+',A,B}, Bs, St) -> 480 | eval_arith(deref(A, Bs), Bs, St) + eval_arith(deref(B, Bs), Bs, St); 481 | eval_arith({'-',A,B}, Bs, St) -> 482 | eval_arith(deref(A, Bs), Bs, St) - eval_arith(deref(B, Bs), Bs, St); 483 | eval_arith({'*',A,B}, Bs, St) -> 484 | eval_arith(deref(A, Bs), Bs, St) * eval_arith(deref(B, Bs), Bs, St); 485 | eval_arith({'/',A,B}, Bs, St) -> 486 | eval_arith(deref(A, Bs), Bs, St) / eval_arith(deref(B, Bs), Bs, St); 487 | eval_arith({'**',A,B}, Bs, St) -> 488 | math:pow(eval_arith(deref(A, Bs), Bs, St), 489 | eval_arith(deref(B, Bs), Bs, St)); 490 | eval_arith({'//',A,B}, Bs, St) -> 491 | eval_int(deref(A, Bs), Bs, St) div eval_int(deref(B, Bs), Bs, St); 492 | eval_arith({'mod',A,B}, Bs, St) -> 493 | eval_int(deref(A, Bs), Bs, St) rem eval_int(deref(B, Bs), Bs, St); 494 | eval_arith({'/\\',A,B}, Bs, St) -> 495 | eval_int(deref(A, Bs), Bs, St) band eval_int(deref(B, Bs), Bs, St); 496 | eval_arith({'\\/',A,B}, Bs, St) -> 497 | eval_int(deref(A, Bs), Bs, St) bor eval_int(deref(B, Bs), Bs, St); 498 | eval_arith({'<<',A,B}, Bs, St) -> 499 | eval_int(deref(A, Bs), Bs, St) bsl eval_int(deref(B, Bs), Bs, St); 500 | eval_arith({'>>',A,B}, Bs, St) -> 501 | eval_int(deref(A, Bs), Bs, St) bsr eval_int(deref(B, Bs), Bs, St); 502 | eval_arith({'\\',A}, Bs, St) -> 503 | bnot eval_int(deref(A, Bs), Bs, St); 504 | eval_arith({'+',A}, Bs, St) -> 505 | + eval_arith(deref(A, Bs), Bs, St); 506 | eval_arith({'-',A}, Bs, St) -> 507 | - eval_arith(deref(A, Bs), Bs, St); 508 | eval_arith({'abs',A}, Bs, St) -> 509 | abs(eval_arith(deref(A, Bs), Bs, St)); 510 | eval_arith({'float',A}, Bs, St) -> 511 | float(eval_arith(deref(A, Bs), Bs, St)); 512 | eval_arith({'truncate',A}, Bs, St) -> 513 | trunc(eval_arith(deref(A, Bs), Bs, St)); 514 | eval_arith(N, _Bs, _Db) when is_number(N) -> N; %Just a number 515 | %% Error cases. 516 | eval_arith({_}, _Bs, St) -> 517 | erlog_int:instantiation_error(St); 518 | eval_arith(N, _Bs, Db) when is_tuple(N) -> 519 | Pi = pred_ind(element(1, N), tuple_size(N)-1), 520 | erlog_int:type_error(evaluable, Pi, Db); 521 | eval_arith([_|_], _Bs, Db) -> 522 | erlog_int:type_error(evaluable, pred_ind('.', 2), Db); 523 | eval_arith(O, _Bs, Db) -> 524 | erlog_int:type_error(evaluable, O, Db). 525 | 526 | %% eval_int(IntegerExpr, Bindings, State) -> Integer. 527 | %% Evaluate an integer expression, include the state for errors. 528 | 529 | eval_int(E0, Bs, St) -> 530 | E = eval_arith(E0, Bs, St), 531 | if is_integer(E) -> E; 532 | true -> erlog_int:type_error(integer, E, St) 533 | end. 534 | 535 | pred_ind(N, A) -> {'/',N,A}. 536 | 537 | %% prove_nl_0(Next, State) -> void. 538 | 539 | prove_nl_0(Next, St) -> 540 | io:nl(), 541 | prove_body(Next, St). 542 | 543 | %% prove_put_char_1(Char, NextGoal, State) -> void. 544 | %% prove_put_code_1(Code, NextGoal, State) -> void. 545 | 546 | prove_put_char_1(C0, Next, #est{bs=Bs}=St) -> 547 | case dderef(C0, Bs) of 548 | {_} -> erlog_int:instantiation_error(St); 549 | C1 -> 550 | case is_atom(C1) andalso atom_to_list(C1) of 551 | [C] -> 552 | io:put_chars([C]), 553 | prove_body(Next, St); 554 | _ -> erlog_int:type_error(character, C1) 555 | end 556 | end. 557 | 558 | -define(IS_UNICODE(C), ((C >= 0) and (C =< 16#10FFFF))). 559 | 560 | prove_put_code_1(C0, Next, #est{bs=Bs}=St) -> 561 | case dderef(C0, Bs) of 562 | {_} -> erlog_int:instantiation_error(St); 563 | C1 -> 564 | case is_integer(C1) andalso ?IS_UNICODE(C1) of 565 | true -> 566 | io:put_chars([C1]), 567 | prove_body(Next, St); 568 | false -> erlog_int:type_error(integer, C1) 569 | end 570 | end. 571 | 572 | %% prove_read_1(Var, NextGoal, State) -> void. 573 | 574 | prove_read_1(Var, Next, St) -> 575 | case erlog_io:read('') of %No prompt 576 | {ok,Term} -> 577 | unify_prove_body(Var, Term, Next, St); 578 | {error,{_,_,Error}} -> 579 | erlog_int:erlog_error({syntax_error,Error}, St) 580 | end. 581 | 582 | %% prove_write_1(Term, NextGoal, State) -> void. 583 | %% prove_writeq_1(Term, NextGoal, State) -> void. 584 | %% prove_write_canonical_1(Term, NextGoal, State) -> void. 585 | %% These can call the write functions in the erlog_io module directly. 586 | 587 | prove_write_1(T0, Next, #est{bs=Bs}=St) -> 588 | T1 = dderef(T0, Bs), 589 | erlog_io:write(T1), 590 | prove_body(Next, St). 591 | 592 | prove_writeq_1(T0, Next, #est{bs=Bs}=St) -> 593 | T1 = dderef(T0, Bs), 594 | erlog_io:writeq(T1), 595 | prove_body(Next, St). 596 | 597 | prove_write_canonical_1(T0, Next, #est{bs=Bs}=St) -> 598 | T1 = dderef(T0, Bs), 599 | erlog_io:write_canonical(T1), 600 | prove_body(Next, St). 601 | 602 | %% prove_write_term_2(Term, Options, NextGoal, State) -> void. 603 | 604 | prove_write_term_2(T0, Opts0, Next, #est{bs=Bs}=St) -> 605 | T1 = dderef(T0, Bs), 606 | Opts1 = write_term_opts(dderef(Opts0, Bs), St), 607 | erlog_io:write_term(T1, Opts1), 608 | prove_body(Next, St). 609 | 610 | write_term_opts([{ignore_ops,true}|Opts], St) -> 611 | [ignore_ops|write_term_opts(Opts, St)]; 612 | write_term_opts([{ignore_ops,false}|Opts], St) -> 613 | write_term_opts(Opts, St); 614 | write_term_opts([{numbervars,true}|Opts], St) -> 615 | [numbervars|write_term_opts(Opts, St)]; 616 | write_term_opts([{numbervars,false}|Opts], St) -> 617 | write_term_opts(Opts, St); 618 | write_term_opts([{quoted,true}|Opts], St) -> 619 | [quoted|write_term_opts(Opts, St)]; 620 | write_term_opts([{quoted,false}|Opts], St) -> 621 | write_term_opts(Opts, St); 622 | write_term_opts([{_}|_], St) -> 623 | erlog_int:instantiation_error(St); 624 | write_term_opts([T|_], St) -> 625 | erlog_int:domain_error(write_option, T, St); 626 | write_term_opts([], _) -> []. 627 | --------------------------------------------------------------------------------