From d188f098848fab83fc6aeb2a22c10b89fc4e70ac Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 26 May 2014 18:43:01 +0300 Subject: [PATCH 001/251] format code (auto) and sort it to directories --- .gitignore | 4 + ebin/erlog.app | 20 - {src => include}/erlog_int.hrl | 4 +- rebar.config | 19 + src/core/erlog_int.erl | 1314 +++++++++++++++++++++++++++++++ src/core/erlog_lists.erl | 204 +++++ src/{ => core}/erlog_scan.xrl | 0 src/core/lang/erlog_bips.erl | 382 ++++++++++ src/core/lang/erlog_dcg.erl | 164 ++++ src/core/lang/erlog_parse.erl | 313 ++++++++ src/erlog.erl | 209 ----- src/erlog_bips.erl | 382 ---------- src/erlog_dcg.erl | 167 ---- src/erlog_demo.erl | 80 +- src/erlog_ets.erl | 149 ---- src/erlog_int.erl | 1315 -------------------------------- src/erlog_io.erl | 248 ------ src/erlog_lists.erl | 204 ----- src/erlog_parse.erl | 313 -------- src/erlog_shell.erl | 108 --- src/{ => io}/erlog_file.erl | 74 +- src/io/erlog_io.erl | 248 ++++++ src/io/erlog_shell.erl | 108 +++ src/main/erlog.erl | 207 +++++ src/{ => main}/erlog_boot.erl | 2 +- src/storage/erlog_ets.erl | 149 ++++ 26 files changed, 3192 insertions(+), 3195 deletions(-) delete mode 100644 ebin/erlog.app rename {src => include}/erlog_int.hrl (92%) create mode 100644 rebar.config create mode 100644 src/core/erlog_int.erl create mode 100644 src/core/erlog_lists.erl rename src/{ => core}/erlog_scan.xrl (100%) create mode 100644 src/core/lang/erlog_bips.erl create mode 100644 src/core/lang/erlog_dcg.erl create mode 100644 src/core/lang/erlog_parse.erl delete mode 100644 src/erlog.erl delete mode 100644 src/erlog_bips.erl delete mode 100644 src/erlog_dcg.erl delete mode 100644 src/erlog_ets.erl delete mode 100644 src/erlog_int.erl delete mode 100644 src/erlog_io.erl delete mode 100644 src/erlog_lists.erl delete mode 100644 src/erlog_parse.erl delete mode 100644 src/erlog_shell.erl rename src/{ => io}/erlog_file.erl (51%) create mode 100644 src/io/erlog_io.erl create mode 100644 src/io/erlog_shell.erl create mode 100644 src/main/erlog.erl rename src/{ => main}/erlog_boot.erl (93%) create mode 100644 src/storage/erlog_ets.erl diff --git a/.gitignore b/.gitignore index 389e9ac..cfb0107 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,7 @@ *~ .DS_Store *.beam +ebin +.idea +*.iml +erlog_scan.erl diff --git a/ebin/erlog.app b/ebin/erlog.app deleted file mode 100644 index f4489ae..0000000 --- a/ebin/erlog.app +++ /dev/null @@ -1,20 +0,0 @@ -{application, erlog, - [{description, "Erlog , Prolog in Erlang"}, - {vsn, "0.6"}, - {modules, [erlog, - erlog_bips, - erlog_boot, - erlog_dcg, - erlog_demo, - erlog_ets, - erlog_file, - erlog_int, - erlog_io, - erlog_lists, - erlog_parse, - erlog_scan, - erlog_shell - ]}, - {registered, []}, - {applications, [kernel,stdlib]} - ]}. diff --git a/src/erlog_int.hrl b/include/erlog_int.hrl similarity index 92% rename from src/erlog_int.hrl rename to include/erlog_int.hrl index f65ff70..fcf7741 100644 --- a/src/erlog_int.hrl +++ b/include/erlog_int.hrl @@ -22,5 +22,5 @@ -define(IS_FUNCTOR(T), (is_tuple(T) andalso (tuple_size(T) >= 2) andalso is_atom(element(1, T)))). %% Define the choice point record --record(cp, {type,label,data,next,bs,vn}). --record(cut, {label,next}). +-record(cp, {type, label, data, next, bs, vn}). +-record(cut, {label, next}). diff --git a/rebar.config b/rebar.config new file mode 100644 index 0000000..7677862 --- /dev/null +++ b/rebar.config @@ -0,0 +1,19 @@ +%% deps dirs +{deps_dir, ["deps"]}. + +%% rel dirs +{sub_dirs, ["rel"]}. + +%% compiler options +{ + erl_opts, + [ + no_debug_info, + fail_on_warning + ] +}. + +%% deps +{ + deps, [] +}. \ No newline at end of file diff --git a/src/core/erlog_int.erl b/src/core/erlog_int.erl new file mode 100644 index 0000000..419693d --- /dev/null +++ b/src/core/erlog_int.erl @@ -0,0 +1,1314 @@ +%% Copyright (c) 2008-2013 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : erlog_int.erl +%% Author : Robert Virding +%% Purpose : Basic interpreter of a Prolog sub-set. +%% +%% This is the basic Prolog interpreter. +%% The internal data structures used are very direct and basic: +%% +%% Structures - {Functor,arg1, Arg2,...} where Functor is an atom +%% Variables - {Name} where Name is an atom or integer +%% Lists - Erlang lists +%% Atomic - Erlang constants +%% +%% There is no problem with the representation of variables as Prolog +%% functors of arity 0 are atoms. This representation is much easier +%% to test for, and create new variables with than using funny atom +%% names like '$1' (yuch!), and we need LOTS of variables. +%% +%% All information about the state of an evaluation is held in the +%% variables: +%% +%% [CurrentGoal,] NextGoal, ChoicePoints, Bindings, VarNum, Database +%% +%% Proving a goal succeeds when we have reached the end of the goal +%% list, i.e. NextGoal is empty (true). Proving goal fails when there +%% are no more choice points left to backtrack into. The evaluation +%% is completely flat as all back track information is held in +%% ChoicePoints. Choice points are added going forwards and removed +%% by backtracking and cuts. +%% +%% Internal goals all have the format {{Name},...} as this is an +%% illegal Erlog structure which can never be generated in (legal) +%% code. +%% +%% Proving a top-level goal will return: +%% +%% {succeed,ChoicePoints,Bindings,VarNum,Database} - the +%% goal succeeded and these are the +%% choicepoints/bindings/varnum/database to continue with. +%% +%% {fail,Database} - the goal failed and this is the current database. +%% +%% When a goal has succeeded back tracking is initiated by calling +%% fail(ChoicePoints, Database) which has the same return values as +%% proving the goal. +%% +%% When the interpreter detects an error it builds an error term +%% +%% {erlog_error,ErrorDescriptor,Database} +%% +%% and throws it. The ErrorDescriptor is a valid Erlog term. +%% +%% Database +%% +%% We use a dictionary for the database. All data for a procedure are +%% kept in the database with the functor as key. Interpreted clauses +%% are kept in a list, each clause has a unique (for that functor) +%% tag. Functions which traverse clauses, clause/retract/goals, get +%% the whole list to use. Any database operations can they be done +%% directly on the database. Retract uses the tag to remove the +%% correct clause. This preserves the logical database view. It is +%% possible to use ETS instead if a dictionary, define macro ETS, but +%% the logical database view makes it difficult to directly use ETS +%% efficiently. +%% +%% Interpreted Code +%% +%% Code, interpreted clause bodies, are not stored directly as Erlog +%% terms. Before being added to the database they are checked that +%% they are well-formed, control structures are recognised, cuts +%% augmented with status and sequences of conjunctions are converted +%% to lists. When code is used a new instance is made with fresh +%% variables, correct cut labels, and bodies directly linked to +%% following code to remove the need of later appending. +%% +%% The following functions convert code: +%% +%% well_form_body/4 - converts an Erlog term to database code body +%% format checking that it is well formed. +%% well_form_goal/4 - converts an Erlog term directly to a code body +%% checking that it is well formed. +%% unify_head/4 - unify a goal directly with head without creating a +%% new instance of the head. Saves creating local variables and +%% MANY bindings. This is a BIG WIN! +%% body_instance/5 - creates a new code body instance from the +%% database format. +%% term_instance/2/3 - creates a new instance of a term with new +%% variables. +%% body_term/3 - creates a copy of a body as a legal Erlog term. +%% +%% Choicepoints/Cuts +%% +%% Choicepoints and cuts are kept on the same stack/list. There are +%% different types of cps depending on their context. Failure pops +%% the first cp off the stack, passing over cuts and resumes +%% execution from that cp. A cut has a label and a flag indicating if +%% this is the last cut with this label. Cut steps over cps/cuts +%% until a cut the same label is reached and execution is resumed +%% with that stack. Unless this is the last cut with a label a new +%% cut is pushed on the stack. For efficiency some cps also act as +%% cuts. +%% +%% It is possible to reuse cut labels for different markers as long +%% the areas the cuts are valid don't overlap, though one may be +%% contained within the other, and the cuts correctly indicate when +%% they are the last cut. This is used for ->; and once/1 where we +%% KNOW the last cut of the internal section. +%% +%% It would be better if the cut marker was the actual cps/cut stack +%% to go back to but this would entail a more interactive +%% body_instance. + +-module(erlog_int). + +%% Main execution functions. +-export([prove_goal/2, prove_body/5, fail/2]). +-export([unify_prove_body/7, unify_prove_body/9]). +%% Bindings, unification and dereferncing. +-export([new_bindings/0, add_binding/3, make_vars/2]). +-export([deref/2, deref_list/2, dderef/2, dderef_list/2, unify/3, functor/1]). +%% Creating term and body instances. +-export([term_instance/2]). +%% Adding to database. +-export([asserta_clause/2, assertz_clause/2, abolish_clauses/2]). +-export([add_built_in/2, add_compiled_proc/4]). +-export([new_db/0, built_in_db/0]). + +%% Error types. +-export([erlog_error/1, erlog_error/2, type_error/2, type_error/3, + instantiation_error/0, instantiation_error/1, permission_error/4]). + +%%-compile(export_all). + +-import(lists, [map/2, foldl/3]). + +%% Some standard type macros. + +%% The old is_constant/1 ? +-define(IS_CONSTANT(T), (not (is_tuple(T) orelse is_list(T)))). + +%% -define(IS_ATOMIC(T), (is_atom(T) orelse is_number(T) orelse (T == []))). +-define(IS_ATOMIC(T), (not (is_tuple(T) orelse (is_list(T) andalso T /= [])))). +-define(IS_FUNCTOR(T), ((tuple_size(T) >= 2) andalso is_atom(element(1, T)))). + +%% Define the database to use. ONE of the follwing must be defined. + +%%-define(ETS,true). +%%-define(DB, orddict). +-define(DB, dict). + +%% built_in_db() -> Database. +%% Create an initial clause database containing the built-in +%% predicates and predefined library predicates. + +built_in_db() -> + Db0 = new_db(), + %% First add the Erlang built-ins. + foldl(fun(Head, Db) -> add_built_in(Head, Db) end, Db0, + [ + %% Logic and control. + {call, 1}, + {',', 2}, + {'!', 0}, + {';', 2}, + {fail, 0}, + {'->', 2}, + {'\\+', 1}, + {once, 1}, + {repeat, 0}, + {true, 0}, + %% Clause creation and destruction. + {abolish, 1}, + {assert, 1}, + {asserta, 1}, + {assertz, 1}, + {retract, 1}, + {retractall, 1}, + %% Clause retrieval and information. + {clause, 2}, + {current_predicate, 1}, + {predicate_property, 2}, + %% All solutions + %% External interface + {ecall, 2}, + %% Non-standard but useful + {display, 1} + ]). + +%% Define the choice point record +-record(cp, {type, label, data, next, bs, vn}). +-record(cut, {label, next}). + +%% prove_goal(Goal, Database) -> Succeed | Fail. +%% This is the main entry point into the interpreter. Check that +%% everything is consistent then prove the goal as a call. + +prove_goal(Goal0, Db) -> + %% put(erlog_cut, orddict:new()), + %% put(erlog_cps, orddict:new()), + %% put(erlog_var, orddict:new()), + %% Check term and build new instance of term with bindings. + {Goal1, Bs, Vn} = initial_goal(Goal0), + prove_body([{call, Goal1}], [], Bs, Vn, Db). + +-define(FAIL(Bs, Cps, Db), + begin + put(erlog_cps, orddict:update_counter(length(Cps), 1, get(erlog_cps))), + put(erlog_var, orddict:update_counter(dict:size(Bs), 1, get(erlog_var))), + fail(Cps, Db) + end). +-undef(FAIL). +-define(FAIL(Bs, Cps, Db), fail(Cps, Db)). + +%% prove_goal(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> +%% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase} | +%% {fail,NewDatabase}. +%% Prove one goal. We seldom return succeed here but usually go directly to +%% to NextGoal. +%% Handle built-in predicates here. RTFM for a description of the +%% built-ins. Hopefully we do the same. + +%% Logic and control. Conjunctions are handled in prove_body and true +%% has been compiled away. +prove_goal({call, G}, Next0, Cps, Bs, Vn, Db) -> + %% Only add cut CP to Cps if goal contains a cut. + Label = Vn, + case check_goal(G, Next0, Bs, Db, false, Label) of + {Next1, true} -> + %% Must increment Vn to avoid clashes!!! + Cut = #cut{label = Label}, + prove_body(Next1, [Cut | Cps], Bs, Vn + 1, Db); + {Next1, false} -> prove_body(Next1, Cps, Bs, Vn + 1, Db) + end; +prove_goal({{cut}, Label, Last}, Next, Cps, Bs, Vn, Db) -> + %% Cut succeeds and trims back to cut ancestor. + cut(Label, Last, Next, Cps, Bs, Vn, Db); +prove_goal({{disj}, R}, Next, Cps, Bs, Vn, Db) -> + %% There is no L here, it has already been prepended to Next. + Cp = #cp{type = disjunction, next = R, bs = Bs, vn = Vn}, + prove_body(Next, [Cp | Cps], Bs, Vn, Db); +prove_goal(fail, _Next, Cps, _Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db); +prove_goal({{if_then}, Label}, Next, Cps, Bs, Vn, Db) -> + %% We effetively implement ( C -> T ) with ( C, !, T ) but cuts in + %% C are local to C. + %% There is no ( C, !, T ) here, it has already been prepended to Next. + %%io:fwrite("PG(->): ~p\n", [{Next}]), + Cut = #cut{label = Label}, + prove_body(Next, [Cut | Cps], Bs, Vn, Db); +prove_goal({{if_then_else}, Else, Label}, Next, Cps, Bs, Vn, Db) -> + %% Need to push a choicepoint to fail back to inside Cond and a cut + %% to cut back to before Then when Cond succeeds. #cp{type=if_then_else} + %% functions as both as is always removed whatever the outcome. + %% There is no ( C, !, T ) here, it has already been prepended to Next. + Cp = #cp{type = if_then_else, label = Label, next = Else, bs = Bs, vn = Vn}, + %%io:fwrite("PG(->;): ~p\n", [{Next,Else,[Cp|Cps]}]), + prove_body(Next, [Cp | Cps], Bs, Vn, Db); +prove_goal({'\\+', G}, Next0, Cps, Bs, Vn, Db) -> + %% We effectively implementing \+ G with ( G -> fail ; true ). + Label = Vn, + {Next1, _} = check_goal(G, [{{cut}, Label, true}, fail], Bs, Db, true, Label), + Cp = #cp{type = if_then_else, label = Label, next = Next0, bs = Bs, vn = Vn}, + %%io:fwrite("PG(\\+): ~p\n", [{G1,[Cp|Cps]]), + %% Must increment Vn to avoid clashes!!! + prove_body(Next1, [Cp | Cps], Bs, Vn + 1, Db); +prove_goal({{once}, Label}, Next, Cps, Bs, Vn, Db) -> + %% We effetively implement once(G) with ( G, ! ) but cuts in + %% G are local to G. + %% There is no ( G, ! ) here, it has already been prepended to Next. + Cut = #cut{label = Label}, + prove_body(Next, [Cut | Cps], Bs, Vn, Db); +prove_goal(repeat, Next, Cps, Bs, Vn, Db) -> + Cp = #cp{type = disjunction, next = [repeat | Next], bs = Bs, vn = Vn}, + prove_body(Next, [Cp | Cps], Bs, Vn, Db); +%% Clause creation and destruction. +prove_goal({abolish, Pi0}, Next, Cps, Bs, Vn, Db) -> + case dderef(Pi0, Bs) of + {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> + prove_body(Next, Cps, Bs, Vn, abolish_clauses({N, A}, Db)); + Pi -> type_error(predicate_indicator, Pi, Db) + end; +prove_goal({assert, C0}, Next, Cps, Bs, Vn, Db) -> + C = dderef(C0, Bs), + prove_body(Next, Cps, Bs, Vn, assertz_clause(C, Db)); +prove_goal({asserta, C0}, Next, Cps, Bs, Vn, Db) -> + C = dderef(C0, Bs), + prove_body(Next, Cps, Bs, Vn, asserta_clause(C, Db)); +prove_goal({assertz, C0}, Next, Cps, Bs, Vn, Db) -> + C = dderef(C0, Bs), + prove_body(Next, Cps, Bs, Vn, assertz_clause(C, Db)); +prove_goal({retract, C0}, Next, Cps, Bs, Vn, Db) -> + C = dderef(C0, Bs), + prove_retract(C, Next, Cps, Bs, Vn, Db); +%% Clause retrieval and information +prove_goal({clause, H0, B}, Next, Cps, Bs, Vn, Db) -> + H1 = dderef(H0, Bs), + prove_clause(H1, B, Next, Cps, Bs, Vn, Db); +prove_goal({current_predicate, Pi0}, Next, Cps, Bs, Vn, Db) -> + Pi = dderef(Pi0, Bs), + prove_current_predicate(Pi, Next, Cps, Bs, Vn, Db); +prove_goal({predicate_property, H0, P}, Next, Cps, Bs, Vn, Db) -> + H = dderef(H0, Bs), + case catch get_procedure_type(functor(H), Db) of + built_in -> unify_prove_body(P, built_in, Next, Cps, Bs, Vn, Db); + compiled -> unify_prove_body(P, compiled, Next, Cps, Bs, Vn, Db); + interpreted -> unify_prove_body(P, interpreted, Next, Cps, Bs, Vn, Db); + undefined -> ?FAIL(Bs, Cps, Db); + {erlog_error, E} -> erlog_error(E, Db) + end; +%% External interface +prove_goal({ecall, C0, Val}, Next, Cps, Bs, Vn, Db) -> + %% Build the initial call. + %%io:fwrite("PG(ecall): ~p\n ~p\n ~p\n", [dderef(C0, Bs),Next,Cps]), + Efun = case dderef(C0, Bs) of + {':', M, F} when is_atom(M), is_atom(F) -> + fun() -> M:F() end; + {':', M, {F, A}} when is_atom(M), is_atom(F) -> + fun() -> M:F(A) end; + {':', M, {F, A1, A2}} when is_atom(M), is_atom(F) -> + fun() -> M:F(A1, A2) end; + {':', M, T} when is_atom(M), ?IS_FUNCTOR(T) -> + L = tuple_to_list(T), + fun() -> apply(M, hd(L), tl(L)) end; + Fun when is_function(Fun) -> Fun; + Other -> type_error(callable, Other, Db) + end, + prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db); +%% Non-standard but useful. +prove_goal({display, T}, Next, Cps, Bs, Vn, Db) -> + %% A very simple display procedure. + io:fwrite("~p\n", [dderef(T, Bs)]), + prove_body(Next, Cps, Bs, Vn, Db); +%% Now look up the database. +prove_goal(G, Next, Cps, Bs, Vn, Db) -> + %%io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), + case catch get_procedure(functor(G), Db) of + built_in -> erlog_bips:prove_goal(G, Next, Cps, Bs, Vn, Db); + {code, {Mod, Func}} -> Mod:Func(G, Next, Cps, Bs, Vn, Db); + {clauses, Cs} -> prove_goal_clauses(G, Cs, Next, Cps, Bs, Vn, Db); + undefined -> ?FAIL(Bs, Cps, Db); + %% Getting built_in here is an error! + {erlog_error, E} -> erlog_error(E, Db) %Fill in more error data + end. + +fail_disjunction(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db) -> + prove_body(Next, Cps, Bs, Vn, Db). + +fail_if_then_else(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db) -> + prove_body(Next, Cps, Bs, Vn, Db). + +%% fail(ChoicePoints, Database) -> {fail,Database}. +%% cut(Label, Last, Next, ChoicePoints, Bindings, VarNum, Database) -> void. +%% +%% The functions which manipulate the choice point stack. fail +%% backtracks to next choicepoint skipping cut labels cut steps +%% backwards over choice points until matching cut. + +fail([#cp{type = goal_clauses} = Cp | Cps], Db) -> + fail_goal_clauses(Cp, Cps, Db); +fail([#cp{type = disjunction} = Cp | Cps], Db) -> + fail_disjunction(Cp, Cps, Db); +fail([#cp{type = if_then_else} = Cp | Cps], Db) -> + fail_if_then_else(Cp, Cps, Db); +fail([#cp{type = clause} = Cp | Cps], Db) -> + fail_clause(Cp, Cps, Db); +fail([#cp{type = retract} = Cp | Cps], Db) -> + fail_retract(Cp, Cps, Db); +fail([#cp{type = current_predicate} = Cp | Cps], Db) -> + fail_current_predicate(Cp, Cps, Db); +fail([#cp{type = ecall} = Cp | Cps], Db) -> + fail_ecall(Cp, Cps, Db); +fail([#cp{type = compiled, data = F} = Cp | Cps], Db) -> + F(Cp, Cps, Db); +fail([#cut{} | Cps], Db) -> + fail(Cps, Db); %Fail over cut points. +fail([], Db) -> {fail, Db}. + +cut(Label, Last, Next, [#cut{label = Label} | Cps] = Cps0, Bs, Vn, Db) -> + if Last -> prove_body(Next, Cps, Bs, Vn, Db); + true -> prove_body(Next, Cps0, Bs, Vn, Db) + end; +cut(Label, Last, Next, [#cp{type = if_then_else, label = Label} | Cps] = Cps0, Bs, Vn, Db) -> + if Last -> prove_body(Next, Cps, Bs, Vn, Db); + true -> prove_body(Next, Cps0, Bs, Vn, Db) + end; +cut(Label, Last, Next, [#cp{type = goal_clauses, label = Label} = Cp | Cps], Bs, Vn, Db) -> + cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db); +cut(Label, Last, Next, [_Cp | Cps], Bs, Vn, Db) -> + cut(Label, Last, Next, Cps, Bs, Vn, Db). + +%% cut(Label, Last, Next, Cps, Bs, Vn, Db) -> +%% cut(Label, Last, Next, Cps, Bs, Vn, Db, 1). + +%% cut(Label, Last, Next, [#cut{label=Label}|Cps]=Cps0, Bs, Vn, Db, Cn) -> +%% put(erlog_cut, orddict:update_counter(Cn, 1, get(erlog_cut))), +%% if Last -> prove_body(Next, Cps, Bs, Vn, Db); +%% true -> prove_body(Next, Cps0, Bs, Vn, Db) +%% end; +%% cut(Label, Last, Next, [#cp{type=if_then_else,label=Label}|Cps]=Cps0, Bs, Vn, Db, Cn) -> +%% put(erlog_cut, orddict:update_counter(Cn, 1, get(erlog_cut))), +%% if Last -> prove_body(Next, Cps, Bs, Vn, Db); +%% true -> prove_body(Next, Cps0, Bs, Vn, Db) +%% end; +%% cut(Label, Last, Next, [#cp{type=goal_clauses,label=Label}=Cp|Cps], Bs, Vn, Db, Cn) -> +%% put(erlog_cut, orddict:update_counter(Cn, 1, get(erlog_cut))), +%% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db); +%% cut(Label, Last, Next, [_Cp|Cps], Bs, Vn, Db, Cn) -> +%% cut(Label, Last, Next, Cps, Bs, Vn, Db, Cn+1). + +%% check_goal(Goal, Next, Bindings, Database, CutAfter, CutLabel) -> +%% {WellFormedBody,HasCut}. +%% Check to see that Goal is bound and ensure that it is well-formed. + +check_goal(G0, Next, Bs, Db, Cut, Label) -> + case dderef(G0, Bs) of + {_} -> instantiation_error(Db); %Must have something to call + G1 -> + case catch {ok, well_form_goal(G1, Next, Cut, Label)} of + {erlog_error, E} -> erlog_error(E, Db); + {ok, GC} -> GC %Body and cut + end + end. + +%% unify_prove_body(Term1, Term2, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Unify Term1 = Term2, on success prove body Next else fail. + +unify_prove_body(T1, T2, Next, Cps, Bs0, Vn, Db) -> + case unify(T1, T2, Bs0) of + {succeed, Bs1} -> prove_body(Next, Cps, Bs1, Vn, Db); + fail -> ?FAIL(Bs0, Cps, Db) + end. + +%% unify_prove_body(A1, B1, A2, B2, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Unify A1 = B1, A2 = B2, on success prove body Next else fail. + +unify_prove_body(A1, B1, A2, B2, Next, Cps, Bs0, Vn, Db) -> + case unify(A1, B1, Bs0) of + {succeed, Bs1} -> unify_prove_body(A2, B2, Next, Cps, Bs1, Vn, Db); + fail -> ?FAIL(Bs0, Cps, Db) + end. + +%% prove_ecall(Generator, Value, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Call an external (Erlang) generator and handle return value, either +%% succeed or fail. + +prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db) -> + case Efun() of + {succeed, Ret, Cont} -> %Succeed and more choices + Cp = #cp{type = ecall, data = {Cont, Val}, next = Next, bs = Bs, vn = Vn}, + unify_prove_body(Val, Ret, Next, [Cp | Cps], Bs, Vn, Db); + {succeed_last, Ret} -> %Succeed but last choice + unify_prove_body(Val, Ret, Next, Cps, Bs, Vn, Db); + fail -> ?FAIL(Bs, Cps, Db) %No more + end. + +fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> + prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db). + +%% prove_clause(Head, Body, Next, ChoicePoints, Bindings, VarNum, DataBase) -> +%% void. +%% Unify clauses matching with functor from Head with both Head and Body. + +prove_clause(H, B, Next, Cps, Bs, Vn, Db) -> + Functor = functor(H), + case get_procedure(Functor, Db) of + {clauses, Cs} -> unify_clauses(H, B, Cs, Next, Cps, Bs, Vn, Db); + {code, _} -> + permission_error(access, private_procedure, pred_ind(Functor), Db); + built_in -> + permission_error(access, private_procedure, pred_ind(Functor), Db); + undefined -> ?FAIL(Bs, Cps, Db) + end. + +%% unify_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Try to unify Head and Body using Clauses which all have the same functor. + +unify_clauses(Ch, Cb, [C], Next, Cps, Bs0, Vn0, Db) -> + %% No choice point on last clause + case unify_clause(Ch, Cb, C, Bs0, Vn0) of + {succeed, Bs1, Vn1} -> prove_body(Next, Cps, Bs1, Vn1, Db); + fail -> ?FAIL(Bs0, Cps, Db) + end; +unify_clauses(Ch, Cb, [C | Cs], Next, Cps, Bs0, Vn0, Db) -> + case unify_clause(Ch, Cb, C, Bs0, Vn0) of + {succeed, Bs1, Vn1} -> + Cp = #cp{type = clause, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, + prove_body(Next, [Cp | Cps], Bs1, Vn1, Db); + fail -> unify_clauses(Ch, Cb, Cs, Next, Cps, Bs0, Vn0, Db) + end; +unify_clauses(_Ch, _Cb, [], _Next, Cps, _Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db). + +unify_clause(Ch, Cb, {_Tag, H0, {B0, _}}, Bs0, Vn0) -> + {H1, Rs1, Vn1} = term_instance(H0, Vn0), %Unique vars on head first + case unify(Ch, H1, Bs0) of + {succeed, Bs1} -> + {B1, _Rs2, Vn2} = body_term(B0, Rs1, Vn1), %Now we need the rest + case unify(Cb, B1, Bs1) of + {succeed, Bs2} -> {succeed, Bs2, Vn2}; + fail -> fail + end; + fail -> fail + end. + +fail_clause(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> + unify_clauses(Ch, Cb, Cs, Next, Cps, Bs, Vn, Db). + +%% prove_current_predicate(PredInd, Next, ChoicePoints, Bindings, VarNum, DataBase) -> +%% void. +%% Match functors of existing user (interpreted) predicate with PredInd. + +prove_current_predicate(Pi, Next, Cps, Bs, Vn, Db) -> + case Pi of + {'/', _, _} -> ok; + {_} -> ok; + Other -> type_error(predicate_indicator, Other) + end, + Fs = get_interp_functors(Db), + prove_predicates(Pi, Fs, Next, Cps, Bs, Vn, Db). + +prove_predicates(Pi, [F | Fs], Next, Cps, Bs, Vn, Db) -> + Cp = #cp{type = current_predicate, data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, + unify_prove_body(Pi, pred_ind(F), Next, [Cp | Cps], Bs, Vn, Db); +prove_predicates(_Pi, [], _Next, Cps, _Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db). + +fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> + prove_predicates(Pi, Fs, Next, Cps, Bs, Vn, Db). + +%% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Try to prove Goal using Clauses which all have the same functor. + +prove_goal_clauses(G, [C], Next, Cps, Bs, Vn, Db) -> + %% Must be smart here and test whether we need to add a cut point. + %% C has the structure {Tag,Head,{Body,BodyHasCut}}. + case element(2, element(3, C)) of + true -> + Cut = #cut{label = Vn}, + prove_goal_clause(G, C, Next, [Cut | Cps], Bs, Vn, Db); + false -> + prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db) + end; +%% prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db); +prove_goal_clauses(G, [C | Cs], Next, Cps, Bs, Vn, Db) -> + Cp = #cp{type = goal_clauses, label = Vn, data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, + prove_goal_clause(G, C, Next, [Cp | Cps], Bs, Vn, Db); +prove_goal_clauses(_G, [], _Next, Cps, _Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db). + +prove_goal_clause(G, {_Tag, H0, {B0, _}}, Next, Cps, Bs0, Vn0, Db) -> + %% io:fwrite("PGC1: ~p\n", [{G,H0,B0}]), + Label = Vn0, + case unify_head(G, H0, Bs0, Vn0 + 1) of + {succeed, Rs0, Bs1, Vn1} -> + %% io:fwrite("PGC2: ~p\n", [{Rs0}]), + {B1, _Rs2, Vn2} = body_instance(B0, Next, Rs0, Vn1, Label), + %% io:fwrite("PGC3: ~p\n", [{B1,Next,Cps}]), + prove_body(B1, Cps, Bs1, Vn2, Db); + fail -> ?FAIL(Bs0, Cps, Db) + end. + +fail_goal_clauses(#cp{data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> + prove_goal_clauses(G, Cs, Next, Cps, Bs, Vn, Db). + +%% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db). + +cut_goal_clauses(true, Next, #cp{label = _}, Cps, Bs, Vn, Db) -> + %% Just remove the choice point completely and continue. + prove_body(Next, Cps, Bs, Vn, Db); +cut_goal_clauses(false, Next, #cp{label = L}, Cps, Bs, Vn, Db) -> + %% Replace choice point with cut point then continue. + Cut = #cut{label = L}, + prove_body(Next, [Cut | Cps], Bs, Vn, Db). + +%% prove_retract(Clause, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Retract clauses in database matching Clause. + +prove_retract({':-', H, B}, Next, Cps, Bs, Vn, Db) -> + prove_retract(H, B, Next, Cps, Bs, Vn, Db); +prove_retract(H, Next, Cps, Bs, Vn, Db) -> + prove_retract(H, true, Next, Cps, Bs, Vn, Db). + +prove_retract(H, B, Next, Cps, Bs, Vn, Db) -> + Functor = functor(H), + case get_procedure(Functor, Db) of + {clauses, Cs} -> retract_clauses(H, B, Cs, Next, Cps, Bs, Vn, Db); + {code, _} -> + permission_error(modify, static_procedure, pred_ind(Functor), Db); + built_in -> + permission_error(modify, static_procedure, pred_ind(Functor), Db); + undefined -> ?FAIL(Bs, Cps, Db) + end. + +%% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Try to retract Head and Body using Clauses which all have the same functor. + +retract_clauses(Ch, Cb, [C | Cs], Next, Cps, Bs0, Vn0, Db0) -> + case unify_clause(Ch, Cb, C, Bs0, Vn0) of + {succeed, Bs1, Vn1} -> + %% We have found a right clause so now retract it. + Db1 = retract_clause(functor(Ch), element(1, C), Db0), + Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, + prove_body(Next, [Cp | Cps], Bs1, Vn1, Db1); + fail -> retract_clauses(Ch, Cb, Cs, Next, Cps, Bs0, Vn0, Db0) + end; +retract_clauses(_Ch, _Cb, [], _Next, Cps, _Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db). + +fail_retract(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> + retract_clauses(Ch, Cb, Cs, Next, Cps, Bs, Vn, Db). + +%% prove_body(Body, ChoicePoints, Bindings, VarNum, Database) -> +%% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase}. +%% Prove the goals in a body. Remove the first goal and try to prove +%% it. Return when there are no more goals. This is how proving a +%% goal/body succeeds. + +prove_body([G | Gs], Cps, Bs0, Vn0, Db0) -> + %%io:fwrite("PB: ~p\n", [{G,Gs,Cps}]), + prove_goal(G, Gs, Cps, Bs0, Vn0, Db0); +prove_body([], Cps, Bs, Vn, Db) -> + %%io:fwrite("Cps: ~p\nCut: ~p\nVar: ~p\nVar: ~p\n", + %% [get(erlog_cps),get(erlog_cut),get(erlog_var),dict:size(Bs)]), + %%io:fwrite("PB: ~p\n", [Cps]), + {succeed, Cps, Bs, Vn, Db}. %No more body + +%% unify(Term, Term, Bindings) -> {succeed,NewBindings} | fail. +%% Unify two terms with a set of bindings. + +unify(T10, T20, Bs0) -> + case {deref(T10, Bs0), deref(T20, Bs0)} of + {T1, T2} when ?IS_CONSTANT(T1), T1 == T2 -> + {succeed, Bs0}; + {{V}, {V}} -> {succeed, Bs0}; + {{_} = Var, T2} -> {succeed, add_binding(Var, T2, Bs0)}; + {T1, {_} = Var} -> {succeed, add_binding(Var, T1, Bs0)}; + {[H1 | T1], [H2 | T2]} -> + case unify(H1, H2, Bs0) of + {succeed, Bs1} -> unify(T1, T2, Bs1); + fail -> fail + end; + {[], []} -> {succeed, Bs0}; + {T1, T2} when tuple_size(T1) == tuple_size(T2), + element(1, T1) == element(1, T2) -> + unify_args(T1, T2, Bs0, 2, tuple_size(T1)); + _Other -> fail + end. + +unify_args(_, _, Bs, I, S) when I > S -> {succeed, Bs}; +unify_args(S1, S2, Bs0, I, S) -> + case unify(element(I, S1), element(I, S2), Bs0) of + {succeed, Bs1} -> unify_args(S1, S2, Bs1, I + 1, S); + fail -> fail + end. + +%% make_vars(Count, VarNum) -> [Var]. +%% Make a list of new variables starting at VarNum. + +make_vars(0, _) -> []; +make_vars(I, Vn) -> + [{Vn} | make_vars(I - 1, Vn + 1)]. + +%% Errors +%% To keep dialyzer quiet. +-spec type_error(_, _) -> no_return(). +-spec type_error(_, _, _) -> no_return(). +-spec instantiation_error() -> no_return(). +-spec instantiation_error(_) -> no_return(). +-spec permission_error(_, _, _, _) -> no_return(). +-spec erlog_error(_) -> no_return(). +-spec erlog_error(_, _) -> no_return(). + +type_error(Type, Value, Db) -> erlog_error({type_error, Type, Value}, Db). +type_error(Type, Value) -> erlog_error({type_error, Type, Value}). + +instantiation_error(Db) -> erlog_error(instantiation_error, Db). +instantiation_error() -> erlog_error(instantiation_error). + +permission_error(Op, Type, Value, Db) -> + erlog_error({permission_error, Op, Type, Value}, Db). + +erlog_error(E, Db) -> throw({erlog_error, E, Db}). +erlog_error(E) -> throw({erlog_error, E}). + +-ifdef(DB). +%% Database +%% The database is a dict where the key is the functor pair {Name,Arity}. +%% The value is: built_in | +%% {clauses,NextTag,[{Tag,Head,Body}]} | +%% {code,{Module,Function}}. +%% Built-ins are defined by the system and cannot manipulated by user +%% code. +%% We are a little paranoid here and do our best to ensure consistency +%% in the database by checking input arguments even if we know they +%% come from "good" code. + +new_db() -> ?DB:new(). + +%% add_built_in(Functor, Database) -> NewDatabase. +%% Add Functor as a built-in in the database. + +add_built_in(Functor, Db) -> + ?DB:store(Functor, built_in, Db). + +%% add_compiled_proc(Functor, Module, Function, Database) -> NewDatabase. +%% Add Functor as a compiled procedure with code in Module:Function. No +%% checking. + +add_compiled_proc(Functor, M, F, Db) -> + ?DB:update(Functor, + fun(built_in) -> + permission_error(modify, static_procedure, pred_ind(Functor), Db); + (_) -> {code, {M, F}} + end, {code, {M, F}}, Db). + +%% assertz_clause(Clause, Database) -> NewDatabase. +%% assertz_clause(Head, Body, Database) -> NewDatabase. +%% Assert a clause into the database first checking that it is well +%% formed. + +assertz_clause({':-', H, B}, Db) -> assertz_clause(H, B, Db); +assertz_clause(H, Db) -> assertz_clause(H, true, Db). + +assertz_clause(Head, Body0, Db) -> + {Functor, Body} = case catch {ok, functor(Head), + well_form_body(Body0, false, sture)} of + {erlog_error, E} -> erlog_error(E, Db); + {ok, F, B} -> {F, B} + end, + ?DB:update(Functor, + fun(built_in) -> + permission_error(modify, static_procedure, pred_ind(Functor), Db); + ({code, _}) -> + permission_error(modify, static_procedure, pred_ind(Functor), Db); + ({clauses, T, Cs}) -> {clauses, T + 1, Cs ++ [{T, Head, Body}]} + end, {clauses, 1, [{0, Head, Body}]}, Db). + +%% asserta_clause(Clause, Database) -> NewDatabase. +%% asserta_clause(Head, Body, Database) -> NewDatabase. +%% Assert a clause into the database first checking that it is well +%% formed. + +asserta_clause({':-', H, B}, Db) -> asserta_clause(H, B, Db); +asserta_clause(H, Db) -> asserta_clause(H, true, Db). + +asserta_clause(Head, Body0, Db) -> + {Functor, Body} = case catch {ok, functor(Head), + well_form_body(Body0, false, sture)} of + {erlog_error, E} -> erlog_error(E, Db); + {ok, F, B} -> {F, B} + end, + ?DB:update(Functor, + fun(built_in) -> + permission_error(modify, static_procedure, pred_ind(Functor), Db); + ({code, _}) -> + permission_error(modify, static_procedure, pred_ind(Functor), Db); + ({clauses, T, Cs}) -> {clauses, T + 1, [{T, Head, Body} | Cs]} + end, {clauses, 1, [{0, Head, Body}]}, Db). + +%% retract_clause(Functor, ClauseTag, Database) -> NewDatabase. +%% Retract (remove) the clause with tag ClauseTag from the list of +%% clauses of Functor. + +retract_clause(F, Ct, Db) -> + case ?DB:find(F, Db) of + {ok, built_in} -> + permission_error(modify, static_procedure, pred_ind(F), Db); + {ok, {code, _}} -> + permission_error(modify, static_procedure, pred_ind(F), Db); + {ok, {clauses, Nt, Cs}} -> + ?DB:store(F, {clauses, Nt, lists:keydelete(Ct, 1, Cs)}, Db); + error -> Db %Do nothing + end. + +%% abolish_clauses(Functor, Database) -> NewDatabase. + +abolish_clauses(Func, Db) -> + case ?DB:find(Func, Db) of + {ok, built_in} -> + permission_error(modify, static_procedure, pred_ind(Func), Db); + {ok, {code, _}} -> ?DB:erase(Func, Db); + {ok, {clauses, _, _}} -> ?DB:erase(Func, Db); + error -> Db %Do nothing + end. + +%% get_procedure(Functor, Database) -> +%% built_in | {code,{Mod,Func}} | {clauses,[Clause]} | undefined. +%% Return the procedure type and data for a functor. + +get_procedure(Func, Db) -> + case ?DB:find(Func, Db) of + {ok, built_in} -> built_in; %A built-in + {ok, {code, {_M, _F}} = P} -> P; %Compiled (perhaps someday) + {ok, {clauses, _T, Cs}} -> {clauses, Cs}; %Interpreted clauses + error -> undefined %Undefined + end. + +%% get_procedure_type(Functor, Database) -> +%% built_in | compiled | interpreted | undefined. +%% Return the procedure type for a functor. + +get_procedure_type(Func, Db) -> + case ?DB:find(Func, Db) of + {ok, built_in} -> built_in; %A built-in + {ok, {code, _}} -> compiled; %Compiled (perhaps someday) + {ok, {clauses, _, _}} -> interpreted; %Interpreted clauses + error -> undefined %Undefined + end. + +%% get_interp_functors(Database) -> [Functor]. + +get_interp_functors(Db) -> + ?DB:fold(fun(_Func, built_in, Fs) -> Fs; + (Func, {code, _}, Fs) -> [Func | Fs]; + (Func, {clauses, _, _}, Fs) -> [Func | Fs] + end, [], Db). +-endif. + +-ifdef(ETS). +%% The database is an ets table where the key is the functor pair {Name,Arity}. +%% The value is: {Functor,built_in} | +%% {Functor,clauses,NextTag,[{Tag,Head,Body}]} | +%% {Functor,code,{Module,Function}}. +%% Built-ins are defined by the system and cannot manipulated by user +%% code. +%% We are a little paranoid here and do our best to ensure consistency +%% in the database by checking input arguments even if we know they +%% come from "good" code. + +new_db() -> ets:new(erlog_database, [set, protected, {keypos, 1}]). + +%% add_built_in(Functor, Database) -> NewDatabase. +%% Add Functor as a built-in in the database. + +add_built_in(Functor, Db) -> + ets:insert(Db, {Functor, built_in}), + Db. + +%% add_compiled_proc(Functor, Module, Function, Database) -> NewDatabase. +%% Add Functor as a compiled procedure with code in Module:Function. No +%% checking. + +add_compiled_proc(Functor, M, F, Db) -> + case ets:lookup(Db, Functor) of + [{_, built_in}] -> + permission_error(modify, static_procedure, pred_ind(Functor), Db); + [_] -> ets:insert(Db, {Functor, code, {M, F}}); + [] -> ets:insert(Db, {Functor, code, {M, F}}) + end, + Db. + +%% assertz_clause(Clause, Database) -> NewDatabase. +%% assertz_clause(Head, Body, Database) -> NewDatabase. +%% Assert a clause into the database first checking that it is well +%% formed. + +assertz_clause({':-', H, B}, Db) -> assertz_clause(H, B, Db); +assertz_clause(H, Db) -> assertz_clause(H, true, Db). + +assertz_clause(Head, Body0, Db) -> + {Functor, Body} = case catch {ok, functor(Head), + well_form_body(Body0, false, sture)} of + {erlog_error, E} -> erlog_error(E, Db); + {ok, F, B} -> {F, B} + end, + case ets:lookup(Db, Functor) of + [{_, built_in}] -> permission_error(pred_ind(Functor), Db); + [{_, code, _}] -> permission_error(pred_ind(Functor), Db); + [{_, clauses, Tag, Cs}] -> + ets:insert(Db, {Functor, clauses, Tag + 1, Cs ++ [{Tag, Head, Body}]}); + [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) + end, + Db. + +%% asserta_clause(Clause, Database) -> NewDatabase. +%% asserta_clause(Head, Body, Database) -> NewDatabase. +%% Assert a clause into the database first checking that it is well +%% formed. + +asserta_clause({':-', H, B}, Db) -> asserta_clause(H, B, Db); +asserta_clause(H, Db) -> asserta_clause(H, true, Db). + +asserta_clause(Head, Body0, Db) -> + {Functor, Body} = case catch {ok, functor(Head), + well_form_body(Body0, false, sture)} of + {erlog_error, E} -> erlog_error(E, Db); + {ok, F, B} -> {F, B} + end, + case ets:lookup(Db, Functor) of + [{_, built_in}] -> permission_error(pred_ind(Functor), Db); + [{_, code, _}] -> permission_error(pred_ind(Functor), Db); + [{_, clauses, Tag, Cs}] -> + ets:insert(Db, {Functor, clauses, Tag + 1, [{Tag, Head, Body} | Cs]}); + [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) + end, + Db. + +%% retract_clause(Functor, ClauseTag, Database) -> NewDatabase. +%% Retract (remove) the clause with tag ClauseTag from the list of +%% clauses of Functor. + +retract_clause(F, Ct, Db) -> + case ets:lookup(Db, F) of + [{_, built_in}] -> + permission_error(modify, static_procedure, pred_ind(F), Db); + [{_, code, _}] -> + permission_error(modify, static_procedure, pred_ind(F), Db); + [{_, clauses, Nt, Cs}] -> + ets:insert(Db, {F, clauses, Nt, lists:keydelete(Ct, 1, Cs)}); + [] -> ok %Do nothing + end, + Db. + +%% abolish_clauses(Functor, Database) -> NewDatabase. + +abolish_clauses(Func, Db) -> + case ets:lookup(Db, Func) of + [{_, built_in}] -> + permission_error(modify, static_procedure, pred_ind(F), Db); + [{_, code, _}] -> ets:delete(Db, Func); + [{_, clauses, _, _}] -> ets:delete(Db, Func); + [] -> ok %Do nothing + end, + Db. + +%% get_procedure(Functor, Database) -> +%% built_in | {code,{Mod,Func}} | {clauses,[Clause]} | undefined. +%% Return the procedure type and data for a functor. + +get_procedure(Func, Db) -> + case ets:lookup(Db, Func) of + [{_, built_in}] -> built_in; + [{_, code, C}] -> {code, C}; + [{_, clauses, _, Cs}] -> {clauses, Cs}; + [] -> undefined + end. + +%% get_procedure_type(Functor, Database) -> +%% built_in | compiled | interpreted | undefined. +%% Return the procedure type for a functor. + +get_procedure_type(Func, Db) -> + case ets:lookup(Db, Func) of + [{_, built_in}] -> built_in; %A built-in + [{_, code, C}] -> compiled; %Compiled (perhaps someday) + [{_, clauses, _, Cs}] -> interpreted; %Interpreted clauses + [] -> undefined %Undefined + end. + +%% get_interp_functors(Database) -> [Functor]. + +get_interp_functors(Db) -> + ets:foldl(fun({_, built_in}, Fs) -> Fs; + ({Func, code, _}, Fs) -> [Func | Fs]; + ({Func, clauses, _, _}, Fs) -> [Func | Fs] + end, [], Db). +-endif. + +%% functor(Goal) -> {Name,Arity}. + +functor(T) when ?IS_FUNCTOR(T) -> + {element(1, T), tuple_size(T) - 1}; +functor(T) when is_atom(T) -> {T, 0}; +functor(T) -> type_error(callable, T). + +%% well_form_body(Body, HasCutAfter, CutLabel) -> {Body,HasCut}. +%% well_form_body(Body, Tail, HasCutAfter, CutLabel) -> {Body,HasCut}. +%% Check that Body is well-formed, flatten conjunctions, fix cuts and +%% add explicit call to top-level variables. + +well_form_body(Body, Cut, Label) -> well_form_body(Body, [], Cut, Label). + +well_form_body({',', L, R}, Tail0, Cut0, Label) -> + {Tail1, Cut1} = well_form_body(R, Tail0, Cut0, Label), + well_form_body(L, Tail1, Cut1, Label); +well_form_body({';', {'->', C0, T0}, E0}, Tail, Cut0, Label) -> + {T1, Tc} = well_form_body(T0, Cut0, Label), + {E1, Ec} = well_form_body(E0, Cut0, Label), + %% N.B. an extra cut will be added at run-time! + {C1, _} = well_form_body(C0, true, Label), + {[{{if_then_else}, C1, T1, E1, Label} | Tail], Tc or Ec}; +well_form_body({';', L0, R0}, Tail, Cut0, Label) -> + {L1, Lc} = well_form_body(L0, Cut0, Label), + {R1, Rc} = well_form_body(R0, Cut0, Label), + {[{{disj}, L1, R1} | Tail], Lc or Rc}; +well_form_body({'->', C0, T0}, Tail, Cut0, Label) -> + {T1, Cut1} = well_form_body(T0, Cut0, Label), + %% N.B. an extra cut will be added at run-time! + {C1, _} = well_form_body(C0, true, Label), + {[{{if_then}, C1, T1, Label} | Tail], Cut1}; +well_form_body({once, G}, Tail, Cut, Label) -> + %% N.B. an extra cut is added at run-time! + {G1, _} = well_form_body(G, true, Label), + {[{{once}, G1, Label} | Tail], Cut}; +well_form_body({V}, Tail, Cut, _Label) -> + {[{call, {V}} | Tail], Cut}; +well_form_body(true, Tail, Cut, _Label) -> {Tail, Cut}; %No-op +well_form_body(fail, _Tail, _Cut, _Label) -> {[fail], false}; %No further +well_form_body('!', Tail, Cut, Label) -> + {[{{cut}, Label, not Cut} | Tail], true}; +well_form_body(Goal, Tail, Cut, _Label) -> + functor(Goal), %Check goal + {[Goal | Tail], Cut}. + +%% well_form_goal(Goal, Tail, HasCutAfter, CutLabel) -> {Body,HasCut}. +%% Check that Goal is well-formed, flatten conjunctions, fix cuts and +%% add explicit call to top-level variables. + +well_form_goal({',', L, R}, Tail0, Cut0, Label) -> + {Tail1, Cut1} = well_form_goal(R, Tail0, Cut0, Label), + well_form_goal(L, Tail1, Cut1, Label); +well_form_goal({';', {'->', C0, T0}, E0}, Tail, Cut0, Label) -> + {T1, Tc} = well_form_goal(T0, Tail, Cut0, Label), + {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), + {E1, Ec} = well_form_goal(E0, Tail, Cut0, Label), + {[{{if_then_else}, E1, Label} | C1], Tc or Ec}; +well_form_goal({';', L0, R0}, Tail, Cut0, Label) -> + {L1, Lc} = well_form_goal(L0, Tail, Cut0, Label), + {R1, Rc} = well_form_goal(R0, Tail, Cut0, Label), + {[{{disj}, R1} | L1], Lc or Rc}; +well_form_goal({'->', C0, T0}, Tail, Cut0, Label) -> + {T1, Cut1} = well_form_goal(T0, Tail, Cut0, Label), + %% N.B. an extra cut will be added at run-time! + {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), + {[{{if_then}, Label} | C1], Cut1}; +well_form_goal({once, G}, Tail, Cut, Label) -> + {G1, _} = well_form_goal(G, [{{cut}, Label, true} | Tail], true, Label), + {[{{once}, Label} | G1], Cut}; +well_form_goal({V}, Tail, Cut, _Label) -> + {[{call, {V}} | Tail], Cut}; +well_form_goal(true, Tail, Cut, _Label) -> {Tail, Cut}; %No-op +well_form_goal(fail, _Tail, _Cut, _Label) -> {[fail], false}; %No further +well_form_goal('!', Tail, Cut, Label) -> + {[{{cut}, Label, not Cut} | Tail], true}; +well_form_goal(Goal, Tail, Cut, _Label) -> + functor(Goal), %Check goal + {[Goal | Tail], Cut}. + +%% term_instance(Term, VarNum) -> {Term,NewRepls,NewVarNum}. +%% term_instance(Term, Repls, VarNum) -> {Term,NewRepls,NewVarNum}. +%% Generate a copy of a term with new, fresh unused variables. No +%% bindings from original variables to new variables. It can handle +%% replacing integer variables with overlapping integer ranges. Don't +%% check Term as it should already be checked. Use orddict as there +%% will seldom be many variables and it it fast to setup. + +term_instance(A, Vn) -> term_instance(A, orddict:new(), Vn). + +term_instance([], Rs, Vn) -> {[], Rs, Vn}; +term_instance([H0 | T0], Rs0, Vn0) -> + {H, Rs1, Vn1} = term_instance(H0, Rs0, Vn0), + {T, Rs2, Vn2} = term_instance(T0, Rs1, Vn1), + {[H | T], Rs2, Vn2}; +term_instance({'_'}, Rs, Vn) -> {{Vn}, Rs, Vn + 1}; %Unique variable +term_instance({V0}, Rs0, Vn0) -> %Other variables + case orddict:find(V0, Rs0) of + {ok, V1} -> {V1, Rs0, Vn0}; + error -> + V1 = {Vn0}, + {V1, orddict:store(V0, V1, Rs0), Vn0 + 1} + end; +%% Special case some smaller structures. +term_instance({Atom, Arg}, Rs0, Vn0) -> + {CopyArg, Rs1, Vn1} = term_instance(Arg, Rs0, Vn0), + {{Atom, CopyArg}, Rs1, Vn1}; +term_instance({Atom, A1, A2}, Rs0, Vn0) -> + {CopyA1, Rs1, Vn1} = term_instance(A1, Rs0, Vn0), + {CopyA2, Rs2, Vn2} = term_instance(A2, Rs1, Vn1), + {{Atom, CopyA1, CopyA2}, Rs2, Vn2}; +term_instance(T, Rs0, Vn0) when is_tuple(T) -> + As0 = tl(tuple_to_list(T)), + {As1, Rs1, Vn1} = term_instance(As0, Rs0, Vn0), + {list_to_tuple([element(1, T) | As1]), Rs1, Vn1}; +term_instance(A, Rs, Vn) -> {A, Rs, Vn}. %Constant + +%% unify_head(Goal, Head, Bindings, VarNum) -> +%% {succeed,Repls,NewBindings,NewVarNum} | fail +%% Unify a goal with a head without creating an instance of the +%% head. This saves us creating many variables which are local to the +%% clause and saves many variable bindings. + +unify_head(Goal, Head, Bs, Vn) -> + unify_head(deref(Goal, Bs), Head, orddict:new(), Bs, Vn). + +unify_head(G, H, Rs, Bs, Vn) when ?IS_CONSTANT(G), G == H -> + {succeed, Rs, Bs, Vn}; +unify_head(_T, {'_'}, Rs, Bs, Vn) -> {succeed, Rs, Bs, Vn}; +unify_head(T, {V0}, Rs, Bs0, Vn) -> + %% Now for the tricky bit! + case orddict:find(V0, Rs) of + {ok, V1} -> %Already have a replacement + case unify(T, V1, Bs0) of + {succeed, Bs1} -> {succeed, Rs, Bs1, Vn}; + fail -> fail + end; + error -> %Add a replacement + {succeed, orddict:store(V0, T, Rs), Bs0, Vn} + end; +unify_head({_} = Var, H0, Rs0, Bs, Vn0) -> + %% Must have an instance here. + {H1, Rs1, Vn1} = term_instance(H0, Rs0, Vn0), + {succeed, Rs1, add_binding(Var, H1, Bs), Vn1}; +unify_head([GH | GT], [HH | HT], Rs0, Bs0, Vn0) -> + case unify_head(deref(GH, Bs0), HH, Rs0, Bs0, Vn0) of + {succeed, Rs1, Bs1, Vn1} -> unify_head(deref(GT, Bs1), HT, Rs1, Bs1, Vn1); + fail -> fail + end; +unify_head([], [], Rs, Bs, Vn) -> {succeed, Rs, Bs, Vn}; +unify_head(G, H, Rs, Bs, Vn) when tuple_size(G) == tuple_size(H), + element(1, G) == element(1, H) -> + unify_head_args(G, H, Rs, Bs, Vn, 2, tuple_size(G)); +unify_head(_G, _H, _Rs, _Bs, _Vn) -> fail. + +unify_head_args(_G, _H, Rs, Bs, Vn, I, S) when I > S -> + {succeed, Rs, Bs, Vn}; +unify_head_args(G, H, Rs0, Bs0, Vn0, I, S) -> + case unify_head(deref(element(I, G), Bs0), element(I, H), Rs0, Bs0, Vn0) of + {succeed, Rs1, Bs1, Vn1} -> unify_head_args(G, H, Rs1, Bs1, Vn1, I + 1, S); + fail -> fail + end. + +%% body_instance(Body, Tail, Repls, VarNum, Label) -> +%% {Body,NewRepls,NewVarNum}. +%% Generate a copy of a body in a form ready to be interpreted. No +%% bindings from original variables to new variables. It can handle +%% replacing integer variables with overlapping integer ranges. Don't +%% check Term as it should already be checked. Use term_instance to +%% handle goals. N.B. We have to be VERY careful never to go into the +%% original tail as this will cause havoc. + +body_instance([{{cut} = Cut, _, Last} | Gs0], Tail, Rs0, Vn0, Label) -> + {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), + {[{Cut, Label, Last} | Gs1], Rs1, Vn1}; +body_instance([{{disj} = Disj, L0, R0} | Gs0], Tail, Rs0, Vn0, Label) -> + {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), + %% Append Gs1 directly to L and R. + {L1, Rs2, Vn2} = body_instance(L0, Gs1, Rs1, Vn1, Label), + {R1, Rs3, Vn3} = body_instance(R0, Gs1, Rs2, Vn2, Label), + {[{Disj, R1} | L1], Rs3, Vn3}; +body_instance([{{if_then} = IT, C0, T0, _} | Gs0], Tail, Rs0, Vn0, Label) -> + {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), + {T1, Rs2, Vn2} = body_instance(T0, Gs1, Rs1, Vn1, Label), + {C1, Rs3, Vn3} = body_instance(C0, [{{cut}, Label, true} | T1], Rs2, Vn2, Label), + %% Append Gs1 directly to T1 to C1. + {[{IT, Label} | C1], Rs3, Vn3}; +body_instance([{{if_then_else} = ITE, C0, T0, E0, _} | Gs0], Tail, Rs0, Vn0, Label) -> + {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), + {T1, Rs2, Vn2} = body_instance(T0, Gs1, Rs1, Vn1, Label), + {C1, Rs3, Vn3} = body_instance(C0, [{{cut}, Label, true} | T1], Rs2, Vn2, Label), + {E1, Rs4, Vn4} = body_instance(E0, Gs1, Rs3, Vn3, Label), + {[{ITE, E1, Label} | C1], Rs4, Vn4}; +body_instance([{{once} = Once, G0, _} | Gs0], Tail, Rs0, Vn0, Label) -> + {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), + {G1, Rs2, Vn2} = body_instance(G0, [{{cut}, Label, true} | Gs1], Rs1, Vn1, Label), + {[{Once, Label} | G1], Rs2, Vn2}; +body_instance([G0 | Gs0], Tail, Rs0, Vn0, Label) -> + {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), + {G1, Rs2, Vn2} = term_instance(G0, Rs1, Vn1), + {[G1 | Gs1], Rs2, Vn2}; +body_instance([], Tail, Rs, Vn, _Label) -> {Tail, Rs, Vn}. + +%% body_term(Body, Repls, VarNum) -> {Term,NewRepls,NewVarNum}. +%% Generate a copy of a body as a term with new, fresh unused +%% variables. No bindings from original variables to new +%% variables. It can handle replacing integer variables with +%% overlapping integer ranges. Don't check Term as it should already +%% be checked. Use orddict as there will seldom be many variables and +%% it it fast to setup. + +body_term([{{cut}, _, _} | Gs0], Rs0, Vn0) -> + {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), + {body_conj('!', Gs1), Rs1, Vn1}; +body_term([{{disj}, L0, R0} | Gs0], Rs0, Vn0) -> + {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), + {L1, Rs2, Vn2} = body_term(L0, Rs1, Vn1), + {R1, Rs3, Vn3} = body_term(R0, Rs2, Vn2), + {body_conj({';', L1, R1}, Gs1), Rs3, Vn3}; +body_term([{{if_then}, C0, T0, _} | Gs0], Rs0, Vn0) -> + {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), + {C1, Rs2, Vn2} = body_term(C0, Rs1, Vn1), + {T1, Rs3, Vn3} = body_term(T0, Rs2, Vn2), + {body_conj({'->', C1, T1}, Gs1), Rs3, Vn3}; +body_term([{{if_then_else}, C0, T0, E0, _} | Gs0], Rs0, Vn0) -> + {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), + {C1, Rs2, Vn2} = body_term(C0, Rs1, Vn1), + {T1, Rs3, Vn3} = body_term(T0, Rs2, Vn2), + {E1, Rs4, Vn4} = body_term(E0, Rs3, Vn3), + {body_conj({';', {'->', C1, T1}, E1}, Gs1), Rs4, Vn4}; +body_term([{{once}, G0, _} | Gs0], Rs0, Vn0) -> + {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), + {G1, Rs2, Vn2} = body_term(G0, Rs1, Vn1), + {body_conj({once, G1}, Gs1), Rs2, Vn2}; +body_term([G0 | Gs0], Rs0, Vn0) -> + {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), + {G1, Rs2, Vn2} = term_instance(G0, Rs1, Vn1), + {body_conj(G1, Gs1), Rs2, Vn2}; +body_term([], Rs, Vn) -> {true, Rs, Vn}. + +body_conj(L, true) -> L; +body_conj(L, R) -> {',', L, R}. + +pred_ind({N, A}) -> {'/', N, A}. + +%% pred_ind(N, A) -> {'/',N,A}. + +%% Bindings +%% Bindings are kept in a dict where the key is the variable name. +%%-define(BIND, orddict). +-define(BIND, dict). + +new_bindings() -> ?BIND:new(). + +add_binding({V}, Val, Bs0) -> + ?BIND:store(V, Val, Bs0). + +get_binding({V}, Bs) -> + ?BIND:find(V, Bs). + +%% deref(Term, Bindings) -> Term. +%% Dereference a variable, else just return the term. + +deref({V} = T0, Bs) -> + case ?BIND:find(V, Bs) of + {ok, T1} -> deref(T1, Bs); + error -> T0 + end; +deref(T, _) -> T. %Not a variable, return it. + +%% deref_list(List, Bindings) -> List. +%% Dereference the top-level checking that it is a list. + +deref_list([], _) -> []; %It already is a list +deref_list([_ | _] = L, _) -> L; +deref_list({V}, Bs) -> + case ?BIND:find(V, Bs) of + {ok, L} -> deref_list(L, Bs); + error -> instantiation_error() + end; +deref_list(Other, _) -> type_error(list, Other). + +%% dderef(Term, Bindings) -> Term. +%% Do a deep dereference. Completely dereference all the variables +%% occuring in a term, even those occuring in a variables value. + +dderef(A, _) when ?IS_CONSTANT(A) -> A; +dderef([], _) -> []; +dderef([H0 | T0], Bs) -> + [dderef(H0, Bs) | dderef(T0, Bs)]; +dderef({V} = Var, Bs) -> + case ?BIND:find(V, Bs) of + {ok, T} -> dderef(T, Bs); + error -> Var + end; +dderef(T, Bs) when is_tuple(T) -> + Es0 = tuple_to_list(T), + Es1 = dderef(Es0, Bs), + list_to_tuple(Es1). + +%% dderef_list(List, Bindings) -> List. +%% Dereference all variables to any depth but check that the +%% top-level is a list. + +dderef_list([], _Bs) -> []; +dderef_list([H | T], Bs) -> + [dderef(H, Bs) | dderef_list(T, Bs)]; +dderef_list({V}, Bs) -> + case ?BIND:find(V, Bs) of + {ok, L} -> dderef_list(L, Bs); + error -> instantiation_error() + end; +dderef_list(Other, _Bs) -> type_error(list, Other). + +%% initial_goal(Goal) -> {Goal,Bindings,NewVarNum}. +%% initial_goal(Goal, Bindings, VarNum) -> {Goal,NewBindings,NewVarNum}. +%% Check term for well-formedness as an Erlog term and replace '_' +%% variables with unique numbered variables. Error on non-well-formed +%% goals. + +initial_goal(Goal) -> initial_goal(Goal, new_bindings(), 0). + +initial_goal({'_'}, Bs, Vn) -> {{Vn}, Bs, Vn + 1}; %Anonymous variable +initial_goal({Name} = Var0, Bs, Vn) when is_atom(Name) -> + case get_binding(Var0, Bs) of + {ok, Var1} -> {Var1, Bs, Vn}; + error -> + Var1 = {Vn}, + {Var1, add_binding(Var0, Var1, Bs), Vn + 1} + end; +initial_goal([H0 | T0], Bs0, Vn0) -> + {H1, Bs1, Vn1} = initial_goal(H0, Bs0, Vn0), + {T1, Bs2, Vn2} = initial_goal(T0, Bs1, Vn1), + {[H1 | T1], Bs2, Vn2}; +initial_goal([], Bs, Vn) -> {[], Bs, Vn}; +initial_goal(S, Bs0, Vn0) when ?IS_FUNCTOR(S) -> + As0 = tl(tuple_to_list(S)), + {As1, Bs1, Vn1} = initial_goal(As0, Bs0, Vn0), + {list_to_tuple([element(1, S) | As1]), Bs1, Vn1}; +initial_goal(T, Bs, Vn) when ?IS_ATOMIC(T) -> {T, Bs, Vn}; +initial_goal(T, _Bs, _Vn) -> type_error(callable, T). diff --git a/src/core/erlog_lists.erl b/src/core/erlog_lists.erl new file mode 100644 index 0000000..f6f997f --- /dev/null +++ b/src/core/erlog_lists.erl @@ -0,0 +1,204 @@ +%% Copyright (c) 2013 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : erlog_lists.erl +%% Author : Robert Virding +%% Purpose : Standard Erlog lists library. +%% +%% This is a standard lists library for Erlog. Everything here is +%% pretty basic and common to most Prologs. We are experimenting here +%% and some predicates are compiled. We only get a small benefit when +%% only implementing indexing on the first argument. + +-module(erlog_lists). + +-include("erlog_int.hrl"). + +%% Main interface functions. +-export([load/1]). + +%% Library functions. +-export([append_3/6, insert_3/6, member_2/6, memberchk_2/6, reverse_2/6, sort_2/6]). + +%%-compile(export_all). + +-import(lists, [map/2, foldl/3]). + +%% We use these a lot so we import them for cleaner code. +-import(erlog_int, [prove_body/5, unify_prove_body/7, unify_prove_body/9, fail/2, +add_binding/3, make_vars/2, +deref/2, dderef/2, dderef_list/2, unify/3, +term_instance/2, +add_built_in/2, add_compiled_proc/4, +asserta_clause/2, assertz_clause/2]). + +%% load(Database) -> Database. +%% Assert predicates into the database. + +load(Db0) -> + %% Compiled common list library. + Db1 = foldl(fun({Head, M, F}, Db) -> + add_compiled_proc(Head, M, F, Db) end, Db0, + [ + {{append, 3}, ?MODULE, append_3}, + {{insert, 3}, ?MODULE, insert_3}, + {{member, 2}, ?MODULE, member_2}, + {{memberchk, 2}, ?MODULE, memberchk_2}, + {{reverse, 2}, ?MODULE, reverse_2}, + {{sort, 2}, ?MODULE, sort_2} + ]), + %% Finally interpreted common list library. + foldl(fun(Clause, Db) -> assertz_clause(Clause, Db) end, Db1, + [ + %% insert(L, X, [X|L]). insert([H|L], X, [H|L1]) :- insert(L, X, L1). + %% delete([X|L], X, L). delete([H|L], X, [H|L1]) :- delete(L, X, L1). + {':-', {delete, {1}, {2}, {3}}, {insert, {3}, {2}, {1}}}, + %% perm([], []). + %% perm([X|Xs], Ys1) :- perm(Xs, Ys), insert(Ys, X, Ys1). + {perm, [], []}, + {':-', {perm, [{1} | {2}], {3}}, {',', {perm, {2}, {4}}, {insert, {4}, {1}, {3}}}} + ]). + +%% append_3(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. +%% append([], L, L). +%% append([H|T], L, [H|L1]) :- append(T, L, L1). +%% Here we attempt to compile indexing in the first argument. + +append_3({append, A1, L, A3}, Next0, Cps, Bs0, Vn, Db) -> + case deref(A1, Bs0) of + [] -> %Cannot backtrack + unify_prove_body(L, A3, Next0, Cps, Bs0, Vn, Db); + [H | T] -> %Cannot backtrack + L1 = {Vn}, + Next1 = [{append, T, L, L1} | Next0], + unify_prove_body(A3, [H | L1], Next1, Cps, Bs0, Vn + 1, Db); + {_} = Var -> %This can backtrack + FailFun = fun(LCp, LCps, LDb) -> + fail_append_3(LCp, LCps, LDb, Var, L, A3) + end, + Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, + Bs1 = add_binding(Var, [], Bs0), + unify_prove_body(L, A3, Next0, [Cp | Cps], Bs1, Vn, Db); + _ -> fail(Cps, Db) %Will fail here! + end. + +fail_append_3(#cp{next = Next0, bs = Bs0, vn = Vn}, Cps, Db, A1, L, A3) -> + H = {Vn}, + T = {Vn + 1}, + L1 = {Vn + 2}, + Bs1 = add_binding(A1, [H | T], Bs0), %A1 always a variable here. + Next1 = [{append, T, L, L1} | Next0], + unify_prove_body(A3, [H | L1], Next1, Cps, Bs1, Vn + 3, Db). + +%% insert_3(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. +%% insert(L, X, [X|L]). +%% insert([H|L], X, [H|L1]) :- insert(L, X, L1). + +insert_3({insert, A1, A2, A3}, Next, Cps, Bs, Vn, Db) -> + FailFun = fun(LCp, LCps, LDb) -> + fail_insert_3(LCp, LCps, LDb, A1, A2, A3) + end, + Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, + unify_prove_body(A3, [A2 | A1], Next, [Cp | Cps], Bs, Vn, Db). + +fail_insert_3(#cp{next = Next0, bs = Bs, vn = Vn}, Cps, Db, A1, X, A3) -> + H = {Vn}, + L = {Vn + 1}, + L1 = {Vn + 2}, + Next1 = [{insert, L, X, L1} | Next0], + unify_prove_body(A1, [H | L], A3, [H | L1], Next1, Cps, Bs, Vn + 3, Db). + +%% member_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. +%% member(X, [X|_]). +%% member(X, [_|T]) :- member(X, T). + +member_2({member, A1, A2}, Next, Cps, Bs, Vn, Db) -> + FailFun = fun(LCp, LCps, LDb) -> + fail_member_2(LCp, LCps, LDb, A1, A2) + end, + Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, + T = {Vn}, + unify_prove_body(A2, [A1 | T], Next, [Cp | Cps], Bs, Vn + 1, Db). + +fail_member_2(#cp{next = Next0, bs = Bs, vn = Vn}, Cps, Db, A1, A2) -> + H = {Vn}, + T = {Vn + 1}, + Next1 = [{member, A1, T} | Next0], + unify_prove_body(A2, [H | T], Next1, Cps, Bs, Vn + 2, Db). + +%% memberchk_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. +%% memberchk(X, [X|_]) :- !. +%% memberchk(X, [_|T]) :- member(X, T). +%% We don't build the list and we never backtrack so we can be smart +%% and match directly. Should we give a type error? + +memberchk_2({memberchk, A1, A2}, Next, Cps, Bs0, Vn, Db) -> + case deref(A2, Bs0) of + [H | T] -> + case unify(A1, H, Bs0) of + {succeed, Bs1} -> + prove_body(Next, Cps, Bs1, Vn, Db); + fail -> + memberchk_2({memberchk, A1, T}, Next, Cps, Bs0, Vn, Db) + end; + {_} -> erlog_int:instantiation_error(); + _ -> fail(Cps, Db) + end. + +%% reverse_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. +%% reverse([], []). +%% reverse([H|L1], L) :- reverse(L1, L2), append(L2, [H], L). +%% Here we attempt to compile indexing in the first argument. + +reverse_2({reverse, A1, A2}, Next0, Cps, Bs0, Vn, Db) -> + case deref(A1, Bs0) of + [] -> + unify_prove_body(A2, [], Next0, Cps, Bs0, Vn, Db); + [H | T] -> + L = {Vn}, + L1 = A2, + %% Naive straight expansion of body. + %%Next1 = [{reverse,T,L},{append,L,[H],L1}|Next0], + %%prove_body(Next1, Cps, Bs0, Vn+1, Db); + %% Smarter direct calling of local function. + Next1 = [{append, L, [H], L1} | Next0], + reverse_2({reverse, T, L}, Next1, Cps, Bs0, Vn + 1, Db); + {_} = Var -> + FailFun = fun(LCp, LCps, LDb) -> + fail_reverse_2(LCp, LCps, LDb, Var, A2) + end, + Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, + Bs1 = add_binding(Var, [], Bs0), + unify_prove_body(A2, [], Next0, [Cp | Cps], Bs1, Vn, Db); + _ -> fail(Cps, Db) %Will fail here! + end. + +fail_reverse_2(#cp{next = Next, bs = Bs0, vn = Vn}, Cps, Db, A1, A2) -> + H = {Vn}, + T = {Vn + 1}, + L1 = A2, + L = {Vn + 2}, + Bs1 = add_binding(A1, [H | T], Bs0), + %%Next1 = [{reverse,T,L},{apperse,L,[H],L1}|Next], + %%prove_body(Next1, Cps, Bs1, Vn+3, Db). + Next1 = [{append, L, [H], L1} | Next], + reverse_2({reverse, T, L}, Next1, Cps, Bs1, Vn + 3, Db). + +%% sort_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. +%% sort(List, SortedList). + +sort_2({sort, L0, S}, Next, Cps, Bs, Vn, Db) -> + %% This may throw an erlog error, we don't catch it here. + L1 = lists:usort(dderef_list(L0, Bs)), + unify_prove_body(S, L1, Next, Cps, Bs, Vn, Db). diff --git a/src/erlog_scan.xrl b/src/core/erlog_scan.xrl similarity index 100% rename from src/erlog_scan.xrl rename to src/core/erlog_scan.xrl diff --git a/src/core/lang/erlog_bips.erl b/src/core/lang/erlog_bips.erl new file mode 100644 index 0000000..2bf853f --- /dev/null +++ b/src/core/lang/erlog_bips.erl @@ -0,0 +1,382 @@ +%% Copyright (c) 2008-2013 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : erlog_bips.erl +%% Author : Robert Virding +%% Purpose : Built-in predicates of Erlog interpreter. +%% +%% These are the built-in predicates of the Prolog interpreter which +%% are not control predicates or database predicates. + +-module(erlog_bips). + +-include("erlog_int.hrl"). + +%% Main interface functions. +-export([load/1]). +-export([prove_goal/6]). + +%%-compile(export_all). + +-import(lists, [map/2, foldl/3]). + +%% We use these a lot so we import them for cleaner code. +-import(erlog_int, [prove_body/5, unify_prove_body/7, unify_prove_body/9, fail/2, +add_binding/3, make_vars/2, +deref/2, dderef/2, dderef_list/2, unify/3, +term_instance/2, +add_built_in/2, add_compiled_proc/4, +asserta_clause/2, assertz_clause/2]). + +%% load(Database) -> Database. +%% Assert predicates into the database. + +load(Db0) -> + foldl(fun(Head, Db) -> add_built_in(Head, Db) end, Db0, + [ + %% Term unification and comparison + {'=', 2}, + {'\\=', 2}, + {'@>', 2}, + {'@>=', 2}, + {'==', 2}, + {'\\==', 2}, + {'@<', 2}, + {'@=<', 2}, + %% Term creation and decomposition. + {arg, 3}, + {copy_term, 2}, + {functor, 3}, + {'=..', 2}, + %% Type testing. + {atom, 1}, + {atomic, 1}, + {compound, 1}, + {integer, 1}, + {float, 1}, + {number, 1}, + {nonvar, 1}, + {var, 1}, + %% Atom processing. + {atom_chars, 2}, + {atom_length, 2}, + %% Arithmetic evaluation and comparison + {'is', 2}, + {'>', 2}, + {'>=', 2}, + {'=:=', 2}, + {'=\\=', 2}, + {'<', 2}, + {'=<', 2} + ]). + +%% prove_goal(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> +%% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase} | +%% {fail,NewDatabase}. +%% Prove one goal. We seldom return succeed here but usually go directly to +%% to NextGoal. + +%% Term unification and comparison +prove_goal({'=', L, R}, Next, Cps, Bs, Vn, Db) -> + unify_prove_body(L, R, Next, Cps, Bs, Vn, Db); +prove_goal({'\\=', L, R}, Next, Cps, Bs0, Vn, Db) -> + case unify(L, R, Bs0) of + {succeed, _Bs1} -> fail(Cps, Db); + fail -> prove_body(Next, Cps, Bs0, Vn, Db) + end; +prove_goal({'@>', L, R}, Next, Cps, Bs, Vn, Db) -> + term_test_prove_body('>', L, R, Next, Cps, Bs, Vn, Db); +prove_goal({'@>=', L, R}, Next, Cps, Bs, Vn, Db) -> + term_test_prove_body('>=', L, R, Next, Cps, Bs, Vn, Db); +prove_goal({'==', L, R}, Next, Cps, Bs, Vn, Db) -> + term_test_prove_body('==', L, R, Next, Cps, Bs, Vn, Db); +prove_goal({'\\==', L, R}, Next, Cps, Bs, Vn, Db) -> + term_test_prove_body('/=', L, R, Next, Cps, Bs, Vn, Db); +prove_goal({'@<', L, R}, Next, Cps, Bs, Vn, Db) -> + term_test_prove_body('<', L, R, Next, Cps, Bs, Vn, Db); +prove_goal({'@=<', L, R}, Next, Cps, Bs, Vn, Db) -> + term_test_prove_body('=<', L, R, Next, Cps, Bs, Vn, Db); +%% Term creation and decomposition. +prove_goal({arg, I, Ct, A}, Next, Cps, Bs, Vn, Db) -> + prove_arg(deref(I, Bs), deref(Ct, Bs), A, Next, Cps, Bs, Vn, Db); +prove_goal({copy_term, T0, C}, Next, Cps, Bs, Vn0, Db) -> + %% Use term_instance to create the copy, can ignore orddict it creates. + {T, _Nbs, Vn1} = term_instance(dderef(T0, Bs), Vn0), + unify_prove_body(T, C, Next, Cps, Bs, Vn1, Db); +prove_goal({functor, T, F, A}, Next, Cps, Bs, Vn, Db) -> + prove_functor(dderef(T, Bs), F, A, Next, Cps, Bs, Vn, Db); +prove_goal({'=..', T, L}, Next, Cps, Bs, Vn, Db) -> + prove_univ(dderef(T, Bs), L, Next, Cps, Bs, Vn, Db); +%% Type testing. +prove_goal({atom, T0}, Next, Cps, Bs, Vn, Db) -> + case deref(T0, Bs) of + T when is_atom(T) -> prove_body(Next, Cps, Bs, Vn, Db); + _Other -> fail(Cps, Db) + end; +prove_goal({atomic, T0}, Next, Cps, Bs, Vn, Db) -> + case deref(T0, Bs) of + T when ?IS_ATOMIC(T) -> prove_body(Next, Cps, Bs, Vn, Db); + _Other -> fail(Cps, Db) + end; +prove_goal({compound, T0}, Next, Cps, Bs, Vn, Db) -> + case deref(T0, Bs) of + T when ?IS_ATOMIC(T) -> fail(Cps, Db); + _Other -> prove_body(Next, Cps, Bs, Vn, Db) + end; +prove_goal({integer, T0}, Next, Cps, Bs, Vn, Db) -> + case deref(T0, Bs) of + T when is_integer(T) -> prove_body(Next, Cps, Bs, Vn, Db); + _Other -> fail(Cps, Db) + end; +prove_goal({float, T0}, Next, Cps, Bs, Vn, Db) -> + case deref(T0, Bs) of + T when is_float(T) -> prove_body(Next, Cps, Bs, Vn, Db); + _Other -> fail(Cps, Db) + end; +prove_goal({number, T0}, Next, Cps, Bs, Vn, Db) -> + case deref(T0, Bs) of + T when is_number(T) -> prove_body(Next, Cps, Bs, Vn, Db); + _Other -> fail(Cps, Db) + end; +prove_goal({nonvar, T0}, Next, Cps, Bs, Vn, Db) -> + case deref(T0, Bs) of + {_} -> fail(Cps, Db); + _Other -> prove_body(Next, Cps, Bs, Vn, Db) + end; +prove_goal({var, T0}, Next, Cps, Bs, Vn, Db) -> + case deref(T0, Bs) of + {_} -> prove_body(Next, Cps, Bs, Vn, Db); + _Other -> fail(Cps, Db) + end; +%% Atom processing. +prove_goal({atom_chars, A, L}, Next, Cps, Bs, Vn, Db) -> + prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db); +prove_goal({atom_length, A0, L0}, Next, Cps, Bs, Vn, Db) -> + case dderef(A0, Bs) of + A when is_atom(A) -> + Alen = length(atom_to_list(A)), %No of chars in atom + case dderef(L0, Bs) of + L when is_integer(L) -> + unify_prove_body(Alen, L, Next, Cps, Bs, Vn, Db); + {_} = Var -> + unify_prove_body(Alen, Var, Next, Cps, Bs, Vn, Db); + Other -> erlog_int:type_error(integer, Other, Db) + end; + {_} -> erlog_int:instantiation_error(Db); + Other -> erlog_int:type_error(atom, Other, Db) + end; +%% Arithmetic evalution and comparison. +prove_goal({is, N, E0}, Next, Cps, Bs, Vn, Db) -> + E = eval_arith(deref(E0, Bs), Bs, Db), + unify_prove_body(N, E, Next, Cps, Bs, Vn, Db); +prove_goal({'>', L, R}, Next, Cps, Bs, Vn, Db) -> + arith_test_prove_body('>', L, R, Next, Cps, Bs, Vn, Db); +prove_goal({'>=', L, R}, Next, Cps, Bs, Vn, Db) -> + arith_test_prove_body('>=', L, R, Next, Cps, Bs, Vn, Db); +prove_goal({'=:=', L, R}, Next, Cps, Bs, Vn, Db) -> + arith_test_prove_body('==', L, R, Next, Cps, Bs, Vn, Db); +prove_goal({'=\\=', L, R}, Next, Cps, Bs, Vn, Db) -> + arith_test_prove_body('/=', L, R, Next, Cps, Bs, Vn, Db); +prove_goal({'<', L, R}, Next, Cps, Bs, Vn, Db) -> + arith_test_prove_body('<', L, R, Next, Cps, Bs, Vn, Db); +prove_goal({'=<', L, R}, Next, Cps, Bs, Vn, Db) -> + arith_test_prove_body('=<', L, R, Next, Cps, Bs, Vn, Db). + +%% term_test_prove_body(Test, Left, Right, Next, ChoicePoints, Bindings, Varnum, Database) -> +%% void. + +term_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db) -> + case erlang:Test(dderef(L, Bs), dderef(R, Bs)) of + true -> prove_body(Next, Cps, Bs, Vn, Db); + false -> fail(Cps, Db) + end. + +%% prove_arg(Index, Term, Arg, Next, ChoicePoints, VarNum, Database) -> void. +%% Prove the goal arg(I, Ct, Arg), Index and Term have been dereferenced. + +prove_arg(I, [H | T], A, Next, Cps, Bs, Vn, Db) when is_integer(I) -> + %% He, he, he! + if I == 1 -> unify_prove_body(H, A, Next, Cps, Bs, Vn, Db); + I == 2 -> unify_prove_body(T, A, Next, Cps, Bs, Vn, Db); + true -> {fail, Db} + end; +prove_arg(I, Ct, A, Next, Cps, Bs, Vn, Db) + when is_integer(I), tuple_size(Ct) >= 2 -> + if I > 1, I + 1 =< tuple_size(Ct) -> + unify_prove_body(element(I + 1, Ct), A, Next, Cps, Bs, Vn, Db); + true -> {fail, Db} + end; +prove_arg(I, Ct, _, _, _, _, _, Db) -> + %%Type failure just generates an error. + if not(is_integer(I)) -> erlog_int:type_error(integer, I, Db); + true -> erlog_int:type_error(compound, Ct, Db) + end. + +%% prove_functor(Term, Functor, Arity, Next, ChoicePoints, Bindings, VarNum, Database) -> void. +%% Prove the call functor(T, F, A), Term has been dereferenced. + +prove_functor(T, F, A, Next, Cps, Bs, Vn, Db) when tuple_size(T) >= 2 -> + unify_prove_body(F, element(1, T), A, tuple_size(T) - 1, Next, Cps, Bs, Vn, Db); +prove_functor(T, F, A, Next, Cps, Bs, Vn, Db) when ?IS_ATOMIC(T) -> + unify_prove_body(F, T, A, 0, Next, Cps, Bs, Vn, Db); +prove_functor([_ | _], F, A, Next, Cps, Bs, Vn, Db) -> + %% Just the top level here. + unify_prove_body(F, '.', A, 2, Next, Cps, Bs, Vn, Db); +prove_functor({_} = Var, F0, A0, Next, Cps, Bs0, Vn0, Db) -> + case {dderef(F0, Bs0), dderef(A0, Bs0)} of + {'.', 2} -> %He, he, he! + Bs1 = add_binding(Var, [{Vn0} | {Vn0 + 1}], Bs0), + prove_body(Next, Cps, Bs1, Vn0 + 2, Db); + {F1, 0} when ?IS_ATOMIC(F1) -> + Bs1 = add_binding(Var, F1, Bs0), + prove_body(Next, Cps, Bs1, Vn0, Db); + {F1, A1} when is_atom(F1), is_integer(A1), A1 > 0 -> + As = make_vars(A1, Vn0), + Bs1 = add_binding(Var, list_to_tuple([F1 | As]), Bs0), + prove_body(Next, Cps, Bs1, Vn0 + A1, Db); %!!! + %% Now the error cases. + {{_}, _} -> erlog_int:instantiation_error(Db); + {F1, A1} when is_atom(F1) -> erlog_int:type_error(integer, A1, Db); + {F1, _} -> erlog_int:type_error(atom, F1, Db) + end. + +%% prove_univ(Term, List, Next, ChoicePoints, Bindings, VarNum, Database) -> void. +%% Prove the goal Term =.. List, Term has already been dereferenced. + +prove_univ(T, L, Next, Cps, Bs, Vn, Db) when tuple_size(T) >= 2 -> + Es = tuple_to_list(T), + unify_prove_body(Es, L, Next, Cps, Bs, Vn, Db); +prove_univ(T, L, Next, Cps, Bs, Vn, Db) when ?IS_ATOMIC(T) -> + unify_prove_body([T], L, Next, Cps, Bs, Vn, Db); +prove_univ([Lh | Lt], L, Next, Cps, Bs, Vn, Db) -> + %% He, he, he! + unify_prove_body(['.', Lh, Lt], L, Next, Cps, Bs, Vn, Db); +prove_univ({_} = Var, L, Next, Cps, Bs0, Vn, Db) -> + case dderef(L, Bs0) of + ['.', Lh, Lt] -> %He, he, he! + Bs1 = add_binding(Var, [Lh | Lt], Bs0), + prove_body(Next, Cps, Bs1, Vn, Db); + [A] when ?IS_ATOMIC(A) -> + Bs1 = add_binding(Var, A, Bs0), + prove_body(Next, Cps, Bs1, Vn, Db); + [F | As] when is_atom(F), length(As) > 0 -> + Bs1 = add_binding(Var, list_to_tuple([F | As]), Bs0), + prove_body(Next, Cps, Bs1, Vn, Db); + %% Now the error cases. + [{_} | _] -> erlog_int:instantiation_error(Db); + {_} -> erlog_int:instantiation_error(Db); + Other -> erlog_int:type_error(list, Other, Db) + end. + +%% prove_atom_chars(Atom, List, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Prove the atom_chars(Atom, List). + +prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db) -> + %% After a suggestion by Sean Cribbs. + case dderef(A, Bs) of + Atom when is_atom(Atom) -> + AtomList = [list_to_atom([C]) || C <- atom_to_list(Atom)], + unify_prove_body(L, AtomList, Next, Cps, Bs, Vn, Db); + {_} = Var -> + %% Error #3: List is neither a list nor a partial list. + %% Handled in dderef_list/2. + List = dderef_list(L, Bs), + %% Error #1, #4: List is a list or partial list with an + %% element which is a variable or not one char atom. + Fun = fun({_}) -> erlog_int:instantiation_error(Db); + (Atom) -> + case is_atom(Atom) andalso atom_to_list(Atom) of + [C] -> C; + _ -> erlog_int:type_error(character, Atom, Db) + end + end, + Chars = lists:map(Fun, List), + Atom = list_to_atom(Chars), + unify_prove_body(Var, Atom, Next, Cps, Bs, Vn, Db); + Other -> + %% Error #2: Atom is neither a variable nor an atom + erlog_int:type_error(atom, Other, Db) + end. + +%% arith_test_prove_body(Test, Left, Right, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. + +arith_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db) -> + case erlang:Test(eval_arith(deref(L, Bs), Bs, Db), + eval_arith(deref(R, Bs), Bs, Db)) of + true -> prove_body(Next, Cps, Bs, Vn, Db); + false -> fail(Cps, Db) + end. + +%% eval_arith(ArithExpr, Bindings, Database) -> Number. +%% Evaluate an arithmetic expression, include the database for +%% errors. Dereference each level as we go, might fail so save some +%% work. Must be called deferenced. + +eval_arith({'+', A, B}, Bs, Db) -> + eval_arith(deref(A, Bs), Bs, Db) + eval_arith(deref(B, Bs), Bs, Db); +eval_arith({'-', A, B}, Bs, Db) -> + eval_arith(deref(A, Bs), Bs, Db) - eval_arith(deref(B, Bs), Bs, Db); +eval_arith({'*', A, B}, Bs, Db) -> + eval_arith(deref(A, Bs), Bs, Db) * eval_arith(deref(B, Bs), Bs, Db); +eval_arith({'/', A, B}, Bs, Db) -> + eval_arith(deref(A, Bs), Bs, Db) / eval_arith(deref(B, Bs), Bs, Db); +eval_arith({'**', A, B}, Bs, Db) -> + math:pow(eval_arith(deref(A, Bs), Bs, Db), + eval_arith(deref(B, Bs), Bs, Db)); +eval_arith({'//', A, B}, Bs, Db) -> + eval_int(deref(A, Bs), Bs, Db) div eval_int(deref(B, Bs), Bs, Db); +eval_arith({'mod', A, B}, Bs, Db) -> + eval_int(deref(A, Bs), Bs, Db) rem eval_int(deref(B, Bs), Bs, Db); +eval_arith({'/\\', A, B}, Bs, Db) -> + eval_int(deref(A, Bs), Bs, Db) band eval_int(deref(B, Bs), Bs, Db); +eval_arith({'\\/', A, B}, Bs, Db) -> + eval_int(deref(A, Bs), Bs, Db) bor eval_int(deref(B, Bs), Bs, Db); +eval_arith({'<<', A, B}, Bs, Db) -> + eval_int(deref(A, Bs), Bs, Db) bsl eval_int(deref(B, Bs), Bs, Db); +eval_arith({'>>', A, B}, Bs, Db) -> + eval_int(deref(A, Bs), Bs, Db) bsr eval_int(deref(B, Bs), Bs, Db); +eval_arith({'\\', A}, Bs, Db) -> + bnot eval_int(deref(A, Bs), Bs, Db); +eval_arith({'+', A}, Bs, Db) -> + + eval_arith(deref(A, Bs), Bs, Db); +eval_arith({'-', A}, Bs, Db) -> + - eval_arith(deref(A, Bs), Bs, Db); +eval_arith({'abs', A}, Bs, Db) -> + abs(eval_arith(deref(A, Bs), Bs, Db)); +eval_arith({'float', A}, Bs, Db) -> + float(eval_arith(deref(A, Bs), Bs, Db)); +eval_arith({'truncate', A}, Bs, Db) -> + trunc(eval_arith(deref(A, Bs), Bs, Db)); +eval_arith(N, _Bs, _Db) when is_number(N) -> N; %Just a number +%% Error cases. +eval_arith({_}, _Bs, Db) -> erlog_int:instantiation_error(Db); +eval_arith(N, _Bs, Db) when is_tuple(N) -> + Pi = pred_ind(element(1, N), tuple_size(N) - 1), + erlog_int:type_error(evaluable, Pi, Db); +eval_arith([_ | _], _Bs, Db) -> + erlog_int:type_error(evaluable, pred_ind('.', 2), Db); +eval_arith(O, _Bs, Db) -> erlog_int:type_error(evaluable, O, Db). + +%% eval_int(IntegerExpr, Bindings, Database) -> Integer. +%% Evaluate an integer expression, include the database for errors. + +eval_int(E0, Bs, Db) -> + E = eval_arith(E0, Bs, Db), + if is_integer(E) -> E; + true -> erlog_int:type_error(integer, E, Db) + end. + +pred_ind(N, A) -> {'/', N, A}. diff --git a/src/core/lang/erlog_dcg.erl b/src/core/lang/erlog_dcg.erl new file mode 100644 index 0000000..2be44b1 --- /dev/null +++ b/src/core/lang/erlog_dcg.erl @@ -0,0 +1,164 @@ +%% Copyright (c) 2008-2013 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : erlog_dcg.erl +%% Author : Robert Virding +%% Purpose : DCG conversion and procedures. + +-module(erlog_dcg). + +-include("erlog_int.hrl"). + +-export([expand_term/1, expand_term/2]). +-export([expand_term_2/6, phrase_3/6]). +-export([load/1]). + +-import(lists, [foldl/3]). + +%% We use these a lot so we import them for cleaner code. +-import(erlog_int, [prove_body/5, unify_prove_body/7, unify_prove_body/9, fail/2, +add_binding/3, make_vars/2, deref/2, dderef/2, dderef_list/2, unify/3, +term_instance/2, add_built_in/2, add_compiled_proc/4, asserta_clause/2, assertz_clause/2]). + +load(Db0) -> + %% Compiled DCG predicates. + Db1 = foldl(fun({Head, M, F}, Db) -> add_compiled_proc(Head, M, F, Db) end, + Db0, + [ + {{expand_term, 2}, erlog_dcg, expand_term_2}, + {{phrase, 3}, erlog_dcg, phrase_3} + ]), + %% Interpreted DCG predicates. + foldl(fun(Clause, Db) -> assertz_clause(Clause, Db) end, Db1, + [ + %% 'C'([H|T], H, T). + %% {'C',[{1}|{2}],{1},{2}}, %For DCGs + %% phrase(V, L) :- phrase(V, L, []). + {':-', {phrase, {1}, {2}}, {phrase, {1}, {2}, []}} + %% phrase(V, L, R) :- + %% V =.. Z, append(Z, [L,R], G), C =.. G, C. + %% {':-',{phrase,{1},{2},{3}}, + %% {',',{'=..',{1},{4}},{',',{append,{4},[{2},{3}],{5}}, + %% {',',{'=..',{6},{5}},{6}}}}} + ]). + +%% expand_term_2(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> +%% void +%% Call the expand_term/2 predicate. + +expand_term_2(Goal, Next, Cps, Bs, Vn0, Db) -> + {expand_term, DCGRule, A2} = dderef(Goal, Bs), + {Exp, Vn1} = expand_term(DCGRule, Vn0), + unify_prove_body(A2, Exp, Next, Cps, Bs, Vn1, Db). + +%% phrase_3(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> void. +%% Call the phrase/3 preidicate. We could easily do this in prolog +%% except for that it calls dcg_body/4 which is not exported. +%% +%% phrase(GRBody, S0, S) -> dcg_body(GRBody, S0, S, Goal), call(Goal). + +phrase_3(Goal, Next0, Cps, Bs, Vn0, Db) -> + {phrase, GRBody, S0, S} = dderef(Goal, Bs), + {Body, Vn1} = dcg_body(GRBody, S0, S, Vn0), + %% io:format("~p\n", [Body]), + Next1 = [{call, Body} | Next0], %Evaluate body + prove_body(Next1, Cps, Bs, Vn1, Db). + +%% expand_term(Term) -> {ExpTerm}. +%% expand_term(Term, VarNum) -> {ExpTerm,NewVarNum}. +%% Handle DCG expansion. We do NOT work backwards. + +expand_term(Term) -> + {Exp, _} = expand_term(Term, 0), + Exp. + +expand_term({'-->', _, _} = Term, Vn) -> + dcg_rule(Term, Vn); +expand_term(Term, Vn) -> {Term, Vn}. + +%% dcg_rule(Term, VarNum) -> {ExpTerm,NewVarNum}. +%% dcg_rule(DCGRule, VarIn, VarOout, VarNum) -> {ExpTerm,NewVarNum}. +%% dcg_non_term(NonTerminal, VarIn, VarOut) -> ExpTerm. +%% dcg_body(BodyTerm, VarIn, VarOut, VarNum) -> {ExpBody,NewVarOut,NewVarNum}. +%% dcg_goal(BodyGoal, VarIn, VarOut, VarNum) -> {ExpGaol,NewVarOut,NewVarNum}. +%% dcg_terminal(Terminals, VarIn, VarOut, VarNum) -> +%% {ExpTerms,NewVarOut,NewVarNum}. +%% dcg_body and dcg_goal do smae the thing except the dcg_body +%% guarantees the output variable is the one we specify. It may +%% insert an explicit '=' to get this. + +dcg_rule(DCGRule, Vn0) -> + S0 = {Vn0}, + S = {Vn0 + 1}, + dcg_rule(DCGRule, S0, S, Vn0 + 2). + +dcg_rule({'-->', {',', H, RHC}, B}, S0, S, Vn0) -> + S1 = {Vn0}, + Head = dcg_non_term(H, S0, S), + {Goal1, S2, Vn1} = dcg_goal(B, S0, S1, Vn0 + 1), + {Goal2, Vn2} = dcg_terminals(RHC, S, S2, Vn1), + {{':-', Head, {',', Goal1, Goal2}}, Vn2}; +dcg_rule({'-->', H, B}, S0, S, Vn0) -> + Head = dcg_non_term(H, S0, S), + {Body, Vn1} = dcg_body(B, S0, S, Vn0), + {{':-', Head, Body}, Vn1}. + +dcg_non_term(A, S0, S) when is_atom(A) -> {A, S0, S}; +dcg_non_term(T, S0, S) when ?IS_FUNCTOR(T) -> + list_to_tuple(tuple_to_list(T) ++ [S0, S]); +dcg_non_term(Other, _, _) -> erlog_int:type_error(callable, Other). + +dcg_body({',', G0, B0}, S0, S, Vn0) -> + S1 = {Vn0}, + {G1, S2, Vn1} = dcg_goal(G0, S0, S1, Vn0 + 1), + {B1, Vn2} = dcg_body(B0, S2, S, Vn1), + {{',', G1, B1}, Vn2}; +dcg_body(G0, S0, S, Vn0) -> + case dcg_goal(G0, S0, S, Vn0) of + {G1, S, Vn1} -> {G1, Vn1}; %Already uses S + {G1, S1, Vn1} -> %So we get S! + %% io:format("~p\n", [{G1,S0,S1,S}]), + {{',', G1, {'=', S1, S}}, Vn1} + end. + +dcg_goal('!', S0, _, Vn) -> {'!', S0, Vn}; +dcg_goal({_} = V, S0, S, Vn) -> + {{phrase, V, S0, S}, S, Vn}; +dcg_goal({'{}', G}, S0, _, Vn) -> {G, S0, Vn}; +dcg_goal({',', L0, R0}, S0, S, Vn0) -> + S1 = {Vn0}, + {L1, S2, Vn1} = dcg_goal(L0, S0, S1, Vn0 + 1), + {R1, S3, Vn2} = dcg_goal(R0, S2, S, Vn1), + {{',', L1, R1}, S3, Vn2}; +dcg_goal({';', L0, R0}, S0, S, Vn0) -> + {L1, Vn1} = dcg_body(L0, S0, S, Vn0), + {R1, Vn2} = dcg_body(R0, S0, S, Vn1), + {{';', L1, R1}, S, Vn2}; +dcg_goal({'->', GRIf, GRThen}, S0, S, Vn0) -> + S1 = {Vn0}, + {If, S2, Vn1} = dcg_goal(GRIf, S0, S1, Vn0 + 1), + {Then, S3, Vn2} = dcg_goal(GRThen, S2, S, Vn1), + {{'->', If, Then}, S3, Vn2}; +dcg_goal({'\\+', G0}, S0, S, Vn) -> + {G1, _, _} = dcg_goal(G0, S0, S, Vn), + {{'\\+', G1}, S0, Vn}; +dcg_goal(Lits, S0, S, Vn0) when is_list(Lits) -> + {ELits, Vn1} = dcg_terminals(Lits, S0, S, Vn0), + {ELits, S, Vn1}; +dcg_goal(NonT, S0, S, Vn) -> + Goal = dcg_non_term(NonT, S0, S), + {Goal, S, Vn}. + +dcg_terminals(Lits, S0, S, Vn) -> %Without 'C'/3 + {{'=', S0, Lits ++ S}, Vn}. diff --git a/src/core/lang/erlog_parse.erl b/src/core/lang/erlog_parse.erl new file mode 100644 index 0000000..fcf47e6 --- /dev/null +++ b/src/core/lang/erlog_parse.erl @@ -0,0 +1,313 @@ +%% Copyright (c) 2008-2013 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : erlog_parse.erl +%% Author : Robert Virding +%% Purpose : Erlog parser +%% +%% Parses Erlog tokens into Erlog terms. Based on the Standard prolog +%% parser and directly coded from the parser description. To handle +%% back-tracking in the parser we use a continuation style using funs +%% where each fun handles one step of what follows. This allows +%% back-tracking. This may not be a specially efficient way of +%% parsing but it is simple and easy to derive from the +%%% description. No logical variables are necessary here. + +-module(erlog_parse). + +-export([term/1, term/2, format_error/1]). +-export([prefix_op/1, infix_op/1, postfix_op/1]). + +-compile({nowarn_unused_function, [type/1, line/1, val/1]}). +%% -compile(export_all). + +term(Toks) -> term(Toks, 1). + +term(Toks, _) -> + case term(Toks, 1200, fun(Ts, T) -> all_read(Ts, T) end) of + {succeed, Term} -> {ok, Term}; + {fail, {Line, Error}} -> {error, {Line, ?MODULE, Error}} + end. + +all_read([{'.', _}], Term) -> {succeed, Term}; +all_read([{T, L} | _], _) -> syntax_error(L, {operator_expected, T}); +all_read([{_, L, V} | _], _) -> syntax_error(L, {operator_expected, V}); +all_read([], _) -> syntax_error(9999, premature_end). + +syntax_error(Line, Error) -> {fail, {Line, Error}}. +%% syntax_error(Line, Error) -> +%% io:fwrite("se: ~p\n", [{Line,Error}]), {fail,{Line,Error}}. + +format_error(premature_end) -> "premature end"; +format_error({operator_expected, T}) -> + io_lib:fwrite("operator expected before: ~w", [T]); +format_error({illegal, T}) -> + io_lib:fwrite("illegal token: ~w", [T]); +format_error(no_term) -> "missing term"; +format_error({op_priority, Op}) -> + io_lib:fwrite("operator priority clash: ~w", [Op]); +format_error({expected, T}) -> + io_lib:fwrite("~w or operator expected", [T]). + +%% term(Tokens, Precedence, Next) -> {succeed,Term} | {fail,Error}. + +term([{number, _, N} | Toks], Prec, Next) -> rest_term(Toks, N, 0, Prec, Next); +term([{string, _, S} | Toks], Prec, Next) -> rest_term(Toks, S, 0, Prec, Next); +term([{'(', _} | Toks], Prec, Next) -> + bracket_term(Toks, Prec, Next); +term([{' (', _} | Toks], Prec, Next) -> + bracket_term(Toks, Prec, Next); +term([{'{', L}, {'}', _} | Toks], Prec, Next) -> + term([{atom, L, '{}'} | Toks], Prec, Next); +term([{'{', _} | Toks0], Prec, Next) -> + term(Toks0, 1200, + fun(Toks1, Term) -> + expect(Toks1, '}', Term, + fun(Toks2, Term1) -> + rest_term(Toks2, {'{}', Term1}, 0, Prec, Next) + end) + end); +term([{'[', _}, {']', _} | Toks], Prec, Next) -> + rest_term(Toks, [], 0, Prec, Next); +term([{'[', _} | Toks0], Prec, Next) -> + term(Toks0, 999, + fun(Toks1, E) -> + list_elems(Toks1, [E], + fun(Toks2, List) -> + rest_term(Toks2, List, 0, Prec, Next) + end) + end); +term([{var, _, V} | Toks], Prec, Next) -> rest_term(Toks, {V}, 0, Prec, Next); +term([{atom, _, F}, {'(', _} | Toks0], Prec, Next) -> + %% Compound term in functional syntax. + term(Toks0, 999, + fun(Toks1, A) -> + arg_list(Toks1, [A], + fun(Toks2, Args) -> + %% Equivalence of '.'/2 and lists. + Term = case {F, Args} of + {'.', [H, T]} -> [H | T]; + _ -> list_to_tuple([F | Args]) + end, + rest_term(Toks2, Term, 0, Prec, Next) + end) + end); +term([{atom, L, Op} | Toks0], Prec, Next) -> + case prefix_op(Op) of + {yes, OpP, ArgP} when Prec >= OpP -> + case possible_right_operand(Toks0) of + true -> + %% First try as prefix op, then as atom. + Next1 = fun(Toks1, Arg) -> + rest_term(Toks1, {Op, Arg}, OpP, Prec, Next) + end, + cp([fun() -> term(Toks0, ArgP, Next1) end, + fun() -> rest_term(Toks0, Op, 0, Prec, Next) end]); + false -> rest_term(Toks0, Op, 0, Prec, Next) + end; + {yes, _, _} -> + syntax_error(L, {op_priority, Op}); + no -> rest_term(Toks0, Op, 0, Prec, Next) + end; +term([{T, L} | _], _, _) -> syntax_error(L, {illegal, T}); +term([{_, L, V} | _], _, _) -> syntax_error(L, {illegal, V}); +term([], _, _) -> syntax_error(9999, no_term). + +%% possible_right_operand(Tokens) -> true | false. +%% Test if there maybe a possible right operand. + +possible_right_operand([{')', _} | _]) -> false; +possible_right_operand([{'}', _} | _]) -> false; +possible_right_operand([{']', _} | _]) -> false; +possible_right_operand([{',', _} | _]) -> false; +possible_right_operand([{'|', _} | _]) -> false; +possible_right_operand(_) -> true. + +%% bracket_term(Tokens, Precedence, Next) -> +%% {succeed,Term} | {fail,Error}. + +bracket_term(Toks0, Prec, Next) -> + term(Toks0, 1200, + fun(Toks1, Term) -> + expect(Toks1, ')', Term, + fun(Toks2, Term1) -> + rest_term(Toks2, Term1, 0, Prec, Next) + end) + end). + +%% rest_term(Tokens, Term, LeftPrec, Precedence, Next) -> +%% {succeed,Term} | {fail,Error}. +%% Have a term to the left, test if operator follows or just go on. + +rest_term([{atom, L, Op} | Toks0], Term, Left, Prec, Next) -> + cp([fun() -> infix_term(Op, L, Toks0, Term, Left, Prec, Next) end, + fun() -> postfix_term(Op, L, Toks0, Term, Left, Prec, Next) end, + fun() -> Next([{atom, L, Op} | Toks0], Term) end]); +rest_term([{',', L} | Toks0], Term, Left, Prec, Next) -> + %% , is an operator as well as a separator. + if Prec >= 1000, Left < 1000 -> + term(Toks0, 1000, + fun(Toks1, RArg) -> + rest_term(Toks1, {',', Term, RArg}, 1000, Prec, Next) + end); + true -> Next([{',', L} | Toks0], Term) + end; +rest_term(Toks, Term, _, _, Next) -> + Next(Toks, Term). + +%% infix_term(Operator, Line, Tokens, Term, LeftPrec, Prec, Next) -> +%% {succeed,Term} | {fail,Error}. +%% Test if infix operator of correct priority, fail with +%% operator_expected if not an operator to have some error. + +infix_term(Op, L, Toks0, Term, Left, Prec, Next) -> + case infix_op(Op) of + {yes, LAP, OpP, RAP} when Prec >= OpP, Left =< LAP -> + term(Toks0, RAP, + fun(Toks1, Arg2) -> + rest_term(Toks1, {Op, Term, Arg2}, OpP, Prec, Next) + end); + {yes, _, _, _} -> syntax_error(L, {op_priority, Op}); + no -> fail + end. + +%% postfix_term(Operator, Line, Tokens, Term, LeftPrec, Prec, Next) -> +%% {succeed,Term} | {fail,Error}. +%% Test if postfix operator of correct priority, fail with +%% operator_expected if not an operator to have some error. + +postfix_term(Op, L, Toks0, Term, Left, Prec, Next) -> + case postfix_op(Op) of + {yes, ArgP, OpP} when Prec >= OpP, Left =< ArgP -> + rest_term(Toks0, {Op, Term}, OpP, Prec, Next); + {yes, _, _} -> syntax_error(L, {op_priority, Op}); + no -> fail + end. + +%% list_elems(Tokens, RevElems, Next) -> +%% {succeed,Term} | {fail,Error}. + +list_elems([{',', _} | Toks0], REs, Next) -> + term(Toks0, 999, + fun(Toks1, E) -> + list_elems(Toks1, [E | REs], Next) + end); +list_elems([{'|', _} | Toks0], REs, Next) -> + term(Toks0, 999, + fun(Toks1, E) -> + expect(Toks1, ']', lists:reverse(REs, E), Next) + end); +list_elems(Toks, REs, Next) -> + expect(Toks, ']', lists:reverse(REs), Next). + +%% arg_list(Tokens, RevArgs, Next) -> {succeed,Term} | {fail,Error}. + +arg_list([{',', _} | Toks0], RAs, Next) -> + term(Toks0, 999, + fun(Toks1, Arg) -> + arg_list(Toks1, [Arg | RAs], Next) + end); +arg_list(Toks, RAs, Next) -> + expect(Toks, ')', lists:reverse(RAs), Next). + +%% expect(Tokens, TokenType, Term, Next) -> {succeed,Term} | {fail,Error}. + +expect([T | Toks], Tok, Term, Next) -> + case type(T) of + Tok -> Next(Toks, Term); + _ -> syntax_error(line(T), {expected, Tok}) + end; +expect([], Tok, _, _) -> syntax_error(9999, {expected, Tok}). + +%% cp(Choices) -> {succeed,Term} | {fail,_} | fail. +%% Special choice point handler for parser. If all clauses fail then +%% fail with first fail value, this usually gives better error report. + +cp([C | Cs]) -> + case C() of + {succeed, Res} -> {succeed, Res}; + {fail, _} = Fail -> cp(Cs, Fail); %Try rest with first fail + fail -> cp(Cs) %Stay till we get reason + end. + +cp([C | Cs], Fail) -> + case C() of + {succeed, Res} -> {succeed, Res}; + {fail, _} -> cp(Cs, Fail); %Drop this fail, use first + fail -> cp(Cs, Fail) + end; +cp([], Fail) -> Fail. + +%% type(Tok) -> Line. +%% line(Tok) -> Line. +%% val(Tok) -> Value. + +type(Tok) -> element(1, Tok). +line(Tok) -> element(2, Tok). +val(Tok) -> element(3, Tok). + +%% prefix_op(Op) -> {yes,Prec,ArgPrec} | no. + +prefix_op('?-') -> {yes, 1200, 1199}; %fx 1200 +prefix_op(':-') -> {yes, 1200, 1199}; %fx 1200 +prefix_op('\\+') -> {yes, 900, 900}; %fy 900 +prefix_op('+') -> {yes, 200, 200}; %fy 200 +prefix_op('-') -> {yes, 200, 200}; %fy 200 +prefix_op('\\') -> {yes, 200, 200}; %fy 200 +prefix_op(_Op) -> no. %The rest + +%% postfix_op(Op) -> {yes,ArgPrec,Prec} | no. + +postfix_op('+') -> {yes, 500, 500}; +postfix_op('*') -> {yes, 400, 400}; +postfix_op(_Op) -> no. + +%% infix_op(Op) -> {yes,LeftArgPrec,Prec,RightArgPrec} | no. + +infix_op(':-') -> {yes, 1199, 1200, 1199}; %xfx 1200 +infix_op('-->') -> {yes, 1199, 1200, 1199}; %xfx 1200 +infix_op(';') -> {yes, 1099, 1100, 1100}; %xfy 1100 +infix_op('->') -> {yes, 1049, 1050, 1050}; %xfy 1050 +infix_op(',') -> {yes, 999, 1000, 1000}; %xfy 1000 +infix_op('=') -> {yes, 699, 700, 699}; %xfx 700 +infix_op('\\=') -> {yes, 699, 700, 699}; %xfx 700 +infix_op('\\==') -> {yes, 699, 700, 699}; %xfx 700 +infix_op('==') -> {yes, 699, 700, 699}; %xfx 700 +infix_op('@<') -> {yes, 699, 700, 699}; %xfx 700 +infix_op('@=<') -> {yes, 699, 700, 699}; %xfx 700 +infix_op('@>') -> {yes, 699, 700, 699}; %xfx 700 +infix_op('@>=') -> {yes, 699, 700, 699}; %xfx 700 +infix_op('=..') -> {yes, 699, 700, 699}; %xfx 700 +infix_op('is') -> {yes, 699, 700, 699}; %xfx 700 +infix_op('=:=') -> {yes, 699, 700, 699}; %xfx 700 +infix_op('=\\=') -> {yes, 699, 700, 699}; %xfx 700 +infix_op('<') -> {yes, 699, 700, 699}; %xfx 700 +infix_op('=<') -> {yes, 699, 700, 699}; %xfx 700 +infix_op('>') -> {yes, 699, 700, 699}; %xfx 700 +infix_op('>=') -> {yes, 699, 700, 699}; %xfx 700 +infix_op(':') -> {yes, 599, 600, 600}; %xfy 600 +infix_op('+') -> {yes, 500, 500, 499}; %yfx 500 +infix_op('-') -> {yes, 500, 500, 499}; %yfx 500 +infix_op('/\\') -> {yes, 500, 500, 499}; %yfx 500 +infix_op('\\/') -> {yes, 500, 500, 499}; %yfx 500 +infix_op('*') -> {yes, 400, 400, 399}; %yfx 400 +infix_op('/') -> {yes, 400, 400, 399}; %yfx 400 +infix_op('//') -> {yes, 400, 400, 399}; %yfx 400 +infix_op('rem') -> {yes, 400, 400, 399}; %yfx 400 +infix_op('mod') -> {yes, 400, 400, 399}; %yfx 400 +infix_op('<<') -> {yes, 400, 400, 399}; %yfx 400 +infix_op('>>') -> {yes, 400, 400, 399}; %yfx 400 +infix_op('**') -> {yes, 199, 200, 199}; %xfx 200 +infix_op('^') -> {yes, 199, 200, 200}; %xfy 200 +infix_op(_Op) -> no. diff --git a/src/erlog.erl b/src/erlog.erl deleted file mode 100644 index 361cae9..0000000 --- a/src/erlog.erl +++ /dev/null @@ -1,209 +0,0 @@ -%% Copyright (c) 2008-2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - -%% File : erlog.erl -%% Author : Robert Virding -%% Purpose : Main interface to the Erlog interpreter. -%% -%% Structures - {Functor,arg1, Arg2,...} where Functor is an atom -%% Variables - {Name} where Name is an atom or integer -%% Lists - Erlang lists -%% Atomic - Erlang constants -%% -%% There is no problem with the representation of variables as Prolog -%% functors of arity 0 are atoms. This representation is much easier -%% to test for, and create new variables with than using funny atom -%% names like '$1' (yuch!), and we need LOTS of variables. - --module(erlog). - --include("erlog_int.hrl"). - -%% Basic evaluator interface. --export([new/0]). -%% Interface to server. --export([start/0,start_link/0]). --export([prove/2,next_solution/1, - consult/2,reconsult/2,get_db/1,set_db/2,halt/1]). --export([init/1,handle_call/3,handle_cast/2,handle_info/2,terminate/2, - code_change/3]). -%% User utilities. --export([is_legal_term/1,vars_in/1]). - --import(lists, [foldl/3,foreach/2]). - --behaviour(gen_server). --vsn('0.6'). - -%% -compile(export_all). - -%% new() -> erlog(). -%% Define an Erlog instance. This is a fun which is called with the -%% top-level command and returns the result and the continutation in -%% a new fun. - -new() -> - Db0 = erlog_int:built_in_db(), %Basic interpreter predicates - Db1 = foldl(fun (Mod, Db) -> Mod:load(Db) end, Db0, - [erlog_bips, %Built in predicates - erlog_dcg, %DCG predicates - erlog_lists %Common lists library - ]), - fun (Cmd) -> top_cmd(Cmd, Db1) end. - -top_cmd({prove,Goal}, Db) -> - prove_goal(Goal, Db); -top_cmd(next_solution, Db) -> - {fail,fun (Cmd) -> top_cmd(Cmd, Db) end}; -top_cmd({consult,File}, Db0) -> - case erlog_file:consult(File, Db0) of - {ok,Db1} -> {ok,fun (Cmd) -> top_cmd(Cmd, Db1) end}; - {erlog_error,Error} -> - {{error,Error},fun (Cmd) -> top_cmd(Cmd, Db0) end}; - {error,Error} -> - {{error,Error},fun (Cmd) -> top_cmd(Cmd, Db0) end} - end; -top_cmd({reconsult,File}, Db0) -> - case erlog_file:reconsult(File, Db0) of - {ok,Db1} -> {ok,fun (Cmd) -> top_cmd(Cmd, Db1) end}; - {erlog_error,Error} -> - {{error,Error},fun (Cmd) -> top_cmd(Cmd, Db0) end}; - {error,Error} -> - {{error,Error},fun (Cmd) -> top_cmd(Cmd, Db0) end} - end; -top_cmd(get_db, Db) -> - {{ok,Db},fun (Cmd) -> top_cmd(Cmd, Db) end}; -top_cmd({set_db,NewDb}, _Db) -> - {ok,fun (Cmd) -> top_cmd(Cmd, NewDb) end}; -top_cmd(halt, _Db) -> ok. - -prove_goal(Goal0, Db) -> - Vs = vars_in(Goal0), - %% Goal may be a list of goals, ensure proper goal. - Goal1 = unlistify(Goal0), - %% Must use 'catch' here as 'try' does not do last-call - %% optimisation. - prove_result(catch erlog_int:prove_goal(Goal1, Db), Vs, Db). - -unlistify([G]) -> G; -unlistify([G|Gs]) -> {',',G,unlistify(Gs)}; -unlistify([]) -> true; -unlistify(G) -> G. %In case it wasn't a list. - -prove_result({succeed,Cps,Bs,Vn,Db1}, Vs, _Db0) -> - {{succeed,erlog_int:dderef(Vs, Bs)}, - fun (Cmd) -> prove_cmd(Cmd, Vs, Cps, Bs, Vn, Db1) end}; -prove_result({fail,Db1}, _Vs, _Db0) -> - {fail,fun (Cmd) -> top_cmd(Cmd, Db1) end}; -prove_result({erlog_error,Error,Db1}, _Vs, _Db0) -> - {{error,Error},fun (Cmd) -> top_cmd(Cmd, Db1) end}; -prove_result({erlog_error,Error}, _Vs, Db) -> %No new database - {{error,Error},fun (Cmd) -> top_cmd(Cmd, Db) end}; -prove_result({'EXIT',Error}, _Vs, Db) -> - {{'EXIT',Error},fun (Cmd) -> top_cmd(Cmd, Db) end}. - -prove_cmd(next_solution, Vs, Cps, _Bs, _Vn, Db) -> - prove_result(catch erlog_int:fail(Cps, Db), Vs, Db); -prove_cmd(Cmd, _Vs, _Cps, _Bs, _Vn, Db) -> - top_cmd(Cmd, Db). - -%% prove(Erlog, Goal) -> {succeed,Bindings} | fail. -%% next_solution(Erlog) -> {succeed,Bindings} | fail. -%% consult(Erlog, File) -> ok | {error,Error}. -%% reconsult(Erlog, File) -> ok | {error,Error}. -%% get_db(Erlog) -> {ok,Database}. -%% set_db(Erlog, Database) -> ok. -%% halt(Erlog) -> ok. -%% Interface functions to server. - -prove(Erl, Goal) when is_list(Goal) -> - {ok, TS, _ } = erlog_scan:string(Goal ++ " "), - {ok, G} = erlog_parse:term(TS), - prove(Erl, G); -prove(Erl, Goal) -> gen_server:call(Erl, {prove,Goal}, infinity). - -next_solution(Erl) -> gen_server:call(Erl, next_solution, infinity). - -consult(Erl, File) -> gen_server:call(Erl, {consult,File}, infinity). - -reconsult(Erl, File) -> gen_server:call(Erl, {reconsult,File}, infinity). - -get_db(Erl) -> gen_server:call(Erl, get_db, infinity). - -set_db(Erl, Db) -> gen_server:call(Erl, {set_db,Db}, infinity). - -halt(Erl) -> gen_server:cast(Erl, halt). - -%% Erlang server code. --record(state, {erlog}). %Erlog state - -start() -> - gen_server:start(?MODULE, [], []). - -start_link() -> - gen_server:start_link(?MODULE, [], []). - -init(_) -> - {ok,#state{erlog=new()}}. - -handle_call(Req, _, St) -> - {Res,Erl} = (St#state.erlog)(Req), - {reply,Res,St#state{erlog=Erl}}. - -handle_cast(halt, St) -> - {stop,normal,St}. - -handle_info(_, St) -> - {noreply,St}. - -terminate(_, St) -> - (St#state.erlog)(halt). - -code_change(_, _, St) -> {ok,St}. - -%% vars_in(Term) -> [{Name,Var}]. -%% Returns an ordered list of {VarName,Variable} pairs. - -vars_in(Term) -> vars_in(Term, orddict:new()). - -vars_in({'_'}, Vs) -> Vs; %Never in! -vars_in({Name}=Var, Vs) -> orddict:store(Name, Var, Vs); -vars_in(Struct, Vs) when is_tuple(Struct) -> - vars_in_struct(Struct, 2, size(Struct), Vs); -vars_in([H|T], Vs) -> - vars_in(T, vars_in(H, Vs)); -vars_in(_, Vs) -> Vs. - -vars_in_struct(_Str, I, S, Vs) when I > S -> Vs; -vars_in_struct(Str, I, S, Vs) -> - vars_in_struct(Str, I+1, S, vars_in(element(I, Str), Vs)). - -%% is_legal_term(Goal) -> true | false. -%% Test if a goal is a legal Erlog term. Basically just check if -%% tuples are used correctly as structures and variables. - -is_legal_term({V}) -> is_atom(V); -is_legal_term([H|T]) -> - is_legal_term(H) andalso is_legal_term(T); -is_legal_term(T) when is_tuple(T) -> - if tuple_size(T) >= 2, is_atom(element(1, T)) -> - are_legal_args(T, 2, size(T)); %The right tuples. - true -> false - end; -is_legal_term(T) when ?IS_ATOMIC(T) -> true; %All constants, including [] -is_legal_term(_T) -> false. - -are_legal_args(_T, I, S) when I > S -> true; -are_legal_args(T, I, S) -> - is_legal_term(element(I, T)) andalso are_legal_args(T, I+1, S). diff --git a/src/erlog_bips.erl b/src/erlog_bips.erl deleted file mode 100644 index d5bf00e..0000000 --- a/src/erlog_bips.erl +++ /dev/null @@ -1,382 +0,0 @@ -%% Copyright (c) 2008-2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - -%% File : erlog_bips.erl -%% Author : Robert Virding -%% Purpose : Built-in predicates of Erlog interpreter. -%% -%% These are the built-in predicates of the Prolog interpreter which -%% are not control predicates or database predicates. - --module(erlog_bips). - --include("erlog_int.hrl"). - -%% Main interface functions. --export([load/1]). --export([prove_goal/6]). - -%%-compile(export_all). - --import(lists, [map/2,foldl/3]). - -%% We use these a lot so we import them for cleaner code. --import(erlog_int, [prove_body/5,unify_prove_body/7,unify_prove_body/9,fail/2, - add_binding/3,make_vars/2, - deref/2,dderef/2,dderef_list/2,unify/3, - term_instance/2, - add_built_in/2,add_compiled_proc/4, - asserta_clause/2,assertz_clause/2]). - -%% load(Database) -> Database. -%% Assert predicates into the database. - -load(Db0) -> - foldl(fun (Head, Db) -> add_built_in(Head, Db) end, Db0, - [ - %% Term unification and comparison - {'=',2}, - {'\\=',2}, - {'@>',2}, - {'@>=',2}, - {'==',2}, - {'\\==',2}, - {'@<',2}, - {'@=<',2}, - %% Term creation and decomposition. - {arg,3}, - {copy_term,2}, - {functor,3}, - {'=..',2}, - %% Type testing. - {atom,1}, - {atomic,1}, - {compound,1}, - {integer,1}, - {float,1}, - {number,1}, - {nonvar,1}, - {var,1}, - %% Atom processing. - {atom_chars,2}, - {atom_length,2}, - %% Arithmetic evaluation and comparison - {'is',2}, - {'>',2}, - {'>=',2}, - {'=:=',2}, - {'=\\=',2}, - {'<',2}, - {'=<',2} - ]). - -%% prove_goal(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> -%% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase} | -%% {fail,NewDatabase}. -%% Prove one goal. We seldom return succeed here but usually go directly to -%% to NextGoal. - -%% Term unification and comparison -prove_goal({'=',L,R}, Next, Cps, Bs, Vn, Db) -> - unify_prove_body(L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'\\=',L,R}, Next, Cps, Bs0, Vn, Db) -> - case unify(L, R, Bs0) of - {succeed,_Bs1} -> fail(Cps, Db); - fail -> prove_body(Next, Cps, Bs0, Vn, Db) - end; -prove_goal({'@>',L,R}, Next, Cps, Bs, Vn, Db) -> - term_test_prove_body('>', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'@>=',L,R}, Next, Cps, Bs, Vn, Db) -> - term_test_prove_body('>=', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'==',L,R}, Next, Cps, Bs, Vn, Db) -> - term_test_prove_body('==', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'\\==',L,R}, Next, Cps, Bs, Vn, Db) -> - term_test_prove_body('/=', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'@<',L,R}, Next, Cps, Bs, Vn, Db) -> - term_test_prove_body('<', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'@=<',L,R}, Next, Cps, Bs, Vn, Db) -> - term_test_prove_body('=<', L, R, Next, Cps, Bs, Vn, Db); -%% Term creation and decomposition. -prove_goal({arg,I,Ct,A}, Next, Cps, Bs, Vn, Db) -> - prove_arg(deref(I, Bs), deref(Ct, Bs), A, Next, Cps, Bs, Vn, Db); -prove_goal({copy_term,T0,C}, Next, Cps, Bs, Vn0, Db) -> - %% Use term_instance to create the copy, can ignore orddict it creates. - {T,_Nbs,Vn1} = term_instance(dderef(T0, Bs), Vn0), - unify_prove_body(T, C, Next, Cps, Bs, Vn1, Db); -prove_goal({functor,T,F,A}, Next, Cps, Bs, Vn, Db) -> - prove_functor(dderef(T, Bs), F, A, Next, Cps, Bs, Vn, Db); -prove_goal({'=..',T,L}, Next, Cps, Bs, Vn, Db) -> - prove_univ(dderef(T, Bs), L, Next, Cps, Bs, Vn, Db); -%% Type testing. -prove_goal({atom,T0}, Next, Cps, Bs, Vn, Db) -> - case deref(T0, Bs) of - T when is_atom(T) -> prove_body(Next, Cps, Bs, Vn, Db); - _Other -> fail(Cps, Db) - end; -prove_goal({atomic,T0}, Next, Cps, Bs, Vn, Db) -> - case deref(T0, Bs) of - T when ?IS_ATOMIC(T) -> prove_body(Next, Cps, Bs, Vn, Db); - _Other -> fail(Cps, Db) - end; -prove_goal({compound,T0}, Next, Cps, Bs, Vn, Db) -> - case deref(T0, Bs) of - T when ?IS_ATOMIC(T) -> fail(Cps, Db); - _Other -> prove_body(Next, Cps, Bs, Vn, Db) - end; -prove_goal({integer,T0}, Next, Cps, Bs, Vn, Db) -> - case deref(T0, Bs) of - T when is_integer(T) -> prove_body(Next, Cps, Bs, Vn, Db); - _Other -> fail(Cps, Db) - end; -prove_goal({float,T0}, Next, Cps, Bs, Vn, Db) -> - case deref(T0, Bs) of - T when is_float(T) -> prove_body(Next, Cps, Bs, Vn, Db); - _Other -> fail(Cps, Db) - end; -prove_goal({number,T0}, Next, Cps, Bs, Vn, Db) -> - case deref(T0, Bs) of - T when is_number(T) -> prove_body(Next, Cps, Bs, Vn, Db); - _Other -> fail(Cps, Db) - end; -prove_goal({nonvar,T0}, Next, Cps, Bs, Vn, Db) -> - case deref(T0, Bs) of - {_} -> fail(Cps, Db); - _Other -> prove_body(Next, Cps, Bs, Vn, Db) - end; -prove_goal({var,T0}, Next, Cps, Bs, Vn, Db) -> - case deref(T0, Bs) of - {_} -> prove_body(Next, Cps, Bs, Vn, Db); - _Other -> fail(Cps, Db) - end; -%% Atom processing. -prove_goal({atom_chars,A,L}, Next, Cps, Bs, Vn, Db) -> - prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db); -prove_goal({atom_length,A0,L0}, Next, Cps, Bs, Vn, Db) -> - case dderef(A0, Bs) of - A when is_atom(A) -> - Alen = length(atom_to_list(A)), %No of chars in atom - case dderef(L0, Bs) of - L when is_integer(L) -> - unify_prove_body (Alen, L, Next, Cps, Bs, Vn, Db); - {_}=Var -> - unify_prove_body (Alen, Var, Next, Cps, Bs, Vn, Db); - Other -> erlog_int:type_error(integer, Other, Db) - end; - {_} -> erlog_int:instantiation_error(Db); - Other -> erlog_int:type_error(atom, Other, Db) - end; -%% Arithmetic evalution and comparison. -prove_goal({is,N,E0}, Next, Cps, Bs, Vn, Db) -> - E = eval_arith(deref(E0, Bs), Bs, Db), - unify_prove_body(N, E, Next, Cps, Bs, Vn, Db); -prove_goal({'>',L,R}, Next, Cps, Bs, Vn, Db) -> - arith_test_prove_body('>', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'>=',L,R}, Next, Cps, Bs, Vn, Db) -> - arith_test_prove_body('>=', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'=:=',L,R}, Next, Cps, Bs, Vn, Db) -> - arith_test_prove_body('==', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'=\\=',L,R}, Next, Cps, Bs, Vn, Db) -> - arith_test_prove_body('/=', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'<',L,R}, Next, Cps, Bs, Vn, Db) -> - arith_test_prove_body('<', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'=<',L,R}, Next, Cps, Bs, Vn, Db) -> - arith_test_prove_body('=<', L, R, Next, Cps, Bs, Vn, Db). - -%% term_test_prove_body(Test, Left, Right, Next, ChoicePoints, Bindings, Varnum, Database) -> -%% void. - -term_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db) -> - case erlang:Test(dderef(L, Bs), dderef(R, Bs)) of - true -> prove_body(Next, Cps, Bs, Vn, Db); - false -> fail(Cps, Db) - end. - -%% prove_arg(Index, Term, Arg, Next, ChoicePoints, VarNum, Database) -> void. -%% Prove the goal arg(I, Ct, Arg), Index and Term have been dereferenced. - -prove_arg(I, [H|T], A, Next, Cps, Bs, Vn, Db) when is_integer(I) -> - %% He, he, he! - if I == 1 -> unify_prove_body(H, A, Next, Cps, Bs, Vn, Db); - I == 2 -> unify_prove_body(T, A, Next, Cps, Bs, Vn, Db); - true -> {fail,Db} - end; -prove_arg(I, Ct, A, Next, Cps, Bs, Vn, Db) - when is_integer(I), tuple_size(Ct) >= 2 -> - if I > 1, I + 1 =< tuple_size(Ct) -> - unify_prove_body(element(I+1, Ct), A, Next, Cps, Bs, Vn, Db); - true -> {fail,Db} - end; -prove_arg(I, Ct, _, _, _, _, _, Db) -> - %%Type failure just generates an error. - if not(is_integer(I)) -> erlog_int:type_error(integer, I, Db); - true -> erlog_int:type_error(compound, Ct, Db) - end. - -%% prove_functor(Term, Functor, Arity, Next, ChoicePoints, Bindings, VarNum, Database) -> void. -%% Prove the call functor(T, F, A), Term has been dereferenced. - -prove_functor(T, F, A, Next, Cps, Bs, Vn, Db) when tuple_size(T) >= 2 -> - unify_prove_body(F, element(1, T), A, tuple_size(T)-1, Next, Cps, Bs, Vn, Db); -prove_functor(T, F, A, Next, Cps, Bs, Vn, Db) when ?IS_ATOMIC(T) -> - unify_prove_body(F, T, A, 0, Next, Cps, Bs, Vn, Db); -prove_functor([_|_], F, A, Next, Cps, Bs, Vn, Db) -> - %% Just the top level here. - unify_prove_body(F, '.', A, 2, Next, Cps, Bs, Vn, Db); -prove_functor({_}=Var, F0, A0, Next, Cps, Bs0, Vn0, Db) -> - case {dderef(F0, Bs0),dderef(A0, Bs0)} of - {'.',2} -> %He, he, he! - Bs1 = add_binding(Var, [{Vn0}|{Vn0+1}], Bs0), - prove_body(Next, Cps, Bs1, Vn0+2, Db); - {F1,0} when ?IS_ATOMIC(F1) -> - Bs1 = add_binding(Var, F1, Bs0), - prove_body(Next, Cps, Bs1, Vn0, Db); - {F1,A1} when is_atom(F1), is_integer(A1), A1 > 0 -> - As = make_vars(A1, Vn0), - Bs1 = add_binding(Var, list_to_tuple([F1|As]), Bs0), - prove_body(Next, Cps, Bs1, Vn0+A1, Db); %!!! - %% Now the error cases. - {{_},_} -> erlog_int:instantiation_error(Db); - {F1,A1} when is_atom(F1) -> erlog_int:type_error(integer, A1, Db); - {F1,_} -> erlog_int:type_error(atom, F1, Db) - end. - -%% prove_univ(Term, List, Next, ChoicePoints, Bindings, VarNum, Database) -> void. -%% Prove the goal Term =.. List, Term has already been dereferenced. - -prove_univ(T, L, Next, Cps, Bs, Vn, Db) when tuple_size(T) >= 2 -> - Es = tuple_to_list(T), - unify_prove_body(Es, L, Next, Cps, Bs, Vn, Db); -prove_univ(T, L, Next, Cps, Bs, Vn, Db) when ?IS_ATOMIC(T) -> - unify_prove_body([T], L, Next, Cps, Bs, Vn, Db); -prove_univ([Lh|Lt], L, Next, Cps, Bs, Vn, Db) -> - %% He, he, he! - unify_prove_body(['.',Lh,Lt], L, Next, Cps, Bs, Vn, Db); -prove_univ({_}=Var, L, Next, Cps, Bs0, Vn, Db) -> - case dderef(L, Bs0) of - ['.',Lh,Lt] -> %He, he, he! - Bs1 = add_binding(Var, [Lh|Lt], Bs0), - prove_body(Next, Cps, Bs1, Vn, Db); - [A] when ?IS_ATOMIC(A) -> - Bs1 = add_binding(Var, A, Bs0), - prove_body(Next, Cps, Bs1, Vn, Db); - [F|As] when is_atom(F), length(As) > 0 -> - Bs1 = add_binding(Var, list_to_tuple([F|As]), Bs0), - prove_body(Next, Cps, Bs1, Vn, Db); - %% Now the error cases. - [{_}|_] -> erlog_int:instantiation_error(Db); - {_} -> erlog_int:instantiation_error(Db); - Other -> erlog_int:type_error(list, Other, Db) -end. - -%% prove_atom_chars(Atom, List, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Prove the atom_chars(Atom, List). - -prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db) -> - %% After a suggestion by Sean Cribbs. - case dderef(A, Bs) of - Atom when is_atom(Atom) -> - AtomList = [ list_to_atom([C]) || C <- atom_to_list(Atom) ], - unify_prove_body(L, AtomList, Next, Cps, Bs, Vn, Db); - {_}=Var -> - %% Error #3: List is neither a list nor a partial list. - %% Handled in dderef_list/2. - List = dderef_list(L, Bs), - %% Error #1, #4: List is a list or partial list with an - %% element which is a variable or not one char atom. - Fun = fun ({_}) -> erlog_int:instantiation_error(Db); - (Atom) -> - case is_atom(Atom) andalso atom_to_list(Atom) of - [C] -> C; - _ -> erlog_int:type_error(character, Atom, Db) - end - end, - Chars = lists:map(Fun, List), - Atom = list_to_atom(Chars), - unify_prove_body(Var, Atom, Next, Cps, Bs, Vn, Db); - Other -> - %% Error #2: Atom is neither a variable nor an atom - erlog_int:type_error(atom, Other, Db) - end. - -%% arith_test_prove_body(Test, Left, Right, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. - -arith_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db) -> - case erlang:Test(eval_arith(deref(L, Bs), Bs, Db), - eval_arith(deref(R, Bs), Bs, Db)) of - true -> prove_body(Next, Cps, Bs, Vn, Db); - false -> fail(Cps, Db) - end. - -%% eval_arith(ArithExpr, Bindings, Database) -> Number. -%% Evaluate an arithmetic expression, include the database for -%% errors. Dereference each level as we go, might fail so save some -%% work. Must be called deferenced. - -eval_arith({'+',A,B}, Bs, Db) -> - eval_arith(deref(A, Bs), Bs, Db) + eval_arith(deref(B, Bs), Bs, Db); -eval_arith({'-',A,B}, Bs, Db) -> - eval_arith(deref(A, Bs), Bs, Db) - eval_arith(deref(B, Bs), Bs, Db); -eval_arith({'*',A,B}, Bs, Db) -> - eval_arith(deref(A, Bs), Bs, Db) * eval_arith(deref(B, Bs), Bs, Db); -eval_arith({'/',A,B}, Bs, Db) -> - eval_arith(deref(A, Bs), Bs, Db) / eval_arith(deref(B, Bs), Bs, Db); -eval_arith({'**',A,B}, Bs, Db) -> - math:pow(eval_arith(deref(A, Bs), Bs, Db), - eval_arith(deref(B, Bs), Bs, Db)); -eval_arith({'//',A,B}, Bs, Db) -> - eval_int(deref(A, Bs), Bs, Db) div eval_int(deref(B, Bs), Bs, Db); -eval_arith({'mod',A,B}, Bs, Db) -> - eval_int(deref(A, Bs), Bs, Db) rem eval_int(deref(B, Bs), Bs, Db); -eval_arith({'/\\',A,B}, Bs, Db) -> - eval_int(deref(A, Bs), Bs, Db) band eval_int(deref(B, Bs), Bs, Db); -eval_arith({'\\/',A,B}, Bs, Db) -> - eval_int(deref(A, Bs), Bs, Db) bor eval_int(deref(B, Bs), Bs, Db); -eval_arith({'<<',A,B}, Bs, Db) -> - eval_int(deref(A, Bs), Bs, Db) bsl eval_int(deref(B, Bs), Bs, Db); -eval_arith({'>>',A,B}, Bs, Db) -> - eval_int(deref(A, Bs), Bs, Db) bsr eval_int(deref(B, Bs), Bs, Db); -eval_arith({'\\',A}, Bs, Db) -> - bnot eval_int(deref(A, Bs), Bs, Db); -eval_arith({'+',A}, Bs, Db) -> - + eval_arith(deref(A, Bs), Bs, Db); -eval_arith({'-',A}, Bs, Db) -> - - eval_arith(deref(A, Bs), Bs, Db); -eval_arith({'abs',A}, Bs, Db) -> - abs(eval_arith(deref(A, Bs), Bs, Db)); -eval_arith({'float',A}, Bs, Db) -> - float(eval_arith(deref(A, Bs), Bs, Db)); -eval_arith({'truncate',A}, Bs, Db) -> - trunc(eval_arith(deref(A, Bs), Bs, Db)); -eval_arith(N, _Bs, _Db) when is_number(N) -> N; %Just a number -%% Error cases. -eval_arith({_}, _Bs, Db) -> erlog_int:instantiation_error(Db); -eval_arith(N, _Bs, Db) when is_tuple(N) -> - Pi = pred_ind(element(1, N), tuple_size(N)-1), - erlog_int:type_error(evaluable, Pi, Db); -eval_arith([_|_], _Bs, Db) -> - erlog_int:type_error(evaluable, pred_ind('.', 2), Db); -eval_arith(O, _Bs, Db) -> erlog_int:type_error(evaluable, O, Db). - -%% eval_int(IntegerExpr, Bindings, Database) -> Integer. -%% Evaluate an integer expression, include the database for errors. - -eval_int(E0, Bs, Db) -> - E = eval_arith(E0, Bs, Db), - if is_integer(E) -> E; - true -> erlog_int:type_error(integer, E, Db) - end. - -pred_ind(N, A) -> {'/',N,A}. diff --git a/src/erlog_dcg.erl b/src/erlog_dcg.erl deleted file mode 100644 index 6253c9d..0000000 --- a/src/erlog_dcg.erl +++ /dev/null @@ -1,167 +0,0 @@ -%% Copyright (c) 2008-2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - -%% File : erlog_dcg.erl -%% Author : Robert Virding -%% Purpose : DCG conversion and procedures. - --module(erlog_dcg). - --include("erlog_int.hrl"). - --export([expand_term/1,expand_term/2]). --export([expand_term_2/6,phrase_3/6]). --export([load/1]). - --import(lists, [foldl/3]). - -%% We use these a lot so we import them for cleaner code. --import(erlog_int, [prove_body/5,unify_prove_body/7,unify_prove_body/9,fail/2, - add_binding/3,make_vars/2, - deref/2,dderef/2,dderef_list/2,unify/3, - term_instance/2, - add_built_in/2,add_compiled_proc/4, - asserta_clause/2,assertz_clause/2]). - -load(Db0) -> - %% Compiled DCG predicates. - Db1 = foldl(fun ({Head,M,F}, Db) -> add_compiled_proc(Head, M, F, Db) end, - Db0, - [ - {{expand_term,2},erlog_dcg,expand_term_2}, - {{phrase,3},erlog_dcg,phrase_3} - ]), - %% Interpreted DCG predicates. - foldl(fun (Clause, Db) -> assertz_clause(Clause, Db) end, Db1, - [ - %% 'C'([H|T], H, T). - %% {'C',[{1}|{2}],{1},{2}}, %For DCGs - %% phrase(V, L) :- phrase(V, L, []). - {':-',{phrase,{1},{2}},{phrase,{1},{2},[]}} - %% phrase(V, L, R) :- - %% V =.. Z, append(Z, [L,R], G), C =.. G, C. - %% {':-',{phrase,{1},{2},{3}}, - %% {',',{'=..',{1},{4}},{',',{append,{4},[{2},{3}],{5}}, - %% {',',{'=..',{6},{5}},{6}}}}} - ]). - -%% expand_term_2(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> -%% void -%% Call the expand_term/2 predicate. - -expand_term_2(Goal, Next, Cps, Bs, Vn0, Db) -> - {expand_term,DCGRule,A2} = dderef(Goal, Bs), - {Exp,Vn1} = expand_term(DCGRule, Vn0), - unify_prove_body(A2, Exp, Next, Cps, Bs, Vn1, Db). - -%% phrase_3(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> void. -%% Call the phrase/3 preidicate. We could easily do this in prolog -%% except for that it calls dcg_body/4 which is not exported. -%% -%% phrase(GRBody, S0, S) -> dcg_body(GRBody, S0, S, Goal), call(Goal). - -phrase_3(Goal, Next0, Cps, Bs, Vn0, Db) -> - {phrase,GRBody,S0,S} = dderef(Goal, Bs), - {Body,Vn1} = dcg_body(GRBody, S0, S, Vn0), - %% io:format("~p\n", [Body]), - Next1 = [{call,Body}|Next0], %Evaluate body - prove_body(Next1, Cps, Bs, Vn1, Db). - -%% expand_term(Term) -> {ExpTerm}. -%% expand_term(Term, VarNum) -> {ExpTerm,NewVarNum}. -%% Handle DCG expansion. We do NOT work backwards. - -expand_term(Term) -> - {Exp,_} = expand_term(Term, 0), - Exp. - -expand_term({'-->',_,_}=Term, Vn) -> - dcg_rule(Term, Vn); -expand_term(Term, Vn) -> {Term,Vn}. - -%% dcg_rule(Term, VarNum) -> {ExpTerm,NewVarNum}. -%% dcg_rule(DCGRule, VarIn, VarOout, VarNum) -> {ExpTerm,NewVarNum}. -%% dcg_non_term(NonTerminal, VarIn, VarOut) -> ExpTerm. -%% dcg_body(BodyTerm, VarIn, VarOut, VarNum) -> {ExpBody,NewVarOut,NewVarNum}. -%% dcg_goal(BodyGoal, VarIn, VarOut, VarNum) -> {ExpGaol,NewVarOut,NewVarNum}. -%% dcg_terminal(Terminals, VarIn, VarOut, VarNum) -> -%% {ExpTerms,NewVarOut,NewVarNum}. -%% dcg_body and dcg_goal do smae the thing except the dcg_body -%% guarantees the output variable is the one we specify. It may -%% insert an explicit '=' to get this. - -dcg_rule(DCGRule, Vn0) -> - S0 = {Vn0}, - S = {Vn0+1}, - dcg_rule(DCGRule, S0, S, Vn0+2). - -dcg_rule({'-->',{',',H,RHC},B}, S0, S, Vn0) -> - S1 = {Vn0}, - Head = dcg_non_term(H, S0, S), - {Goal1,S2,Vn1} = dcg_goal(B, S0, S1, Vn0+1), - {Goal2,Vn2} = dcg_terminals(RHC, S, S2, Vn1), - {{':-',Head,{',',Goal1,Goal2}},Vn2}; -dcg_rule({'-->',H,B}, S0, S, Vn0) -> - Head = dcg_non_term(H, S0, S), - {Body,Vn1} = dcg_body(B, S0, S, Vn0), - {{':-',Head,Body},Vn1}. - -dcg_non_term(A, S0, S) when is_atom(A) -> {A,S0,S}; -dcg_non_term(T, S0, S) when ?IS_FUNCTOR(T) -> - list_to_tuple(tuple_to_list(T) ++ [S0,S]); -dcg_non_term(Other, _, _) -> erlog_int:type_error(callable, Other). - -dcg_body({',',G0,B0}, S0, S, Vn0) -> - S1 = {Vn0}, - {G1,S2,Vn1} = dcg_goal(G0, S0, S1, Vn0+1), - {B1,Vn2} = dcg_body(B0, S2, S, Vn1), - {{',',G1,B1},Vn2}; -dcg_body(G0, S0, S, Vn0) -> - case dcg_goal(G0, S0, S, Vn0) of - {G1,S,Vn1} -> {G1,Vn1}; %Already uses S - {G1,S1,Vn1} -> %So we get S! - %% io:format("~p\n", [{G1,S0,S1,S}]), - {{',',G1,{'=',S1,S}},Vn1} - end. - -dcg_goal('!', S0, _, Vn) -> {'!',S0,Vn}; -dcg_goal({_}=V, S0, S, Vn) -> - {{phrase,V,S0,S},S,Vn}; -dcg_goal({'{}',G}, S0, _, Vn) -> {G,S0,Vn}; -dcg_goal({',',L0,R0}, S0, S, Vn0) -> - S1 = {Vn0}, - {L1,S2,Vn1} = dcg_goal(L0, S0, S1, Vn0+1), - {R1,S3,Vn2} = dcg_goal(R0, S2, S, Vn1), - {{',',L1,R1},S3,Vn2}; -dcg_goal({';',L0,R0}, S0, S, Vn0) -> - {L1,Vn1} = dcg_body(L0, S0, S, Vn0), - {R1,Vn2} = dcg_body(R0, S0, S, Vn1), - {{';',L1,R1},S,Vn2}; -dcg_goal({'->',GRIf,GRThen}, S0, S, Vn0) -> - S1 = {Vn0}, - {If,S2,Vn1} = dcg_goal(GRIf, S0, S1, Vn0+1), - {Then,S3,Vn2} = dcg_goal(GRThen, S2, S, Vn1), - {{'->',If,Then},S3,Vn2}; -dcg_goal({'\\+',G0}, S0, S, Vn) -> - {G1,_,_} = dcg_goal(G0, S0, S, Vn), - {{'\\+',G1},S0,Vn}; -dcg_goal(Lits, S0, S, Vn0) when is_list(Lits) -> - {ELits,Vn1} = dcg_terminals(Lits, S0, S, Vn0), - {ELits,S,Vn1}; -dcg_goal(NonT, S0, S, Vn) -> - Goal = dcg_non_term(NonT, S0, S), - {Goal,S,Vn}. - -dcg_terminals(Lits, S0, S, Vn) -> %Without 'C'/3 - {{'=',S0,Lits ++ S},Vn}. diff --git a/src/erlog_demo.erl b/src/erlog_demo.erl index ad3c1d6..5fba472 100644 --- a/src/erlog_demo.erl +++ b/src/erlog_demo.erl @@ -18,7 +18,7 @@ -module(erlog_demo). --export([efunc/1,ets_keys/1,get_list/1]). +-export([efunc/1, ets_keys/1, get_list/1]). %% efunc(Fcall) -> {succeed_last,Val}. %% ets_keys(Table) -> {succeed,Val,Cont} | {succeed_last,Val} | fail. @@ -27,49 +27,49 @@ %% of generating solutions. efunc(Fcall) -> - %% Call an erlang function and return the value. - %% This is what the operators will generate. - Val = case Fcall of - {':',M,F} when is_atom(M), is_atom(F) -> M:F(); - {':',M,{F,A}} when is_atom(M), is_atom(F) -> M:F(A); - {':',M,T} when is_atom(M), is_tuple(T), size(T) >= 2, - is_atom(element(1, T)) -> - apply(M,element(1, T),tl(tuple_to_list(T))) - end, - {succeed_last,Val}. %Optimisation + %% Call an erlang function and return the value. + %% This is what the operators will generate. + Val = case Fcall of + {':', M, F} when is_atom(M), is_atom(F) -> M:F(); + {':', M, {F, A}} when is_atom(M), is_atom(F) -> M:F(A); + {':', M, T} when is_atom(M), is_tuple(T), size(T) >= 2, + is_atom(element(1, T)) -> + apply(M, element(1, T), tl(tuple_to_list(T))) + end, + {succeed_last, Val}. %Optimisation ets_keys(Tab) -> - %% Ets table keys back-trackable. - %% Solution with no look-ahead, get keys when requested. - %% This fun returns next key and itself for continuation. - F = fun (F1, Tab1, Last1) -> + %% Ets table keys back-trackable. + %% Solution with no look-ahead, get keys when requested. + %% This fun returns next key and itself for continuation. + F = fun(F1, Tab1, Last1) -> case ets:next(Tab1, Last1) of - '$end_of_table' -> fail; %No more elements - Key1 -> {succeed,Key1, fun () -> F1(F1, Tab1, Key1) end} + '$end_of_table' -> fail; %No more elements + Key1 -> {succeed, Key1, fun() -> F1(F1, Tab1, Key1) end} end end, - case ets:first(Tab) of - '$end_of_table' -> fail; %No elements - Key -> {succeed,Key, fun () -> F(F, Tab, Key) end} - end. + case ets:first(Tab) of + '$end_of_table' -> fail; %No elements + Key -> {succeed, Key, fun() -> F(F, Tab, Key) end} + end. get_list(ListGen) -> - %% List as back-trackable generator. - %% This is what the operators will generate. - Vals = case ListGen of - {':',M,F} when is_atom(M), is_atom(F) -> M:F(); - {':',M,{F,A}} when is_atom(M), is_atom(F) -> - M:F(A); - {':',M,T} when is_atom(M), is_tuple(T), size(T) >= 2, - is_atom(element(1, T)) -> - apply(M,element(1, T),tl(tuple_to_list(T))) - end, - %% This fun will return head and itself for continuation. - Fun = fun (F1, Es0) -> - case Es0 of - [E] -> {succeed_last,E}; %Optimisation for last one - [E|Es] -> {succeed,E,fun () -> F1(F1, Es) end}; - [] -> fail %No more elements - end - end, - Fun(Fun, Vals). %Call with list of values + %% List as back-trackable generator. + %% This is what the operators will generate. + Vals = case ListGen of + {':', M, F} when is_atom(M), is_atom(F) -> M:F(); + {':', M, {F, A}} when is_atom(M), is_atom(F) -> + M:F(A); + {':', M, T} when is_atom(M), is_tuple(T), size(T) >= 2, + is_atom(element(1, T)) -> + apply(M, element(1, T), tl(tuple_to_list(T))) + end, + %% This fun will return head and itself for continuation. + Fun = fun(F1, Es0) -> + case Es0 of + [E] -> {succeed_last, E}; %Optimisation for last one + [E | Es] -> {succeed, E, fun() -> F1(F1, Es) end}; + [] -> fail %No more elements + end + end, + Fun(Fun, Vals). %Call with list of values diff --git a/src/erlog_ets.erl b/src/erlog_ets.erl deleted file mode 100644 index 012a903..0000000 --- a/src/erlog_ets.erl +++ /dev/null @@ -1,149 +0,0 @@ -%% Copyright (c) 2008-2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - -%% File : erlog_ets.erl -%% Author : Robert Virding -%% Purpose : ETS interface for Erlog. - --module(erlog_ets). - --include("erlog_int.hrl"). - --compile(export_all). - --export([assert/1,all_1/6,keys_2/6,match_2/6]). - --import(lists, [foldl/3]). --import(erlog_int, [add_compiled_proc/4,dderef/2,unify/3, - prove_body/5,unify_prove_body/7,fail/2]). - -%% assert(Database) -> Database. -%% Assert predicates into the database. - -assert(Db) -> - foldl(fun ({Head,M,F}, LDb) -> - add_compiled_proc(Head, M, F, LDb) end, Db, - [ - {{ets_all,1},?MODULE,all_1}, - {{ets_keys,2},?MODULE,keys_2}, - {{ets_match,2},?MODULE,match_2} - ]). - - -%% all_1(Goal, Next, ChoicePoints, Bindings, VarNum, Database) -> void(). -%% Goal = {ets_all,Tables}. -%% Return all the ETS databases. - -all_1({ets_all,Var}, Next, Cps, Bs, Vn, Db) -> - Tabs = ets:all(), - unify_prove_body(Var, Tabs, Next, Cps, Bs, Vn, Db). - -%% keys_2(Goal, Next, ChoicePoints, Bindings, VarNum, Database) -> void(). -%% Goal = {ets_keys,Table,Key}. -%% Return the keys in an ETS database one at a time over backtracking. - -keys_2({ets_keys,Tab0,KeyVar}, Next, Cps, Bs, Vn, Db) -> - Tab1 = dderef(Tab0, Bs), - case ets:first(Tab1) of - '$end_of_table' -> fail(Cps, Db); - Key -> keys_loop(Tab1, Key, KeyVar, Next, Cps, Bs, Vn, Db) - end. - -keys_loop(Tab, Key, KeyVar, Next, Cps, Bs, Vn, Db) -> - FailFun = fun(LCp, LCps, LDb) -> - keys_fail(LCp, LCps, LDb, Tab, Key, KeyVar) - end, - C = #cp{type=compiled,data=FailFun,next=Next,bs=Bs,vn=Vn}, - unify_prove_body(KeyVar, Key, Next, [C|Cps], Bs, Vn, Db). - -keys_fail(#cp{next=Next,bs=Bs,vn=Vn}, Cps, Db, Tab, PrevKey, KeyVar) -> - case ets:next(Tab, PrevKey) of - '$end_of_table' -> fail(Cps, Db); - Key -> keys_loop(Tab, Key, KeyVar, Next, Cps, Bs, Vn, Db) - end. - -%% match_2(Goal, Next, ChoicePoints, Bindings, VarNum, Database) -> void(). -%% Goal = {ets_match,Table,Pattern}. -%% Match objects in an ETS database one at a time over backtracking -%% using Pattern in goal. Variables in Pattern are bound for each -%% object matched. - -match_2({ets_match,Tab0,Pat0}, Next, Cps, Bs, Vn, Db) -> - Tab1 = dderef(Tab0, Bs), - Pat1 = dderef(Pat0, Bs), - {Epat,Vs} = ets_pat(Pat1), - match_2_loop(ets:match(Tab1, Epat, 10), Next, Cps, Bs, Vn, Db, Epat, Vs). - -match_2_loop({[M|Ms],Cont}, Next, Cps, Bs, Vn, Db, Epat, Vs) -> - FailFun = fun (LCp, LCps, LDb) -> - match_2_fail(LCp, LCps, LDb, Epat, Vs, {Ms,Cont}) - end, - Cp = #cp{type=compiled,data=FailFun,next=Next,bs=Bs,vn=Vn}, - unify_prove_body(Vs, M, Next, [Cp|Cps], Bs, Vn, Db); -match_2_loop({[],Cont}, Next, Cps, Bs, Vn, Db, Epat, Vs) -> - match_2_loop(ets:match(Cont), Next, Cps, Bs, Vn, Db, Epat, Vs); -match_2_loop('$end_of_table', _Next, Cps, _Bs, _Vn, Db, _Epat, _Vs) -> - fail(Cps, Db). - -match_2_fail(#cp{next=Next,bs=Bs,vn=Vn}, Cps, Db, Epat, Vs, Ms) -> - match_2_loop(Ms, Next, Cps, Bs, Vn, Db, Epat, Vs). - -%% ets_pat(Term) -> {EtsPattern,VarList}. -%% Convert a term into an ETS pattern replacing variables with the ETS -%% pattern variables. Also return a list of variables in the same -%% order as ETS will return the list of values. This is slightly -%% tricky as the order they are in ETS which is not the same as term -%% order so they can not be easily sorted. Sigh! - -ets_pat(Pat) -> - {Epat,_Vn,Vs0} = ets_pat(Pat, 11, []), - Vs1 = [ V || {V,_Ev} <- Vs0 ], - {Epat,Vs1}. - -ets_pat({_}=V, Vn, Vs) -> - case find(V, Vs) of - {yes,Ev} -> {Ev,Vn,Vs}; - no -> - Ev = ets_var(Vn), - {Ev,Vn-1,[{V,Ev}|Vs]} - end; -ets_pat([H0|T0], Vn0, Vs0) -> - {T1,Vn1,Vs1} = ets_pat(T0, Vn0, Vs0), %Right to left! - {H1,Vn2,Vs2} = ets_pat(H0, Vn1, Vs1), - {[H1|T1],Vn2,Vs2}; -ets_pat(P, Vn0, Vs0) when is_tuple(P), size(P) >= 2 -> - {As,Vn1,Vs1} = ets_pat_arg(P, Vn0, Vs0, size(P), []), - {list_to_tuple([element(1, P)|As]),Vn1,Vs1}; -ets_pat(P, Vn, Vs) -> {P,Vn,Vs}. %Constant - -ets_pat_arg(_P, Vn, Vs, 1, As) -> {As,Vn,Vs}; -ets_pat_arg(P, Vn0, Vs0, I, As) -> - {A,Vn1,Vs1} = ets_pat(element(I, P), Vn0, Vs0), - ets_pat_arg(P, Vn1, Vs1, I-1, [A|As]). - -find(V, [{V,Ev}|_Vs]) -> {yes,Ev}; -find(V, [_P|Vs]) -> find(V, Vs); -find(_V, []) -> no. - -ets_var(1) -> '$1'; -ets_var(2) -> '$2'; -ets_var(3) -> '$3'; -ets_var(4) -> '$4'; -ets_var(5) -> '$5'; -ets_var(6) -> '$6'; -ets_var(7) -> '$7'; -ets_var(8) -> '$8'; -ets_var(9) -> '$9'; -ets_var(10) -> '$10'; -ets_var(11) -> '$11'. diff --git a/src/erlog_int.erl b/src/erlog_int.erl deleted file mode 100644 index f91a99d..0000000 --- a/src/erlog_int.erl +++ /dev/null @@ -1,1315 +0,0 @@ -%% Copyright (c) 2008-2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - -%% File : erlog_int.erl -%% Author : Robert Virding -%% Purpose : Basic interpreter of a Prolog sub-set. -%% -%% This is the basic Prolog interpreter. -%% The internal data structures used are very direct and basic: -%% -%% Structures - {Functor,arg1, Arg2,...} where Functor is an atom -%% Variables - {Name} where Name is an atom or integer -%% Lists - Erlang lists -%% Atomic - Erlang constants -%% -%% There is no problem with the representation of variables as Prolog -%% functors of arity 0 are atoms. This representation is much easier -%% to test for, and create new variables with than using funny atom -%% names like '$1' (yuch!), and we need LOTS of variables. -%% -%% All information about the state of an evaluation is held in the -%% variables: -%% -%% [CurrentGoal,] NextGoal, ChoicePoints, Bindings, VarNum, Database -%% -%% Proving a goal succeeds when we have reached the end of the goal -%% list, i.e. NextGoal is empty (true). Proving goal fails when there -%% are no more choice points left to backtrack into. The evaluation -%% is completely flat as all back track information is held in -%% ChoicePoints. Choice points are added going forwards and removed -%% by backtracking and cuts. -%% -%% Internal goals all have the format {{Name},...} as this is an -%% illegal Erlog structure which can never be generated in (legal) -%% code. -%% -%% Proving a top-level goal will return: -%% -%% {succeed,ChoicePoints,Bindings,VarNum,Database} - the -%% goal succeeded and these are the -%% choicepoints/bindings/varnum/database to continue with. -%% -%% {fail,Database} - the goal failed and this is the current database. -%% -%% When a goal has succeeded back tracking is initiated by calling -%% fail(ChoicePoints, Database) which has the same return values as -%% proving the goal. -%% -%% When the interpreter detects an error it builds an error term -%% -%% {erlog_error,ErrorDescriptor,Database} -%% -%% and throws it. The ErrorDescriptor is a valid Erlog term. -%% -%% Database -%% -%% We use a dictionary for the database. All data for a procedure are -%% kept in the database with the functor as key. Interpreted clauses -%% are kept in a list, each clause has a unique (for that functor) -%% tag. Functions which traverse clauses, clause/retract/goals, get -%% the whole list to use. Any database operations can they be done -%% directly on the database. Retract uses the tag to remove the -%% correct clause. This preserves the logical database view. It is -%% possible to use ETS instead if a dictionary, define macro ETS, but -%% the logical database view makes it difficult to directly use ETS -%% efficiently. -%% -%% Interpreted Code -%% -%% Code, interpreted clause bodies, are not stored directly as Erlog -%% terms. Before being added to the database they are checked that -%% they are well-formed, control structures are recognised, cuts -%% augmented with status and sequences of conjunctions are converted -%% to lists. When code is used a new instance is made with fresh -%% variables, correct cut labels, and bodies directly linked to -%% following code to remove the need of later appending. -%% -%% The following functions convert code: -%% -%% well_form_body/4 - converts an Erlog term to database code body -%% format checking that it is well formed. -%% well_form_goal/4 - converts an Erlog term directly to a code body -%% checking that it is well formed. -%% unify_head/4 - unify a goal directly with head without creating a -%% new instance of the head. Saves creating local variables and -%% MANY bindings. This is a BIG WIN! -%% body_instance/5 - creates a new code body instance from the -%% database format. -%% term_instance/2/3 - creates a new instance of a term with new -%% variables. -%% body_term/3 - creates a copy of a body as a legal Erlog term. -%% -%% Choicepoints/Cuts -%% -%% Choicepoints and cuts are kept on the same stack/list. There are -%% different types of cps depending on their context. Failure pops -%% the first cp off the stack, passing over cuts and resumes -%% execution from that cp. A cut has a label and a flag indicating if -%% this is the last cut with this label. Cut steps over cps/cuts -%% until a cut the same label is reached and execution is resumed -%% with that stack. Unless this is the last cut with a label a new -%% cut is pushed on the stack. For efficiency some cps also act as -%% cuts. -%% -%% It is possible to reuse cut labels for different markers as long -%% the areas the cuts are valid don't overlap, though one may be -%% contained within the other, and the cuts correctly indicate when -%% they are the last cut. This is used for ->; and once/1 where we -%% KNOW the last cut of the internal section. -%% -%% It would be better if the cut marker was the actual cps/cut stack -%% to go back to but this would entail a more interactive -%% body_instance. - --module(erlog_int). - -%% Main execution functions. --export([prove_goal/2,prove_body/5,fail/2]). --export([unify_prove_body/7,unify_prove_body/9]). -%% Bindings, unification and dereferncing. --export([new_bindings/0,add_binding/3,make_vars/2]). --export([deref/2,deref_list/2,dderef/2,dderef_list/2,unify/3,functor/1]). -%% Creating term and body instances. --export([term_instance/2]). -%% Adding to database. --export([asserta_clause/2,assertz_clause/2,abolish_clauses/2]). --export([add_built_in/2,add_compiled_proc/4]). --export([new_db/0,built_in_db/0]). - -%% Error types. --export([erlog_error/1,erlog_error/2,type_error/2,type_error/3, - instantiation_error/0,instantiation_error/1,permission_error/4]). - -%%-compile(export_all). - --import(lists, [map/2,foldl/3]). - -%% Some standard type macros. - -%% The old is_constant/1 ? --define(IS_CONSTANT(T), (not (is_tuple(T) orelse is_list(T)))). - -%% -define(IS_ATOMIC(T), (is_atom(T) orelse is_number(T) orelse (T == []))). --define(IS_ATOMIC(T), (not (is_tuple(T) orelse (is_list(T) andalso T /= [])))). --define(IS_FUNCTOR(T), ((tuple_size(T) >= 2) andalso is_atom(element(1, T)))). - -%% Define the database to use. ONE of the follwing must be defined. - -%%-define(ETS,true). -%%-define(DB, orddict). --define(DB, dict). - -%% built_in_db() -> Database. -%% Create an initial clause database containing the built-in -%% predicates and predefined library predicates. - -built_in_db() -> - Db0 = new_db(), - %% First add the Erlang built-ins. - Db1 = foldl(fun (Head, Db) -> add_built_in(Head, Db) end, Db0, - [ - %% Logic and control. - {call,1}, - {',',2}, - {'!',0}, - {';',2}, - {fail,0}, - {'->',2}, - {'\\+',1}, - {once,1}, - {repeat,0}, - {true,0}, - %% Clause creation and destruction. - {abolish,1}, - {assert,1}, - {asserta,1}, - {assertz,1}, - {retract,1}, - {retractall,1}, - %% Clause retrieval and information. - {clause,2}, - {current_predicate,1}, - {predicate_property,2}, - %% All solutions - %% External interface - {ecall,2}, - %% Non-standard but useful - {display,1} - ]), - Db1. - -%% Define the choice point record --record(cp, {type,label,data,next,bs,vn}). --record(cut, {label,next}). - -%% prove_goal(Goal, Database) -> Succeed | Fail. -%% This is the main entry point into the interpreter. Check that -%% everything is consistent then prove the goal as a call. - -prove_goal(Goal0, Db) -> - %% put(erlog_cut, orddict:new()), - %% put(erlog_cps, orddict:new()), - %% put(erlog_var, orddict:new()), - %% Check term and build new instance of term with bindings. - {Goal1,Bs,Vn} = initial_goal(Goal0), - prove_body([{call,Goal1}], [], Bs, Vn, Db). - --define(FAIL(Bs, Cps, Db), - begin - put(erlog_cps, orddict:update_counter(length(Cps), 1, get(erlog_cps))), - put(erlog_var, orddict:update_counter(dict:size(Bs), 1, get(erlog_var))), - fail(Cps, Db) - end). --undef(FAIL). --define(FAIL(Bs, Cps, Db), fail(Cps, Db)). - -%% prove_goal(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> -%% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase} | -%% {fail,NewDatabase}. -%% Prove one goal. We seldom return succeed here but usually go directly to -%% to NextGoal. -%% Handle built-in predicates here. RTFM for a description of the -%% built-ins. Hopefully we do the same. - -%% Logic and control. Conjunctions are handled in prove_body and true -%% has been compiled away. -prove_goal({call,G}, Next0, Cps, Bs, Vn, Db) -> - %% Only add cut CP to Cps if goal contains a cut. - Label = Vn, - case check_goal(G, Next0, Bs, Db, false, Label) of - {Next1,true} -> - %% Must increment Vn to avoid clashes!!! - Cut = #cut{label=Label}, - prove_body(Next1, [Cut|Cps], Bs, Vn+1, Db); - {Next1,false} -> prove_body(Next1, Cps, Bs, Vn+1, Db) - end; -prove_goal({{cut},Label,Last}, Next, Cps, Bs, Vn, Db) -> - %% Cut succeeds and trims back to cut ancestor. - cut(Label, Last, Next, Cps, Bs, Vn, Db); -prove_goal({{disj},R}, Next, Cps, Bs, Vn, Db) -> - %% There is no L here, it has already been prepended to Next. - Cp = #cp{type=disjunction,next=R,bs=Bs,vn=Vn}, - prove_body(Next, [Cp|Cps], Bs, Vn, Db); -prove_goal(fail, _Next, Cps, _Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db); -prove_goal({{if_then},Label}, Next, Cps, Bs, Vn, Db) -> - %% We effetively implement ( C -> T ) with ( C, !, T ) but cuts in - %% C are local to C. - %% There is no ( C, !, T ) here, it has already been prepended to Next. - %%io:fwrite("PG(->): ~p\n", [{Next}]), - Cut = #cut{label=Label}, - prove_body(Next, [Cut|Cps], Bs, Vn, Db); -prove_goal({{if_then_else},Else,Label}, Next, Cps, Bs, Vn, Db) -> - %% Need to push a choicepoint to fail back to inside Cond and a cut - %% to cut back to before Then when Cond succeeds. #cp{type=if_then_else} - %% functions as both as is always removed whatever the outcome. - %% There is no ( C, !, T ) here, it has already been prepended to Next. - Cp = #cp{type=if_then_else,label=Label,next=Else,bs=Bs,vn=Vn}, - %%io:fwrite("PG(->;): ~p\n", [{Next,Else,[Cp|Cps]}]), - prove_body(Next, [Cp|Cps], Bs, Vn, Db); -prove_goal({'\\+',G}, Next0, Cps, Bs, Vn, Db) -> - %% We effectively implementing \+ G with ( G -> fail ; true ). - Label = Vn, - {Next1,_} = check_goal(G, [{{cut},Label,true},fail], Bs, Db, true, Label), - Cp = #cp{type=if_then_else,label=Label,next=Next0,bs=Bs,vn=Vn}, - %%io:fwrite("PG(\\+): ~p\n", [{G1,[Cp|Cps]]), - %% Must increment Vn to avoid clashes!!! - prove_body(Next1, [Cp|Cps], Bs, Vn+1, Db); -prove_goal({{once},Label}, Next, Cps, Bs, Vn, Db) -> - %% We effetively implement once(G) with ( G, ! ) but cuts in - %% G are local to G. - %% There is no ( G, ! ) here, it has already been prepended to Next. - Cut = #cut{label=Label}, - prove_body(Next, [Cut|Cps], Bs, Vn, Db); -prove_goal(repeat, Next, Cps, Bs, Vn, Db) -> - Cp = #cp{type=disjunction,next=[repeat|Next],bs=Bs,vn=Vn}, - prove_body(Next, [Cp|Cps], Bs, Vn, Db); -%% Clause creation and destruction. -prove_goal({abolish,Pi0}, Next, Cps, Bs, Vn, Db) -> - case dderef(Pi0, Bs) of - {'/',N,A} when is_atom(N), is_integer(A), A > 0 -> - prove_body(Next, Cps, Bs, Vn, abolish_clauses({N,A}, Db)); - Pi -> type_error(predicate_indicator, Pi, Db) - end; -prove_goal({assert,C0}, Next, Cps, Bs, Vn, Db) -> - C = dderef(C0, Bs), - prove_body(Next, Cps, Bs, Vn, assertz_clause(C, Db)); -prove_goal({asserta,C0}, Next, Cps, Bs, Vn, Db) -> - C = dderef(C0, Bs), - prove_body(Next, Cps, Bs, Vn, asserta_clause(C, Db)); -prove_goal({assertz,C0}, Next, Cps, Bs, Vn, Db) -> - C = dderef(C0, Bs), - prove_body(Next, Cps, Bs, Vn, assertz_clause(C, Db)); -prove_goal({retract,C0}, Next, Cps, Bs, Vn, Db) -> - C = dderef(C0, Bs), - prove_retract(C, Next, Cps, Bs, Vn, Db); -%% Clause retrieval and information -prove_goal({clause,H0,B}, Next, Cps, Bs, Vn, Db) -> - H1 = dderef(H0, Bs), - prove_clause(H1, B, Next, Cps, Bs, Vn, Db); -prove_goal({current_predicate,Pi0}, Next, Cps, Bs, Vn, Db) -> - Pi = dderef(Pi0, Bs), - prove_current_predicate(Pi, Next, Cps, Bs, Vn, Db); -prove_goal({predicate_property,H0,P}, Next, Cps, Bs, Vn, Db) -> - H = dderef(H0, Bs), - case catch get_procedure_type(functor(H), Db) of - built_in -> unify_prove_body(P, built_in, Next, Cps, Bs, Vn, Db); - compiled -> unify_prove_body(P, compiled, Next, Cps, Bs, Vn, Db); - interpreted -> unify_prove_body(P, interpreted, Next, Cps, Bs, Vn, Db); - undefined -> ?FAIL(Bs, Cps, Db); - {erlog_error,E} -> erlog_error(E, Db) - end; -%% External interface -prove_goal({ecall,C0,Val}, Next, Cps, Bs, Vn, Db) -> - %% Build the initial call. - %%io:fwrite("PG(ecall): ~p\n ~p\n ~p\n", [dderef(C0, Bs),Next,Cps]), - Efun = case dderef(C0, Bs) of - {':',M,F} when is_atom(M), is_atom(F) -> - fun () -> M:F() end; - {':',M,{F,A}} when is_atom(M), is_atom(F) -> - fun () -> M:F(A) end; - {':',M,{F,A1,A2}} when is_atom(M), is_atom(F) -> - fun () -> M:F(A1,A2) end; - {':',M,T} when is_atom(M), ?IS_FUNCTOR(T) -> - L = tuple_to_list(T), - fun () -> apply(M, hd(L), tl(L)) end; - Fun when is_function(Fun) -> Fun; - Other -> type_error(callable, Other, Db) - end, - prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db); -%% Non-standard but useful. -prove_goal({display,T}, Next, Cps, Bs, Vn, Db) -> - %% A very simple display procedure. - io:fwrite("~p\n", [dderef(T, Bs)]), - prove_body(Next, Cps, Bs, Vn, Db); -%% Now look up the database. -prove_goal(G, Next, Cps, Bs, Vn, Db) -> - %%io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), - case catch get_procedure(functor(G), Db) of - built_in -> erlog_bips:prove_goal(G, Next, Cps, Bs, Vn, Db); - {code,{Mod,Func}} -> Mod:Func(G, Next, Cps, Bs, Vn, Db); - {clauses,Cs} -> prove_goal_clauses(G, Cs, Next, Cps, Bs, Vn, Db); - undefined -> ?FAIL(Bs, Cps, Db); - %% Getting built_in here is an error! - {erlog_error,E} -> erlog_error(E, Db) %Fill in more error data - end. - -fail_disjunction(#cp{next=Next,bs=Bs,vn=Vn}, Cps, Db) -> - prove_body(Next, Cps, Bs, Vn, Db). - -fail_if_then_else(#cp{next=Next,bs=Bs,vn=Vn}, Cps, Db) -> - prove_body(Next, Cps, Bs, Vn, Db). - -%% fail(ChoicePoints, Database) -> {fail,Database}. -%% cut(Label, Last, Next, ChoicePoints, Bindings, VarNum, Database) -> void. -%% -%% The functions which manipulate the choice point stack. fail -%% backtracks to next choicepoint skipping cut labels cut steps -%% backwards over choice points until matching cut. - -fail([#cp{type=goal_clauses}=Cp|Cps], Db) -> - fail_goal_clauses(Cp, Cps, Db); -fail([#cp{type=disjunction}=Cp|Cps], Db) -> - fail_disjunction(Cp, Cps, Db); -fail([#cp{type=if_then_else}=Cp|Cps], Db) -> - fail_if_then_else(Cp, Cps, Db); -fail([#cp{type=clause}=Cp|Cps], Db) -> - fail_clause(Cp, Cps, Db); -fail([#cp{type=retract}=Cp|Cps], Db) -> - fail_retract(Cp, Cps, Db); -fail([#cp{type=current_predicate}=Cp|Cps], Db) -> - fail_current_predicate(Cp, Cps, Db); -fail([#cp{type=ecall}=Cp|Cps], Db) -> - fail_ecall(Cp, Cps, Db); -fail([#cp{type=compiled,data=F}=Cp|Cps], Db) -> - F(Cp, Cps, Db); -fail([#cut{}|Cps], Db) -> - fail(Cps, Db); %Fail over cut points. -fail([], Db) -> {fail,Db}. - -cut(Label, Last, Next, [#cut{label=Label}|Cps]=Cps0, Bs, Vn, Db) -> - if Last -> prove_body(Next, Cps, Bs, Vn, Db); - true -> prove_body(Next, Cps0, Bs, Vn, Db) - end; -cut(Label, Last, Next, [#cp{type=if_then_else,label=Label}|Cps]=Cps0, Bs, Vn, Db) -> - if Last -> prove_body(Next, Cps, Bs, Vn, Db); - true -> prove_body(Next, Cps0, Bs, Vn, Db) - end; -cut(Label, Last, Next, [#cp{type=goal_clauses,label=Label}=Cp|Cps], Bs, Vn, Db) -> - cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db); -cut(Label, Last, Next, [_Cp|Cps], Bs, Vn, Db) -> - cut(Label, Last, Next, Cps, Bs, Vn, Db). - -%% cut(Label, Last, Next, Cps, Bs, Vn, Db) -> -%% cut(Label, Last, Next, Cps, Bs, Vn, Db, 1). - -%% cut(Label, Last, Next, [#cut{label=Label}|Cps]=Cps0, Bs, Vn, Db, Cn) -> -%% put(erlog_cut, orddict:update_counter(Cn, 1, get(erlog_cut))), -%% if Last -> prove_body(Next, Cps, Bs, Vn, Db); -%% true -> prove_body(Next, Cps0, Bs, Vn, Db) -%% end; -%% cut(Label, Last, Next, [#cp{type=if_then_else,label=Label}|Cps]=Cps0, Bs, Vn, Db, Cn) -> -%% put(erlog_cut, orddict:update_counter(Cn, 1, get(erlog_cut))), -%% if Last -> prove_body(Next, Cps, Bs, Vn, Db); -%% true -> prove_body(Next, Cps0, Bs, Vn, Db) -%% end; -%% cut(Label, Last, Next, [#cp{type=goal_clauses,label=Label}=Cp|Cps], Bs, Vn, Db, Cn) -> -%% put(erlog_cut, orddict:update_counter(Cn, 1, get(erlog_cut))), -%% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db); -%% cut(Label, Last, Next, [_Cp|Cps], Bs, Vn, Db, Cn) -> -%% cut(Label, Last, Next, Cps, Bs, Vn, Db, Cn+1). - -%% check_goal(Goal, Next, Bindings, Database, CutAfter, CutLabel) -> -%% {WellFormedBody,HasCut}. -%% Check to see that Goal is bound and ensure that it is well-formed. - -check_goal(G0, Next, Bs, Db, Cut, Label) -> - case dderef(G0, Bs) of - {_} -> instantiation_error(Db); %Must have something to call - G1 -> - case catch {ok,well_form_goal(G1, Next, Cut, Label)} of - {erlog_error,E} -> erlog_error(E, Db); - {ok,GC} -> GC %Body and cut - end - end. - -%% unify_prove_body(Term1, Term2, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Unify Term1 = Term2, on success prove body Next else fail. - -unify_prove_body(T1, T2, Next, Cps, Bs0, Vn, Db) -> - case unify(T1, T2, Bs0) of - {succeed,Bs1} -> prove_body(Next, Cps, Bs1, Vn, Db); - fail -> ?FAIL(Bs0, Cps, Db) - end. - -%% unify_prove_body(A1, B1, A2, B2, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Unify A1 = B1, A2 = B2, on success prove body Next else fail. - -unify_prove_body(A1, B1, A2, B2, Next, Cps, Bs0, Vn, Db) -> - case unify(A1, B1, Bs0) of - {succeed,Bs1} -> unify_prove_body(A2, B2, Next, Cps, Bs1, Vn, Db); - fail -> ?FAIL(Bs0, Cps, Db) - end. - -%% prove_ecall(Generator, Value, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Call an external (Erlang) generator and handle return value, either -%% succeed or fail. - -prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db) -> - case Efun() of - {succeed,Ret,Cont} -> %Succeed and more choices - Cp = #cp{type=ecall,data={Cont,Val},next=Next,bs=Bs,vn=Vn}, - unify_prove_body(Val, Ret, Next, [Cp|Cps], Bs, Vn, Db); - {succeed_last,Ret} -> %Succeed but last choice - unify_prove_body(Val, Ret, Next, Cps, Bs, Vn, Db); - fail -> ?FAIL(Bs, Cps, Db) %No more - end. - -fail_ecall(#cp{data={Efun,Val},next=Next,bs=Bs,vn=Vn}, Cps, Db) -> - prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db). - -%% prove_clause(Head, Body, Next, ChoicePoints, Bindings, VarNum, DataBase) -> -%% void. -%% Unify clauses matching with functor from Head with both Head and Body. - -prove_clause(H, B, Next, Cps, Bs, Vn, Db) -> - Functor = functor(H), - case get_procedure(Functor, Db) of - {clauses,Cs} -> unify_clauses(H, B, Cs, Next, Cps, Bs, Vn, Db); - {code,_} -> - permission_error(access, private_procedure, pred_ind(Functor), Db); - built_in -> - permission_error(access, private_procedure, pred_ind(Functor), Db); - undefined -> ?FAIL(Bs, Cps, Db) - end. - -%% unify_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Try to unify Head and Body using Clauses which all have the same functor. - -unify_clauses(Ch, Cb, [C], Next, Cps, Bs0, Vn0, Db) -> - %% No choice point on last clause - case unify_clause(Ch, Cb, C, Bs0, Vn0) of - {succeed,Bs1,Vn1} -> prove_body(Next, Cps, Bs1, Vn1, Db); - fail -> ?FAIL(Bs0, Cps, Db) - end; -unify_clauses(Ch, Cb, [C|Cs], Next, Cps, Bs0, Vn0, Db) -> - case unify_clause(Ch, Cb, C, Bs0, Vn0) of - {succeed,Bs1,Vn1} -> - Cp = #cp{type=clause,data={Ch,Cb,Cs},next=Next,bs=Bs0,vn=Vn0}, - prove_body(Next, [Cp|Cps], Bs1, Vn1, Db); - fail -> unify_clauses(Ch, Cb, Cs, Next, Cps, Bs0, Vn0, Db) - end; -unify_clauses(_Ch, _Cb, [], _Next, Cps,_Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db). - -unify_clause(Ch, Cb, {_Tag,H0,{B0,_}}, Bs0, Vn0) -> - {H1,Rs1,Vn1} = term_instance(H0, Vn0), %Unique vars on head first - case unify(Ch, H1, Bs0) of - {succeed,Bs1} -> - {B1,_Rs2,Vn2} = body_term(B0, Rs1, Vn1), %Now we need the rest - case unify(Cb, B1, Bs1) of - {succeed,Bs2} -> {succeed,Bs2,Vn2}; - fail -> fail - end; - fail -> fail - end. - -fail_clause(#cp{data={Ch,Cb,Cs},next=Next,bs=Bs,vn=Vn}, Cps, Db) -> - unify_clauses(Ch, Cb, Cs, Next, Cps, Bs, Vn, Db). - -%% prove_current_predicate(PredInd, Next, ChoicePoints, Bindings, VarNum, DataBase) -> -%% void. -%% Match functors of existing user (interpreted) predicate with PredInd. - -prove_current_predicate(Pi, Next, Cps, Bs, Vn, Db) -> - case Pi of - {'/',_,_} -> ok; - {_} -> ok; - Other -> type_error(predicate_indicator, Other) - end, - Fs = get_interp_functors(Db), - prove_predicates(Pi, Fs, Next, Cps, Bs, Vn, Db). - -prove_predicates(Pi, [F|Fs], Next, Cps, Bs, Vn, Db) -> - Cp = #cp{type=current_predicate,data={Pi,Fs},next=Next,bs=Bs,vn=Vn}, - unify_prove_body(Pi, pred_ind(F), Next, [Cp|Cps], Bs, Vn, Db); -prove_predicates(_Pi, [], _Next, Cps, _Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db). - -fail_current_predicate(#cp{data={Pi,Fs},next=Next,bs=Bs,vn=Vn}, Cps, Db) -> - prove_predicates(Pi, Fs, Next, Cps, Bs, Vn, Db). - -%% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Try to prove Goal using Clauses which all have the same functor. - -prove_goal_clauses(G, [C], Next, Cps, Bs, Vn, Db) -> - %% Must be smart here and test whether we need to add a cut point. - %% C has the structure {Tag,Head,{Body,BodyHasCut}}. - case element(2, element(3, C)) of - true -> - Cut = #cut{label=Vn}, - prove_goal_clause(G, C, Next, [Cut|Cps], Bs, Vn, Db); - false -> - prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db) - end; - %% prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db); -prove_goal_clauses(G, [C|Cs], Next, Cps, Bs, Vn, Db) -> - Cp = #cp{type=goal_clauses,label=Vn,data={G,Cs},next=Next,bs=Bs,vn=Vn}, - prove_goal_clause(G, C, Next, [Cp|Cps], Bs, Vn, Db); -prove_goal_clauses(_G, [], _Next, Cps,_Bs, _Vn, Db) -> ?FAIL(_Bs, Cps ,Db). - -prove_goal_clause(G, {_Tag,H0,{B0,_}}, Next, Cps, Bs0, Vn0, Db) -> - %% io:fwrite("PGC1: ~p\n", [{G,H0,B0}]), - Label = Vn0, - case unify_head(G, H0, Bs0, Vn0+1) of - {succeed,Rs0,Bs1,Vn1} -> - %% io:fwrite("PGC2: ~p\n", [{Rs0}]), - {B1,_Rs2,Vn2} = body_instance(B0, Next, Rs0, Vn1, Label), - %% io:fwrite("PGC3: ~p\n", [{B1,Next,Cps}]), - prove_body(B1, Cps, Bs1, Vn2, Db); - fail -> ?FAIL(Bs0, Cps, Db) - end. - -fail_goal_clauses(#cp{data={G,Cs},next=Next,bs=Bs,vn=Vn}, Cps, Db) -> - prove_goal_clauses(G, Cs, Next, Cps, Bs, Vn, Db). - -%% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db). - -cut_goal_clauses(true, Next, #cp{label=_}, Cps, Bs, Vn, Db) -> - %% Just remove the choice point completely and continue. - prove_body(Next, Cps, Bs, Vn, Db); -cut_goal_clauses(false, Next, #cp{label=L}, Cps, Bs, Vn, Db) -> - %% Replace choice point with cut point then continue. - Cut = #cut{label=L}, - prove_body(Next, [Cut|Cps], Bs, Vn, Db). - -%% prove_retract(Clause, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Retract clauses in database matching Clause. - -prove_retract({':-',H,B}, Next, Cps, Bs, Vn, Db) -> - prove_retract(H, B, Next, Cps, Bs, Vn, Db); -prove_retract(H, Next, Cps, Bs, Vn, Db) -> - prove_retract(H, true, Next, Cps, Bs, Vn, Db). - -prove_retract(H, B, Next, Cps, Bs, Vn, Db) -> - Functor = functor(H), - case get_procedure(Functor, Db) of - {clauses,Cs} -> retract_clauses(H, B, Cs, Next, Cps, Bs, Vn, Db); - {code,_} -> - permission_error(modify, static_procedure, pred_ind(Functor), Db); - built_in -> - permission_error(modify, static_procedure, pred_ind(Functor), Db); - undefined -> ?FAIL(Bs, Cps, Db) - end. - -%% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Try to retract Head and Body using Clauses which all have the same functor. - -retract_clauses(Ch, Cb, [C|Cs], Next, Cps, Bs0, Vn0, Db0) -> - case unify_clause(Ch, Cb, C, Bs0, Vn0) of - {succeed,Bs1,Vn1} -> - %% We have found a right clause so now retract it. - Db1 = retract_clause(functor(Ch), element(1, C), Db0), - Cp = #cp{type=retract,data={Ch,Cb,Cs},next=Next,bs=Bs0,vn=Vn0}, - prove_body(Next, [Cp|Cps], Bs1, Vn1, Db1); - fail -> retract_clauses(Ch, Cb, Cs, Next, Cps, Bs0, Vn0, Db0) - end; -retract_clauses(_Ch, _Cb, [], _Next, Cps, _Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db). - -fail_retract(#cp{data={Ch,Cb,Cs},next=Next,bs=Bs,vn=Vn}, Cps, Db) -> - retract_clauses(Ch, Cb, Cs, Next, Cps, Bs, Vn, Db). - -%% prove_body(Body, ChoicePoints, Bindings, VarNum, Database) -> -%% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase}. -%% Prove the goals in a body. Remove the first goal and try to prove -%% it. Return when there are no more goals. This is how proving a -%% goal/body succeeds. - -prove_body([G|Gs], Cps, Bs0, Vn0, Db0) -> - %%io:fwrite("PB: ~p\n", [{G,Gs,Cps}]), - prove_goal(G, Gs, Cps, Bs0, Vn0, Db0); -prove_body([], Cps, Bs, Vn, Db) -> - %%io:fwrite("Cps: ~p\nCut: ~p\nVar: ~p\nVar: ~p\n", - %% [get(erlog_cps),get(erlog_cut),get(erlog_var),dict:size(Bs)]), - %%io:fwrite("PB: ~p\n", [Cps]), - {succeed,Cps,Bs,Vn,Db}. %No more body - -%% unify(Term, Term, Bindings) -> {succeed,NewBindings} | fail. -%% Unify two terms with a set of bindings. - -unify(T10, T20, Bs0) -> - case {deref(T10, Bs0),deref(T20, Bs0)} of - {T1,T2} when ?IS_CONSTANT(T1), T1 == T2 -> - {succeed,Bs0}; - {{V},{V}} -> {succeed,Bs0}; - {{_}=Var,T2} -> {succeed,add_binding(Var, T2, Bs0)}; - {T1,{_}=Var} -> {succeed,add_binding(Var, T1, Bs0)}; - {[H1|T1],[H2|T2]} -> - case unify(H1, H2, Bs0) of - {succeed,Bs1} -> unify(T1, T2, Bs1); - fail -> fail - end; - {[],[]} -> {succeed,Bs0}; - {T1,T2} when tuple_size(T1) == tuple_size(T2), - element(1, T1) == element(1, T2) -> - unify_args(T1, T2, Bs0, 2, tuple_size(T1)); - _Other -> fail - end. - -unify_args(_, _, Bs, I, S) when I > S -> {succeed,Bs}; -unify_args(S1, S2, Bs0, I, S) -> - case unify(element(I, S1), element(I, S2), Bs0) of - {succeed,Bs1} -> unify_args(S1, S2, Bs1, I+1, S); - fail -> fail - end. - -%% make_vars(Count, VarNum) -> [Var]. -%% Make a list of new variables starting at VarNum. - -make_vars(0, _) -> []; -make_vars(I, Vn) -> - [{Vn}|make_vars(I-1, Vn+1)]. - -%% Errors -%% To keep dialyzer quiet. --spec type_error(_, _) -> no_return(). --spec type_error(_, _, _) -> no_return(). --spec instantiation_error() -> no_return(). --spec instantiation_error(_) -> no_return(). --spec permission_error(_, _, _, _) -> no_return(). --spec erlog_error(_) -> no_return(). --spec erlog_error(_, _) -> no_return(). - -type_error(Type, Value, Db) -> erlog_error({type_error,Type,Value}, Db). -type_error(Type, Value) -> erlog_error({type_error,Type,Value}). - -instantiation_error(Db) -> erlog_error(instantiation_error, Db). -instantiation_error() -> erlog_error(instantiation_error). - -permission_error(Op, Type, Value, Db) -> - erlog_error({permission_error,Op,Type,Value}, Db). - -erlog_error(E, Db) -> throw({erlog_error,E,Db}). -erlog_error(E) -> throw({erlog_error,E}). - --ifdef(DB). -%% Database -%% The database is a dict where the key is the functor pair {Name,Arity}. -%% The value is: built_in | -%% {clauses,NextTag,[{Tag,Head,Body}]} | -%% {code,{Module,Function}}. -%% Built-ins are defined by the system and cannot manipulated by user -%% code. -%% We are a little paranoid here and do our best to ensure consistency -%% in the database by checking input arguments even if we know they -%% come from "good" code. - -new_db() -> ?DB:new(). - -%% add_built_in(Functor, Database) -> NewDatabase. -%% Add Functor as a built-in in the database. - -add_built_in(Functor, Db) -> - ?DB:store(Functor, built_in, Db). - -%% add_compiled_proc(Functor, Module, Function, Database) -> NewDatabase. -%% Add Functor as a compiled procedure with code in Module:Function. No -%% checking. - -add_compiled_proc(Functor, M, F, Db) -> - ?DB:update(Functor, - fun (built_in) -> - permission_error(modify, static_procedure, pred_ind(Functor), Db); - (_) -> {code,{M,F}} - end, {code,{M,F}}, Db). - -%% assertz_clause(Clause, Database) -> NewDatabase. -%% assertz_clause(Head, Body, Database) -> NewDatabase. -%% Assert a clause into the database first checking that it is well -%% formed. - -assertz_clause({':-',H,B}, Db) -> assertz_clause(H, B, Db); -assertz_clause(H, Db) -> assertz_clause(H, true, Db). - -assertz_clause(Head, Body0, Db) -> - {Functor,Body} = case catch {ok,functor(Head), - well_form_body(Body0, false, sture)} of - {erlog_error,E} -> erlog_error(E, Db); - {ok,F,B} -> {F,B} - end, - ?DB:update(Functor, - fun (built_in) -> - permission_error(modify, static_procedure, pred_ind(Functor), Db); - ({code,_}) -> - permission_error(modify, static_procedure, pred_ind(Functor), Db); - ({clauses,T,Cs}) -> {clauses,T+1,Cs ++ [{T,Head,Body}]} - end, {clauses,1,[{0,Head,Body}]}, Db). - -%% asserta_clause(Clause, Database) -> NewDatabase. -%% asserta_clause(Head, Body, Database) -> NewDatabase. -%% Assert a clause into the database first checking that it is well -%% formed. - -asserta_clause({':-',H,B}, Db) -> asserta_clause(H, B, Db); -asserta_clause(H, Db) -> asserta_clause(H, true, Db). - -asserta_clause(Head, Body0, Db) -> - {Functor,Body} = case catch {ok,functor(Head), - well_form_body(Body0, false, sture)} of - {erlog_error,E} -> erlog_error(E, Db); - {ok,F,B} -> {F,B} - end, - ?DB:update(Functor, - fun (built_in) -> - permission_error(modify, static_procedure, pred_ind(Functor), Db); - ({code,_}) -> - permission_error(modify, static_procedure, pred_ind(Functor), Db); - ({clauses,T,Cs}) -> {clauses,T+1,[{T,Head,Body}|Cs]} - end, {clauses,1,[{0,Head,Body}]}, Db). - -%% retract_clause(Functor, ClauseTag, Database) -> NewDatabase. -%% Retract (remove) the clause with tag ClauseTag from the list of -%% clauses of Functor. - -retract_clause(F, Ct, Db) -> - case ?DB:find(F, Db) of - {ok,built_in} -> - permission_error(modify, static_procedure, pred_ind(F), Db); - {ok,{code,_}} -> - permission_error(modify, static_procedure, pred_ind(F), Db); - {ok,{clauses,Nt,Cs}} -> - ?DB:store(F, {clauses,Nt,lists:keydelete(Ct, 1, Cs)}, Db); - error -> Db %Do nothing - end. - -%% abolish_clauses(Functor, Database) -> NewDatabase. - -abolish_clauses(Func, Db) -> - case ?DB:find(Func, Db) of - {ok,built_in} -> - permission_error(modify, static_procedure, pred_ind(Func), Db); - {ok,{code,_}} -> ?DB:erase(Func, Db); - {ok,{clauses,_,_}} -> ?DB:erase(Func, Db); - error -> Db %Do nothing - end. - -%% get_procedure(Functor, Database) -> -%% built_in | {code,{Mod,Func}} | {clauses,[Clause]} | undefined. -%% Return the procedure type and data for a functor. - -get_procedure(Func, Db) -> - case ?DB:find(Func, Db) of - {ok,built_in} -> built_in; %A built-in - {ok,{code,{_M,_F}}=P} -> P; %Compiled (perhaps someday) - {ok,{clauses,_T,Cs}} -> {clauses,Cs}; %Interpreted clauses - error -> undefined %Undefined - end. - -%% get_procedure_type(Functor, Database) -> -%% built_in | compiled | interpreted | undefined. -%% Return the procedure type for a functor. - -get_procedure_type(Func, Db) -> - case ?DB:find(Func, Db) of - {ok,built_in} -> built_in; %A built-in - {ok,{code,_}} -> compiled; %Compiled (perhaps someday) - {ok,{clauses,_,_}} -> interpreted; %Interpreted clauses - error -> undefined %Undefined - end. - -%% get_interp_functors(Database) -> [Functor]. - -get_interp_functors(Db) -> - ?DB:fold(fun (_Func, built_in, Fs) -> Fs; - (Func, {code,_}, Fs) -> [Func|Fs]; - (Func, {clauses,_,_}, Fs) -> [Func|Fs] - end, [], Db). --endif. - --ifdef(ETS). -%% The database is an ets table where the key is the functor pair {Name,Arity}. -%% The value is: {Functor,built_in} | -%% {Functor,clauses,NextTag,[{Tag,Head,Body}]} | -%% {Functor,code,{Module,Function}}. -%% Built-ins are defined by the system and cannot manipulated by user -%% code. -%% We are a little paranoid here and do our best to ensure consistency -%% in the database by checking input arguments even if we know they -%% come from "good" code. - -new_db() -> ets:new(erlog_database, [set,protected,{keypos,1}]). - -%% add_built_in(Functor, Database) -> NewDatabase. -%% Add Functor as a built-in in the database. - -add_built_in(Functor, Db) -> - ets:insert(Db, {Functor,built_in}), - Db. - -%% add_compiled_proc(Functor, Module, Function, Database) -> NewDatabase. -%% Add Functor as a compiled procedure with code in Module:Function. No -%% checking. - -add_compiled_proc(Functor, M, F, Db) -> - case ets:lookup(Db, Functor) of - [{_,built_in}] -> - permission_error(modify, static_procedure, pred_ind(Functor), Db); - [_] -> ets:insert(Db, {Functor,code,{M,F}}); - [] -> ets:insert(Db, {Functor,code,{M,F}}) - end, - Db. - -%% assertz_clause(Clause, Database) -> NewDatabase. -%% assertz_clause(Head, Body, Database) -> NewDatabase. -%% Assert a clause into the database first checking that it is well -%% formed. - -assertz_clause({':-',H,B}, Db) -> assertz_clause(H, B, Db); -assertz_clause(H, Db) -> assertz_clause(H, true, Db). - -assertz_clause(Head, Body0, Db) -> - {Functor,Body} = case catch {ok,functor(Head), - well_form_body(Body0, false, sture)} of - {erlog_error,E} -> erlog_error(E, Db); - {ok,F,B} -> {F,B} - end, - case ets:lookup(Db, Functor) of - [{_,built_in}] -> permission_error(pred_ind(Functor), Db); - [{_,code,_}] -> permission_error(pred_ind(Functor), Db); - [{_,clauses,Tag,Cs}] -> - ets:insert(Db, {Functor,clauses,Tag+1,Cs ++ [{Tag,Head,Body}]}); - [] -> ets:insert(Db, {Functor,clauses,1,[{0,Head,Body}]}) - end, - Db. - -%% asserta_clause(Clause, Database) -> NewDatabase. -%% asserta_clause(Head, Body, Database) -> NewDatabase. -%% Assert a clause into the database first checking that it is well -%% formed. - -asserta_clause({':-',H,B}, Db) -> asserta_clause(H, B, Db); -asserta_clause(H, Db) -> asserta_clause(H, true, Db). - -asserta_clause(Head, Body0, Db) -> - {Functor,Body} = case catch {ok,functor(Head), - well_form_body(Body0, false, sture)} of - {erlog_error,E} -> erlog_error(E, Db); - {ok,F,B} -> {F,B} - end, - case ets:lookup(Db, Functor) of - [{_,built_in}] -> permission_error(pred_ind(Functor), Db); - [{_,code,_}] -> permission_error(pred_ind(Functor), Db); - [{_,clauses,Tag,Cs}] -> - ets:insert(Db, {Functor,clauses,Tag+1,[{Tag,Head,Body}|Cs]}); - [] -> ets:insert(Db, {Functor,clauses,1,[{0,Head,Body}]}) - end, - Db. - -%% retract_clause(Functor, ClauseTag, Database) -> NewDatabase. -%% Retract (remove) the clause with tag ClauseTag from the list of -%% clauses of Functor. - -retract_clause(F, Ct, Db) -> - case ets:lookup(Db, F) of - [{_,built_in}] -> - permission_error(modify, static_procedure, pred_ind(F), Db); - [{_,code,_}] -> - permission_error(modify, static_procedure, pred_ind(F), Db); - [{_,clauses,Nt,Cs}] -> - ets:insert(Db, {F,clauses,Nt,lists:keydelete(Ct, 1, Cs)}); - [] -> ok %Do nothing - end, - Db. - -%% abolish_clauses(Functor, Database) -> NewDatabase. - -abolish_clauses(Func, Db) -> - case ets:lookup(Db, Func) of - [{_,built_in}] -> - permission_error(modify, static_procedure, pred_ind(F), Db); - [{_,code,_}] -> ets:delete(Db, Func); - [{_,clauses,_,_}] -> ets:delete(Db, Func); - [] -> ok %Do nothing - end, - Db. - -%% get_procedure(Functor, Database) -> -%% built_in | {code,{Mod,Func}} | {clauses,[Clause]} | undefined. -%% Return the procedure type and data for a functor. - -get_procedure(Func, Db) -> - case ets:lookup(Db, Func) of - [{_,built_in}] -> built_in; - [{_,code,C}] -> {code,C}; - [{_,clauses,_,Cs}] -> {clauses,Cs}; - [] -> undefined - end. - -%% get_procedure_type(Functor, Database) -> -%% built_in | compiled | interpreted | undefined. -%% Return the procedure type for a functor. - -get_procedure_type(Func, Db) -> - case ets:lookup(Db, Func) of - [{_,built_in}] -> built_in; %A built-in - [{_,code,C}] -> compiled; %Compiled (perhaps someday) - [{_,clauses,_,Cs}] -> interpreted; %Interpreted clauses - [] -> undefined %Undefined - end. - -%% get_interp_functors(Database) -> [Functor]. - -get_interp_functors(Db) -> - ets:foldl(fun ({_,built_in}, Fs) -> Fs; - ({Func,code,_}, Fs) -> [Func|Fs]; - ({Func,clauses,_,_}, Fs) -> [Func|Fs] - end, [], Db). --endif. - -%% functor(Goal) -> {Name,Arity}. - -functor(T) when ?IS_FUNCTOR(T) -> - {element(1, T),tuple_size(T)-1}; -functor(T) when is_atom(T) -> {T,0}; -functor(T) -> type_error(callable, T). - -%% well_form_body(Body, HasCutAfter, CutLabel) -> {Body,HasCut}. -%% well_form_body(Body, Tail, HasCutAfter, CutLabel) -> {Body,HasCut}. -%% Check that Body is well-formed, flatten conjunctions, fix cuts and -%% add explicit call to top-level variables. - -well_form_body(Body, Cut, Label) -> well_form_body(Body, [], Cut, Label). - -well_form_body({',',L,R}, Tail0, Cut0, Label) -> - {Tail1,Cut1} = well_form_body(R, Tail0, Cut0, Label), - well_form_body(L, Tail1, Cut1, Label); -well_form_body({';',{'->',C0,T0},E0}, Tail, Cut0, Label) -> - {T1,Tc} = well_form_body(T0, Cut0, Label), - {E1,Ec} = well_form_body(E0, Cut0, Label), - %% N.B. an extra cut will be added at run-time! - {C1,_} = well_form_body(C0, true, Label), - {[{{if_then_else},C1,T1,E1,Label}|Tail],Tc or Ec}; -well_form_body({';',L0,R0}, Tail, Cut0, Label) -> - {L1,Lc} = well_form_body(L0, Cut0, Label), - {R1,Rc} = well_form_body(R0, Cut0, Label), - {[{{disj},L1,R1}|Tail],Lc or Rc}; -well_form_body({'->',C0,T0}, Tail, Cut0, Label) -> - {T1,Cut1} = well_form_body(T0, Cut0, Label), - %% N.B. an extra cut will be added at run-time! - {C1,_} = well_form_body(C0, true, Label), - {[{{if_then},C1,T1,Label}|Tail],Cut1}; -well_form_body({once,G}, Tail, Cut, Label) -> - %% N.B. an extra cut is added at run-time! - {G1,_} = well_form_body(G, true, Label), - {[{{once},G1,Label}|Tail],Cut}; -well_form_body({V}, Tail, Cut, _Label) -> - {[{call,{V}}|Tail],Cut}; -well_form_body(true, Tail, Cut, _Label) -> {Tail,Cut}; %No-op -well_form_body(fail, _Tail, _Cut, _Label) -> {[fail],false}; %No further -well_form_body('!', Tail, Cut, Label) -> - {[{{cut},Label,not Cut}|Tail],true}; -well_form_body(Goal, Tail, Cut, _Label) -> - functor(Goal), %Check goal - {[Goal|Tail],Cut}. - -%% well_form_goal(Goal, Tail, HasCutAfter, CutLabel) -> {Body,HasCut}. -%% Check that Goal is well-formed, flatten conjunctions, fix cuts and -%% add explicit call to top-level variables. - -well_form_goal({',',L,R}, Tail0, Cut0, Label) -> - {Tail1,Cut1} = well_form_goal(R, Tail0, Cut0, Label), - well_form_goal(L, Tail1, Cut1, Label); -well_form_goal({';',{'->',C0,T0},E0}, Tail, Cut0, Label) -> - {T1,Tc} = well_form_goal(T0, Tail, Cut0, Label), - {C1,_} = well_form_goal(C0, [{{cut},Label,true}|T1], true, Label), - {E1,Ec} = well_form_goal(E0, Tail, Cut0, Label), - {[{{if_then_else},E1,Label}|C1],Tc or Ec}; -well_form_goal({';',L0,R0}, Tail, Cut0, Label) -> - {L1,Lc} = well_form_goal(L0, Tail, Cut0, Label), - {R1,Rc} = well_form_goal(R0, Tail, Cut0, Label), - {[{{disj},R1}|L1],Lc or Rc}; -well_form_goal({'->',C0,T0}, Tail, Cut0, Label) -> - {T1,Cut1} = well_form_goal(T0, Tail, Cut0, Label), - %% N.B. an extra cut will be added at run-time! - {C1,_} = well_form_goal(C0, [{{cut},Label,true}|T1], true, Label), - {[{{if_then},Label}|C1],Cut1}; -well_form_goal({once,G}, Tail, Cut, Label) -> - {G1,_} = well_form_goal(G, [{{cut},Label,true}|Tail], true, Label), - {[{{once},Label}|G1],Cut}; -well_form_goal({V}, Tail, Cut, _Label) -> - {[{call,{V}}|Tail],Cut}; -well_form_goal(true, Tail, Cut, _Label) -> {Tail,Cut}; %No-op -well_form_goal(fail, _Tail, _Cut, _Label) -> {[fail],false}; %No further -well_form_goal('!', Tail, Cut, Label) -> - {[{{cut},Label,not Cut}|Tail],true}; -well_form_goal(Goal, Tail, Cut, _Label) -> - functor(Goal), %Check goal - {[Goal|Tail],Cut}. - -%% term_instance(Term, VarNum) -> {Term,NewRepls,NewVarNum}. -%% term_instance(Term, Repls, VarNum) -> {Term,NewRepls,NewVarNum}. -%% Generate a copy of a term with new, fresh unused variables. No -%% bindings from original variables to new variables. It can handle -%% replacing integer variables with overlapping integer ranges. Don't -%% check Term as it should already be checked. Use orddict as there -%% will seldom be many variables and it it fast to setup. - -term_instance(A, Vn) -> term_instance(A, orddict:new(), Vn). - -term_instance([], Rs, Vn) -> {[],Rs,Vn}; -term_instance([H0|T0], Rs0, Vn0) -> - {H,Rs1,Vn1} = term_instance(H0, Rs0, Vn0), - {T,Rs2,Vn2} = term_instance(T0, Rs1, Vn1), - {[H|T],Rs2,Vn2}; -term_instance({'_'}, Rs, Vn) -> {{Vn},Rs,Vn+1}; %Unique variable -term_instance({V0}, Rs0, Vn0) -> %Other variables - case orddict:find(V0, Rs0) of - {ok,V1} -> {V1,Rs0,Vn0}; - error -> - V1 = {Vn0}, - {V1,orddict:store(V0, V1, Rs0),Vn0+1} - end; -%% Special case some smaller structures. -term_instance({Atom,Arg}, Rs0, Vn0) -> - {CopyArg,Rs1,Vn1} = term_instance(Arg, Rs0, Vn0), - {{Atom,CopyArg},Rs1,Vn1}; -term_instance({Atom,A1,A2}, Rs0, Vn0) -> - {CopyA1,Rs1,Vn1} = term_instance(A1, Rs0, Vn0), - {CopyA2,Rs2,Vn2} = term_instance(A2, Rs1, Vn1), - {{Atom,CopyA1,CopyA2},Rs2,Vn2}; -term_instance(T, Rs0, Vn0) when is_tuple(T) -> - As0 = tl(tuple_to_list(T)), - {As1,Rs1,Vn1} = term_instance(As0, Rs0, Vn0), - {list_to_tuple([element(1, T)|As1]),Rs1,Vn1}; -term_instance(A, Rs, Vn) -> {A,Rs,Vn}. %Constant - -%% unify_head(Goal, Head, Bindings, VarNum) -> -%% {succeed,Repls,NewBindings,NewVarNum} | fail -%% Unify a goal with a head without creating an instance of the -%% head. This saves us creating many variables which are local to the -%% clause and saves many variable bindings. - -unify_head(Goal, Head, Bs, Vn) -> - unify_head(deref(Goal, Bs), Head, orddict:new(), Bs, Vn). - -unify_head(G, H, Rs, Bs, Vn) when ?IS_CONSTANT(G), G == H -> - {succeed,Rs,Bs,Vn}; -unify_head(_T, {'_'}, Rs, Bs, Vn) -> {succeed,Rs,Bs,Vn}; -unify_head(T, {V0}, Rs, Bs0, Vn) -> - %% Now for the tricky bit! - case orddict:find(V0, Rs) of - {ok,V1} -> %Already have a replacement - case unify(T, V1, Bs0) of - {succeed,Bs1} -> {succeed,Rs,Bs1,Vn}; - fail -> fail - end; - error -> %Add a replacement - {succeed,orddict:store(V0, T, Rs),Bs0,Vn} - end; -unify_head({_}=Var, H0, Rs0, Bs, Vn0) -> - %% Must have an instance here. - {H1,Rs1,Vn1} = term_instance(H0, Rs0, Vn0), - {succeed,Rs1,add_binding(Var, H1, Bs),Vn1}; -unify_head([GH|GT], [HH|HT], Rs0, Bs0, Vn0) -> - case unify_head(deref(GH, Bs0), HH, Rs0, Bs0, Vn0) of - {succeed,Rs1,Bs1,Vn1} -> unify_head(deref(GT, Bs1), HT, Rs1, Bs1, Vn1); - fail -> fail - end; -unify_head([], [], Rs, Bs, Vn) -> {succeed,Rs,Bs,Vn}; -unify_head(G, H, Rs, Bs, Vn) when tuple_size(G) == tuple_size(H), - element(1, G) == element(1, H) -> - unify_head_args(G, H, Rs, Bs, Vn, 2, tuple_size(G)); -unify_head(_G, _H, _Rs, _Bs, _Vn) -> fail. - -unify_head_args(_G, _H, Rs, Bs, Vn, I, S) when I > S -> - {succeed,Rs,Bs,Vn}; -unify_head_args(G, H, Rs0, Bs0, Vn0, I, S) -> - case unify_head(deref(element(I, G), Bs0), element(I, H), Rs0, Bs0, Vn0) of - {succeed,Rs1,Bs1,Vn1} -> unify_head_args(G, H, Rs1, Bs1, Vn1, I+1, S); - fail -> fail - end. - -%% body_instance(Body, Tail, Repls, VarNum, Label) -> -%% {Body,NewRepls,NewVarNum}. -%% Generate a copy of a body in a form ready to be interpreted. No -%% bindings from original variables to new variables. It can handle -%% replacing integer variables with overlapping integer ranges. Don't -%% check Term as it should already be checked. Use term_instance to -%% handle goals. N.B. We have to be VERY careful never to go into the -%% original tail as this will cause havoc. - -body_instance([{{cut}=Cut,_,Last}|Gs0], Tail, Rs0, Vn0, Label) -> - {Gs1,Rs1,Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), - {[{Cut,Label,Last}|Gs1],Rs1,Vn1}; -body_instance([{{disj}=Disj,L0,R0}|Gs0], Tail, Rs0, Vn0, Label) -> - {Gs1,Rs1,Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), - %% Append Gs1 directly to L and R. - {L1,Rs2,Vn2} = body_instance(L0, Gs1, Rs1, Vn1, Label), - {R1,Rs3,Vn3} = body_instance(R0, Gs1, Rs2, Vn2, Label), - {[{Disj,R1}|L1],Rs3,Vn3}; -body_instance([{{if_then}=IT,C0,T0,_}|Gs0], Tail, Rs0, Vn0, Label) -> - {Gs1,Rs1,Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), - {T1,Rs2,Vn2} = body_instance(T0, Gs1, Rs1, Vn1, Label), - {C1,Rs3,Vn3} = body_instance(C0, [{{cut},Label,true}|T1], Rs2, Vn2, Label), - %% Append Gs1 directly to T1 to C1. - {[{IT,Label}|C1],Rs3,Vn3}; -body_instance([{{if_then_else}=ITE,C0,T0,E0,_}|Gs0], Tail, Rs0, Vn0, Label) -> - {Gs1,Rs1,Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), - {T1,Rs2,Vn2} = body_instance(T0, Gs1, Rs1, Vn1, Label), - {C1,Rs3,Vn3} = body_instance(C0, [{{cut},Label,true}|T1], Rs2, Vn2, Label), - {E1,Rs4,Vn4} = body_instance(E0, Gs1, Rs3, Vn3, Label), - {[{ITE,E1,Label}|C1],Rs4,Vn4}; -body_instance([{{once}=Once,G0,_}|Gs0], Tail, Rs0, Vn0, Label) -> - {Gs1,Rs1,Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), - {G1,Rs2,Vn2} = body_instance(G0, [{{cut},Label,true}|Gs1], Rs1, Vn1, Label), - {[{Once,Label}|G1],Rs2,Vn2}; -body_instance([G0|Gs0], Tail, Rs0, Vn0, Label) -> - {Gs1,Rs1,Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), - {G1,Rs2,Vn2} = term_instance(G0, Rs1, Vn1), - {[G1|Gs1],Rs2,Vn2}; -body_instance([], Tail, Rs, Vn, _Label) -> {Tail,Rs,Vn}. - -%% body_term(Body, Repls, VarNum) -> {Term,NewRepls,NewVarNum}. -%% Generate a copy of a body as a term with new, fresh unused -%% variables. No bindings from original variables to new -%% variables. It can handle replacing integer variables with -%% overlapping integer ranges. Don't check Term as it should already -%% be checked. Use orddict as there will seldom be many variables and -%% it it fast to setup. - -body_term([{{cut},_,_}|Gs0], Rs0, Vn0) -> - {Gs1,Rs1,Vn1} = body_term(Gs0, Rs0, Vn0), - {body_conj('!', Gs1),Rs1,Vn1}; -body_term([{{disj},L0,R0}|Gs0], Rs0, Vn0) -> - {Gs1,Rs1,Vn1} = body_term(Gs0, Rs0, Vn0), - {L1,Rs2,Vn2} = body_term(L0, Rs1, Vn1), - {R1,Rs3,Vn3} = body_term(R0, Rs2, Vn2), - {body_conj({';',L1,R1}, Gs1),Rs3,Vn3}; -body_term([{{if_then},C0,T0,_}|Gs0], Rs0, Vn0) -> - {Gs1,Rs1,Vn1} = body_term(Gs0, Rs0, Vn0), - {C1,Rs2,Vn2} = body_term(C0, Rs1, Vn1), - {T1,Rs3,Vn3} = body_term(T0, Rs2, Vn2), - {body_conj({'->',C1,T1}, Gs1),Rs3,Vn3}; -body_term([{{if_then_else},C0,T0,E0,_}|Gs0], Rs0, Vn0) -> - {Gs1,Rs1,Vn1} = body_term(Gs0, Rs0, Vn0), - {C1,Rs2,Vn2} = body_term(C0, Rs1, Vn1), - {T1,Rs3,Vn3} = body_term(T0, Rs2, Vn2), - {E1,Rs4,Vn4} = body_term(E0, Rs3, Vn3), - {body_conj({';',{'->',C1,T1},E1}, Gs1),Rs4,Vn4}; -body_term([{{once},G0,_}|Gs0], Rs0, Vn0) -> - {Gs1,Rs1,Vn1} = body_term(Gs0, Rs0, Vn0), - {G1,Rs2,Vn2} = body_term(G0, Rs1, Vn1), - {body_conj({once,G1}, Gs1),Rs2,Vn2}; -body_term([G0|Gs0], Rs0, Vn0) -> - {Gs1,Rs1,Vn1} = body_term(Gs0, Rs0, Vn0), - {G1,Rs2,Vn2} = term_instance(G0, Rs1, Vn1), - {body_conj(G1, Gs1),Rs2,Vn2}; -body_term([], Rs, Vn) -> {true,Rs,Vn}. - -body_conj(L, true) -> L; -body_conj(L, R) -> {',',L,R}. - -pred_ind({N,A}) -> {'/',N,A}. - -%% pred_ind(N, A) -> {'/',N,A}. - -%% Bindings -%% Bindings are kept in a dict where the key is the variable name. -%%-define(BIND, orddict). --define(BIND, dict). - -new_bindings() -> ?BIND:new(). - -add_binding({V}, Val, Bs0) -> - ?BIND:store(V, Val, Bs0). - -get_binding({V}, Bs) -> - ?BIND:find(V, Bs). - -%% deref(Term, Bindings) -> Term. -%% Dereference a variable, else just return the term. - -deref({V}=T0, Bs) -> - case ?BIND:find(V, Bs) of - {ok,T1} -> deref(T1, Bs); - error -> T0 - end; -deref(T, _) -> T. %Not a variable, return it. - -%% deref_list(List, Bindings) -> List. -%% Dereference the top-level checking that it is a list. - -deref_list([], _) -> []; %It already is a list -deref_list([_|_]=L, _) -> L; -deref_list({V}, Bs) -> - case ?BIND:find(V, Bs) of - {ok,L} -> deref_list(L, Bs); - error -> instantiation_error() - end; -deref_list(Other, _) -> type_error(list, Other). - -%% dderef(Term, Bindings) -> Term. -%% Do a deep dereference. Completely dereference all the variables -%% occuring in a term, even those occuring in a variables value. - -dderef(A, _) when ?IS_CONSTANT(A) -> A; -dderef([], _) -> []; -dderef([H0|T0], Bs) -> - [dderef(H0, Bs)|dderef(T0, Bs)]; -dderef({V}=Var, Bs) -> - case ?BIND:find(V, Bs) of - {ok,T} -> dderef(T, Bs); - error -> Var - end; -dderef(T, Bs) when is_tuple(T) -> - Es0 = tuple_to_list(T), - Es1 = dderef(Es0, Bs), - list_to_tuple(Es1). - -%% dderef_list(List, Bindings) -> List. -%% Dereference all variables to any depth but check that the -%% top-level is a list. - -dderef_list([], _Bs) -> []; -dderef_list([H|T], Bs) -> - [dderef(H, Bs)|dderef_list(T, Bs)]; -dderef_list({V}, Bs) -> - case ?BIND:find(V, Bs) of - {ok,L} -> dderef_list(L, Bs); - error -> instantiation_error() - end; -dderef_list(Other, _Bs) -> type_error(list, Other). - -%% initial_goal(Goal) -> {Goal,Bindings,NewVarNum}. -%% initial_goal(Goal, Bindings, VarNum) -> {Goal,NewBindings,NewVarNum}. -%% Check term for well-formedness as an Erlog term and replace '_' -%% variables with unique numbered variables. Error on non-well-formed -%% goals. - -initial_goal(Goal) -> initial_goal(Goal, new_bindings(), 0). - -initial_goal({'_'}, Bs, Vn) -> {{Vn},Bs,Vn+1}; %Anonymous variable -initial_goal({Name}=Var0, Bs, Vn) when is_atom(Name) -> - case get_binding(Var0, Bs) of - {ok,Var1} -> {Var1,Bs,Vn}; - error -> - Var1 = {Vn}, - {Var1,add_binding(Var0, Var1, Bs),Vn+1} - end; -initial_goal([H0|T0], Bs0, Vn0) -> - {H1,Bs1,Vn1} = initial_goal(H0, Bs0, Vn0), - {T1,Bs2,Vn2} = initial_goal(T0, Bs1, Vn1), - {[H1|T1],Bs2,Vn2}; -initial_goal([], Bs, Vn) -> {[],Bs,Vn}; -initial_goal(S, Bs0, Vn0) when ?IS_FUNCTOR(S) -> - As0 = tl(tuple_to_list(S)), - {As1,Bs1,Vn1} = initial_goal(As0, Bs0, Vn0), - {list_to_tuple([element(1, S)|As1]),Bs1,Vn1}; -initial_goal(T, Bs, Vn) when ?IS_ATOMIC(T) -> {T,Bs,Vn}; -initial_goal(T, _Bs, _Vn) -> type_error(callable, T). diff --git a/src/erlog_io.erl b/src/erlog_io.erl deleted file mode 100644 index c5350fd..0000000 --- a/src/erlog_io.erl +++ /dev/null @@ -1,248 +0,0 @@ -%% Copyright (c) 2008-2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - -%% File : erlog_io.erl -%% Author : Robert Virding -%% Purpose : Some basic i/o functions for Erlog. -%% -%% Structures - {Functor,arg1, Arg2,...} where Functor is an atom -%% Variables - {Name} where Name is an atom or integer -%% Lists - Erlang lists -%% Atomic - Erlang constants -%% -%% There is no problem with the representation of variables as Prolog -%% functors of arity 0 are atoms. This representation is much easier -%% to test for, and create new variables with than using funny atom -%% names like '$1' (yuch!), and we need LOTS of variables. - --module(erlog_io). - --export([scan_file/1,read_file/1,read/1,read/2, - write/1,write/2,write1/1,writeq/1,writeq/2,writeq1/1, - write_canonical/1,write_canonical/2,write_canonical1/1]). - -scan_file(File) -> - case file:open(File, [read]) of - {ok,Fd} -> - try - {ok,scan_stream(Fd, 1)} - catch - throw:Term -> Term; - error:Error -> {error,einval,Error}; - exit:Exit -> {exit,einval,Exit} - after - file:close(Fd) - end; - Error -> Error - end. - -scan_stream(Fd, L0) -> - case scan_erlog_term(Fd, '', L0) of - {ok,Toks,L1} -> [Toks|scan_stream(Fd, L1)]; - {error,Error,_} -> throw({error,Error}); - {eof,_}=Eof -> Eof - end. - -%% read_file(FileName) -> {ok,[Term]} | {error,Error}. -%% Read a file containing Prolog terms. This has been taken from 'io' -%% but cleaned up using try. - -read_file(File) -> - case file:open(File, [read]) of - {ok,Fd} -> - try - {ok,read_stream(Fd, 1)} - catch - throw:Term -> Term; - error:Error -> {error,einval,Error}; - exit:Exit -> {exit,einval,Exit} - after - file:close(Fd) - end; - Error -> Error - end. - -read_stream(Fd, L0) -> - case scan_erlog_term(Fd, '', L0) of - {ok,Toks,L1} -> - case erlog_parse:term(Toks, L0) of - {ok,end_of_file} -> []; %Prolog does this. - {ok,Term} -> - [Term|read_stream(Fd, L1)]; - {error,What} -> throw({error,What}) - end; - {error,Error,_} -> throw({error,Error}); - {eof,_} -> [] - end. - -%% read([IoDevice], Prompt) -> Term. -%% A very simple read function. Returns the direct representation of -%% the term without variable processing. - -read(P) -> read(standard_io, P). - -read(Io, P) -> - case scan_erlog_term(Io, P, 1) of - {ok,Ts,_} -> - case erlog_parse:term(Ts) of - {ok,T} -> {ok,T}; - {error,Pe} -> {error,Pe} - end; - {error,Se,_} -> {error,Se}; - {eof,_} -> {ok,end_of_file} %Prolog does this - end. - -scan_erlog_term(Io, Prompt, Line) -> - io:request(Io, {get_until,Prompt,erlog_scan,tokens,[Line]}). - --record(ops, {op=false,q=true}). - -%% write([IoDevice], Term) -> ok. -%% writeq([IoDevice], Term) -> ok. -%% write_canonical([IoDevice], Term) -> ok. -%% A very simple write function. Does not pretty-print but can handle -%% operators. The xxx1 verions return an iolist of the characters. - -write(T) -> write(standard_io, T). - -write(Io, T) -> io:put_chars(Io, write1(T)). - -write1(T) -> write1(T, 1200, #ops{op=true,q=false}). - -writeq(T) -> writeq(standard_io, T). - -writeq(Io, T) -> io:put_chars(Io, writeq1(T)). - -writeq1(T) -> write1(T, 1200, #ops{op=true,q=true}). - -write_canonical(T) -> write_canonical(standard_io, T). - -write_canonical(Io, T) -> io:put_chars(Io, write_canonical1(T)). - -write_canonical1(T) -> write1(T, 1200, #ops{op=false,q=true}). - -%% write1(Term, Precedence, Ops) -> iolist(). -%% The function which does the actual writing. - -write1(T, Prec, Ops) when is_atom(T) -> write1_atom(T, Prec, Ops); -write1(T, _, _) when is_number(T) -> io_lib:write(T); -write1({V}, _, _) when is_integer(V) -> "_" ++ integer_to_list(V); -write1({V}, _, _) -> atom_to_list(V); %Variable -write1([H|T], _, Ops) -> - [$[,write1(H, 999, Ops),write1_tail(T, Ops),$]]; -write1([], _, _) -> "[]"; -write1({F,A}, Prec, #ops{op=true}=Ops) -> - case erlog_parse:prefix_op(F) of - {yes,OpP,ArgP} -> - Out = [write1(F, 1200, Ops),$\s,write1(A, ArgP, Ops)], - write1_prec(Out, OpP, Prec); - no -> - case erlog_parse:postfix_op(F) of - {yes,ArgP,OpP} -> - Out = [write1(A, ArgP, Ops),$\s,write1(F, 1200, Ops)], - write1_prec(Out, OpP, Prec); - no -> - [write1(F, 1200, Ops),$(,write1(A, 999, Ops),$)] - end - end; -write1({',',A1,A2}, Prec, #ops{op=true}=Ops) -> - %% Must special case , here. - Out = [write1(A1, 999, Ops),", ",write1(A2, 1000, Ops)], - write1_prec(Out, 1000, Prec); -write1({F,A1,A2}, Prec, #ops{op=true}=Ops) -> - case erlog_parse:infix_op(F) of - {yes,Lp,OpP,Rp} -> - Out = [write1(A1, Lp, Ops),$\s,write1(F, 1200, Ops), - $\s,write1(A2, Rp,Ops)], - write1_prec(Out, OpP, Prec); - no -> - [write1(F, 1200, Ops),$(,write1(A1, 999, Ops), - $,,write1(A2, 999, Ops),$)] - end; -write1(T, _, Ops) when is_tuple(T) -> - [F,A1|As] = tuple_to_list(T), - [write1(F, 1200, Ops),$(,write1(A1, 999, Ops),write1_tail(As, Ops),$)]; -write1(T, _, _) -> %Else use default Erlang. - io_lib:write(T). - -%% write1_prec(OutString, OpPrecedence, Precedence) -> iolist(). -%% Encase OutString with (..) if op precedence higher than -%% precedence. - -write1_prec(Out, OpP, Prec) when OpP > Prec -> [$(,Out,$)]; -write1_prec(Out, _, _) -> Out. - -write1_tail([T|Ts], Ops) -> - [$,,write1(T, 999, Ops)|write1_tail(Ts, Ops)]; -write1_tail([], _) -> []; -write1_tail(T, Ops) -> [$|,write1(T, 999, Ops)]. - -write1_atom(A, Prec, #ops{q=false}) -> %No quoting - write1_atom_1(A, atom_to_list(A), Prec); -write1_atom(A, Prec, _) when A == '!'; A == ';' -> %Special atoms - write1_atom_1(A, atom_to_list(A), Prec); -write1_atom(A, Prec, _) -> - case atom_to_list(A) of - [C|Cs]=Acs -> - case (lower_case(C) andalso alpha_chars(Cs)) - orelse symbol_chars(Acs) of - true -> write1_atom_1(A, Acs, Prec); - false -> - Qcs = quote_atom(Acs), - write1_atom_1(A, Qcs, Prec) - end; - [] -> write1_atom_1(A, "''", Prec) - end. - -write1_atom_1(A, Acs, Prec) -> - case erlog_parse:prefix_op(A) of - {yes,OpP,_} when OpP > Prec -> [$(,Acs,$)]; - _ -> - case erlog_parse:postfix_op(A) of - {yes,_,OpP} when OpP > Prec -> [$(,Acs,$)]; - _ -> Acs - end - end. - -quote_atom(Acs) -> [$',Acs,$']. %Very naive as yet. - -symbol_chars(Cs) -> lists:all(fun symbol_char/1, Cs). - -symbol_char($-) -> true; -symbol_char($#) -> true; -symbol_char($$) -> true; -symbol_char($&) -> true; -symbol_char($*) -> true; -symbol_char($+) -> true; -symbol_char($.) -> true; -symbol_char($/) -> true; -symbol_char($\\) -> true; -symbol_char($:) -> true; -symbol_char($<) -> true; -symbol_char($=) -> true; -symbol_char($>) -> true; -symbol_char($?) -> true; -symbol_char($@) -> true; -symbol_char($^) -> true; -symbol_char($~) -> true; -symbol_char(_) -> false. - -lower_case(C) -> (C >= $a) and (C =< $z). - -alpha_chars(Cs) -> lists:all(fun alpha_char/1, Cs). - -alpha_char($_) -> true; -alpha_char(C) when C >= $A, C =< $Z -> true; -alpha_char(C) when C >= $0, C =< $9 -> true; -alpha_char(C) -> lower_case(C). diff --git a/src/erlog_lists.erl b/src/erlog_lists.erl deleted file mode 100644 index 564de43..0000000 --- a/src/erlog_lists.erl +++ /dev/null @@ -1,204 +0,0 @@ -%% Copyright (c) 2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - -%% File : erlog_lists.erl -%% Author : Robert Virding -%% Purpose : Standard Erlog lists library. -%% -%% This is a standard lists library for Erlog. Everything here is -%% pretty basic and common to most Prologs. We are experimenting here -%% and some predicates are compiled. We only get a small benefit when -%% only implementing indexing on the first argument. - --module(erlog_lists). - --include("erlog_int.hrl"). - -%% Main interface functions. --export([load/1]). - -%% Library functions. --export([append_3/6,insert_3/6,member_2/6,memberchk_2/6,reverse_2/6,sort_2/6]). - -%%-compile(export_all). - --import(lists, [map/2,foldl/3]). - -%% We use these a lot so we import them for cleaner code. --import(erlog_int, [prove_body/5,unify_prove_body/7,unify_prove_body/9,fail/2, - add_binding/3,make_vars/2, - deref/2,dderef/2,dderef_list/2,unify/3, - term_instance/2, - add_built_in/2,add_compiled_proc/4, - asserta_clause/2,assertz_clause/2]). - -%% load(Database) -> Database. -%% Assert predicates into the database. - -load(Db0) -> - %% Compiled common list library. - Db1 = foldl(fun ({Head,M,F}, Db) -> - add_compiled_proc(Head, M, F, Db) end, Db0, - [ - {{append,3},?MODULE,append_3}, - {{insert,3},?MODULE,insert_3}, - {{member,2},?MODULE,member_2}, - {{memberchk,2},?MODULE,memberchk_2}, - {{reverse,2},?MODULE,reverse_2}, - {{sort,2},?MODULE,sort_2} - ]), - %% Finally interpreted common list library. - foldl(fun (Clause, Db) -> assertz_clause(Clause, Db) end, Db1, - [ - %% insert(L, X, [X|L]). insert([H|L], X, [H|L1]) :- insert(L, X, L1). - %% delete([X|L], X, L). delete([H|L], X, [H|L1]) :- delete(L, X, L1). - {':-',{delete,{1},{2},{3}},{insert,{3},{2},{1}}}, - %% perm([], []). - %% perm([X|Xs], Ys1) :- perm(Xs, Ys), insert(Ys, X, Ys1). - {perm,[],[]}, - {':-',{perm,[{1}|{2}],{3}},{',',{perm,{2},{4}},{insert,{4},{1},{3}}}} - ]). - -%% append_3(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. -%% append([], L, L). -%% append([H|T], L, [H|L1]) :- append(T, L, L1). -%% Here we attempt to compile indexing in the first argument. - -append_3({append,A1,L,A3}, Next0, Cps, Bs0, Vn, Db) -> - case deref(A1, Bs0) of - [] -> %Cannot backtrack - unify_prove_body(L, A3, Next0, Cps, Bs0, Vn, Db); - [H|T] -> %Cannot backtrack - L1 = {Vn}, - Next1 = [{append,T,L,L1}|Next0], - unify_prove_body(A3, [H|L1], Next1, Cps, Bs0, Vn+1, Db); - {_}=Var -> %This can backtrack - FailFun = fun (LCp, LCps, LDb) -> - fail_append_3(LCp, LCps, LDb, Var, L, A3) - end, - Cp = #cp{type=compiled,data=FailFun,next=Next0,bs=Bs0,vn=Vn}, - Bs1 = add_binding(Var, [], Bs0), - unify_prove_body(L, A3, Next0, [Cp|Cps], Bs1, Vn, Db); - _ -> fail(Cps, Db) %Will fail here! - end. - -fail_append_3(#cp{next=Next0,bs=Bs0,vn=Vn}, Cps, Db, A1, L, A3) -> - H = {Vn}, - T = {Vn+1}, - L1 = {Vn+2}, - Bs1 = add_binding(A1, [H|T], Bs0), %A1 always a variable here. - Next1 = [{append,T,L,L1}|Next0], - unify_prove_body(A3, [H|L1], Next1, Cps, Bs1, Vn+3, Db). - -%% insert_3(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. -%% insert(L, X, [X|L]). -%% insert([H|L], X, [H|L1]) :- insert(L, X, L1). - -insert_3({insert,A1,A2,A3}, Next, Cps, Bs, Vn, Db) -> - FailFun = fun (LCp, LCps, LDb) -> - fail_insert_3(LCp, LCps, LDb, A1, A2, A3) - end, - Cp = #cp{type=compiled,data=FailFun,next=Next,bs=Bs,vn=Vn}, - unify_prove_body(A3, [A2|A1], Next, [Cp|Cps], Bs, Vn, Db). - -fail_insert_3(#cp{next=Next0,bs=Bs,vn=Vn}, Cps, Db, A1, X, A3) -> - H = {Vn}, - L = {Vn+1}, - L1 = {Vn+2}, - Next1 = [{insert,L,X,L1}|Next0], - unify_prove_body(A1, [H|L], A3, [H|L1], Next1, Cps, Bs, Vn+3, Db). - -%% member_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. -%% member(X, [X|_]). -%% member(X, [_|T]) :- member(X, T). - -member_2({member,A1,A2}, Next, Cps, Bs, Vn, Db) -> - FailFun = fun (LCp, LCps, LDb) -> - fail_member_2(LCp, LCps, LDb, A1, A2) - end, - Cp = #cp{type=compiled,data=FailFun,next=Next,bs=Bs,vn=Vn}, - T = {Vn}, - unify_prove_body(A2, [A1|T], Next, [Cp|Cps], Bs, Vn+1, Db). - -fail_member_2(#cp{next=Next0,bs=Bs,vn=Vn}, Cps, Db, A1, A2) -> - H = {Vn}, - T = {Vn+1}, - Next1 = [{member,A1,T}|Next0], - unify_prove_body(A2, [H|T], Next1, Cps, Bs, Vn+2, Db). - -%% memberchk_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. -%% memberchk(X, [X|_]) :- !. -%% memberchk(X, [_|T]) :- member(X, T). -%% We don't build the list and we never backtrack so we can be smart -%% and match directly. Should we give a type error? - -memberchk_2({memberchk,A1,A2}, Next, Cps, Bs0, Vn, Db) -> - case deref(A2, Bs0) of - [H|T] -> - case unify(A1, H, Bs0) of - {succeed,Bs1} -> - prove_body(Next, Cps, Bs1, Vn, Db); - fail -> - memberchk_2({memberchk,A1,T}, Next, Cps, Bs0, Vn, Db) - end; - {_} -> erlog_int:instantiation_error(); - _ -> fail(Cps, Db) - end. - -%% reverse_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. -%% reverse([], []). -%% reverse([H|L1], L) :- reverse(L1, L2), append(L2, [H], L). -%% Here we attempt to compile indexing in the first argument. - -reverse_2({reverse,A1,A2}, Next0, Cps, Bs0, Vn, Db) -> - case deref(A1, Bs0) of - [] -> - unify_prove_body(A2, [], Next0, Cps, Bs0, Vn, Db); - [H|T] -> - L = {Vn}, - L1 = A2, - %% Naive straight expansion of body. - %%Next1 = [{reverse,T,L},{append,L,[H],L1}|Next0], - %%prove_body(Next1, Cps, Bs0, Vn+1, Db); - %% Smarter direct calling of local function. - Next1 = [{append,L,[H],L1}|Next0], - reverse_2({reverse,T,L}, Next1, Cps, Bs0, Vn+1, Db); - {_}=Var -> - FailFun = fun (LCp, LCps, LDb) -> - fail_reverse_2(LCp, LCps, LDb, Var, A2) - end, - Cp = #cp{type=compiled,data=FailFun,next=Next0,bs=Bs0,vn=Vn}, - Bs1 = add_binding(Var, [], Bs0), - unify_prove_body(A2, [], Next0, [Cp|Cps], Bs1, Vn, Db); - _ -> fail(Cps, Db) %Will fail here! - end. - -fail_reverse_2(#cp{next=Next,bs=Bs0,vn=Vn}, Cps, Db, A1, A2) -> - H = {Vn}, - T = {Vn+1}, - L1 = A2, - L = {Vn+2}, - Bs1 = add_binding(A1, [H|T], Bs0), - %%Next1 = [{reverse,T,L},{apperse,L,[H],L1}|Next], - %%prove_body(Next1, Cps, Bs1, Vn+3, Db). - Next1 = [{append,L,[H],L1}|Next], - reverse_2({reverse,T,L}, Next1, Cps, Bs1, Vn+3, Db). - -%% sort_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. -%% sort(List, SortedList). - -sort_2({sort,L0,S}, Next, Cps, Bs, Vn, Db) -> - %% This may throw an erlog error, we don't catch it here. - L1 = lists:usort(dderef_list(L0, Bs)), - unify_prove_body(S, L1, Next, Cps, Bs, Vn, Db). diff --git a/src/erlog_parse.erl b/src/erlog_parse.erl deleted file mode 100644 index fc88d84..0000000 --- a/src/erlog_parse.erl +++ /dev/null @@ -1,313 +0,0 @@ -%% Copyright (c) 2008-2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - -%% File : erlog_parse.erl -%% Author : Robert Virding -%% Purpose : Erlog parser -%% -%% Parses Erlog tokens into Erlog terms. Based on the Standard prolog -%% parser and directly coded from the parser description. To handle -%% back-tracking in the parser we use a continuation style using funs -%% where each fun handles one step of what follows. This allows -%% back-tracking. This may not be a specially efficient way of -%% parsing but it is simple and easy to derive from the -%%% description. No logical variables are necessary here. - --module(erlog_parse). - --export([term/1,term/2,format_error/1]). --export([prefix_op/1,infix_op/1,postfix_op/1]). - --compile({nowarn_unused_function,[type/1,line/1,val/1]}). -%% -compile(export_all). - -term(Toks) -> term(Toks, 1). - -term(Toks, _) -> - case term(Toks, 1200, fun(Ts, T) -> all_read(Ts, T) end) of - {succeed,Term} -> {ok,Term}; - {fail,{Line,Error}} -> {error,{Line,?MODULE,Error}} - end. - -all_read([{'.',_}], Term) -> {succeed,Term}; -all_read([{T,L}|_], _) -> syntax_error(L, {operator_expected,T}); -all_read([{_,L,V}|_], _) -> syntax_error(L, {operator_expected,V}); -all_read([], _) -> syntax_error(9999, premature_end). - -syntax_error(Line, Error) -> {fail,{Line,Error}}. -%% syntax_error(Line, Error) -> -%% io:fwrite("se: ~p\n", [{Line,Error}]), {fail,{Line,Error}}. - -format_error(premature_end) -> "premature end"; -format_error({operator_expected,T}) -> - io_lib:fwrite("operator expected before: ~w", [T]); -format_error({illegal,T}) -> - io_lib:fwrite("illegal token: ~w", [T]); -format_error(no_term) -> "missing term"; -format_error({op_priority,Op}) -> - io_lib:fwrite("operator priority clash: ~w", [Op]); -format_error({expected,T}) -> - io_lib:fwrite("~w or operator expected", [T]). - -%% term(Tokens, Precedence, Next) -> {succeed,Term} | {fail,Error}. - -term([{number,_,N}|Toks], Prec, Next) -> rest_term(Toks, N, 0, Prec, Next); -term([{string,_,S}|Toks], Prec, Next) -> rest_term(Toks, S, 0, Prec, Next); -term([{'(',_}|Toks], Prec, Next) -> - bracket_term(Toks, Prec, Next); -term([{' (',_}|Toks], Prec, Next) -> - bracket_term(Toks, Prec, Next); -term([{'{',L},{'}',_}|Toks], Prec, Next) -> - term([{atom,L,'{}'}|Toks], Prec, Next); -term([{'{',_}|Toks0], Prec, Next) -> - term(Toks0, 1200, - fun (Toks1, Term) -> - expect(Toks1, '}', Term, - fun (Toks2, Term1) -> - rest_term(Toks2, {'{}',Term1}, 0, Prec, Next) - end) - end); -term([{'[',_},{']',_}|Toks], Prec, Next) -> - rest_term(Toks, [], 0, Prec, Next); -term([{'[',_}|Toks0], Prec, Next) -> - term(Toks0, 999, - fun (Toks1, E) -> - list_elems(Toks1, [E], - fun (Toks2, List) -> - rest_term(Toks2, List, 0, Prec, Next) - end) - end); -term([{var,_,V}|Toks], Prec, Next) -> rest_term(Toks, {V}, 0, Prec, Next); -term([{atom,_,F},{'(',_}|Toks0], Prec, Next) -> - %% Compound term in functional syntax. - term(Toks0, 999, - fun (Toks1, A) -> - arg_list(Toks1, [A], - fun (Toks2, Args) -> - %% Equivalence of '.'/2 and lists. - Term = case {F,Args} of - {'.',[H,T]} -> [H|T]; - _ -> list_to_tuple([F|Args]) - end, - rest_term(Toks2, Term, 0, Prec, Next) - end) - end); -term([{atom,L,Op}|Toks0], Prec, Next) -> - case prefix_op(Op) of - {yes,OpP,ArgP} when Prec >= OpP -> - case possible_right_operand(Toks0) of - true -> - %% First try as prefix op, then as atom. - Next1 = fun (Toks1, Arg) -> - rest_term(Toks1, {Op,Arg}, OpP, Prec, Next) - end, - cp([fun () -> term(Toks0, ArgP, Next1) end, - fun () -> rest_term(Toks0, Op, 0, Prec, Next) end]); - false -> rest_term(Toks0, Op, 0, Prec, Next) - end; - {yes,_,_} -> - syntax_error(L, {op_priority,Op}); - no -> rest_term(Toks0, Op, 0, Prec, Next) - end; -term([{T,L}|_], _, _) -> syntax_error(L, {illegal,T}); -term([{_,L,V}|_], _, _) -> syntax_error(L, {illegal,V}); -term([], _, _) -> syntax_error(9999, no_term). - -%% possible_right_operand(Tokens) -> true | false. -%% Test if there maybe a possible right operand. - -possible_right_operand([{')',_}|_]) -> false; -possible_right_operand([{'}',_}|_]) -> false; -possible_right_operand([{']',_}|_]) -> false; -possible_right_operand([{',',_}|_]) -> false; -possible_right_operand([{'|',_}|_]) -> false; -possible_right_operand(_) -> true. - -%% bracket_term(Tokens, Precedence, Next) -> -%% {succeed,Term} | {fail,Error}. - -bracket_term(Toks0, Prec, Next) -> - term(Toks0, 1200, - fun (Toks1, Term) -> - expect(Toks1, ')', Term, - fun (Toks2, Term1) -> - rest_term(Toks2, Term1, 0, Prec, Next) - end) - end). - -%% rest_term(Tokens, Term, LeftPrec, Precedence, Next) -> -%% {succeed,Term} | {fail,Error}. -%% Have a term to the left, test if operator follows or just go on. - -rest_term([{atom,L,Op}|Toks0], Term, Left, Prec, Next) -> - cp([fun () -> infix_term(Op, L, Toks0, Term, Left, Prec, Next) end, - fun () -> postfix_term(Op, L, Toks0, Term, Left, Prec, Next) end, - fun () -> Next([{atom,L,Op}|Toks0], Term) end]); -rest_term([{',',L}|Toks0], Term, Left, Prec, Next) -> - %% , is an operator as well as a separator. - if Prec >= 1000, Left < 1000 -> - term(Toks0, 1000, - fun (Toks1, RArg) -> - rest_term(Toks1, {',',Term,RArg}, 1000, Prec, Next) - end); - true -> Next([{',',L}|Toks0], Term) - end; -rest_term(Toks, Term, _, _, Next) -> - Next(Toks, Term). - -%% infix_term(Operator, Line, Tokens, Term, LeftPrec, Prec, Next) -> -%% {succeed,Term} | {fail,Error}. -%% Test if infix operator of correct priority, fail with -%% operator_expected if not an operator to have some error. - -infix_term(Op, L, Toks0, Term, Left, Prec, Next) -> - case infix_op(Op) of - {yes,LAP,OpP,RAP} when Prec >= OpP, Left =< LAP -> - term(Toks0, RAP, - fun (Toks1, Arg2) -> - rest_term(Toks1, {Op,Term,Arg2}, OpP, Prec, Next) - end); - {yes,_,_,_} -> syntax_error(L, {op_priority,Op}); - no -> fail - end. - -%% postfix_term(Operator, Line, Tokens, Term, LeftPrec, Prec, Next) -> -%% {succeed,Term} | {fail,Error}. -%% Test if postfix operator of correct priority, fail with -%% operator_expected if not an operator to have some error. - -postfix_term(Op, L, Toks0, Term, Left, Prec, Next) -> - case postfix_op(Op) of - {yes,ArgP,OpP} when Prec >= OpP, Left =< ArgP -> - rest_term(Toks0, {Op,Term}, OpP, Prec, Next); - {yes,_,_} -> syntax_error(L, {op_priority,Op}); - no -> fail - end. - -%% list_elems(Tokens, RevElems, Next) -> -%% {succeed,Term} | {fail,Error}. - -list_elems([{',',_}|Toks0], REs, Next) -> - term(Toks0, 999, - fun (Toks1, E) -> - list_elems(Toks1, [E|REs], Next) - end); -list_elems([{'|',_}|Toks0], REs, Next) -> - term(Toks0, 999, - fun (Toks1, E) -> - expect(Toks1, ']', lists:reverse(REs, E), Next) - end); -list_elems(Toks, REs, Next) -> - expect(Toks, ']', lists:reverse(REs), Next). - -%% arg_list(Tokens, RevArgs, Next) -> {succeed,Term} | {fail,Error}. - -arg_list([{',',_}|Toks0], RAs, Next) -> - term(Toks0, 999, - fun (Toks1, Arg) -> - arg_list(Toks1, [Arg|RAs], Next) - end); -arg_list(Toks, RAs, Next) -> - expect(Toks, ')', lists:reverse(RAs), Next). - -%% expect(Tokens, TokenType, Term, Next) -> {succeed,Term} | {fail,Error}. - -expect([T|Toks], Tok, Term, Next) -> - case type(T) of - Tok -> Next(Toks, Term); - _ -> syntax_error(line(T), {expected,Tok}) - end; -expect([], Tok, _, _) -> syntax_error(9999, {expected,Tok}). - -%% cp(Choices) -> {succeed,Term} | {fail,_} | fail. -%% Special choice point handler for parser. If all clauses fail then -%% fail with first fail value, this usually gives better error report. - -cp([C|Cs]) -> - case C() of - {succeed,Res} -> {succeed,Res}; - {fail,_}=Fail -> cp(Cs, Fail); %Try rest with first fail - fail -> cp(Cs) %Stay till we get reason - end. - -cp([C|Cs], Fail) -> - case C() of - {succeed,Res} -> {succeed,Res}; - {fail,_} -> cp(Cs, Fail); %Drop this fail, use first - fail -> cp(Cs, Fail) - end; -cp([], Fail) -> Fail. - -%% type(Tok) -> Line. -%% line(Tok) -> Line. -%% val(Tok) -> Value. - -type(Tok) -> element(1, Tok). -line(Tok) -> element(2, Tok). -val(Tok) -> element(3, Tok). - -%% prefix_op(Op) -> {yes,Prec,ArgPrec} | no. - -prefix_op('?-') -> {yes,1200,1199}; %fx 1200 -prefix_op(':-') -> {yes,1200,1199}; %fx 1200 -prefix_op('\\+') -> {yes,900,900}; %fy 900 -prefix_op('+') -> {yes,200,200}; %fy 200 -prefix_op('-') -> {yes,200,200}; %fy 200 -prefix_op('\\') -> {yes,200,200}; %fy 200 -prefix_op(_Op) -> no. %The rest - -%% postfix_op(Op) -> {yes,ArgPrec,Prec} | no. - -postfix_op('+') -> {yes,500,500}; -postfix_op('*') -> {yes,400,400}; -postfix_op(_Op) -> no. - -%% infix_op(Op) -> {yes,LeftArgPrec,Prec,RightArgPrec} | no. - -infix_op(':-') -> {yes,1199,1200,1199}; %xfx 1200 -infix_op('-->') -> {yes,1199,1200,1199}; %xfx 1200 -infix_op(';') -> {yes,1099,1100,1100}; %xfy 1100 -infix_op('->') -> {yes,1049,1050,1050}; %xfy 1050 -infix_op(',') -> {yes,999,1000,1000}; %xfy 1000 -infix_op('=') -> {yes,699,700,699}; %xfx 700 -infix_op('\\=') -> {yes,699,700,699}; %xfx 700 -infix_op('\\==') -> {yes,699,700,699}; %xfx 700 -infix_op('==') -> {yes,699,700,699}; %xfx 700 -infix_op('@<') -> {yes,699,700,699}; %xfx 700 -infix_op('@=<') -> {yes,699,700,699}; %xfx 700 -infix_op('@>') -> {yes,699,700,699}; %xfx 700 -infix_op('@>=') -> {yes,699,700,699}; %xfx 700 -infix_op('=..') -> {yes,699,700,699}; %xfx 700 -infix_op('is') -> {yes,699,700,699}; %xfx 700 -infix_op('=:=') -> {yes,699,700,699}; %xfx 700 -infix_op('=\\=') -> {yes,699,700,699}; %xfx 700 -infix_op('<') -> {yes,699,700,699}; %xfx 700 -infix_op('=<') -> {yes,699,700,699}; %xfx 700 -infix_op('>') -> {yes,699,700,699}; %xfx 700 -infix_op('>=') -> {yes,699,700,699}; %xfx 700 -infix_op(':') -> {yes,599,600,600}; %xfy 600 -infix_op('+') -> {yes,500,500,499}; %yfx 500 -infix_op('-') -> {yes,500,500,499}; %yfx 500 -infix_op('/\\') -> {yes,500,500,499}; %yfx 500 -infix_op('\\/') -> {yes,500,500,499}; %yfx 500 -infix_op('*') -> {yes,400,400,399}; %yfx 400 -infix_op('/') -> {yes,400,400,399}; %yfx 400 -infix_op('//') -> {yes,400,400,399}; %yfx 400 -infix_op('rem') -> {yes,400,400,399}; %yfx 400 -infix_op('mod') -> {yes,400,400,399}; %yfx 400 -infix_op('<<') -> {yes,400,400,399}; %yfx 400 -infix_op('>>') -> {yes,400,400,399}; %yfx 400 -infix_op('**') -> {yes,199,200,199}; %xfx 200 -infix_op('^') -> {yes,199,200,200}; %xfy 200 -infix_op(_Op) -> no. diff --git a/src/erlog_shell.erl b/src/erlog_shell.erl deleted file mode 100644 index 4199cf8..0000000 --- a/src/erlog_shell.erl +++ /dev/null @@ -1,108 +0,0 @@ -%% Copyright (c) 2008-2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - -%% File : erlog_shell.erl -%% Author : Robert Virding -%% Purpose : A simple Erlog shell. - --module(erlog_shell). - --export([start/0,start/1,server/0,server/1]). - --import(lists, [foldl/3,foreach/2]). - -start() -> start(default). - -start(P) -> - spawn(fun () -> server(P) end). - -server() -> server(default). - -server(_) -> - io:fwrite("Erlog Shell V~s (abort with ^G)\n", - [erlang:system_info(version)]), - server_loop(erlog:new()). - -%% A simple Erlog shell similar to a "normal" Prolog shell. It allows -%% user to enter goals, see resulting bindings and request next -%% solution. - -server_loop(P0) -> - case erlog_io:read('| ?- ') of - {ok,halt} -> ok; - {ok,Files} when is_list(Files) -> - {{ok,Db0},P1} = P0(get_db), - case reconsult_files(Files, Db0) of - {ok,Db1} -> - io:fwrite("Yes\n"), - {ok,P2} = P1({set_db,Db1}), - server_loop(P2); - {erlog_error,Error} -> - io:fwrite("Error: ~p\n", [Error]), - server_loop(P0); - {error,{L,Pm,Pe}} -> - io:fwrite("Error: ~w: ~s\n", [L,Pm:format_error(Pe)]), - server_loop(P0); - {error,Error} -> - io:fwrite("Error: ~p\n", [Error]), - server_loop(P0) - end; - {ok,Goal} -> - shell_prove_result(P0({prove,Goal})); - {error,{_,Em,E}} -> - io:fwrite("Error: ~s\n", [Em:format_error(E)]), - server_loop(P0) - end. - -reconsult_files([F|Fs], Db0) -> - case erlog_file:reconsult(F, Db0) of - {ok,Db1} -> reconsult_files(Fs, Db1); - {erlog_error,Error} -> {erlog_error,Error}; - {error,Error} -> {error,Error} - end; -reconsult_files([], Db) -> {ok,Db}; -reconsult_files(Other, _Db) -> {error,{type_error,list,Other}}. - -shell_prove_result({{succeed,Vs},P}) -> show_bindings(Vs, P); -shell_prove_result({fail,P}) -> - io:fwrite("No\n"), - server_loop(P); -shell_prove_result({{error,Error},P}) -> - %% Errors from the Erlog interpreters. - io:fwrite("Error: ~p\n", [Error]), - server_loop(P); -shell_prove_result({{'EXIT',Error},P}) -> %No new database here - %% Errors and exits from user code. - io:fwrite("EXIT: ~p\n", [Error]), - server_loop(P). - -%% show_bindings(VarList, Prolog()) -%% Show the bindings and query user for next solution. - -show_bindings([], P) -> - io:fwrite("Yes\n"), - server_loop(P); -show_bindings(Vs, P) -> - foreach(fun ({Name,Val}) -> - Out = erlog_io:writeq1({'=',{Name},Val}), - io:fwrite("~s\n", [Out]) - end, Vs), - Line = io:get_line(': '), - case string:chr(Line, $;) of - 0 -> - io:fwrite("Yes\n"), - server_loop(P); - _ -> - shell_prove_result(P(next_solution)) - end. diff --git a/src/erlog_file.erl b/src/io/erlog_file.erl similarity index 51% rename from src/erlog_file.erl rename to src/io/erlog_file.erl index 6e2f029..81c7e05 100644 --- a/src/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -18,7 +18,7 @@ -module(erlog_file). --export([consult/2,reconsult/2]). +-export([consult/2, reconsult/2]). %% consult(File, Database) -> @@ -29,53 +29,53 @@ %% abolish old definitons of clauses. consult(File, Db0) -> - case erlog_io:read_file(File) of - {ok,Terms} -> - consult_terms(fun consult_assert/2, Db0, Terms); - Error -> Error - end. + case erlog_io:read_file(File) of + {ok, Terms} -> + consult_terms(fun consult_assert/2, Db0, Terms); + Error -> Error + end. consult_assert(Term0, Db) -> - Term1 = erlog_dcg:expand_term(Term0), - {ok,erlog_int:assertz_clause(Term1, Db)}. + Term1 = erlog_dcg:expand_term(Term0), + {ok, erlog_int:assertz_clause(Term1, Db)}. reconsult(File, Db0) -> - case erlog_io:read_file(File) of - {ok,Terms} -> - case consult_terms(fun reconsult_assert/2, {Db0,[]}, Terms) of - {ok,{Db1,_Seen1}} -> {ok,Db1}; + case erlog_io:read_file(File) of + {ok, Terms} -> + case consult_terms(fun reconsult_assert/2, {Db0, []}, Terms) of + {ok, {Db1, _Seen1}} -> {ok, Db1}; + Error -> Error + end; Error -> Error - end; - Error -> Error - end. + end. -reconsult_assert(Term0, {Db0,Seen}) -> - Term1 = erlog_dcg:expand_term(Term0), - Func = functor(Term1), - case lists:member(Func, Seen) of - true -> - {ok,{erlog_int:assertz_clause(Term1, Db0), Seen}}; - false -> - Db1 = erlog_int:abolish_clauses(Func, Db0), - {ok,{erlog_int:assertz_clause(Term1, Db1), [Func|Seen]}} - end. +reconsult_assert(Term0, {Db0, Seen}) -> + Term1 = erlog_dcg:expand_term(Term0), + Func = functor(Term1), + case lists:member(Func, Seen) of + true -> + {ok, {erlog_int:assertz_clause(Term1, Db0), Seen}}; + false -> + Db1 = erlog_int:abolish_clauses(Func, Db0), + {ok, {erlog_int:assertz_clause(Term1, Db1), [Func | Seen]}} + end. %% consult_terms(InsertFun, Database, Terms) -> %% {ok,NewDatabase} | {erlog_error,Error}. %% Add terms to the database using InsertFun. Ignore directives and %% queries. -consult_terms(Ifun, Db, [{':-',_}|Ts]) -> - consult_terms(Ifun, Db, Ts); -consult_terms(Ifun, Db, [{'?-',_}|Ts]) -> - consult_terms(Ifun, Db, Ts); -consult_terms(Ifun, Db0, [T|Ts]) -> - case catch Ifun(T, Db0) of - {ok,Db1} -> consult_terms(Ifun, Db1, Ts); - {erlog_error,E,_Db1} -> {erlog_error,E}; - {erlog_error,E} -> {erlog_error,E} - end; -consult_terms(_Ifun, Db, []) -> {ok,Db}. +consult_terms(Ifun, Db, [{':-', _} | Ts]) -> + consult_terms(Ifun, Db, Ts); +consult_terms(Ifun, Db, [{'?-', _} | Ts]) -> + consult_terms(Ifun, Db, Ts); +consult_terms(Ifun, Db0, [T | Ts]) -> + case catch Ifun(T, Db0) of + {ok, Db1} -> consult_terms(Ifun, Db1, Ts); + {erlog_error, E, _Db1} -> {erlog_error, E}; + {erlog_error, E} -> {erlog_error, E} + end; +consult_terms(_Ifun, Db, []) -> {ok, Db}. -functor({':-',H,_B}) -> erlog_int:functor(H); +functor({':-', H, _B}) -> erlog_int:functor(H); functor(T) -> erlog_int:functor(T). diff --git a/src/io/erlog_io.erl b/src/io/erlog_io.erl new file mode 100644 index 0000000..bca7ac8 --- /dev/null +++ b/src/io/erlog_io.erl @@ -0,0 +1,248 @@ +%% Copyright (c) 2008-2013 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : erlog_io.erl +%% Author : Robert Virding +%% Purpose : Some basic i/o functions for Erlog. +%% +%% Structures - {Functor,arg1, Arg2,...} where Functor is an atom +%% Variables - {Name} where Name is an atom or integer +%% Lists - Erlang lists +%% Atomic - Erlang constants +%% +%% There is no problem with the representation of variables as Prolog +%% functors of arity 0 are atoms. This representation is much easier +%% to test for, and create new variables with than using funny atom +%% names like '$1' (yuch!), and we need LOTS of variables. + +-module(erlog_io). + +-export([scan_file/1, read_file/1, read/1, read/2]). +-export([write/1, write/2, write1/1, writeq/1, writeq/2, writeq1/1, + write_canonical/1, write_canonical/2, write_canonical1/1]). + +scan_file(File) -> + case file:open(File, [read]) of + {ok, Fd} -> + try + {ok, scan_stream(Fd, 1)} + catch + throw:Term -> Term; + error:Error -> {error, einval, Error}; + exit:Exit -> {exit, einval, Exit} + after + file:close(Fd) + end; + Error -> Error + end. + +scan_stream(Fd, L0) -> + case scan_erlog_term(Fd, '', L0) of + {ok, Toks, L1} -> [Toks | scan_stream(Fd, L1)]; + {error, Error, _} -> throw({error, Error}); + {eof, _} = Eof -> Eof + end. + +%% read_file(FileName) -> {ok,[Term]} | {error,Error}. +%% Read a file containing Prolog terms. This has been taken from 'io' +%% but cleaned up using try. + +read_file(File) -> + case file:open(File, [read]) of + {ok, Fd} -> + try + {ok, read_stream(Fd, 1)} + catch + throw:Term -> Term; + error:Error -> {error, einval, Error}; + exit:Exit -> {exit, einval, Exit} + after + file:close(Fd) + end; + Error -> Error + end. + +read_stream(Fd, L0) -> + case scan_erlog_term(Fd, '', L0) of + {ok, Toks, L1} -> + case erlog_parse:term(Toks, L0) of + {ok, end_of_file} -> []; %Prolog does this. + {ok, Term} -> + [Term | read_stream(Fd, L1)]; + {error, What} -> throw({error, What}) + end; + {error, Error, _} -> throw({error, Error}); + {eof, _} -> [] + end. + +%% read([IoDevice], Prompt) -> Term. +%% A very simple read function. Returns the direct representation of +%% the term without variable processing. + +read(P) -> read(standard_io, P). + +read(Io, P) -> + case scan_erlog_term(Io, P, 1) of + {ok, Ts, _} -> + case erlog_parse:term(Ts) of + {ok, T} -> {ok, T}; + {error, Pe} -> {error, Pe} + end; + {error, Se, _} -> {error, Se}; + {eof, _} -> {ok, end_of_file} %Prolog does this + end. + +scan_erlog_term(Io, Prompt, Line) -> + io:request(Io, {get_until, Prompt, erlog_scan, tokens, [Line]}). + +-record(ops, {op = false, q = true}). + +%% write([IoDevice], Term) -> ok. +%% writeq([IoDevice], Term) -> ok. +%% write_canonical([IoDevice], Term) -> ok. +%% A very simple write function. Does not pretty-print but can handle +%% operators. The xxx1 verions return an iolist of the characters. + +write(T) -> write(standard_io, T). + +write(Io, T) -> io:put_chars(Io, write1(T)). + +write1(T) -> write1(T, 1200, #ops{op = true, q = false}). + +writeq(T) -> writeq(standard_io, T). + +writeq(Io, T) -> io:put_chars(Io, writeq1(T)). + +writeq1(T) -> write1(T, 1200, #ops{op = true, q = true}). + +write_canonical(T) -> write_canonical(standard_io, T). + +write_canonical(Io, T) -> io:put_chars(Io, write_canonical1(T)). + +write_canonical1(T) -> write1(T, 1200, #ops{op = false, q = true}). + +%% write1(Term, Precedence, Ops) -> iolist(). +%% The function which does the actual writing. + +write1(T, Prec, Ops) when is_atom(T) -> write1_atom(T, Prec, Ops); +write1(T, _, _) when is_number(T) -> io_lib:write(T); +write1({V}, _, _) when is_integer(V) -> "_" ++ integer_to_list(V); +write1({V}, _, _) -> atom_to_list(V); %Variable +write1([H | T], _, Ops) -> + [$[, write1(H, 999, Ops), write1_tail(T, Ops), $]]; +write1([], _, _) -> "[]"; +write1({F, A}, Prec, #ops{op = true} = Ops) -> + case erlog_parse:prefix_op(F) of + {yes, OpP, ArgP} -> + Out = [write1(F, 1200, Ops), $\s, write1(A, ArgP, Ops)], + write1_prec(Out, OpP, Prec); + no -> + case erlog_parse:postfix_op(F) of + {yes, ArgP, OpP} -> + Out = [write1(A, ArgP, Ops), $\s, write1(F, 1200, Ops)], + write1_prec(Out, OpP, Prec); + no -> + [write1(F, 1200, Ops), $(, write1(A, 999, Ops), $)] + end + end; +write1({',', A1, A2}, Prec, #ops{op = true} = Ops) -> + %% Must special case , here. + Out = [write1(A1, 999, Ops), ", ", write1(A2, 1000, Ops)], + write1_prec(Out, 1000, Prec); +write1({F, A1, A2}, Prec, #ops{op = true} = Ops) -> + case erlog_parse:infix_op(F) of + {yes, Lp, OpP, Rp} -> + Out = [write1(A1, Lp, Ops), $\s, write1(F, 1200, Ops), + $\s, write1(A2, Rp, Ops)], + write1_prec(Out, OpP, Prec); + no -> + [write1(F, 1200, Ops), $(, write1(A1, 999, Ops), + $,, write1(A2, 999, Ops), $)] + end; +write1(T, _, Ops) when is_tuple(T) -> + [F, A1 | As] = tuple_to_list(T), + [write1(F, 1200, Ops), $(, write1(A1, 999, Ops), write1_tail(As, Ops), $)]; +write1(T, _, _) -> %Else use default Erlang. + io_lib:write(T). + +%% write1_prec(OutString, OpPrecedence, Precedence) -> iolist(). +%% Encase OutString with (..) if op precedence higher than +%% precedence. + +write1_prec(Out, OpP, Prec) when OpP > Prec -> [$(, Out, $)]; +write1_prec(Out, _, _) -> Out. + +write1_tail([T | Ts], Ops) -> + [$,, write1(T, 999, Ops) | write1_tail(Ts, Ops)]; +write1_tail([], _) -> []; +write1_tail(T, Ops) -> [$|, write1(T, 999, Ops)]. + +write1_atom(A, Prec, #ops{q = false}) -> %No quoting + write1_atom_1(A, atom_to_list(A), Prec); +write1_atom(A, Prec, _) when A == '!'; A == ';' -> %Special atoms + write1_atom_1(A, atom_to_list(A), Prec); +write1_atom(A, Prec, _) -> + case atom_to_list(A) of + [C | Cs] = Acs -> + case (lower_case(C) andalso alpha_chars(Cs)) + orelse symbol_chars(Acs) of + true -> write1_atom_1(A, Acs, Prec); + false -> + Qcs = quote_atom(Acs), + write1_atom_1(A, Qcs, Prec) + end; + [] -> write1_atom_1(A, "''", Prec) + end. + +write1_atom_1(A, Acs, Prec) -> + case erlog_parse:prefix_op(A) of + {yes, OpP, _} when OpP > Prec -> [$(, Acs, $)]; + _ -> + case erlog_parse:postfix_op(A) of + {yes, _, OpP} when OpP > Prec -> [$(, Acs, $)]; + _ -> Acs + end + end. + +quote_atom(Acs) -> [$', Acs, $']. %Very naive as yet. + +symbol_chars(Cs) -> lists:all(fun symbol_char/1, Cs). + +symbol_char($-) -> true; +symbol_char($#) -> true; +symbol_char($$) -> true; +symbol_char($&) -> true; +symbol_char($*) -> true; +symbol_char($+) -> true; +symbol_char($.) -> true; +symbol_char($/) -> true; +symbol_char($\\) -> true; +symbol_char($:) -> true; +symbol_char($<) -> true; +symbol_char($=) -> true; +symbol_char($>) -> true; +symbol_char($?) -> true; +symbol_char($@) -> true; +symbol_char($^) -> true; +symbol_char($~) -> true; +symbol_char(_) -> false. + +lower_case(C) -> (C >= $a) and (C =< $z). + +alpha_chars(Cs) -> lists:all(fun alpha_char/1, Cs). + +alpha_char($_) -> true; +alpha_char(C) when C >= $A, C =< $Z -> true; +alpha_char(C) when C >= $0, C =< $9 -> true; +alpha_char(C) -> lower_case(C). diff --git a/src/io/erlog_shell.erl b/src/io/erlog_shell.erl new file mode 100644 index 0000000..dabbef8 --- /dev/null +++ b/src/io/erlog_shell.erl @@ -0,0 +1,108 @@ +%% Copyright (c) 2008-2013 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : erlog_shell.erl +%% Author : Robert Virding +%% Purpose : A simple Erlog shell. + +-module(erlog_shell). + +-export([start/0, start/1, server/0, server/1]). + +-import(lists, [foldl/3, foreach/2]). + +start() -> start(default). + +start(P) -> + spawn(fun() -> server(P) end). + +server() -> server(default). + +server(_) -> + io:fwrite("Erlog Shell V~s (abort with ^G)\n", + [erlang:system_info(version)]), + server_loop(erlog:new()). + +%% A simple Erlog shell similar to a "normal" Prolog shell. It allows +%% user to enter goals, see resulting bindings and request next +%% solution. + +server_loop(P0) -> + case erlog_io:read('| ?- ') of + {ok, halt} -> ok; + {ok, Files} when is_list(Files) -> + {{ok, Db0}, P1} = P0(get_db), + case reconsult_files(Files, Db0) of + {ok, Db1} -> + io:fwrite("Yes\n"), + {ok, P2} = P1({set_db, Db1}), + server_loop(P2); + {erlog_error, Error} -> + io:fwrite("Error: ~p\n", [Error]), + server_loop(P0); + {error, {L, Pm, Pe}} -> + io:fwrite("Error: ~w: ~s\n", [L, Pm:format_error(Pe)]), + server_loop(P0); + {error, Error} -> + io:fwrite("Error: ~p\n", [Error]), + server_loop(P0) + end; + {ok, Goal} -> + shell_prove_result(P0({prove, Goal})); + {error, {_, Em, E}} -> + io:fwrite("Error: ~s\n", [Em:format_error(E)]), + server_loop(P0) + end. + +reconsult_files([F | Fs], Db0) -> + case erlog_file:reconsult(F, Db0) of + {ok, Db1} -> reconsult_files(Fs, Db1); + {erlog_error, Error} -> {erlog_error, Error}; + {error, Error} -> {error, Error} + end; +reconsult_files([], Db) -> {ok, Db}; +reconsult_files(Other, _Db) -> {error, {type_error, list, Other}}. + +shell_prove_result({{succeed, Vs}, P}) -> show_bindings(Vs, P); +shell_prove_result({fail, P}) -> + io:fwrite("No\n"), + server_loop(P); +shell_prove_result({{error, Error}, P}) -> + %% Errors from the Erlog interpreters. + io:fwrite("Error: ~p\n", [Error]), + server_loop(P); +shell_prove_result({{'EXIT', Error}, P}) -> %No new database here + %% Errors and exits from user code. + io:fwrite("EXIT: ~p\n", [Error]), + server_loop(P). + +%% show_bindings(VarList, Prolog()) +%% Show the bindings and query user for next solution. + +show_bindings([], P) -> + io:fwrite("Yes\n"), + server_loop(P); +show_bindings(Vs, P) -> + foreach(fun({Name, Val}) -> + Out = erlog_io:writeq1({'=', {Name}, Val}), + io:fwrite("~s\n", [Out]) + end, Vs), + Line = io:get_line(': '), + case string:chr(Line, $;) of + 0 -> + io:fwrite("Yes\n"), + server_loop(P); + _ -> + shell_prove_result(P(next_solution)) + end. diff --git a/src/main/erlog.erl b/src/main/erlog.erl new file mode 100644 index 0000000..98f7b25 --- /dev/null +++ b/src/main/erlog.erl @@ -0,0 +1,207 @@ +%% Copyright (c) 2008-2013 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : erlog.erl +%% Author : Robert Virding +%% Purpose : Main interface to the Erlog interpreter. +%% +%% Structures - {Functor,arg1, Arg2,...} where Functor is an atom +%% Variables - {Name} where Name is an atom or integer +%% Lists - Erlang lists +%% Atomic - Erlang constants +%% +%% There is no problem with the representation of variables as Prolog +%% functors of arity 0 are atoms. This representation is much easier +%% to test for, and create new variables with than using funny atom +%% names like '$1' (yuch!), and we need LOTS of variables. + +-module(erlog). + +-include("erlog_int.hrl"). + +%% Basic evaluator interface. +-export([new/0]). +%% Interface to server. +-export([start/0, start_link/0]). +-export([prove/2, next_solution/1, + consult/2, reconsult/2, get_db/1, set_db/2, halt/1]). +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, + code_change/3]). +%% User utilities. +-export([is_legal_term/1, vars_in/1]). + +-import(lists, [foldl/3, foreach/2]). + +-behaviour(gen_server). +-vsn('0.6'). + +%% new() -> erlog(). +%% Define an Erlog instance. This is a fun which is called with the +%% top-level command and returns the result and the continutation in +%% a new fun. + +new() -> + Db0 = erlog_int:built_in_db(), %Basic interpreter predicates + Db1 = foldl(fun(Mod, Db) -> Mod:load(Db) end, Db0, + [erlog_bips, %Built in predicates + erlog_dcg, %DCG predicates + erlog_lists %Common lists library + ]), + fun(Cmd) -> top_cmd(Cmd, Db1) end. + +top_cmd({prove, Goal}, Db) -> + prove_goal(Goal, Db); +top_cmd(next_solution, Db) -> + {fail, fun(Cmd) -> top_cmd(Cmd, Db) end}; +top_cmd({consult, File}, Db0) -> + case erlog_file:consult(File, Db0) of + {ok, Db1} -> {ok, fun(Cmd) -> top_cmd(Cmd, Db1) end}; + {erlog_error, Error} -> + {{error, Error}, fun(Cmd) -> top_cmd(Cmd, Db0) end}; + {error, Error} -> + {{error, Error}, fun(Cmd) -> top_cmd(Cmd, Db0) end} + end; +top_cmd({reconsult, File}, Db0) -> + case erlog_file:reconsult(File, Db0) of + {ok, Db1} -> {ok, fun(Cmd) -> top_cmd(Cmd, Db1) end}; + {erlog_error, Error} -> + {{error, Error}, fun(Cmd) -> top_cmd(Cmd, Db0) end}; + {error, Error} -> + {{error, Error}, fun(Cmd) -> top_cmd(Cmd, Db0) end} + end; +top_cmd(get_db, Db) -> + {{ok, Db}, fun(Cmd) -> top_cmd(Cmd, Db) end}; +top_cmd({set_db, NewDb}, _Db) -> + {ok, fun(Cmd) -> top_cmd(Cmd, NewDb) end}; +top_cmd(halt, _Db) -> ok. + +prove_goal(Goal0, Db) -> + Vs = vars_in(Goal0), + %% Goal may be a list of goals, ensure proper goal. + Goal1 = unlistify(Goal0), + %% Must use 'catch' here as 'try' does not do last-call + %% optimisation. + prove_result(catch erlog_int:prove_goal(Goal1, Db), Vs, Db). + +unlistify([G]) -> G; +unlistify([G | Gs]) -> {',', G, unlistify(Gs)}; +unlistify([]) -> true; +unlistify(G) -> G. %In case it wasn't a list. + +prove_result({succeed, Cps, Bs, Vn, Db1}, Vs, _Db0) -> + {{succeed, erlog_int:dderef(Vs, Bs)}, + fun(Cmd) -> prove_cmd(Cmd, Vs, Cps, Bs, Vn, Db1) end}; +prove_result({fail, Db1}, _Vs, _Db0) -> + {fail, fun(Cmd) -> top_cmd(Cmd, Db1) end}; +prove_result({erlog_error, Error, Db1}, _Vs, _Db0) -> + {{error, Error}, fun(Cmd) -> top_cmd(Cmd, Db1) end}; +prove_result({erlog_error, Error}, _Vs, Db) -> %No new database + {{error, Error}, fun(Cmd) -> top_cmd(Cmd, Db) end}; +prove_result({'EXIT', Error}, _Vs, Db) -> + {{'EXIT', Error}, fun(Cmd) -> top_cmd(Cmd, Db) end}. + +prove_cmd(next_solution, Vs, Cps, _Bs, _Vn, Db) -> + prove_result(catch erlog_int:fail(Cps, Db), Vs, Db); +prove_cmd(Cmd, _Vs, _Cps, _Bs, _Vn, Db) -> + top_cmd(Cmd, Db). + +%% prove(Erlog, Goal) -> {succeed,Bindings} | fail. +%% next_solution(Erlog) -> {succeed,Bindings} | fail. +%% consult(Erlog, File) -> ok | {error,Error}. +%% reconsult(Erlog, File) -> ok | {error,Error}. +%% get_db(Erlog) -> {ok,Database}. +%% set_db(Erlog, Database) -> ok. +%% halt(Erlog) -> ok. +%% Interface functions to server. + +prove(Erl, Goal) when is_list(Goal) -> + {ok, TS, _} = erlog_scan:string(Goal ++ " "), + {ok, G} = erlog_parse:term(TS), + prove(Erl, G); +prove(Erl, Goal) -> gen_server:call(Erl, {prove, Goal}, infinity). + +next_solution(Erl) -> gen_server:call(Erl, next_solution, infinity). + +consult(Erl, File) -> gen_server:call(Erl, {consult, File}, infinity). + +reconsult(Erl, File) -> gen_server:call(Erl, {reconsult, File}, infinity). + +get_db(Erl) -> gen_server:call(Erl, get_db, infinity). + +set_db(Erl, Db) -> gen_server:call(Erl, {set_db, Db}, infinity). + +halt(Erl) -> gen_server:cast(Erl, halt). + +%% Erlang server code. +-record(state, {erlog}). %Erlog state + +start() -> + gen_server:start(?MODULE, [], []). + +start_link() -> + gen_server:start_link(?MODULE, [], []). + +init(_) -> + {ok, #state{erlog = new()}}. + +handle_call(Req, _, St) -> + {Res, Erl} = (St#state.erlog)(Req), + {reply, Res, St#state{erlog = Erl}}. + +handle_cast(halt, St) -> + {stop, normal, St}. + +handle_info(_, St) -> + {noreply, St}. + +terminate(_, St) -> + (St#state.erlog)(halt). + +code_change(_, _, St) -> {ok, St}. + +%% vars_in(Term) -> [{Name,Var}]. +%% Returns an ordered list of {VarName,Variable} pairs. + +vars_in(Term) -> vars_in(Term, orddict:new()). + +vars_in({'_'}, Vs) -> Vs; %Never in! +vars_in({Name} = Var, Vs) -> orddict:store(Name, Var, Vs); +vars_in(Struct, Vs) when is_tuple(Struct) -> + vars_in_struct(Struct, 2, size(Struct), Vs); +vars_in([H | T], Vs) -> + vars_in(T, vars_in(H, Vs)); +vars_in(_, Vs) -> Vs. + +vars_in_struct(_Str, I, S, Vs) when I > S -> Vs; +vars_in_struct(Str, I, S, Vs) -> + vars_in_struct(Str, I + 1, S, vars_in(element(I, Str), Vs)). + +%% is_legal_term(Goal) -> true | false. +%% Test if a goal is a legal Erlog term. Basically just check if +%% tuples are used correctly as structures and variables. + +is_legal_term({V}) -> is_atom(V); +is_legal_term([H | T]) -> + is_legal_term(H) andalso is_legal_term(T); +is_legal_term(T) when is_tuple(T) -> + if tuple_size(T) >= 2, is_atom(element(1, T)) -> + are_legal_args(T, 2, size(T)); %The right tuples. + true -> false + end; +is_legal_term(T) when ?IS_ATOMIC(T) -> true; %All constants, including [] +is_legal_term(_T) -> false. + +are_legal_args(_T, I, S) when I > S -> true; +are_legal_args(T, I, S) -> + is_legal_term(element(I, T)) andalso are_legal_args(T, I + 1, S). diff --git a/src/erlog_boot.erl b/src/main/erlog_boot.erl similarity index 93% rename from src/erlog_boot.erl rename to src/main/erlog_boot.erl index da938a0..8ec17f0 100644 --- a/src/erlog_boot.erl +++ b/src/main/erlog_boot.erl @@ -30,4 +30,4 @@ -export([start/0]). -start() -> user_drv:start(['tty_sl -c -e',{erlog_shell,start,[]}]). +start() -> user_drv:start(['tty_sl -c -e', {erlog_shell, start, []}]). diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl new file mode 100644 index 0000000..f9da374 --- /dev/null +++ b/src/storage/erlog_ets.erl @@ -0,0 +1,149 @@ +%% Copyright (c) 2008-2013 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : erlog_ets.erl +%% Author : Robert Virding +%% Purpose : ETS interface for Erlog. + +-module(erlog_ets). + +-include("erlog_int.hrl"). + +-compile(export_all). + +-export([assert/1, all_1/6, keys_2/6, match_2/6]). + +-import(lists, [foldl/3]). +-import(erlog_int, [add_compiled_proc/4, dderef/2, unify/3, +prove_body/5, unify_prove_body/7, fail/2]). + +%% assert(Database) -> Database. +%% Assert predicates into the database. + +assert(Db) -> + foldl(fun({Head, M, F}, LDb) -> + add_compiled_proc(Head, M, F, LDb) end, Db, + [ + {{ets_all, 1}, ?MODULE, all_1}, + {{ets_keys, 2}, ?MODULE, keys_2}, + {{ets_match, 2}, ?MODULE, match_2} + ]). + + +%% all_1(Goal, Next, ChoicePoints, Bindings, VarNum, Database) -> void(). +%% Goal = {ets_all,Tables}. +%% Return all the ETS databases. + +all_1({ets_all, Var}, Next, Cps, Bs, Vn, Db) -> + Tabs = ets:all(), + unify_prove_body(Var, Tabs, Next, Cps, Bs, Vn, Db). + +%% keys_2(Goal, Next, ChoicePoints, Bindings, VarNum, Database) -> void(). +%% Goal = {ets_keys,Table,Key}. +%% Return the keys in an ETS database one at a time over backtracking. + +keys_2({ets_keys, Tab0, KeyVar}, Next, Cps, Bs, Vn, Db) -> + Tab1 = dderef(Tab0, Bs), + case ets:first(Tab1) of + '$end_of_table' -> fail(Cps, Db); + Key -> keys_loop(Tab1, Key, KeyVar, Next, Cps, Bs, Vn, Db) + end. + +keys_loop(Tab, Key, KeyVar, Next, Cps, Bs, Vn, Db) -> + FailFun = fun(LCp, LCps, LDb) -> + keys_fail(LCp, LCps, LDb, Tab, Key, KeyVar) + end, + C = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, + unify_prove_body(KeyVar, Key, Next, [C | Cps], Bs, Vn, Db). + +keys_fail(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db, Tab, PrevKey, KeyVar) -> + case ets:next(Tab, PrevKey) of + '$end_of_table' -> fail(Cps, Db); + Key -> keys_loop(Tab, Key, KeyVar, Next, Cps, Bs, Vn, Db) + end. + +%% match_2(Goal, Next, ChoicePoints, Bindings, VarNum, Database) -> void(). +%% Goal = {ets_match,Table,Pattern}. +%% Match objects in an ETS database one at a time over backtracking +%% using Pattern in goal. Variables in Pattern are bound for each +%% object matched. + +match_2({ets_match, Tab0, Pat0}, Next, Cps, Bs, Vn, Db) -> + Tab1 = dderef(Tab0, Bs), + Pat1 = dderef(Pat0, Bs), + {Epat, Vs} = ets_pat(Pat1), + match_2_loop(ets:match(Tab1, Epat, 10), Next, Cps, Bs, Vn, Db, Epat, Vs). + +match_2_loop({[M | Ms], Cont}, Next, Cps, Bs, Vn, Db, Epat, Vs) -> + FailFun = fun(LCp, LCps, LDb) -> + match_2_fail(LCp, LCps, LDb, Epat, Vs, {Ms, Cont}) + end, + Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, + unify_prove_body(Vs, M, Next, [Cp | Cps], Bs, Vn, Db); +match_2_loop({[], Cont}, Next, Cps, Bs, Vn, Db, Epat, Vs) -> + match_2_loop(ets:match(Cont), Next, Cps, Bs, Vn, Db, Epat, Vs); +match_2_loop('$end_of_table', _Next, Cps, _Bs, _Vn, Db, _Epat, _Vs) -> + fail(Cps, Db). + +match_2_fail(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db, Epat, Vs, Ms) -> + match_2_loop(Ms, Next, Cps, Bs, Vn, Db, Epat, Vs). + +%% ets_pat(Term) -> {EtsPattern,VarList}. +%% Convert a term into an ETS pattern replacing variables with the ETS +%% pattern variables. Also return a list of variables in the same +%% order as ETS will return the list of values. This is slightly +%% tricky as the order they are in ETS which is not the same as term +%% order so they can not be easily sorted. Sigh! + +ets_pat(Pat) -> + {Epat, _Vn, Vs0} = ets_pat(Pat, 11, []), + Vs1 = [V || {V, _Ev} <- Vs0], + {Epat, Vs1}. + +ets_pat({_} = V, Vn, Vs) -> + case find(V, Vs) of + {yes, Ev} -> {Ev, Vn, Vs}; + no -> + Ev = ets_var(Vn), + {Ev, Vn - 1, [{V, Ev} | Vs]} + end; +ets_pat([H0 | T0], Vn0, Vs0) -> + {T1, Vn1, Vs1} = ets_pat(T0, Vn0, Vs0), %Right to left! + {H1, Vn2, Vs2} = ets_pat(H0, Vn1, Vs1), + {[H1 | T1], Vn2, Vs2}; +ets_pat(P, Vn0, Vs0) when is_tuple(P), size(P) >= 2 -> + {As, Vn1, Vs1} = ets_pat_arg(P, Vn0, Vs0, size(P), []), + {list_to_tuple([element(1, P) | As]), Vn1, Vs1}; +ets_pat(P, Vn, Vs) -> {P, Vn, Vs}. %Constant + +ets_pat_arg(_P, Vn, Vs, 1, As) -> {As, Vn, Vs}; +ets_pat_arg(P, Vn0, Vs0, I, As) -> + {A, Vn1, Vs1} = ets_pat(element(I, P), Vn0, Vs0), + ets_pat_arg(P, Vn1, Vs1, I - 1, [A | As]). + +find(V, [{V, Ev} | _Vs]) -> {yes, Ev}; +find(V, [_P | Vs]) -> find(V, Vs); +find(_V, []) -> no. + +ets_var(1) -> '$1'; +ets_var(2) -> '$2'; +ets_var(3) -> '$3'; +ets_var(4) -> '$4'; +ets_var(5) -> '$5'; +ets_var(6) -> '$6'; +ets_var(7) -> '$7'; +ets_var(8) -> '$8'; +ets_var(9) -> '$9'; +ets_var(10) -> '$10'; +ets_var(11) -> '$11'. From 2edb7e5b33af9fe70fbc1a4eb7cda2b125b0ef0c Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 27 May 2014 17:05:22 +0300 Subject: [PATCH 002/251] make rel & make remote console --- .gitignore | 2 + src/ChangeLog => ChangeLog | 0 Makefile | 3 + rel/files/erl | 44 ++++ rel/files/erlog | 347 ++++++++++++++++++++++++++++ rel/files/erlog.cmd | 103 +++++++++ rel/files/install_upgrade.escript | 44 ++++ rel/files/nodetool | 182 +++++++++++++++ rel/files/start_erl.cmd | 40 ++++ rel/files/sys.config | 11 + rel/files/vm.args | 19 ++ rel/reltool.config | 44 ++++ src/{main => core}/erlog.erl | 8 +- src/core/{ => lang}/erlog_lists.erl | 0 src/core/{ => lang}/erlog_scan.xrl | 0 src/erlog.app.src | 16 ++ src/io/erlog_io.erl | 17 +- src/io/erlog_shell.erl | 253 ++++++++++++-------- src/io/erlog_shell_logic.erl | 71 ++++++ src/io/erlog_shell_sup.erl | 83 +++++++ src/main/erlog_app.erl | 16 ++ src/main/erlog_super_sup.erl | 28 +++ 22 files changed, 1232 insertions(+), 99 deletions(-) rename src/ChangeLog => ChangeLog (100%) create mode 100644 rel/files/erl create mode 100644 rel/files/erlog create mode 100644 rel/files/erlog.cmd create mode 100644 rel/files/install_upgrade.escript create mode 100644 rel/files/nodetool create mode 100644 rel/files/start_erl.cmd create mode 100644 rel/files/sys.config create mode 100644 rel/files/vm.args create mode 100644 rel/reltool.config rename src/{main => core}/erlog.erl (98%) rename src/core/{ => lang}/erlog_lists.erl (100%) rename src/core/{ => lang}/erlog_scan.xrl (100%) create mode 100644 src/erlog.app.src create mode 100644 src/io/erlog_shell_logic.erl create mode 100644 src/io/erlog_shell_sup.erl create mode 100644 src/main/erlog_app.erl create mode 100644 src/main/erlog_super_sup.erl diff --git a/.gitignore b/.gitignore index cfb0107..40350db 100644 --- a/.gitignore +++ b/.gitignore @@ -5,3 +5,5 @@ ebin .idea *.iml erlog_scan.erl +*.dump +rel/erlog diff --git a/src/ChangeLog b/ChangeLog similarity index 100% rename from src/ChangeLog rename to ChangeLog diff --git a/Makefile b/Makefile index 138472f..e3a67fb 100644 --- a/Makefile +++ b/Makefile @@ -37,6 +37,9 @@ compile: ## Compile using erlc erlc_compile: $(addprefix $(EBINDIR)/, $(EBINS)) +rel: compile + rebar generate + docs: clean: diff --git a/rel/files/erl b/rel/files/erl new file mode 100644 index 0000000..f4c63af --- /dev/null +++ b/rel/files/erl @@ -0,0 +1,44 @@ +#!/bin/sh + +# /bin/sh on Solaris is not a POSIX compatible shell, but /usr/bin/ksh is. +if [ `uname -s` = 'SunOS' -a "${POSIX_SHELL}" != "true" ]; then + POSIX_SHELL="true" + export POSIX_SHELL + exec /usr/bin/ksh $0 "$@" +fi + +# clear it so if we invoke other scripts, they run as ksh as well +unset POSIX_SHELL + +## This script replaces the default "erl" in erts-VSN/bin. This is +## necessary as escript depends on erl and in turn, erl depends on +## having access to a bootscript (start.boot). Note that this script +## is ONLY invoked as a side-effect of running escript -- the embedded +## node bypasses erl and uses erlexec directly (as it should). +## +## Note that this script makes the assumption that there is a +## start_clean.boot file available in $ROOTDIR/release/VSN. + +# Determine the abspath of where this script is executing from. +ERTS_BIN_DIR=$(cd ${0%/*} && pwd -P) + +# Now determine the root directory -- this script runs from erts-VSN/bin, +# so we simply need to strip off two dirs from the end of the ERTS_BIN_DIR +# path. +ROOTDIR=${ERTS_BIN_DIR%/*/*} + +# Parse out release and erts info +START_ERL=`cat $ROOTDIR/releases/start_erl.data` +ERTS_VSN=${START_ERL% *} +APP_VSN=${START_ERL#* } + +BINDIR=$ROOTDIR/erts-$ERTS_VSN/bin +EMU=beam +PROGNAME=`echo $0 | sed 's/.*\\///'` +CMD="$BINDIR/erlexec" +export EMU +export ROOTDIR +export BINDIR +export PROGNAME + +exec $CMD -boot $ROOTDIR/releases/$APP_VSN/start_clean ${1+"$@"} diff --git a/rel/files/erlog b/rel/files/erlog new file mode 100644 index 0000000..c2ef258 --- /dev/null +++ b/rel/files/erlog @@ -0,0 +1,347 @@ +#!/bin/sh +# -*- tab-width:4;indent-tabs-mode:nil -*- +# ex: ts=4 sw=4 et + +# /bin/sh on Solaris is not a POSIX compatible shell, but /usr/bin/ksh is. +if [ `uname -s` = 'SunOS' -a "${POSIX_SHELL}" != "true" ]; then + POSIX_SHELL="true" + export POSIX_SHELL + # To support 'whoami' add /usr/ucb to path + PATH=/usr/ucb:$PATH + export PATH + exec /usr/bin/ksh $0 "$@" +fi + +# clear it so if we invoke other scripts, they run as ksh +unset POSIX_SHELL + +RUNNER_SCRIPT_DIR=$(cd ${0%/*} && pwd -P) + +CALLER_DIR=$PWD + +RUNNER_BASE_DIR=${RUNNER_SCRIPT_DIR%/*} +RUNNER_ETC_DIR=$RUNNER_BASE_DIR/etc +# Note the trailing slash on $PIPE_DIR/ +PIPE_DIR=/tmp/$RUNNER_BASE_DIR/ +RUNNER_USER= +WHOAMI=$(whoami) + +# Make sure this script is running as the appropriate user +if ([ "$RUNNER_USER" ] && [ "x$WHOAMI" != "x$RUNNER_USER" ]); then + type sudo > /dev/null 2>&1 + if [ $? -ne 0 ]; then + echo "sudo doesn't appear to be installed and your EUID isn't $RUNNER_USER" 1>&2 + exit 1 + fi + echo "Attempting to restart script through sudo -H -u $RUNNER_USER" >&2 + exec sudo -H -u $RUNNER_USER -i $RUNNER_SCRIPT_DIR/$RUNNER_SCRIPT $@ +fi + +# Identify the script name +SCRIPT=`basename $0` + +# Parse out release and erts info +START_ERL=`cat $RUNNER_BASE_DIR/releases/start_erl.data` +ERTS_VSN=${START_ERL% *} +APP_VSN=${START_ERL#* } + +# Use $CWD/vm.args if exists, otherwise releases/APP_VSN/vm.args, or +# else etc/vm.args +if [ -e "$CALLER_DIR/vm.args" ]; then + VMARGS_PATH=$CALLER_DIR/vm.args + USE_DIR=$CALLER_DIR +else + USE_DIR=$RUNNER_BASE_DIR + if [ -e "$RUNNER_BASE_DIR/releases/$APP_VSN/vm.args" ]; then + VMARGS_PATH="$RUNNER_BASE_DIR/releases/$APP_VSN/vm.args" + else + VMARGS_PATH="$RUNNER_ETC_DIR/vm.args" + fi +fi + +RUNNER_LOG_DIR=$USE_DIR/log +# Make sure log directory exists +mkdir -p $RUNNER_LOG_DIR + +# Use releases/VSN/sys.config if it exists otherwise use etc/app.config +if [ -e "$USE_DIR/sys.config" ]; then + CONFIG_PATH="$USE_DIR/sys.config" +else + if [ -e "$RUNNER_BASE_DIR/releases/$APP_VSN/sys.config" ]; then + CONFIG_PATH="$RUNNER_BASE_DIR/releases/$APP_VSN/sys.config" + else + CONFIG_PATH="$RUNNER_ETC_DIR/app.config" + fi +fi + +# Extract the target node name from node.args +NAME_ARG=`egrep '^\-s?name' $VMARGS_PATH` +if [ -z "$NAME_ARG" ]; then + echo "vm.args needs to have either -name or -sname parameter." + exit 1 +fi + +# Extract the name type and name from the NAME_ARG for REMSH +REMSH_TYPE=`echo $NAME_ARG | awk '{print $1}'` +REMSH_NAME=`echo $NAME_ARG | awk '{print $2}'` + +# Note the `date +%s`, used to allow multiple remsh to the same node +# transparently +REMSH_NAME_ARG="$REMSH_TYPE remsh`date +%s`@`echo $REMSH_NAME | awk -F@ '{print $2}'`" +REMSH_REMSH_ARG="-remsh $REMSH_NAME" + +# Extract the target cookie +COOKIE_ARG=`grep '^\-setcookie' $VMARGS_PATH` +if [ -z "$COOKIE_ARG" ]; then + echo "vm.args needs to have a -setcookie parameter." + exit 1 +fi + +# Make sure CWD is set to the right dir +cd $USE_DIR + +# Make sure log directory exists +mkdir -p $USE_DIR/log + +# Add ERTS bin dir to our path +ERTS_PATH=$RUNNER_BASE_DIR/erts-$ERTS_VSN/bin + +# Setup command to control the node +NODETOOL="$ERTS_PATH/escript $ERTS_PATH/nodetool $NAME_ARG $COOKIE_ARG" + +# Setup remote shell command to control node +REMSH="$ERTS_PATH/erl $REMSH_NAME_ARG $REMSH_REMSH_ARG $COOKIE_ARG" + +# Common functions + +# Ping node without allowing nodetool to take stdin +ping_node() { + $NODETOOL ping < /dev/null +} + +# Set the PID global variable, return 1 on error +get_pid() { + PID=`$NODETOOL getpid < /dev/null` + ES=$? + if [ "$ES" -ne 0 ]; then + echo "Node is not running!" + return 1 + fi + + # don't allow empty or init pid's + if [ -z $PID ] || [ "$PID" -le 1 ]; then + return 1 + fi + + return 0 +} + +# Check the first argument for instructions +case "$1" in + start|start_boot) + # Make sure there is not already a node running + RES=`ping_node` + if [ "$RES" = "pong" ]; then + echo "Node is already running!" + exit 1 + fi + case "$1" in + start) + shift + START_OPTION="console" + HEART_OPTION="start" + ;; + start_boot) + shift + START_OPTION="console_boot" + HEART_OPTION="start_boot" + ;; + esac + RUN_PARAM=$(printf "\'%s\' " "$@") + HEART_COMMAND="$RUNNER_BASE_DIR/bin/$SCRIPT $HEART_OPTION $RUN_PARAM" + export HEART_COMMAND + mkdir -p $PIPE_DIR + $ERTS_PATH/run_erl -daemon $PIPE_DIR $RUNNER_LOG_DIR "exec $RUNNER_BASE_DIR/bin/$SCRIPT $START_OPTION $RUN_PARAM" 2>&1 + ;; + + stop) + # Wait for the node to completely stop... + case `uname -s` in + Darwin) + # Make sure we explicitly set this because iTerm.app doesn't for + # some reason. + COMMAND_MODE=unix2003 + esac + + # Get the PID from nodetool + get_pid + GPR=$? + if [ "$GPR" -ne 0 ] || [ -z $PID ]; then + exit $GPR + fi + + # Tell nodetool to initiate a stop + $NODETOOL stop + ES=$? + if [ "$ES" -ne 0 ]; then + exit $ES + fi + + # Wait for the node to completely stop... + while `kill -s 0 $PID 2>/dev/null` + do + sleep 1 + done + ;; + + restart) + ## Restart the VM without exiting the process + $NODETOOL restart + ES=$? + if [ "$ES" -ne 0 ]; then + exit $ES + fi + ;; + + reboot) + ## Restart the VM completely (uses heart to restart it) + $NODETOOL reboot + ES=$? + if [ "$ES" -ne 0 ]; then + exit $ES + fi + ;; + + ping) + ## See if the VM is alive + ping_node + ES=$? + if [ "$ES" -ne 0 ]; then + exit $ES + fi + ;; + + attach) + # Make sure a node is running + ping_node + ES=$? + if [ "$ES" -ne 0 ]; then + echo "Node is not running!" + exit $ES + fi + + shift + exec $ERTS_PATH/to_erl $PIPE_DIR + ;; + + remote_console) + # Make sure a node is running + ping_node + ES=$? + if [ "$ES" -ne 0 ]; then + echo "Node is not running!" + exit $ES + fi + + shift + exec $REMSH + ;; + + upgrade) + if [ -z "$2" ]; then + echo "Missing upgrade package argument" + echo "Usage: $SCRIPT upgrade {package base name}" + echo "NOTE {package base name} MUST NOT include the .tar.gz suffix" + exit 1 + fi + + # Make sure a node IS running + ping_node + ES=$? + if [ "$ES" -ne 0 ]; then + echo "Node is not running!" + exit $ES + fi + + node_name=`echo $NAME_ARG | awk '{print $2}'` + erlang_cookie=`echo $COOKIE_ARG | awk '{print $2}'` + + $ERTS_PATH/escript $RUNNER_BASE_DIR/bin/install_upgrade.escript $node_name $erlang_cookie $2 + ;; + + console|console_clean|console_boot) + # .boot file typically just $SCRIPT (ie, the app name) + # however, for debugging, sometimes start_clean.boot is useful. + # For e.g. 'setup', one may even want to name another boot script. + case "$1" in + console) BOOTFILE=$SCRIPT ;; + console_clean) BOOTFILE=start_clean ;; + console_boot) + shift + BOOTFILE="$1" + shift + ;; + esac + # Setup beam-required vars + ROOTDIR=$RUNNER_BASE_DIR + BINDIR=$ROOTDIR/erts-$ERTS_VSN/bin + EMU=beam + PROGNAME=`echo $0 | sed 's/.*\\///'` + CMD="$BINDIR/erlexec -boot $RUNNER_BASE_DIR/releases/$APP_VSN/$BOOTFILE -mode embedded -config $CONFIG_PATH -args_file $VMARGS_PATH" + export EMU + export ROOTDIR + export BINDIR + export PROGNAME + + # Dump environment info for logging purposes + echo "Exec: $CMD" -- ${1+"$@"} + echo "Root: $ROOTDIR" + + # Log the startup + logger -t "$SCRIPT[$$]" "Starting up" + + # Start the VM + exec $CMD -- ${1+"$@"} + ;; + + foreground) + # start up the release in the foreground for use by runit + # or other supervision services + + BOOTFILE=$SCRIPT + FOREGROUNDOPTIONS="-noinput +Bd" + + # Setup beam-required vars + ROOTDIR=$RUNNER_BASE_DIR + BINDIR=$ROOTDIR/erts-$ERTS_VSN/bin + EMU=beam + PROGNAME=`echo $0 | sed 's/.*\///'` + CMD="$BINDIR/erlexec $FOREGROUNDOPTIONS -boot $RUNNER_BASE_DIR/releases/$APP_VSN/$BOOTFILE -config $CONFIG_PATH -args_file $VMARGS_PATH" + export EMU + export ROOTDIR + export BINDIR + export PROGNAME + + # Dump environment info for logging purposes + echo "Exec: $CMD" -- ${1+"$@"} + echo "Root: $ROOTDIR" + + # Start the VM + exec $CMD -- ${1+"$@"} + ;; + getpid) + # Get the PID from nodetool + get_pid + ES=$? + if [ "$ES" -ne 0 ] || [ -z $PID ]; then + exit $ES + fi + echo $PID + ;; + *) + echo "Usage: $SCRIPT {start|start_boot |foreground|stop|restart|reboot|ping|console|getpid|console_clean|console_boot |attach|remote_console|upgrade}" + exit 1 + ;; +esac + +exit 0 diff --git a/rel/files/erlog.cmd b/rel/files/erlog.cmd new file mode 100644 index 0000000..1abf13d --- /dev/null +++ b/rel/files/erlog.cmd @@ -0,0 +1,103 @@ +@setlocal + +@set node_name=erlog + +@rem Get the absolute path to the parent directory, +@rem which is assumed to be the node root. +@for /F "delims=" %%I in ("%~dp0..") do @set node_root=%%~fI + +@set releases_dir=%node_root%\releases + +@rem Parse ERTS version and release version from start_erl.data +@for /F "usebackq tokens=1,2" %%I in ("%releases_dir%\start_erl.data") do @( + @call :set_trim erts_version %%I + @call :set_trim release_version %%J +) + +@set vm_args=%releases_dir%\%release_version%\vm.args +@set sys_config=%releases_dir%\%release_version%\sys.config +@set node_boot_script=%releases_dir%\%release_version%\%node_name% +@set clean_boot_script=%releases_dir%\%release_version%\start_clean + +@rem extract erlang cookie from vm.args +@for /f "usebackq tokens=1-2" %%I in (`findstr /b \-setcookie "%vm_args%"`) do @set erlang_cookie=%%J + +@set erts_bin=%node_root%\erts-%erts_version%\bin + +@set service_name=%node_name%_%release_version% + +@set erlsrv="%erts_bin%\erlsrv.exe" +@set epmd="%erts_bin%\epmd.exe" +@set escript="%erts_bin%\escript.exe" +@set werl="%erts_bin%\werl.exe" +@set nodetool="%erts_bin%\nodetool" + +@if "%1"=="usage" @goto usage +@if "%1"=="install" @goto install +@if "%1"=="uninstall" @goto uninstall +@if "%1"=="start" @goto start +@if "%1"=="stop" @goto stop +@if "%1"=="restart" @call :stop && @goto start +@if "%1"=="console" @goto console +@if "%1"=="ping" @goto ping +@if "%1"=="query" @goto query +@if "%1"=="attach" @goto attach +@if "%1"=="upgrade" @goto upgrade +@echo Unknown command: "%1" + +:usage +@echo Usage: %~n0 [install^|uninstall^|start^|stop^|restart^|console^|ping^|query^|attach^|upgrade] +@goto :EOF + +:install +@set description=Erlang node %node_name% in %node_root% +@set start_erl=%node_root%\bin\start_erl.cmd +@set args= ++ %node_name% ++ %node_root% +@%erlsrv% add %service_name% -c "%description%" -sname %node_name% -w "%node_root%" -m "%start_erl%" -args "%args%" -stopaction "init:stop()." +@goto :EOF + +:uninstall +@%erlsrv% remove %service_name% +@%epmd% -kill +@goto :EOF + +:start +@%erlsrv% start %service_name% +@goto :EOF + +:stop +@%erlsrv% stop %service_name% +@goto :EOF + +:console +@start "%node_name% console" %werl% -boot "%node_boot_script%" -config "%sys_config%" -args_file "%vm_args%" -sname %node_name% +@goto :EOF + +:ping +@%escript% %nodetool% ping -sname "%node_name%" -setcookie "%erlang_cookie%" +@exit %ERRORLEVEL% +@goto :EOF + +:query +@%erlsrv% list %service_name% +@exit %ERRORLEVEL% +@goto :EOF + +:attach +@for /f "usebackq" %%I in (`hostname`) do @set hostname=%%I +start "%node_name% attach" %werl% -boot "%clean_boot_script%" -remsh %node_name%@%hostname% -sname console -setcookie %erlang_cookie% +@goto :EOF + +:upgrade +@if "%2"=="" ( + @echo Missing upgrade package argument + @echo Usage: %~n0 upgrade {package base name} + @echo NOTE {package base name} MUST NOT include the .tar.gz suffix + @goto :EOF +) +@%escript% %node_root%\bin\install_upgrade.escript %node_name% %erlang_cookie% %2 +@goto :EOF + +:set_trim +@set %1=%2 +@goto :EOF diff --git a/rel/files/install_upgrade.escript b/rel/files/install_upgrade.escript new file mode 100644 index 0000000..56cea19 --- /dev/null +++ b/rel/files/install_upgrade.escript @@ -0,0 +1,44 @@ +#!/usr/bin/env escript +%%! -noshell -noinput +%% -*- mode: erlang;erlang-indent-level: 4;indent-tabs-mode: nil -*- +%% ex: ft=erlang ts=4 sw=4 et + +-define(TIMEOUT, 60000). +-define(INFO(Fmt,Args), io:format(Fmt,Args)). + +main([NodeName, Cookie, ReleasePackage]) -> + TargetNode = start_distribution(NodeName, Cookie), + {ok, Vsn} = rpc:call(TargetNode, release_handler, unpack_release, + [ReleasePackage], ?TIMEOUT), + ?INFO("Unpacked Release ~p~n", [Vsn]), + {ok, OtherVsn, Desc} = rpc:call(TargetNode, release_handler, + check_install_release, [Vsn], ?TIMEOUT), + {ok, OtherVsn, Desc} = rpc:call(TargetNode, release_handler, + install_release, [Vsn], ?TIMEOUT), + ?INFO("Installed Release ~p~n", [Vsn]), + ok = rpc:call(TargetNode, release_handler, make_permanent, [Vsn], ?TIMEOUT), + ?INFO("Made Release ~p Permanent~n", [Vsn]); +main(_) -> + init:stop(1). + +start_distribution(NodeName, Cookie) -> + MyNode = make_script_node(NodeName), + {ok, _Pid} = net_kernel:start([MyNode, shortnames]), + erlang:set_cookie(node(), list_to_atom(Cookie)), + TargetNode = make_target_node(NodeName), + case {net_kernel:hidden_connect_node(TargetNode), + net_adm:ping(TargetNode)} of + {true, pong} -> + ok; + {_, pang} -> + io:format("Node ~p not responding to pings.\n", [TargetNode]), + init:stop(1) + end, + TargetNode. + +make_target_node(Node) -> + [_, Host] = string:tokens(atom_to_list(node()), "@"), + list_to_atom(lists:concat([Node, "@", Host])). + +make_script_node(Node) -> + list_to_atom(lists:concat([Node, "_upgrader_", os:getpid()])). diff --git a/rel/files/nodetool b/rel/files/nodetool new file mode 100644 index 0000000..ce06c6a --- /dev/null +++ b/rel/files/nodetool @@ -0,0 +1,182 @@ +#!/usr/bin/env escript +%% -*- mode: erlang;erlang-indent-level: 4;indent-tabs-mode: nil -*- +%% ex: ft=erlang ts=4 sw=4 et +%% ------------------------------------------------------------------- +%% +%% nodetool: Helper Script for interacting with live nodes +%% +%% ------------------------------------------------------------------- +main(Args) -> + ok = start_epmd(), + %% Extract the args + {RestArgs, TargetNode} = process_args(Args, [], undefined), + + %% any commands that don't need a running node + case RestArgs of + ["chkconfig", File] -> + case file:consult(File) of + {ok, _} -> + io:format("ok\n"), + halt(0); + {error, {Line, Mod, Term}} -> + io:format(standard_error, ["Error on line ", + file:format_error({Line, Mod, Term}), "\n"], []), + halt(1); + {error, R} -> + io:format(standard_error, ["Error reading config file: ", + file:format_error(R), "\n"], []), + halt(1) + end; + _ -> + ok + end, + + %% See if the node is currently running -- if it's not, we'll bail + case {net_kernel:hidden_connect_node(TargetNode), + net_adm:ping(TargetNode)} of + {true, pong} -> + ok; + {false,pong} -> + io:format("Failed to connect to node ~p .\n", [TargetNode]), + halt(1); + {_, pang} -> + io:format("Node ~p not responding to pings.\n", [TargetNode]), + halt(1) + end, + + case RestArgs of + ["getpid"] -> + io:format("~p\n", + [list_to_integer(rpc:call(TargetNode, os, getpid, []))]); + ["ping"] -> + %% If we got this far, the node already responsed to a + %% ping, so just dump a "pong" + io:format("pong\n"); + ["stop"] -> + io:format("~p\n", [rpc:call(TargetNode, init, stop, [], 60000)]); + ["restart"] -> + io:format("~p\n", [rpc:call(TargetNode, init, restart, [], 60000)]); + ["reboot"] -> + io:format("~p\n", [rpc:call(TargetNode, init, reboot, [], 60000)]); + ["rpc", Module, Function | RpcArgs] -> + case rpc:call(TargetNode, + list_to_atom(Module), + list_to_atom(Function), + [RpcArgs], 60000) of + ok -> + ok; + {badrpc, Reason} -> + io:format("RPC to ~p failed: ~p\n", [TargetNode, Reason]), + halt(1); + _ -> + halt(1) + end; + ["rpc_infinity", Module, Function | RpcArgs] -> + case rpc:call(TargetNode, + list_to_atom(Module), + list_to_atom(Function), + [RpcArgs], infinity) of + ok -> + ok; + {badrpc, Reason} -> + io:format("RPC to ~p failed: ~p\n", [TargetNode, Reason]), + halt(1); + _ -> + halt(1) + end; + ["rpcterms", Module, Function, ArgsAsString] -> + case rpc:call(TargetNode, + list_to_atom(Module), + list_to_atom(Function), + consult(ArgsAsString), 60000) of + {badrpc, Reason} -> + io:format("RPC to ~p failed: ~p\n", [TargetNode, Reason]), + halt(1); + Other -> + io:format("~p\n", [Other]) + end; + Other -> + io:format("Other: ~p\n", [Other]), + io:format("Usage: nodetool {chkconfig|getpid|ping|stop|restart|reboot|rpc|rpc_infinity|rpcterms}\n") + end, + net_kernel:stop(). + +process_args([], Acc, TargetNode) -> + {lists:reverse(Acc), TargetNode}; +process_args(["-setcookie", Cookie | Rest], Acc, TargetNode) -> + erlang:set_cookie(node(), list_to_atom(Cookie)), + process_args(Rest, Acc, TargetNode); +process_args(["-name", TargetName | Rest], Acc, _) -> + ThisNode = append_node_suffix(TargetName, "_maint_"), + {ok, _} = net_kernel:start([ThisNode, longnames]), + process_args(Rest, Acc, nodename(TargetName)); +process_args(["-sname", TargetName | Rest], Acc, _) -> + ThisNode = append_node_suffix(TargetName, "_maint_"), + {ok, _} = net_kernel:start([ThisNode, shortnames]), + process_args(Rest, Acc, nodename(TargetName)); +process_args([Arg | Rest], Acc, Opts) -> + process_args(Rest, [Arg | Acc], Opts). + + +start_epmd() -> + [] = os:cmd(epmd_path() ++ " -daemon"), + ok. + +epmd_path() -> + ErtsBinDir = filename:dirname(escript:script_name()), + Name = "epmd", + case os:find_executable(Name, ErtsBinDir) of + false -> + case os:find_executable(Name) of + false -> + io:format("Could not find epmd.~n"), + halt(1); + GlobalEpmd -> + GlobalEpmd + end; + Epmd -> + Epmd + end. + + +nodename(Name) -> + case string:tokens(Name, "@") of + [_Node, _Host] -> + list_to_atom(Name); + [Node] -> + [_, Host] = string:tokens(atom_to_list(node()), "@"), + list_to_atom(lists:concat([Node, "@", Host])) + end. + +append_node_suffix(Name, Suffix) -> + case string:tokens(Name, "@") of + [Node, Host] -> + list_to_atom(lists:concat([Node, Suffix, os:getpid(), "@", Host])); + [Node] -> + list_to_atom(lists:concat([Node, Suffix, os:getpid()])) + end. + + +%% +%% Given a string or binary, parse it into a list of terms, ala file:consult/0 +%% +consult(Str) when is_list(Str) -> + consult([], Str, []); +consult(Bin) when is_binary(Bin)-> + consult([], binary_to_list(Bin), []). + +consult(Cont, Str, Acc) -> + case erl_scan:tokens(Cont, Str, 0) of + {done, Result, Remaining} -> + case Result of + {ok, Tokens, _} -> + {ok, Term} = erl_parse:parse_term(Tokens), + consult([], Remaining, [Term | Acc]); + {eof, _Other} -> + lists:reverse(Acc); + {error, Info, _} -> + {error, Info} + end; + {more, Cont1} -> + consult(Cont1, eof, Acc) + end. diff --git a/rel/files/start_erl.cmd b/rel/files/start_erl.cmd new file mode 100644 index 0000000..c0f2072 --- /dev/null +++ b/rel/files/start_erl.cmd @@ -0,0 +1,40 @@ +@setlocal + +@rem Parse arguments. erlsrv.exe prepends erl arguments prior to first ++. +@rem Other args are position dependent. +@set args="%*" +@for /F "delims=++ tokens=1,2,3" %%I in (%args%) do @( + @set erl_args=%%I + @call :set_trim node_name %%J + @rem Trim spaces from the left of %%K (node_root), which may have spaces inside + @for /f "tokens=* delims= " %%a in ("%%K") do @set node_root=%%a +) + +@set releases_dir=%node_root%\releases + +@rem parse ERTS version and release version from start_erl.dat +@for /F "usebackq tokens=1,2" %%I in ("%releases_dir%\start_erl.data") do @( + @call :set_trim erts_version %%I + @call :set_trim release_version %%J +) + +@set erl_exe="%node_root%\erts-%erts_version%\bin\erl.exe" +@set boot_file="%releases_dir%\%release_version%\%node_name%" + +@if exist "%releases_dir%\%release_version%\sys.config" ( + @set app_config="%releases_dir%\%release_version%\sys.config" +) else ( + @set app_config="%node_root%\etc\app.config" +) + +@if exist "%releases_dir%\%release_version%\vm.args" ( + @set vm_args="%releases_dir%\%release_version%\vm.args" +) else ( + @set vm_args="%node_root%\etc\vm.args" +) + +@%erl_exe% %erl_args% -boot %boot_file% -config %app_config% -args_file %vm_args% + +:set_trim +@set %1=%2 +@goto :EOF diff --git a/rel/files/sys.config b/rel/files/sys.config new file mode 100644 index 0000000..3b7f6bd --- /dev/null +++ b/rel/files/sys.config @@ -0,0 +1,11 @@ +[ + %% SASL config + {sasl, [ + {sasl_error_logger, {file, "log/sasl-error.log"}}, + {errlog_type, error}, + {error_logger_mf_dir, "log/sasl"}, % Log directory + {error_logger_mf_maxbytes, 10485760}, % 10 MB max file size + {error_logger_mf_maxfiles, 5} % 5 files max + ]} +]. + diff --git a/rel/files/vm.args b/rel/files/vm.args new file mode 100644 index 0000000..f258ed7 --- /dev/null +++ b/rel/files/vm.args @@ -0,0 +1,19 @@ +## Name of the node +-name erlog@127.0.0.1 + +## Cookie for distributed erlang +-setcookie erlog + +## Heartbeat management; auto-restarts VM if it dies or becomes unresponsive +## (Disabled by default..use with caution!) +##-heart + +## Enable kernel poll and a few async threads +##+K true +##+A 5 + +## Increase number of concurrent ports/sockets +##-env ERL_MAX_PORTS 4096 + +## Tweak GC to run more often +##-env ERL_FULLSWEEP_AFTER 10 diff --git a/rel/reltool.config b/rel/reltool.config new file mode 100644 index 0000000..065b63f --- /dev/null +++ b/rel/reltool.config @@ -0,0 +1,44 @@ +%% -*- mode: erlang -*- +%% ex: ft=erlang +{sys, [ + {lib_dirs, ["../deps"]}, + {erts, [{mod_cond, derived}, {app_file, strip}]}, + {app_file, strip}, + {rel, "erlog", "0.6", + [ + kernel, + stdlib, + sasl, + erlog + ]}, + {rel, "start_clean", "", + [ + kernel, + stdlib + ]}, + {boot_rel, "erlog"}, + {profile, embedded}, + {incl_cond, derived}, + {excl_archive_filters, [".*"]}, %% Do not archive built libs + {excl_sys_filters, ["^bin/(?!start_clean.boot)", + "^erts.*/bin/(dialyzer|typer)", + "^erts.*/(doc|info|include|lib|man|src)"]}, + {excl_app_filters, ["\.gitignore"]}, + {app, erlog, [{mod_cond, app}, {incl_cond, include}, {lib_dir, ".."}]} + ]}. + +{target_dir, "erlog"}. + +{overlay, [ + {mkdir, "log/sasl"}, + {copy, "files/erl", "\{\{erts_vsn\}\}/bin/erl"}, + {copy, "files/nodetool", "\{\{erts_vsn\}\}/bin/nodetool"}, + {copy, "erlog/bin/start_clean.boot", + "\{\{erts_vsn\}\}/bin/start_clean.boot"}, + {copy, "files/erlog", "bin/erlog"}, + {copy, "files/erlog.cmd", "bin/erlog.cmd"}, + {copy, "files/start_erl.cmd", "bin/start_erl.cmd"}, + {copy, "files/install_upgrade.escript", "bin/install_upgrade.escript"}, + {copy, "files/sys.config", "releases/\{\{rel_vsn\}\}/sys.config"}, + {copy, "files/vm.args", "releases/\{\{rel_vsn\}\}/vm.args"} + ]}. diff --git a/src/main/erlog.erl b/src/core/erlog.erl similarity index 98% rename from src/main/erlog.erl rename to src/core/erlog.erl index 98f7b25..c400dd8 100644 --- a/src/main/erlog.erl +++ b/src/core/erlog.erl @@ -34,10 +34,8 @@ -export([new/0]). %% Interface to server. -export([start/0, start_link/0]). --export([prove/2, next_solution/1, - consult/2, reconsult/2, get_db/1, set_db/2, halt/1]). --export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, - code_change/3]). +-export([prove/2, next_solution/1, consult/2, reconsult/2, get_db/1, set_db/2, halt/1]). +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). %% User utilities. -export([is_legal_term/1, vars_in/1]). @@ -59,7 +57,7 @@ new() -> erlog_lists %Common lists library ]), fun(Cmd) -> top_cmd(Cmd, Db1) end. - +%TODO OTP me? top_cmd({prove, Goal}, Db) -> prove_goal(Goal, Db); top_cmd(next_solution, Db) -> diff --git a/src/core/erlog_lists.erl b/src/core/lang/erlog_lists.erl similarity index 100% rename from src/core/erlog_lists.erl rename to src/core/lang/erlog_lists.erl diff --git a/src/core/erlog_scan.xrl b/src/core/lang/erlog_scan.xrl similarity index 100% rename from src/core/erlog_scan.xrl rename to src/core/lang/erlog_scan.xrl diff --git a/src/erlog.app.src b/src/erlog.app.src new file mode 100644 index 0000000..cea2be0 --- /dev/null +++ b/src/erlog.app.src @@ -0,0 +1,16 @@ +{application, erlog, + [ + {description, "Erlog , Prolog in Erlang"}, + {vsn, "0.6"}, + {registered, []}, + {applications, [ + kernel, + stdlib + ]}, + {mod, {erlog_app, []}}, + {env, + [ + {database, ets}, % ets | dict + {console_port, 8080} + ]} + ]}. diff --git a/src/io/erlog_io.erl b/src/io/erlog_io.erl index bca7ac8..4602402 100644 --- a/src/io/erlog_io.erl +++ b/src/io/erlog_io.erl @@ -28,7 +28,7 @@ -module(erlog_io). --export([scan_file/1, read_file/1, read/1, read/2]). +-export([scan_file/1, read_file/1, read/1, read/2, format_error/1, format_error/2, trim_command/1]). -export([write/1, write/2, write1/1, writeq/1, writeq/2, writeq1/1, write_canonical/1, write_canonical/2, write_canonical1/1]). @@ -246,3 +246,18 @@ alpha_char($_) -> true; alpha_char(C) when C >= $A, C =< $Z -> true; alpha_char(C) when C >= $0, C =< $9 -> true; alpha_char(C) -> lower_case(C). + +format_error(Params) -> format_error("Error", Params). +format_error(Type, Params) -> + B = lists:foldr( + fun(Param, Acc) when is_list(Param) -> + [Param | Acc]; + (Param, Acc) -> + [io_lib:format("~p", [Param]) | Acc] + end, ["\n"], [Type | Params]), + string:join(B, ": "). + +% removes result "\n\r" from a Command (in case it was get through telnet) +trim_command(Command) -> + Nned = string:strip(Command, right, $\n), + string:strip(Nned, right, $\r). \ No newline at end of file diff --git a/src/io/erlog_shell.erl b/src/io/erlog_shell.erl index dabbef8..dc95531 100644 --- a/src/io/erlog_shell.erl +++ b/src/io/erlog_shell.erl @@ -1,108 +1,175 @@ -%% Copyright (c) 2008-2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% server for handling telnet (tcp, plaintext) connections. +%%% Such connecitons are used for debug purpose +%%% @end +%%% Created : 26. май 2014 20:05 +%%%------------------------------------------------------------------- +-module(erlog_shell). +-author("tihon"). -%% File : erlog_shell.erl -%% Author : Robert Virding -%% Purpose : A simple Erlog shell. +-behaviour(gen_server). --module(erlog_shell). +%% API +-export([start_link/1]). --export([start/0, start/1, server/0, server/1]). +%% gen_server callbacks +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). --import(lists, [foldl/3, foreach/2]). +-define(SERVER, ?MODULE). -start() -> start(default). +-record(state, {socket, core}). -start(P) -> - spawn(fun() -> server(P) end). +%%%=================================================================== +%%% API +%%%=================================================================== -server() -> server(default). +%%-------------------------------------------------------------------- +%% @doc +%% Starts the server +%% +%% @end +%%-------------------------------------------------------------------- +-spec(start_link(Args :: term()) -> + {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). +start_link(Args) -> gen_server:start_link(?MODULE, Args, []). -server(_) -> - io:fwrite("Erlog Shell V~s (abort with ^G)\n", - [erlang:system_info(version)]), - server_loop(erlog:new()). +%%%=================================================================== +%%% gen_server callbacks +%%%=================================================================== -%% A simple Erlog shell similar to a "normal" Prolog shell. It allows -%% user to enter goals, see resulting bindings and request next -%% solution. +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Initializes the server +%% +%% @spec init(Args) -> {ok, State} | +%% {ok, State, Timeout} | +%% ignore | +%% {stop, Reason} +%% @end +%%-------------------------------------------------------------------- +-spec(init(Args :: term()) -> + {ok, State :: #state{}} | {ok, State :: #state{}, timeout() | hibernate} | + {stop, Reason :: term()} | ignore). +init({tcp, Socket}) -> + gen_server:cast(self(), accept), + {ok, #state{socket = Socket}}. -server_loop(P0) -> - case erlog_io:read('| ?- ') of - {ok, halt} -> ok; - {ok, Files} when is_list(Files) -> - {{ok, Db0}, P1} = P0(get_db), - case reconsult_files(Files, Db0) of - {ok, Db1} -> - io:fwrite("Yes\n"), - {ok, P2} = P1({set_db, Db1}), - server_loop(P2); - {erlog_error, Error} -> - io:fwrite("Error: ~p\n", [Error]), - server_loop(P0); - {error, {L, Pm, Pe}} -> - io:fwrite("Error: ~w: ~s\n", [L, Pm:format_error(Pe)]), - server_loop(P0); - {error, Error} -> - io:fwrite("Error: ~p\n", [Error]), - server_loop(P0) - end; - {ok, Goal} -> - shell_prove_result(P0({prove, Goal})); - {error, {_, Em, E}} -> - io:fwrite("Error: ~s\n", [Em:format_error(E)]), - server_loop(P0) - end. +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Handling call messages +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_call(Request :: term(), From :: {pid(), Tag :: term()}, + State :: #state{}) -> + {reply, Reply :: term(), NewState :: #state{}} | + {reply, Reply :: term(), NewState :: #state{}, timeout() | hibernate} | + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | + {stop, Reason :: term(), NewState :: #state{}}). +handle_call(_Request, _From, State) -> + {reply, ok, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Handling cast messages +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_cast(Request :: term(), State :: #state{}) -> + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), NewState :: #state{}}). +handle_cast(accept, State = #state{socket = ListenSocket}) -> + {ok, AcceptSocket} = gen_tcp:accept(ListenSocket), + erlog_shell_sup:start_socket(), + Version = list_to_binary(erlang:system_info(version)), + gen_tcp:send(AcceptSocket, [<<<<"Erlog Shell V">>/binary, Version/binary, <<" (abort with ^G)\n| ?- ">>/binary>>]), + {noreply, State#state{socket = AcceptSocket, core = erlog:new()}}; +handle_cast(_Request, State) -> + {noreply, State}. -reconsult_files([F | Fs], Db0) -> - case erlog_file:reconsult(F, Db0) of - {ok, Db1} -> reconsult_files(Fs, Db1); - {erlog_error, Error} -> {erlog_error, Error}; - {error, Error} -> {error, Error} +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Handling all non call/cast messages +%% +%% @spec handle_info(Info, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} +%% @end +%%-------------------------------------------------------------------- +-spec(handle_info(Info :: timeout() | term(), State :: #state{}) -> + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), NewState :: #state{}}). +handle_info({tcp, Socket, CommandRaw}, State = #state{core = Logic}) -> + CommandStr = erlog_io:trim_command(CommandRaw), + try list_to_existing_atom(CommandStr) of + halt -> + gen_tcp:send(Socket, <<"Ok.\n">>), + {stop, normal, State}; + Command -> + {NewCore, Res} = erlog_shell_logic:process_command(Logic, Command), + gen_tcp:send(Socket, Res), + gen_tcp:send(Socket, <<"| ?- ">>), + {noreply, State#state{core = NewCore}} + catch + error:badarg -> + gen_tcp:send(Socket, <<"No\n| ?- ">>), + {noreply, State} end; -reconsult_files([], Db) -> {ok, Db}; -reconsult_files(Other, _Db) -> {error, {type_error, list, Other}}. +handle_info({tcp_error, _}, State) -> + {stop, normal, State}; +handle_info({tcp_closed, _}, State) -> + {stop, normal, State}; +handle_info(_Info, State) -> + io:format("~p Unexpected: ~p~n", [?MODULE, _Info]), + {noreply, State}. -shell_prove_result({{succeed, Vs}, P}) -> show_bindings(Vs, P); -shell_prove_result({fail, P}) -> - io:fwrite("No\n"), - server_loop(P); -shell_prove_result({{error, Error}, P}) -> - %% Errors from the Erlog interpreters. - io:fwrite("Error: ~p\n", [Error]), - server_loop(P); -shell_prove_result({{'EXIT', Error}, P}) -> %No new database here - %% Errors and exits from user code. - io:fwrite("EXIT: ~p\n", [Error]), - server_loop(P). +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% This function is called by a gen_server when it is about to +%% terminate. It should be the opposite of Module:init/1 and do any +%% necessary cleaning up. When it returns, the gen_server terminates +%% with Reason. The return value is ignored. +%% +%% @spec terminate(Reason, State) -> void() +%% @end +%%-------------------------------------------------------------------- +-spec(terminate(Reason :: (normal | shutdown | {shutdown, term()} | term()), + State :: #state{}) -> term()). +terminate(_Reason, #state{socket = Socket}) -> %TODO destroy core + gen_tcp:close(Socket), + ok. -%% show_bindings(VarList, Prolog()) -%% Show the bindings and query user for next solution. +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Convert process state when code is changed +%% +%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState} +%% @end +%%-------------------------------------------------------------------- +-spec(code_change(OldVsn :: term() | {down, term()}, State :: #state{}, + Extra :: term()) -> + {ok, NewState :: #state{}} | {error, Reason :: term()}). +code_change(_OldVsn, State, _Extra) -> + {ok, State}. -show_bindings([], P) -> - io:fwrite("Yes\n"), - server_loop(P); -show_bindings(Vs, P) -> - foreach(fun({Name, Val}) -> - Out = erlog_io:writeq1({'=', {Name}, Val}), - io:fwrite("~s\n", [Out]) - end, Vs), - Line = io:get_line(': '), - case string:chr(Line, $;) of - 0 -> - io:fwrite("Yes\n"), - server_loop(P); - _ -> - shell_prove_result(P(next_solution)) - end. +%%%=================================================================== +%%% Internal functions +%%%=================================================================== \ No newline at end of file diff --git a/src/io/erlog_shell_logic.erl b/src/io/erlog_shell_logic.erl new file mode 100644 index 0000000..1d516e1 --- /dev/null +++ b/src/io/erlog_shell_logic.erl @@ -0,0 +1,71 @@ +%% Copyright (c) 2008-2013 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : erlog_shell.erl +%% Author : Robert Virding +%% Purpose : A simple Erlog shell. + +-module(erlog_shell_logic). + +-export([process_command/2]). + +% Gets prolog function and command, executes it. +process_command(Core, Command) when is_list(Command) -> + {{ok, Db0}, P1} = Core(get_db), + case reconsult_files(Command, Db0) of + {ok, Db1} -> + {ok, P2} = P1({set_db, Db1}), + {P2, <<"Yes\n">>}; + {error, {L, Pm, Pe}} -> + {Core, erlog_io:format_error([L, Pm:format_error(Pe)])}; + {Error, Message} when Error == error; Error == erlog_error -> + {Core, erlog_io:format_error([Message])} + end; +process_command(Core, Command) -> + shell_prove_result(Core({prove, Command})). + +reconsult_files([F | Fs], Db0) -> + case erlog_file:reconsult(F, Db0) of + {ok, Db1} -> reconsult_files(Fs, Db1); + {erlog_error, Error} -> {erlog_error, Error}; + {error, Error} -> {error, Error} + end; +reconsult_files([], Db) -> {ok, Db}; +reconsult_files(Other, _Db) -> {error, {type_error, list, Other}}. + +shell_prove_result({{succeed, Vs}, P}) -> show_bindings(Vs, P); +shell_prove_result({fail, P}) -> {P, <<"No\n">>}; +%% Errors from the Erlog interpreters. +shell_prove_result({{error, Error}, P}) -> {P, erlog_io:format_error([Error])}; +%Errors and exits from user code. No new database here +shell_prove_result({{'EXIT', Error}, P}) -> {P, erlog_io:format_error("EXIT", [Error])}. + +%% show_bindings(VarList, Prolog()) +%% Show the bindings and query user for next solution. +show_bindings([], P) -> {P, <<"Yes\n">>}; +show_bindings(Vs, P) -> + Out = lists:foldr( + fun({Name, Val}, Acc) -> + [erlog_io:writeq1({'=', {Name}, Val}) | Acc] + end, [], Vs), %format reply + + F = fun(Selection) -> + case string:chr(Selection, $;) of + 0 -> + {P, <<"Yes\n">>}; + _ -> + shell_prove_result(P(next_solution)) + end + end, + {F, Out}. \ No newline at end of file diff --git a/src/io/erlog_shell_sup.erl b/src/io/erlog_shell_sup.erl new file mode 100644 index 0000000..5fd22bb --- /dev/null +++ b/src/io/erlog_shell_sup.erl @@ -0,0 +1,83 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 26. май 2014 20:04 +%%%------------------------------------------------------------------- +-module(erlog_shell_sup). +-author("tihon"). + +-behaviour(supervisor). + +%% API +-export([start_link/0, process_connection/1, start_socket/0]). + +%% Supervisor callbacks +-export([init/1]). + +-define(SERVER, ?MODULE). + +%%%=================================================================== +%%% API functions +%%%=================================================================== +% for rpc for server-server integration +process_connection(Args) -> supervisor:start_child(?MODULE, [Args]). %TODO fix me +% for console +start_socket() -> supervisor:start_child(?MODULE, []). + +%%-------------------------------------------------------------------- +%% @doc +%% Starts the supervisor +%% +%% @end +%%-------------------------------------------------------------------- +-spec(start_link() -> + {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). +start_link() -> + supervisor:start_link({local, ?SERVER}, ?MODULE, []). + +%%%=================================================================== +%%% Supervisor callbacks +%%%=================================================================== + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Whenever a supervisor is started using supervisor:start_link/[2,3], +%% this function is called by the new process to find out about +%% restart strategy, maximum restart frequency and child +%% specifications. +%% +%% @end +%%-------------------------------------------------------------------- +-spec(init(Args :: term()) -> + {ok, {SupFlags :: {RestartStrategy :: supervisor:strategy(), + MaxR :: non_neg_integer(), MaxT :: non_neg_integer()}, + [ChildSpec :: supervisor:child_spec()] + }} | + ignore | + {error, Reason :: term()}). +init([]) -> + {ok, Port} = application:get_env(console_port), + Opts = [{active, true}, {keepalive, true}, {packet, 0}, {reuseaddr, true}], + case gen_tcp:listen(Port, Opts) of + {ok, ListenSocket} -> + io:fwrite("~w:Listening on port ~p~n", [?MODULE, Port]), %TODO lager + RestartStrategy = {simple_one_for_one, 10, 60}, + Listener = {erlog_shell, {erlog_shell, start_link, [{tcp, ListenSocket}]}, + temporary, 2000, worker, [erlog_shell]}, + spawn_link(fun start_socket/0), + {ok, {RestartStrategy, [Listener]}}; + {error, Reason} -> + io:format("Can't start server on ~p port!~nError: ~p", [Port, Reason]), + {stop, Reason}; + Other -> + io:format("Can't start server on ~p port!~nReason: ~p", [Port, Other]), + {stop, Other} + end. + +%%%=================================================================== +%%% Internal functions +%%%=================================================================== \ No newline at end of file diff --git a/src/main/erlog_app.erl b/src/main/erlog_app.erl new file mode 100644 index 0000000..b64f67b --- /dev/null +++ b/src/main/erlog_app.erl @@ -0,0 +1,16 @@ +-module(erlog_app). + +-behaviour(application). + +%% Application callbacks +-export([start/2, stop/1]). + +%% =================================================================== +%% Application callbacks +%% =================================================================== + +start(_StartType, _StartArgs) -> + erlog_super_sup:start_link(). + +stop(_State) -> + ok. diff --git a/src/main/erlog_super_sup.erl b/src/main/erlog_super_sup.erl new file mode 100644 index 0000000..b9fb38c --- /dev/null +++ b/src/main/erlog_super_sup.erl @@ -0,0 +1,28 @@ +-module(erlog_super_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). + +%% Supervisor callbacks +-export([init/1]). + +%% Helper macro for declaring children of supervisor +-define(CHILD(I, Type), {I, {I, start_link, []}, permanent, 5000, Type, [I]}). + +%% =================================================================== +%% API functions +%% =================================================================== + +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +%% =================================================================== +%% Supervisor callbacks +%% =================================================================== + +init([]) -> + ShellSup = ?CHILD(erlog_shell_sup, supervisor), + {ok, {{one_for_one, 5, 10}, [ShellSup]}}. + From efd146c242148a14d8ff444d754bffc7e949fd9d Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 27 May 2014 18:49:41 +0300 Subject: [PATCH 003/251] improve console --- src/core/lang/erlog_parse.erl | 18 +++++++++++- src/io/erlog_io.erl | 38 ++---------------------- src/io/erlog_shell.erl | 55 +++++++++++++++++++++++------------ src/io/erlog_shell_logic.erl | 3 +- 4 files changed, 59 insertions(+), 55 deletions(-) diff --git a/src/core/lang/erlog_parse.erl b/src/core/lang/erlog_parse.erl index fcf47e6..ba36371 100644 --- a/src/core/lang/erlog_parse.erl +++ b/src/core/lang/erlog_parse.erl @@ -26,7 +26,7 @@ -module(erlog_parse). --export([term/1, term/2, format_error/1]). +-export([term/1, term/2, format_error/1, parse_prolog_term/1]). -export([prefix_op/1, infix_op/1, postfix_op/1]). -compile({nowarn_unused_function, [type/1, line/1, val/1]}). @@ -311,3 +311,19 @@ infix_op('>>') -> {yes, 400, 400, 399}; %yfx 400 infix_op('**') -> {yes, 199, 200, 199}; %xfx 200 infix_op('^') -> {yes, 199, 200, 200}; %xfy 200 infix_op(_Op) -> no. + +parse_prolog_term(Commands) -> + case Commands of + {ok, Ts} -> + case erlog_parse:term(Ts) of + {ok, T} -> {ok, T}; + {error, Pe} -> {error, Pe} + end; + {ok, Ts, _} -> % TODO remove me. This is for erlog_io:read_stream. + case erlog_parse:term(Ts) of + {ok, T} -> {ok, T}; + {error, Pe} -> {error, Pe} + end; + {error, Se, _} -> {error, Se}; + {eof, _} -> {ok, end_of_file} %Prolog does this + end. \ No newline at end of file diff --git a/src/io/erlog_io.erl b/src/io/erlog_io.erl index 4602402..8c67a96 100644 --- a/src/io/erlog_io.erl +++ b/src/io/erlog_io.erl @@ -28,7 +28,7 @@ -module(erlog_io). --export([scan_file/1, read_file/1, read/1, read/2, format_error/1, format_error/2, trim_command/1]). +-export([scan_file/1, read_file/1, format_error/1, format_error/2]). -export([write/1, write/2, write1/1, writeq/1, writeq/2, writeq1/1, write_canonical/1, write_canonical/2, write_canonical1/1]). @@ -74,34 +74,7 @@ read_file(File) -> end. read_stream(Fd, L0) -> - case scan_erlog_term(Fd, '', L0) of - {ok, Toks, L1} -> - case erlog_parse:term(Toks, L0) of - {ok, end_of_file} -> []; %Prolog does this. - {ok, Term} -> - [Term | read_stream(Fd, L1)]; - {error, What} -> throw({error, What}) - end; - {error, Error, _} -> throw({error, Error}); - {eof, _} -> [] - end. - -%% read([IoDevice], Prompt) -> Term. -%% A very simple read function. Returns the direct representation of -%% the term without variable processing. - -read(P) -> read(standard_io, P). - -read(Io, P) -> - case scan_erlog_term(Io, P, 1) of - {ok, Ts, _} -> - case erlog_parse:term(Ts) of - {ok, T} -> {ok, T}; - {error, Pe} -> {error, Pe} - end; - {error, Se, _} -> {error, Se}; - {eof, _} -> {ok, end_of_file} %Prolog does this - end. + erlog_parse:parse_prolog_term(scan_erlog_term(Fd, '', L0)). scan_erlog_term(Io, Prompt, Line) -> io:request(Io, {get_until, Prompt, erlog_scan, tokens, [Line]}). @@ -255,9 +228,4 @@ format_error(Type, Params) -> (Param, Acc) -> [io_lib:format("~p", [Param]) | Acc] end, ["\n"], [Type | Params]), - string:join(B, ": "). - -% removes result "\n\r" from a Command (in case it was get through telnet) -trim_command(Command) -> - Nned = string:strip(Command, right, $\n), - string:strip(Nned, right, $\r). \ No newline at end of file + string:join(B, ": "). \ No newline at end of file diff --git a/src/io/erlog_shell.erl b/src/io/erlog_shell.erl index dc95531..229aa8f 100644 --- a/src/io/erlog_shell.erl +++ b/src/io/erlog_shell.erl @@ -25,7 +25,12 @@ -define(SERVER, ?MODULE). --record(state, {socket, core}). +-record(state, +{ + socket, % client's socket + core, % erlog function + line = [] % current line (not separated with dot). +}). %%%=================================================================== %%% API @@ -115,22 +120,14 @@ handle_cast(_Request, State) -> {noreply, NewState :: #state{}} | {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), NewState :: #state{}}). -handle_info({tcp, Socket, CommandRaw}, State = #state{core = Logic}) -> - CommandStr = erlog_io:trim_command(CommandRaw), - try list_to_existing_atom(CommandStr) of - halt -> - gen_tcp:send(Socket, <<"Ok.\n">>), - {stop, normal, State}; - Command -> - {NewCore, Res} = erlog_shell_logic:process_command(Logic, Command), - gen_tcp:send(Socket, Res), - gen_tcp:send(Socket, <<"| ?- ">>), - {noreply, State#state{core = NewCore}} - catch - error:badarg -> - gen_tcp:send(Socket, <<"No\n| ?- ">>), - {noreply, State} - end; +handle_info({tcp, _, CommandRaw}, State) -> +%% try + process_command(CommandRaw, State); +%% catch +%% _:Msg -> +%% gen_tcp:send(State#state.socket, io_lib:format("Error occurred: ~p~n| ? -", [Msg])), +%% {noreply, State} +%% end; handle_info({tcp_error, _}, State) -> {stop, normal, State}; handle_info({tcp_closed, _}, State) -> @@ -172,4 +169,26 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== %%% Internal functions -%%%=================================================================== \ No newline at end of file +%%%=================================================================== +% processes command and send it to prolog +process_command(CommandRaw, State = #state{line = Line}) when Line /= [] -> %TODO handle ^C + process_command(lists:append(Line, CommandRaw), State#state{line = []}); % collect all preceeding dot chunks +process_command(CommandRaw, State = #state{line = Line, socket = Socket}) -> + case erlog_scan:tokens([], CommandRaw, 1) of + {done, Result, _Rest} -> run_command(Result, State); % command is finished + {more, _} -> % unfinished command. Save chunk and ask for next. + gen_tcp:send(Socket, <<"| ?- ">>), + {noreply, State#state{line = lists:append(Line, CommandRaw)}} + end. +run_command(Command, State = #state{core = Logic, socket = Socket}) -> + io:format("run command ~p~n", [Command]), + case erlog_parse:parse_prolog_term(Command) of + halt -> + gen_tcp:send(Socket, <<"Ok.\n">>), + {stop, normal, State}; + PrologCmd -> + {NewCore, Res} = erlog_shell_logic:process_command(Logic, PrologCmd), + gen_tcp:send(Socket, Res), + gen_tcp:send(Socket, <<"| ?- ">>), + {noreply, State#state{core = NewCore}} + end. \ No newline at end of file diff --git a/src/io/erlog_shell_logic.erl b/src/io/erlog_shell_logic.erl index 1d516e1..81130c6 100644 --- a/src/io/erlog_shell_logic.erl +++ b/src/io/erlog_shell_logic.erl @@ -22,6 +22,7 @@ % Gets prolog function and command, executes it. process_command(Core, Command) when is_list(Command) -> + io:format("Process comand ~p~n", [Command]), {{ok, Db0}, P1} = Core(get_db), case reconsult_files(Command, Db0) of {ok, Db1} -> @@ -60,7 +61,7 @@ show_bindings(Vs, P) -> [erlog_io:writeq1({'=', {Name}, Val}) | Acc] end, [], Vs), %format reply - F = fun(Selection) -> + F = fun(Selection) -> %TODO test me! case string:chr(Selection, $;) of 0 -> {P, <<"Yes\n">>}; From 3022a0af653b98ddebb842ebe7c0f901f5e6db6e Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 27 May 2014 19:56:10 +0300 Subject: [PATCH 004/251] add debug --- src/io/erlog_shell.erl | 20 ++++++++++---------- src/io/erlog_shell_logic.erl | 17 +++++++++-------- 2 files changed, 19 insertions(+), 18 deletions(-) diff --git a/src/io/erlog_shell.erl b/src/io/erlog_shell.erl index 229aa8f..a3ef2aa 100644 --- a/src/io/erlog_shell.erl +++ b/src/io/erlog_shell.erl @@ -121,13 +121,14 @@ handle_cast(_Request, State) -> {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), NewState :: #state{}}). handle_info({tcp, _, CommandRaw}, State) -> -%% try - process_command(CommandRaw, State); -%% catch -%% _:Msg -> -%% gen_tcp:send(State#state.socket, io_lib:format("Error occurred: ~p~n| ? -", [Msg])), -%% {noreply, State} -%% end; + try + process_command(CommandRaw, State) + catch + _:Msg -> + gen_tcp:send(State#state.socket, io_lib:format("Error occurred: ~p~n| ? -", [Msg])), + erlang:display(erlang:get_stacktrace()), + {noreply, State#state{line = []}} + end; handle_info({tcp_error, _}, State) -> {stop, normal, State}; handle_info({tcp_closed, _}, State) -> @@ -181,14 +182,13 @@ process_command(CommandRaw, State = #state{line = Line, socket = Socket}) -> {noreply, State#state{line = lists:append(Line, CommandRaw)}} end. run_command(Command, State = #state{core = Logic, socket = Socket}) -> - io:format("run command ~p~n", [Command]), case erlog_parse:parse_prolog_term(Command) of - halt -> + {ok, halt} -> gen_tcp:send(Socket, <<"Ok.\n">>), {stop, normal, State}; PrologCmd -> {NewCore, Res} = erlog_shell_logic:process_command(Logic, PrologCmd), gen_tcp:send(Socket, Res), - gen_tcp:send(Socket, <<"| ?- ">>), + gen_tcp:send(Socket, <<"\n| ?- ">>), {noreply, State#state{core = NewCore}} end. \ No newline at end of file diff --git a/src/io/erlog_shell_logic.erl b/src/io/erlog_shell_logic.erl index 81130c6..faeca99 100644 --- a/src/io/erlog_shell_logic.erl +++ b/src/io/erlog_shell_logic.erl @@ -21,19 +21,18 @@ -export([process_command/2]). % Gets prolog function and command, executes it. -process_command(Core, Command) when is_list(Command) -> - io:format("Process comand ~p~n", [Command]), +process_command(Core, {ok, Command}) when is_list(Command) -> {{ok, Db0}, P1} = Core(get_db), case reconsult_files(Command, Db0) of {ok, Db1} -> {ok, P2} = P1({set_db, Db1}), - {P2, <<"Yes\n">>}; + {P2, <<"Yes">>}; {error, {L, Pm, Pe}} -> {Core, erlog_io:format_error([L, Pm:format_error(Pe)])}; {Error, Message} when Error == error; Error == erlog_error -> {Core, erlog_io:format_error([Message])} end; -process_command(Core, Command) -> +process_command(Core, {ok, Command}) -> shell_prove_result(Core({prove, Command})). reconsult_files([F | Fs], Db0) -> @@ -46,7 +45,7 @@ reconsult_files([], Db) -> {ok, Db}; reconsult_files(Other, _Db) -> {error, {type_error, list, Other}}. shell_prove_result({{succeed, Vs}, P}) -> show_bindings(Vs, P); -shell_prove_result({fail, P}) -> {P, <<"No\n">>}; +shell_prove_result({fail, P}) -> {P, <<"No">>}; %% Errors from the Erlog interpreters. shell_prove_result({{error, Error}, P}) -> {P, erlog_io:format_error([Error])}; %Errors and exits from user code. No new database here @@ -54,17 +53,19 @@ shell_prove_result({{'EXIT', Error}, P}) -> {P, erlog_io:format_error("EXIT", [E %% show_bindings(VarList, Prolog()) %% Show the bindings and query user for next solution. -show_bindings([], P) -> {P, <<"Yes\n">>}; +show_bindings([], P) -> {P, <<"Yes">>}; show_bindings(Vs, P) -> + io:format("show_bindings ~p", [Vs]), Out = lists:foldr( fun({Name, Val}, Acc) -> [erlog_io:writeq1({'=', {Name}, Val}) | Acc] end, [], Vs), %format reply - + io:format("Out = ~p~n", [Out]), + io:format("fun changed~n"), F = fun(Selection) -> %TODO test me! case string:chr(Selection, $;) of 0 -> - {P, <<"Yes\n">>}; + {P, <<"Yes">>}; _ -> shell_prove_result(P(next_solution)) end From bfda9e3d9a57d00f8a507171891dfd312b480159 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 27 May 2014 20:19:59 +0300 Subject: [PATCH 005/251] fix parsing erro --- src/io/erlog_shell_logic.erl | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/io/erlog_shell_logic.erl b/src/io/erlog_shell_logic.erl index faeca99..27005ff 100644 --- a/src/io/erlog_shell_logic.erl +++ b/src/io/erlog_shell_logic.erl @@ -32,8 +32,8 @@ process_command(Core, {ok, Command}) when is_list(Command) -> {Error, Message} when Error == error; Error == erlog_error -> {Core, erlog_io:format_error([Message])} end; -process_command(Core, {ok, Command}) -> - shell_prove_result(Core({prove, Command})). +process_command(Core, {ok, Command}) -> shell_prove_result(Core({prove, Command})); +process_command(Core, {error, {_, Em, E}}) -> {Core, erlog_io:format_error([Em:format_error(E)])}. reconsult_files([F | Fs], Db0) -> case erlog_file:reconsult(F, Db0) of @@ -48,21 +48,19 @@ shell_prove_result({{succeed, Vs}, P}) -> show_bindings(Vs, P); shell_prove_result({fail, P}) -> {P, <<"No">>}; %% Errors from the Erlog interpreters. shell_prove_result({{error, Error}, P}) -> {P, erlog_io:format_error([Error])}; -%Errors and exits from user code. No new database here +%% Errors and exits from user code. No new database here shell_prove_result({{'EXIT', Error}, P}) -> {P, erlog_io:format_error("EXIT", [Error])}. %% show_bindings(VarList, Prolog()) %% Show the bindings and query user for next solution. show_bindings([], P) -> {P, <<"Yes">>}; show_bindings(Vs, P) -> - io:format("show_bindings ~p", [Vs]), Out = lists:foldr( fun({Name, Val}, Acc) -> [erlog_io:writeq1({'=', {Name}, Val}) | Acc] end, [], Vs), %format reply - io:format("Out = ~p~n", [Out]), - io:format("fun changed~n"), - F = fun(Selection) -> %TODO test me! + + F = fun(Selection) -> case string:chr(Selection, $;) of 0 -> {P, <<"Yes">>}; From d5592bef518312a02b16d5ab8143192723a46900 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 27 May 2014 22:04:45 +0300 Subject: [PATCH 006/251] fix result selecting --- src/io/erlog_shell.erl | 24 ++++++++++++++++++------ src/io/erlog_shell_logic.erl | 20 +++++++++----------- 2 files changed, 27 insertions(+), 17 deletions(-) diff --git a/src/io/erlog_shell.erl b/src/io/erlog_shell.erl index a3ef2aa..f95e75a 100644 --- a/src/io/erlog_shell.erl +++ b/src/io/erlog_shell.erl @@ -29,7 +29,8 @@ { socket, % client's socket core, % erlog function - line = [] % current line (not separated with dot). + line = [], % current line (not separated with dot). + spike = normal % this is just a temporary spike, to handle erlog_shell_logic:show_bindings selection }). %%%=================================================================== @@ -172,6 +173,9 @@ code_change(_OldVsn, State, _Extra) -> %%% Internal functions %%%=================================================================== % processes command and send it to prolog +process_command(CommandRaw, State = #state{spike = select, core = Core}) -> + Reply = erlog_shell_logic:process_command(Core, {select, CommandRaw}), + process_reply(State, Reply); process_command(CommandRaw, State = #state{line = Line}) when Line /= [] -> %TODO handle ^C process_command(lists:append(Line, CommandRaw), State#state{line = []}); % collect all preceeding dot chunks process_command(CommandRaw, State = #state{line = Line, socket = Socket}) -> @@ -181,14 +185,22 @@ process_command(CommandRaw, State = #state{line = Line, socket = Socket}) -> gen_tcp:send(Socket, <<"| ?- ">>), {noreply, State#state{line = lists:append(Line, CommandRaw)}} end. +% run full scanned command run_command(Command, State = #state{core = Logic, socket = Socket}) -> case erlog_parse:parse_prolog_term(Command) of {ok, halt} -> gen_tcp:send(Socket, <<"Ok.\n">>), {stop, normal, State}; PrologCmd -> - {NewCore, Res} = erlog_shell_logic:process_command(Logic, PrologCmd), - gen_tcp:send(Socket, Res), - gen_tcp:send(Socket, <<"\n| ?- ">>), - {noreply, State#state{core = NewCore}} - end. \ No newline at end of file + Reply = erlog_shell_logic:process_command(Logic, PrologCmd), + process_reply(State, Reply) + end. +% process reply from prolog %TODO find better way to handle erlog_shell_logic:show_bindings selection +process_reply(State = #state{socket = Socket}, {NewCore, Res}) -> + gen_tcp:send(Socket, Res), + gen_tcp:send(Socket, <<"\n| ?- ">>), + {noreply, State#state{core = NewCore, spike = normal}}; +process_reply(State = #state{socket = Socket}, {NewCore, Res, select}) -> + gen_tcp:send(Socket, Res), + gen_tcp:send(Socket, <<"\n: ">>), + {noreply, State#state{core = NewCore, spike = select}}. \ No newline at end of file diff --git a/src/io/erlog_shell_logic.erl b/src/io/erlog_shell_logic.erl index 27005ff..9726c83 100644 --- a/src/io/erlog_shell_logic.erl +++ b/src/io/erlog_shell_logic.erl @@ -33,7 +33,8 @@ process_command(Core, {ok, Command}) when is_list(Command) -> {Core, erlog_io:format_error([Message])} end; process_command(Core, {ok, Command}) -> shell_prove_result(Core({prove, Command})); -process_command(Core, {error, {_, Em, E}}) -> {Core, erlog_io:format_error([Em:format_error(E)])}. +process_command(Core, {error, {_, Em, E}}) -> {Core, erlog_io:format_error([Em:format_error(E)])}; +process_command(Core, {select, Value}) -> select_bindings(Value, Core). reconsult_files([F | Fs], Db0) -> case erlog_file:reconsult(F, Db0) of @@ -57,15 +58,12 @@ show_bindings([], P) -> {P, <<"Yes">>}; show_bindings(Vs, P) -> Out = lists:foldr( fun({Name, Val}, Acc) -> - [erlog_io:writeq1({'=', {Name}, Val}) | Acc] + [erlog_io:writeq1({'=', {Name}, Val}) | Acc] %TODO better format end, [], Vs), %format reply + {P, Out, select}. - F = fun(Selection) -> - case string:chr(Selection, $;) of - 0 -> - {P, <<"Yes">>}; - _ -> - shell_prove_result(P(next_solution)) - end - end, - {F, Out}. \ No newline at end of file +select_bindings(Selection, P) -> + case string:chr(Selection, $;) of + 0 -> {P, <<"Yes">>}; + _ -> shell_prove_result(P(next_solution)) + end. From 23b9f544a28d3a56b454273b8b504f79be7ef671 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 11 Jun 2014 14:53:54 +0000 Subject: [PATCH 007/251] fix config --- rebar.config | 3 --- rel/reltool.config | 2 +- src/api/erlog.erl | 14 ++++++++++++++ 3 files changed, 15 insertions(+), 4 deletions(-) create mode 100644 src/api/erlog.erl diff --git a/rebar.config b/rebar.config index 7677862..b318795 100644 --- a/rebar.config +++ b/rebar.config @@ -1,6 +1,3 @@ -%% deps dirs -{deps_dir, ["deps"]}. - %% rel dirs {sub_dirs, ["rel"]}. diff --git a/rel/reltool.config b/rel/reltool.config index 065b63f..6faa881 100644 --- a/rel/reltool.config +++ b/rel/reltool.config @@ -1,7 +1,7 @@ %% -*- mode: erlang -*- %% ex: ft=erlang {sys, [ - {lib_dirs, ["../deps"]}, + {lib_dirs, []}, {erts, [{mod_cond, derived}, {app_file, strip}]}, {app_file, strip}, {rel, "erlog", "0.6", diff --git a/src/api/erlog.erl b/src/api/erlog.erl new file mode 100644 index 0000000..e9ed7db --- /dev/null +++ b/src/api/erlog.erl @@ -0,0 +1,14 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 10. июн 2014 18:18 +%%%------------------------------------------------------------------- +-module(erlog). +-author("tihon"). + +%% API +-export([]). + From c834a0debcfbf6cd051aab1bfc02988045386fd4 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 16 Jun 2014 19:21:50 +0000 Subject: [PATCH 008/251] refactoring and add doc --- README | 3 - README.md | 32 ++++++++ rel/reltool.config | 74 +++++++++---------- src/api/erlog.erl | 22 +++++- src/core/{erlog.erl => erlog_core.erl} | 6 +- .../erlog_logic.erl} | 4 +- src/io/erlog_shell.erl | 41 +++------- 7 files changed, 107 insertions(+), 75 deletions(-) delete mode 100644 README create mode 100644 README.md rename src/core/{erlog.erl => erlog_core.erl} (98%) rename src/{io/erlog_shell_logic.erl => core/erlog_logic.erl} (96%) diff --git a/README b/README deleted file mode 100644 index 2d1d664..0000000 --- a/README +++ /dev/null @@ -1,3 +0,0 @@ -Erlog is a Prolog interpreter implemented in Erlang and integrated -with the Erlang runtime system. It is a subset of the Prolog standard. -An erlog shell is also included. diff --git a/README.md b/README.md new file mode 100644 index 0000000..7cafa7a --- /dev/null +++ b/README.md @@ -0,0 +1,32 @@ +Erlog is a Prolog interpreter implemented in Erlang and integrated +with the Erlang runtime system. It is a subset of the Prolog standard. +An erlog shell is also included. + +### Usage +Make erlog: + + make rel + +#### Command line prolog coding: +Run release: + + ./rel/erlog/bin/erlog start +And connect to it via console: + + telnet 127.0.0.1 8080 + +#### Processing prolog code from erlang: +Spawn new logic core: + + Logic = erlog_core:new(). +Process prolog terms, using your core: + + erlog:process_command(CommandRaw, Spike, Core). +Where `CommandRaw` is a command, ended with dot, `Spike` is used for selecting variants of solutions, +`Core` is a pid of your prolog logic core. + +#### Calling erlang functions from erlang: +Spawn new logic core: + + Logic = erlog_core:new(). +Use functions from `erlog_core`: prove/2, next_solution/1, consult/2, reconsult/2, get_db/1, set_db/2, halt/1 then. \ No newline at end of file diff --git a/rel/reltool.config b/rel/reltool.config index 6faa881..56a665a 100644 --- a/rel/reltool.config +++ b/rel/reltool.config @@ -1,44 +1,44 @@ %% -*- mode: erlang -*- %% ex: ft=erlang {sys, [ - {lib_dirs, []}, - {erts, [{mod_cond, derived}, {app_file, strip}]}, - {app_file, strip}, - {rel, "erlog", "0.6", - [ - kernel, - stdlib, - sasl, - erlog - ]}, - {rel, "start_clean", "", - [ - kernel, - stdlib - ]}, - {boot_rel, "erlog"}, - {profile, embedded}, - {incl_cond, derived}, - {excl_archive_filters, [".*"]}, %% Do not archive built libs - {excl_sys_filters, ["^bin/(?!start_clean.boot)", - "^erts.*/bin/(dialyzer|typer)", - "^erts.*/(doc|info|include|lib|man|src)"]}, - {excl_app_filters, ["\.gitignore"]}, - {app, erlog, [{mod_cond, app}, {incl_cond, include}, {lib_dir, ".."}]} - ]}. + {lib_dirs, []}, + {erts, [{mod_cond, derived}, {app_file, strip}]}, + {app_file, strip}, + {rel, "erlog", "0.6", + [ + kernel, + stdlib, + sasl, + erlog + ]}, + {rel, "start_clean", "", + [ + kernel, + stdlib + ]}, + {boot_rel, "erlog"}, + {profile, embedded}, + {incl_cond, derived}, + {excl_archive_filters, [".*"]}, %% Do not archive built libs + {excl_sys_filters, ["^bin/(?!start_clean.boot)", + "^erts.*/bin/(dialyzer|typer)", + "^erts.*/(doc|info|include|lib|man|src)"]}, + {excl_app_filters, ["\.gitignore"]}, + {app, erlog, [{mod_cond, app}, {incl_cond, include}, {lib_dir, ".."}]} +]}. {target_dir, "erlog"}. {overlay, [ - {mkdir, "log/sasl"}, - {copy, "files/erl", "\{\{erts_vsn\}\}/bin/erl"}, - {copy, "files/nodetool", "\{\{erts_vsn\}\}/bin/nodetool"}, - {copy, "erlog/bin/start_clean.boot", - "\{\{erts_vsn\}\}/bin/start_clean.boot"}, - {copy, "files/erlog", "bin/erlog"}, - {copy, "files/erlog.cmd", "bin/erlog.cmd"}, - {copy, "files/start_erl.cmd", "bin/start_erl.cmd"}, - {copy, "files/install_upgrade.escript", "bin/install_upgrade.escript"}, - {copy, "files/sys.config", "releases/\{\{rel_vsn\}\}/sys.config"}, - {copy, "files/vm.args", "releases/\{\{rel_vsn\}\}/vm.args"} - ]}. + {mkdir, "log/sasl"}, + {copy, "files/erl", "\{\{erts_vsn\}\}/bin/erl"}, + {copy, "files/nodetool", "\{\{erts_vsn\}\}/bin/nodetool"}, + {copy, "erlog/bin/start_clean.boot", + "\{\{erts_vsn\}\}/bin/start_clean.boot"}, + {copy, "files/erlog", "bin/erlog"}, + {copy, "files/erlog.cmd", "bin/erlog.cmd"}, + {copy, "files/start_erl.cmd", "bin/start_erl.cmd"}, + {copy, "files/install_upgrade.escript", "bin/install_upgrade.escript"}, + {copy, "files/sys.config", "releases/\{\{rel_vsn\}\}/sys.config"}, + {copy, "files/vm.args", "releases/\{\{rel_vsn\}\}/vm.args"} +]}. diff --git a/src/api/erlog.erl b/src/api/erlog.erl index e9ed7db..e9aeaca 100644 --- a/src/api/erlog.erl +++ b/src/api/erlog.erl @@ -10,5 +10,25 @@ -author("tihon"). %% API --export([]). +-export([process_command/3]). +-spec process_command(CommandRaw :: string(), Spike :: atom(), Core :: pid()) -> any(). +process_command(CommandRaw, select, Core) -> % selecting variants of solutions + erlog_logic:process_command(Core, {select, CommandRaw}); +process_command(CommandRaw, normal, Core) -> + case erlog_scan:tokens([], CommandRaw, 1) of % processing command in normal mode + {done, Result, _Rest} -> run_command(Result, Core); % command is finished + {more, _} -> % unfinished command. Save chunk and ask for next. + {ok, more} + end. + + +%% run full scanned command +%% @private +run_command(Command, Logic) -> + case erlog_parse:parse_prolog_term(Command) of + {ok, halt} -> + {ok, halt}; + PrologCmd -> + erlog_logic:process_command(Logic, PrologCmd) + end. \ No newline at end of file diff --git a/src/core/erlog.erl b/src/core/erlog_core.erl similarity index 98% rename from src/core/erlog.erl rename to src/core/erlog_core.erl index c400dd8..f1f2694 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog_core.erl @@ -26,7 +26,7 @@ %% to test for, and create new variables with than using funny atom %% names like '$1' (yuch!), and we need LOTS of variables. --module(erlog). +-module(erlog_core). -include("erlog_int.hrl"). @@ -49,7 +49,7 @@ %% top-level command and returns the result and the continutation in %% a new fun. -new() -> +new() -> %TODO link with spawning process to die with it Db0 = erlog_int:built_in_db(), %Basic interpreter predicates Db1 = foldl(fun(Mod, Db) -> Mod:load(Db) end, Db0, [erlog_bips, %Built in predicates @@ -202,4 +202,4 @@ is_legal_term(_T) -> false. are_legal_args(_T, I, S) when I > S -> true; are_legal_args(T, I, S) -> - is_legal_term(element(I, T)) andalso are_legal_args(T, I + 1, S). + is_legal_term(element(I, T)) andalso are_legal_args(T, I + 1, S). \ No newline at end of file diff --git a/src/io/erlog_shell_logic.erl b/src/core/erlog_logic.erl similarity index 96% rename from src/io/erlog_shell_logic.erl rename to src/core/erlog_logic.erl index 9726c83..1f4f90d 100644 --- a/src/io/erlog_shell_logic.erl +++ b/src/core/erlog_logic.erl @@ -16,7 +16,7 @@ %% Author : Robert Virding %% Purpose : A simple Erlog shell. --module(erlog_shell_logic). +-module(erlog_logic). -export([process_command/2]). @@ -58,7 +58,7 @@ show_bindings([], P) -> {P, <<"Yes">>}; show_bindings(Vs, P) -> Out = lists:foldr( fun({Name, Val}, Acc) -> - [erlog_io:writeq1({'=', {Name}, Val}) | Acc] %TODO better format + [erlog_io:writeq1({'=', {Name}, Val}) | Acc] end, [], Vs), %format reply {P, Out, select}. diff --git a/src/io/erlog_shell.erl b/src/io/erlog_shell.erl index f95e75a..3497ee7 100644 --- a/src/io/erlog_shell.erl +++ b/src/io/erlog_shell.erl @@ -103,7 +103,7 @@ handle_cast(accept, State = #state{socket = ListenSocket}) -> erlog_shell_sup:start_socket(), Version = list_to_binary(erlang:system_info(version)), gen_tcp:send(AcceptSocket, [<<<<"Erlog Shell V">>/binary, Version/binary, <<" (abort with ^G)\n| ?- ">>/binary>>]), - {noreply, State#state{socket = AcceptSocket, core = erlog:new()}}; + {noreply, State#state{socket = AcceptSocket, core = erlog_core:new()}}; handle_cast(_Request, State) -> {noreply, State}. @@ -121,9 +121,15 @@ handle_cast(_Request, State) -> {noreply, NewState :: #state{}} | {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), NewState :: #state{}}). -handle_info({tcp, _, CommandRaw}, State) -> - try - process_command(CommandRaw, State) +handle_info({tcp, _, CommandRaw}, State = #state{line = Line, core = Core, spike = Spike, socket = Socket}) -> + try erlog:process_command(CommandRaw, Spike, Core) of + {ok, halt} -> + gen_tcp:send(Socket, <<"Ok.\n">>), + {stop, normal, State}; + {ok, more} -> + gen_tcp:send(Socket, <<"| ?- ">>), + {noreply, State#state{line = lists:append(Line, CommandRaw)}}; + Reply -> process_reply(State, Reply) catch _:Msg -> gen_tcp:send(State#state.socket, io_lib:format("Error occurred: ~p~n| ? -", [Msg])), @@ -172,35 +178,12 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== %%% Internal functions %%%=================================================================== -% processes command and send it to prolog -process_command(CommandRaw, State = #state{spike = select, core = Core}) -> - Reply = erlog_shell_logic:process_command(Core, {select, CommandRaw}), - process_reply(State, Reply); -process_command(CommandRaw, State = #state{line = Line}) when Line /= [] -> %TODO handle ^C - process_command(lists:append(Line, CommandRaw), State#state{line = []}); % collect all preceeding dot chunks -process_command(CommandRaw, State = #state{line = Line, socket = Socket}) -> - case erlog_scan:tokens([], CommandRaw, 1) of - {done, Result, _Rest} -> run_command(Result, State); % command is finished - {more, _} -> % unfinished command. Save chunk and ask for next. - gen_tcp:send(Socket, <<"| ?- ">>), - {noreply, State#state{line = lists:append(Line, CommandRaw)}} - end. -% run full scanned command -run_command(Command, State = #state{core = Logic, socket = Socket}) -> - case erlog_parse:parse_prolog_term(Command) of - {ok, halt} -> - gen_tcp:send(Socket, <<"Ok.\n">>), - {stop, normal, State}; - PrologCmd -> - Reply = erlog_shell_logic:process_command(Logic, PrologCmd), - process_reply(State, Reply) - end. % process reply from prolog %TODO find better way to handle erlog_shell_logic:show_bindings selection process_reply(State = #state{socket = Socket}, {NewCore, Res}) -> gen_tcp:send(Socket, Res), gen_tcp:send(Socket, <<"\n| ?- ">>), - {noreply, State#state{core = NewCore, spike = normal}}; + {noreply, State#state{core = NewCore, spike = normal, line = []}}; process_reply(State = #state{socket = Socket}, {NewCore, Res, select}) -> gen_tcp:send(Socket, Res), gen_tcp:send(Socket, <<"\n: ">>), - {noreply, State#state{core = NewCore, spike = select}}. \ No newline at end of file + {noreply, State#state{core = NewCore, spike = select, line = []}}. \ No newline at end of file From 0b18a8649ca4973f8daae4e9a326f99fddc91336 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 16 Jun 2014 19:29:26 +0000 Subject: [PATCH 009/251] refactoring --- src/api/erlog.erl | 2 +- src/core/erlog_core.erl | 47 +++------------------------------------- src/core/erlog_int.erl | 2 +- src/core/erlog_logic.erl | 38 +++++++++++++++++++++++++++++++- 4 files changed, 42 insertions(+), 47 deletions(-) diff --git a/src/api/erlog.erl b/src/api/erlog.erl index e9aeaca..bd95348 100644 --- a/src/api/erlog.erl +++ b/src/api/erlog.erl @@ -12,7 +12,7 @@ %% API -export([process_command/3]). --spec process_command(CommandRaw :: string(), Spike :: atom(), Core :: pid()) -> any(). +-spec process_command(CommandRaw :: string(), Spike :: atom(), Core :: fun()) -> any(). process_command(CommandRaw, select, Core) -> % selecting variants of solutions erlog_logic:process_command(Core, {select, CommandRaw}); process_command(CommandRaw, normal, Core) -> diff --git a/src/core/erlog_core.erl b/src/core/erlog_core.erl index f1f2694..c8e6fbb 100644 --- a/src/core/erlog_core.erl +++ b/src/core/erlog_core.erl @@ -36,10 +36,6 @@ -export([start/0, start_link/0]). -export([prove/2, next_solution/1, consult/2, reconsult/2, get_db/1, set_db/2, halt/1]). -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). -%% User utilities. --export([is_legal_term/1, vars_in/1]). - --import(lists, [foldl/3, foreach/2]). -behaviour(gen_server). -vsn('0.6'). @@ -51,7 +47,7 @@ new() -> %TODO link with spawning process to die with it Db0 = erlog_int:built_in_db(), %Basic interpreter predicates - Db1 = foldl(fun(Mod, Db) -> Mod:load(Db) end, Db0, + Db1 = lists:foldl(fun(Mod, Db) -> Mod:load(Db) end, Db0, [erlog_bips, %Built in predicates erlog_dcg, %DCG predicates erlog_lists %Common lists library @@ -85,7 +81,7 @@ top_cmd({set_db, NewDb}, _Db) -> top_cmd(halt, _Db) -> ok. prove_goal(Goal0, Db) -> - Vs = vars_in(Goal0), + Vs = erlog_logic:vars_in(Goal0), %% Goal may be a list of goals, ensure proper goal. Goal1 = unlistify(Goal0), %% Must use 'catch' here as 'try' does not do last-call @@ -122,7 +118,6 @@ prove_cmd(Cmd, _Vs, _Cps, _Bs, _Vn, Db) -> %% set_db(Erlog, Database) -> ok. %% halt(Erlog) -> ok. %% Interface functions to server. - prove(Erl, Goal) when is_list(Goal) -> {ok, TS, _} = erlog_scan:string(Goal ++ " "), {ok, G} = erlog_parse:term(TS), @@ -166,40 +161,4 @@ handle_info(_, St) -> terminate(_, St) -> (St#state.erlog)(halt). -code_change(_, _, St) -> {ok, St}. - -%% vars_in(Term) -> [{Name,Var}]. -%% Returns an ordered list of {VarName,Variable} pairs. - -vars_in(Term) -> vars_in(Term, orddict:new()). - -vars_in({'_'}, Vs) -> Vs; %Never in! -vars_in({Name} = Var, Vs) -> orddict:store(Name, Var, Vs); -vars_in(Struct, Vs) when is_tuple(Struct) -> - vars_in_struct(Struct, 2, size(Struct), Vs); -vars_in([H | T], Vs) -> - vars_in(T, vars_in(H, Vs)); -vars_in(_, Vs) -> Vs. - -vars_in_struct(_Str, I, S, Vs) when I > S -> Vs; -vars_in_struct(Str, I, S, Vs) -> - vars_in_struct(Str, I + 1, S, vars_in(element(I, Str), Vs)). - -%% is_legal_term(Goal) -> true | false. -%% Test if a goal is a legal Erlog term. Basically just check if -%% tuples are used correctly as structures and variables. - -is_legal_term({V}) -> is_atom(V); -is_legal_term([H | T]) -> - is_legal_term(H) andalso is_legal_term(T); -is_legal_term(T) when is_tuple(T) -> - if tuple_size(T) >= 2, is_atom(element(1, T)) -> - are_legal_args(T, 2, size(T)); %The right tuples. - true -> false - end; -is_legal_term(T) when ?IS_ATOMIC(T) -> true; %All constants, including [] -is_legal_term(_T) -> false. - -are_legal_args(_T, I, S) when I > S -> true; -are_legal_args(T, I, S) -> - is_legal_term(element(I, T)) andalso are_legal_args(T, I + 1, S). \ No newline at end of file +code_change(_, _, St) -> {ok, St}. \ No newline at end of file diff --git a/src/core/erlog_int.erl b/src/core/erlog_int.erl index 419693d..f24aacc 100644 --- a/src/core/erlog_int.erl +++ b/src/core/erlog_int.erl @@ -697,7 +697,7 @@ permission_error(Op, Type, Value, Db) -> erlog_error(E, Db) -> throw({erlog_error, E, Db}). erlog_error(E) -> throw({erlog_error, E}). --ifdef(DB). +-ifdef(DB). %TODO resolve me %% Database %% The database is a dict where the key is the functor pair {Name,Arity}. %% The value is: built_in | diff --git a/src/core/erlog_logic.erl b/src/core/erlog_logic.erl index 1f4f90d..622663b 100644 --- a/src/core/erlog_logic.erl +++ b/src/core/erlog_logic.erl @@ -18,7 +18,9 @@ -module(erlog_logic). --export([process_command/2]). +-include("erlog_int.hrl"). + +-export([process_command/2, vars_in/1, is_legal_term/1]). % Gets prolog function and command, executes it. process_command(Core, {ok, Command}) when is_list(Command) -> @@ -67,3 +69,37 @@ select_bindings(Selection, P) -> 0 -> {P, <<"Yes">>}; _ -> shell_prove_result(P(next_solution)) end. + +%% vars_in(Term) -> [{Name,Var}]. +%% Returns an ordered list of {VarName,Variable} pairs. +vars_in(Term) -> vars_in(Term, orddict:new()). + +vars_in({'_'}, Vs) -> Vs; %Never in! +vars_in({Name} = Var, Vs) -> orddict:store(Name, Var, Vs); +vars_in(Struct, Vs) when is_tuple(Struct) -> + vars_in_struct(Struct, 2, size(Struct), Vs); +vars_in([H | T], Vs) -> + vars_in(T, vars_in(H, Vs)); +vars_in(_, Vs) -> Vs. + +vars_in_struct(_Str, I, S, Vs) when I > S -> Vs; +vars_in_struct(Str, I, S, Vs) -> + vars_in_struct(Str, I + 1, S, vars_in(element(I, Str), Vs)). + +%% is_legal_term(Goal) -> true | false. +%% Test if a goal is a legal Erlog term. Basically just check if +%% tuples are used correctly as structures and variables. +is_legal_term({V}) -> is_atom(V); +is_legal_term([H | T]) -> + is_legal_term(H) andalso is_legal_term(T); +is_legal_term(T) when is_tuple(T) -> + if tuple_size(T) >= 2, is_atom(element(1, T)) -> + are_legal_args(T, 2, size(T)); %The right tuples. + true -> false + end; +is_legal_term(T) when ?IS_ATOMIC(T) -> true; %All constants, including [] +is_legal_term(_T) -> false. + +are_legal_args(_T, I, S) when I > S -> true; +are_legal_args(T, I, S) -> + is_legal_term(element(I, T)) andalso are_legal_args(T, I + 1, S). \ No newline at end of file From 184079c79a460392169a764e51c1ab25aad2fc2f Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 16 Jun 2014 23:31:33 +0000 Subject: [PATCH 010/251] refactoring l1. made core genserver instead passing functions --- src/api/erlog.erl | 50 +++++++---- src/core/erlog_core.erl | 181 ++++++++++++++++++++------------------- src/core/erlog_logic.erl | 26 ++---- src/io/erlog_file.erl | 3 +- 4 files changed, 129 insertions(+), 131 deletions(-) diff --git a/src/api/erlog.erl b/src/api/erlog.erl index bd95348..f521fa6 100644 --- a/src/api/erlog.erl +++ b/src/api/erlog.erl @@ -1,7 +1,7 @@ %%%------------------------------------------------------------------- %%% @author tihon %%% @copyright (C) 2014, -%%% @doc +%%% @doc api for executing prolog code %%% %%% @end %%% Created : 10. июн 2014 18:18 @@ -10,25 +10,39 @@ -author("tihon"). %% API --export([process_command/3]). +-export([execute/3]). --spec process_command(CommandRaw :: string(), Spike :: atom(), Core :: fun()) -> any(). -process_command(CommandRaw, select, Core) -> % selecting variants of solutions - erlog_logic:process_command(Core, {select, CommandRaw}); -process_command(CommandRaw, normal, Core) -> - case erlog_scan:tokens([], CommandRaw, 1) of % processing command in normal mode - {done, Result, _Rest} -> run_command(Result, Core); % command is finished - {more, _} -> % unfinished command. Save chunk and ask for next. - {ok, more} +-spec execute(Command :: string(), Mode :: atom(), Core :: pid) -> any(). +execute(Command, select, Core) -> % selection of solution + process_command(Core, {select, Command}); +execute(Command, normal, Core) -> + case erlog_scan:tokens([], Command, 1) of % processing command in normal mode + {done, Result, _Rest} -> run_command(Result, Core); % command is finished, run. + {more, _} -> {ok, more} % unfinished command. Ask for ending. end. - -%% run full scanned command %% @private -run_command(Command, Logic) -> +%% run full scanned command +run_command(Command, Core) -> case erlog_parse:parse_prolog_term(Command) of - {ok, halt} -> - {ok, halt}; - PrologCmd -> - erlog_logic:process_command(Logic, PrologCmd) - end. \ No newline at end of file + {ok, halt} -> {ok, halt}; + PrologCmd -> process_command(Core, PrologCmd) + end. + +%% @private +%% Gets prolog command and executes it. +-spec process_command(Core :: pid(), tuple()) -> any(). +process_command(Core, {ok, Command}) when is_list(Command) -> + {ok, Db0} = gen_server:call(Core, get_db), + case erlog_logic:reconsult_files(Command, Db0) of + {ok, Db1} -> + {ok, _Db} = gen_server:call(Core, {set_db, Db1}), %TODO if db is connection - disconnect it here? + <<"Yes">>; + {error, {L, Pm, Pe}} -> + erlog_io:format_error([L, Pm:format_error(Pe)]); + {Error, Message} when Error == error; Error == erlog_error -> + erlog_io:format_error([Message]) + end; +process_command(Core, {ok, Command}) -> erlog_logic:shell_prove_result(gen_server:call(Core, {prove, Command})); +process_command(_Core, {error, {_, Em, E}}) -> erlog_io:format_error([Em:format_error(E)]); +process_command(Core, {select, Value}) -> erlog_logic:select_bindings(Value, Core). \ No newline at end of file diff --git a/src/core/erlog_core.erl b/src/core/erlog_core.erl index c8e6fbb..f050fb7 100644 --- a/src/core/erlog_core.erl +++ b/src/core/erlog_core.erl @@ -27,91 +27,29 @@ %% names like '$1' (yuch!), and we need LOTS of variables. -module(erlog_core). +-behaviour(gen_server). +-vsn('0.7'). -include("erlog_int.hrl"). -%% Basic evaluator interface. --export([new/0]). %% Interface to server. --export([start/0, start_link/0]). --export([prove/2, next_solution/1, consult/2, reconsult/2, get_db/1, set_db/2, halt/1]). --export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). - --behaviour(gen_server). --vsn('0.6'). +-export([start_link/0]). -%% new() -> erlog(). -%% Define an Erlog instance. This is a fun which is called with the -%% top-level command and returns the result and the continutation in -%% a new fun. +%% Api for calling prolog core via erlang +-export([prove/2, next/1, consult/2, reconsult/2, get_db/1, set_db/2, halt/1]). -new() -> %TODO link with spawning process to die with it - Db0 = erlog_int:built_in_db(), %Basic interpreter predicates - Db1 = lists:foldl(fun(Mod, Db) -> Mod:load(Db) end, Db0, - [erlog_bips, %Built in predicates - erlog_dcg, %DCG predicates - erlog_lists %Common lists library - ]), - fun(Cmd) -> top_cmd(Cmd, Db1) end. -%TODO OTP me? -top_cmd({prove, Goal}, Db) -> - prove_goal(Goal, Db); -top_cmd(next_solution, Db) -> - {fail, fun(Cmd) -> top_cmd(Cmd, Db) end}; -top_cmd({consult, File}, Db0) -> - case erlog_file:consult(File, Db0) of - {ok, Db1} -> {ok, fun(Cmd) -> top_cmd(Cmd, Db1) end}; - {erlog_error, Error} -> - {{error, Error}, fun(Cmd) -> top_cmd(Cmd, Db0) end}; - {error, Error} -> - {{error, Error}, fun(Cmd) -> top_cmd(Cmd, Db0) end} - end; -top_cmd({reconsult, File}, Db0) -> - case erlog_file:reconsult(File, Db0) of - {ok, Db1} -> {ok, fun(Cmd) -> top_cmd(Cmd, Db1) end}; - {erlog_error, Error} -> - {{error, Error}, fun(Cmd) -> top_cmd(Cmd, Db0) end}; - {error, Error} -> - {{error, Error}, fun(Cmd) -> top_cmd(Cmd, Db0) end} - end; -top_cmd(get_db, Db) -> - {{ok, Db}, fun(Cmd) -> top_cmd(Cmd, Db) end}; -top_cmd({set_db, NewDb}, _Db) -> - {ok, fun(Cmd) -> top_cmd(Cmd, NewDb) end}; -top_cmd(halt, _Db) -> ok. - -prove_goal(Goal0, Db) -> - Vs = erlog_logic:vars_in(Goal0), - %% Goal may be a list of goals, ensure proper goal. - Goal1 = unlistify(Goal0), - %% Must use 'catch' here as 'try' does not do last-call - %% optimisation. - prove_result(catch erlog_int:prove_goal(Goal1, Db), Vs, Db). - -unlistify([G]) -> G; -unlistify([G | Gs]) -> {',', G, unlistify(Gs)}; -unlistify([]) -> true; -unlistify(G) -> G. %In case it wasn't a list. +%% Gen server callbacs. +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). -prove_result({succeed, Cps, Bs, Vn, Db1}, Vs, _Db0) -> - {{succeed, erlog_int:dderef(Vs, Bs)}, - fun(Cmd) -> prove_cmd(Cmd, Vs, Cps, Bs, Vn, Db1) end}; -prove_result({fail, Db1}, _Vs, _Db0) -> - {fail, fun(Cmd) -> top_cmd(Cmd, Db1) end}; -prove_result({erlog_error, Error, Db1}, _Vs, _Db0) -> - {{error, Error}, fun(Cmd) -> top_cmd(Cmd, Db1) end}; -prove_result({erlog_error, Error}, _Vs, Db) -> %No new database - {{error, Error}, fun(Cmd) -> top_cmd(Cmd, Db) end}; -prove_result({'EXIT', Error}, _Vs, Db) -> - {{'EXIT', Error}, fun(Cmd) -> top_cmd(Cmd, Db) end}. - -prove_cmd(next_solution, Vs, Cps, _Bs, _Vn, Db) -> - prove_result(catch erlog_int:fail(Cps, Db), Vs, Db); -prove_cmd(Cmd, _Vs, _Cps, _Bs, _Vn, Db) -> - top_cmd(Cmd, Db). +%% Erlang server code. +-record(state, +{ + db, %database + state = normal :: normal | list() %state for solution selecting. atom or list of params. +}). %% prove(Erlog, Goal) -> {succeed,Bindings} | fail. -%% next_solution(Erlog) -> {succeed,Bindings} | fail. +%% next(Erlog) -> {succeed,Bindings} | fail. %% consult(Erlog, File) -> ok | {error,Error}. %% reconsult(Erlog, File) -> ok | {error,Error}. %% get_db(Erlog) -> {ok,Database}. @@ -124,7 +62,7 @@ prove(Erl, Goal) when is_list(Goal) -> prove(Erl, G); prove(Erl, Goal) -> gen_server:call(Erl, {prove, Goal}, infinity). -next_solution(Erl) -> gen_server:call(Erl, next_solution, infinity). +next(Erl) -> gen_server:call(Erl, next, infinity). consult(Erl, File) -> gen_server:call(Erl, {consult, File}, infinity). @@ -136,21 +74,21 @@ set_db(Erl, Db) -> gen_server:call(Erl, {set_db, Db}, infinity). halt(Erl) -> gen_server:cast(Erl, halt). -%% Erlang server code. --record(state, {erlog}). %Erlog state - -start() -> - gen_server:start(?MODULE, [], []). - start_link() -> gen_server:start_link(?MODULE, [], []). init(_) -> - {ok, #state{erlog = new()}}. + Db0 = erlog_int:built_in_db(), %Basic interpreter predicates + Db1 = lists:foldl(fun(Mod, Db) -> Mod:load(Db) end, Db0, + [erlog_bips, %Built in predicates + erlog_dcg, %DCG predicates + erlog_lists %Common lists library + ]), + {ok, #state{db = Db1}}. -handle_call(Req, _, St) -> - {Res, Erl} = (St#state.erlog)(Req), - {reply, Res, St#state{erlog = Erl}}. +handle_call(Command, _From, State) -> + {Res, NewState} = process_command(Command, State), + {reply, Res, NewState}. handle_cast(halt, St) -> {stop, normal, St}. @@ -158,7 +96,70 @@ handle_cast(halt, St) -> handle_info(_, St) -> {noreply, St}. -terminate(_, St) -> - (St#state.erlog)(halt). +terminate(_, _) -> + ok. + +code_change(_, _, St) -> {ok, St}. + +%%%=================================================================== +%%% Internal functions +%%%=================================================================== +%% @private +%% Process command, modify state. Return {Result, NewState} +-spec process_command(tuple() | atom(), State :: #state{}) -> tuple(). +process_command({prove, Goal}, State) -> + prove_goal(Goal, State); +process_command(next, State = #state{state = normal}) -> + {fail, State}; +process_command(next, State = #state{state = [Vs, Cps], db = Db}) -> + {prove_result(catch erlog_int:fail(Cps, Db), Vs), State}; +process_command({consult, File}, State = #state{db = Db}) -> + case erlog_file:consult(File, Db) of + {ok, Db1} -> ok; %TODO Db1? + {Err, Error} when Err == erlog_error; Err == error -> + {{error, Error}, State} + end; +process_command({reconsult, File}, State = #state{db = Db}) -> + case erlog_file:reconsult(File, Db) of + {ok, Db1} -> ok; %TODO Db1? + {Err, Error} when Err == erlog_error; Err == error -> + {{error, Error}, State} + end; +process_command(get_db, State = #state{db = Db}) -> + {Db, State}; +process_command({set_db, NewDb}, State = #state{db = Db}) -> % set new db, return old + {{ok, Db}, State#state{db = NewDb}}; +process_command(halt, State) -> + gen_server:cast(self(), halt), + {ok, State}. + +%% @private +prove_goal(Goal0, State = #state{db = Db}) -> + Vs = erlog_logic:vars_in(Goal0), + %% Goal may be a list of goals, ensure proper goal. + Goal1 = unlistify(Goal0), + %% Must use 'catch' here as 'try' does not do last-call + %% optimisation. + case prove_result(catch erlog_int:prove_goal(Goal1, Db), Vs) of + {succeed, Res, Args} -> + {{succeed, Res}, State#state{state = Args}}; + OtherRes -> {OtherRes, State#state{state = normal}} + end. + +%% @private +unlistify([G]) -> G; +unlistify([G | Gs]) -> {',', G, unlistify(Gs)}; +unlistify([]) -> true; +unlistify(G) -> G. %In case it wasn't a list. -code_change(_, _, St) -> {ok, St}. \ No newline at end of file +%% @private +prove_result({succeed, Cps, Bs, _Vn, _Db1}, Vs) -> + {succeed, erlog_int:dderef(Vs, Bs), [Vs, Cps]}; +prove_result({fail, _Db1}, _Vs) -> + fail; +prove_result({erlog_error, Error, _Db1}, _Vs) -> + {error, Error}; +prove_result({erlog_error, Error}, _Vs) -> %No new database + {error, Error}; +prove_result({'EXIT', Error}, _Vs) -> + {'EXIT', Error}. \ No newline at end of file diff --git a/src/core/erlog_logic.erl b/src/core/erlog_logic.erl index 622663b..64e0baa 100644 --- a/src/core/erlog_logic.erl +++ b/src/core/erlog_logic.erl @@ -14,29 +14,13 @@ %% File : erlog_shell.erl %% Author : Robert Virding -%% Purpose : A simple Erlog shell. +%% Purpose : Module with functions realisation of erlog module api -module(erlog_logic). -include("erlog_int.hrl"). --export([process_command/2, vars_in/1, is_legal_term/1]). - -% Gets prolog function and command, executes it. -process_command(Core, {ok, Command}) when is_list(Command) -> - {{ok, Db0}, P1} = Core(get_db), - case reconsult_files(Command, Db0) of - {ok, Db1} -> - {ok, P2} = P1({set_db, Db1}), - {P2, <<"Yes">>}; - {error, {L, Pm, Pe}} -> - {Core, erlog_io:format_error([L, Pm:format_error(Pe)])}; - {Error, Message} when Error == error; Error == erlog_error -> - {Core, erlog_io:format_error([Message])} - end; -process_command(Core, {ok, Command}) -> shell_prove_result(Core({prove, Command})); -process_command(Core, {error, {_, Em, E}}) -> {Core, erlog_io:format_error([Em:format_error(E)])}; -process_command(Core, {select, Value}) -> select_bindings(Value, Core). +-export([vars_in/1, is_legal_term/1, reconsult_files/2, shell_prove_result/1, select_bindings/2]). reconsult_files([F | Fs], Db0) -> case erlog_file:reconsult(F, Db0) of @@ -64,10 +48,10 @@ show_bindings(Vs, P) -> end, [], Vs), %format reply {P, Out, select}. -select_bindings(Selection, P) -> +select_bindings(Selection, Core) -> case string:chr(Selection, $;) of - 0 -> {P, <<"Yes">>}; - _ -> shell_prove_result(P(next_solution)) + 0 -> {Core, <<"Yes">>}; + _ -> shell_prove_result(gen_server:call(Core, next_solution)) end. %% vars_in(Term) -> [{Name,Var}]. diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index 81c7e05..e95a3a6 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -37,7 +37,7 @@ consult(File, Db0) -> consult_assert(Term0, Db) -> Term1 = erlog_dcg:expand_term(Term0), - {ok, erlog_int:assertz_clause(Term1, Db)}. + {ok, erlog_int:assertz_clause(Term1, Db)}. %TODO redefining database? reconsult(File, Db0) -> case erlog_io:read_file(File) of @@ -64,7 +64,6 @@ reconsult_assert(Term0, {Db0, Seen}) -> %% {ok,NewDatabase} | {erlog_error,Error}. %% Add terms to the database using InsertFun. Ignore directives and %% queries. - consult_terms(Ifun, Db, [{':-', _} | Ts]) -> consult_terms(Ifun, Db, Ts); consult_terms(Ifun, Db, [{'?-', _} | Ts]) -> From 33634b04086194ac4f2341acba61ac7f17e89c67 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 16 Jun 2014 23:50:51 +0000 Subject: [PATCH 011/251] refactoring l2, remove functions from erlog_logic --- src/api/erlog.erl | 6 +++--- src/core/erlog_core.erl | 29 ----------------------------- src/core/erlog_int.erl | 2 +- src/core/erlog_logic.erl | 27 ++++++++++++++------------- 4 files changed, 18 insertions(+), 46 deletions(-) diff --git a/src/api/erlog.erl b/src/api/erlog.erl index f521fa6..036f766 100644 --- a/src/api/erlog.erl +++ b/src/api/erlog.erl @@ -15,8 +15,8 @@ -spec execute(Command :: string(), Mode :: atom(), Core :: pid) -> any(). execute(Command, select, Core) -> % selection of solution process_command(Core, {select, Command}); -execute(Command, normal, Core) -> - case erlog_scan:tokens([], Command, 1) of % processing command in normal mode +execute(Command, normal, Core) -> % processing command in normal mode + case erlog_scan:tokens([], Command, 1) of {done, Result, _Rest} -> run_command(Result, Core); % command is finished, run. {more, _} -> {ok, more} % unfinished command. Ask for ending. end. @@ -43,6 +43,6 @@ process_command(Core, {ok, Command}) when is_list(Command) -> {Error, Message} when Error == error; Error == erlog_error -> erlog_io:format_error([Message]) end; -process_command(Core, {ok, Command}) -> erlog_logic:shell_prove_result(gen_server:call(Core, {prove, Command})); +process_command(Core, {ok, Command}) -> erlog_logic:shell_prove_result(Core, {prove, Command}); process_command(_Core, {error, {_, Em, E}}) -> erlog_io:format_error([Em:format_error(E)]); process_command(Core, {select, Value}) -> erlog_logic:select_bindings(Value, Core). \ No newline at end of file diff --git a/src/core/erlog_core.erl b/src/core/erlog_core.erl index f050fb7..8928711 100644 --- a/src/core/erlog_core.erl +++ b/src/core/erlog_core.erl @@ -35,9 +35,6 @@ %% Interface to server. -export([start_link/0]). -%% Api for calling prolog core via erlang --export([prove/2, next/1, consult/2, reconsult/2, get_db/1, set_db/2, halt/1]). - %% Gen server callbacs. -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). @@ -48,32 +45,6 @@ state = normal :: normal | list() %state for solution selecting. atom or list of params. }). -%% prove(Erlog, Goal) -> {succeed,Bindings} | fail. -%% next(Erlog) -> {succeed,Bindings} | fail. -%% consult(Erlog, File) -> ok | {error,Error}. -%% reconsult(Erlog, File) -> ok | {error,Error}. -%% get_db(Erlog) -> {ok,Database}. -%% set_db(Erlog, Database) -> ok. -%% halt(Erlog) -> ok. -%% Interface functions to server. -prove(Erl, Goal) when is_list(Goal) -> - {ok, TS, _} = erlog_scan:string(Goal ++ " "), - {ok, G} = erlog_parse:term(TS), - prove(Erl, G); -prove(Erl, Goal) -> gen_server:call(Erl, {prove, Goal}, infinity). - -next(Erl) -> gen_server:call(Erl, next, infinity). - -consult(Erl, File) -> gen_server:call(Erl, {consult, File}, infinity). - -reconsult(Erl, File) -> gen_server:call(Erl, {reconsult, File}, infinity). - -get_db(Erl) -> gen_server:call(Erl, get_db, infinity). - -set_db(Erl, Db) -> gen_server:call(Erl, {set_db, Db}, infinity). - -halt(Erl) -> gen_server:cast(Erl, halt). - start_link() -> gen_server:start_link(?MODULE, [], []). diff --git a/src/core/erlog_int.erl b/src/core/erlog_int.erl index f24aacc..a29a76c 100644 --- a/src/core/erlog_int.erl +++ b/src/core/erlog_int.erl @@ -169,7 +169,7 @@ built_in_db() -> Db0 = new_db(), %% First add the Erlang built-ins. foldl(fun(Head, Db) -> add_built_in(Head, Db) end, Db0, - [ + [ %TODO move me to hrl %% Logic and control. {call, 1}, {',', 2}, diff --git a/src/core/erlog_logic.erl b/src/core/erlog_logic.erl index 64e0baa..43c28db 100644 --- a/src/core/erlog_logic.erl +++ b/src/core/erlog_logic.erl @@ -20,38 +20,39 @@ -include("erlog_int.hrl"). --export([vars_in/1, is_legal_term/1, reconsult_files/2, shell_prove_result/1, select_bindings/2]). +-export([vars_in/1, is_legal_term/1, reconsult_files/2, shell_prove_result/2, select_bindings/2]). +reconsult_files([], Db) -> {ok, Db}; reconsult_files([F | Fs], Db0) -> case erlog_file:reconsult(F, Db0) of {ok, Db1} -> reconsult_files(Fs, Db1); {erlog_error, Error} -> {erlog_error, Error}; {error, Error} -> {error, Error} end; -reconsult_files([], Db) -> {ok, Db}; reconsult_files(Other, _Db) -> {error, {type_error, list, Other}}. -shell_prove_result({{succeed, Vs}, P}) -> show_bindings(Vs, P); -shell_prove_result({fail, P}) -> {P, <<"No">>}; -%% Errors from the Erlog interpreters. -shell_prove_result({{error, Error}, P}) -> {P, erlog_io:format_error([Error])}; -%% Errors and exits from user code. No new database here -shell_prove_result({{'EXIT', Error}, P}) -> {P, erlog_io:format_error("EXIT", [Error])}. +shell_prove_result(Core, Command) -> + case gen_server:call(Core, Command) of + {succeed, Vs} -> show_bindings(Vs); + fail -> <<"No">>; + {error, Error} -> erlog_io:format_error([Error]); + {'EXIT', Error} -> erlog_io:format_error("EXIT", [Error]) + end. -%% show_bindings(VarList, Prolog()) +%% show_bindings(VarList, Pid) %% Show the bindings and query user for next solution. -show_bindings([], P) -> {P, <<"Yes">>}; -show_bindings(Vs, P) -> +show_bindings([]) -> <<"Yes">>; +show_bindings(Vs) -> Out = lists:foldr( fun({Name, Val}, Acc) -> [erlog_io:writeq1({'=', {Name}, Val}) | Acc] end, [], Vs), %format reply - {P, Out, select}. + {Out, select}. select_bindings(Selection, Core) -> case string:chr(Selection, $;) of 0 -> {Core, <<"Yes">>}; - _ -> shell_prove_result(gen_server:call(Core, next_solution)) + _ -> shell_prove_result(Core, gen_server:call(Core, next)) end. %% vars_in(Term) -> [{Name,Var}]. From 5deda3f93effafc217b2d6351d3620b962b6737b Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 17 Jun 2014 00:16:24 +0000 Subject: [PATCH 012/251] fix console --- src/io/erlog_shell.erl | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/src/io/erlog_shell.erl b/src/io/erlog_shell.erl index 3497ee7..bd42ea8 100644 --- a/src/io/erlog_shell.erl +++ b/src/io/erlog_shell.erl @@ -103,7 +103,8 @@ handle_cast(accept, State = #state{socket = ListenSocket}) -> erlog_shell_sup:start_socket(), Version = list_to_binary(erlang:system_info(version)), gen_tcp:send(AcceptSocket, [<<<<"Erlog Shell V">>/binary, Version/binary, <<" (abort with ^G)\n| ?- ">>/binary>>]), - {noreply, State#state{socket = AcceptSocket, core = erlog_core:new()}}; + {ok, Pid} = erlog_core:start_link(), + {noreply, State#state{socket = AcceptSocket, core = Pid}}; handle_cast(_Request, State) -> {noreply, State}. @@ -122,7 +123,7 @@ handle_cast(_Request, State) -> {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), NewState :: #state{}}). handle_info({tcp, _, CommandRaw}, State = #state{line = Line, core = Core, spike = Spike, socket = Socket}) -> - try erlog:process_command(CommandRaw, Spike, Core) of + try erlog:execute(CommandRaw, Spike, Core) of {ok, halt} -> gen_tcp:send(Socket, <<"Ok.\n">>), {stop, normal, State}; @@ -178,12 +179,12 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== %%% Internal functions %%%=================================================================== -% process reply from prolog %TODO find better way to handle erlog_shell_logic:show_bindings selection -process_reply(State = #state{socket = Socket}, {NewCore, Res}) -> - gen_tcp:send(Socket, Res), - gen_tcp:send(Socket, <<"\n| ?- ">>), - {noreply, State#state{core = NewCore, spike = normal, line = []}}; -process_reply(State = #state{socket = Socket}, {NewCore, Res, select}) -> +% process reply from prolog +process_reply(State = #state{socket = Socket}, {Res, select}) -> gen_tcp:send(Socket, Res), gen_tcp:send(Socket, <<"\n: ">>), - {noreply, State#state{core = NewCore, spike = select, line = []}}. \ No newline at end of file + {noreply, State#state{spike = select, line = []}}; +process_reply(State = #state{socket = Socket}, Res) -> + gen_tcp:send(Socket, Res), + gen_tcp:send(Socket, <<"\n| ?- ">>), + {noreply, State#state{spike = normal, line = []}}. \ No newline at end of file From 3c5f168b1a5104eec8bd938d88ce0a0304127fb0 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 17 Jun 2014 00:19:33 +0000 Subject: [PATCH 013/251] update doc --- README.md | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/README.md b/README.md index 7cafa7a..a4e2eec 100644 --- a/README.md +++ b/README.md @@ -18,15 +18,11 @@ And connect to it via console: #### Processing prolog code from erlang: Spawn new logic core: - Logic = erlog_core:new(). + {ok, Pid} = erlog_core:start_link(). Process prolog terms, using your core: - erlog:process_command(CommandRaw, Spike, Core). -Where `CommandRaw` is a command, ended with dot, `Spike` is used for selecting variants of solutions, -`Core` is a pid of your prolog logic core. - -#### Calling erlang functions from erlang: -Spawn new logic core: - - Logic = erlog_core:new(). -Use functions from `erlog_core`: prove/2, next_solution/1, consult/2, reconsult/2, get_db/1, set_db/2, halt/1 then. \ No newline at end of file + erlog:execute(CommandRaw, Spike, Core). +Where: +`CommandRaw` is a command, ended with dot, +`Spike` is used for selecting variants of solutions, it can be `normal` for operating in normal mode and `select` for selecting solutions, +`Core` is a pid of your prolog logic core. \ No newline at end of file From 7c1794e0c8f07ed180210dd2aa772bed2b8c45e2 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 17 Jun 2014 00:25:16 +0000 Subject: [PATCH 014/251] add todo --- src/api/erlog.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/api/erlog.erl b/src/api/erlog.erl index 036f766..bfaee83 100644 --- a/src/api/erlog.erl +++ b/src/api/erlog.erl @@ -13,7 +13,7 @@ -export([execute/3]). -spec execute(Command :: string(), Mode :: atom(), Core :: pid) -> any(). -execute(Command, select, Core) -> % selection of solution +execute(Command, select, Core) -> % selection of solution %TODO move Mode from here to erlog_core state process_command(Core, {select, Command}); execute(Command, normal, Core) -> % processing command in normal mode case erlog_scan:tokens([], Command, 1) of From cc240c94221d1b98671a1b2a9c932c9889a30662 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 17 Jun 2014 22:13:32 +0000 Subject: [PATCH 015/251] refactored core and api --- README.md | 9 ++-- src/api/erlog.erl | 48 ----------------- src/core/{erlog_core.erl => erlog.erl} | 73 ++++++++++++++++---------- src/core/erlog_logic.erl | 35 ++++++++---- src/core/lang/erlog_parse.erl | 18 +++---- src/io/erlog_shell.erl | 9 ++-- 6 files changed, 87 insertions(+), 105 deletions(-) delete mode 100644 src/api/erlog.erl rename src/core/{erlog_core.erl => erlog.erl} (65%) diff --git a/README.md b/README.md index a4e2eec..ae7d314 100644 --- a/README.md +++ b/README.md @@ -18,11 +18,10 @@ And connect to it via console: #### Processing prolog code from erlang: Spawn new logic core: - {ok, Pid} = erlog_core:start_link(). + {ok, Pid} = erlog:start_link(). Process prolog terms, using your core: - erlog:execute(CommandRaw, Spike, Core). + erlog:execute(Worker, Command). Where: -`CommandRaw` is a command, ended with dot, -`Spike` is used for selecting variants of solutions, it can be `normal` for operating in normal mode and `select` for selecting solutions, -`Core` is a pid of your prolog logic core. \ No newline at end of file +`Command` is a command, ended with dot, +`Worker` is a pid of your prolog logic core. \ No newline at end of file diff --git a/src/api/erlog.erl b/src/api/erlog.erl deleted file mode 100644 index bfaee83..0000000 --- a/src/api/erlog.erl +++ /dev/null @@ -1,48 +0,0 @@ -%%%------------------------------------------------------------------- -%%% @author tihon -%%% @copyright (C) 2014, -%%% @doc api for executing prolog code -%%% -%%% @end -%%% Created : 10. июн 2014 18:18 -%%%------------------------------------------------------------------- --module(erlog). --author("tihon"). - -%% API --export([execute/3]). - --spec execute(Command :: string(), Mode :: atom(), Core :: pid) -> any(). -execute(Command, select, Core) -> % selection of solution %TODO move Mode from here to erlog_core state - process_command(Core, {select, Command}); -execute(Command, normal, Core) -> % processing command in normal mode - case erlog_scan:tokens([], Command, 1) of - {done, Result, _Rest} -> run_command(Result, Core); % command is finished, run. - {more, _} -> {ok, more} % unfinished command. Ask for ending. - end. - -%% @private -%% run full scanned command -run_command(Command, Core) -> - case erlog_parse:parse_prolog_term(Command) of - {ok, halt} -> {ok, halt}; - PrologCmd -> process_command(Core, PrologCmd) - end. - -%% @private -%% Gets prolog command and executes it. --spec process_command(Core :: pid(), tuple()) -> any(). -process_command(Core, {ok, Command}) when is_list(Command) -> - {ok, Db0} = gen_server:call(Core, get_db), - case erlog_logic:reconsult_files(Command, Db0) of - {ok, Db1} -> - {ok, _Db} = gen_server:call(Core, {set_db, Db1}), %TODO if db is connection - disconnect it here? - <<"Yes">>; - {error, {L, Pm, Pe}} -> - erlog_io:format_error([L, Pm:format_error(Pe)]); - {Error, Message} when Error == error; Error == erlog_error -> - erlog_io:format_error([Message]) - end; -process_command(Core, {ok, Command}) -> erlog_logic:shell_prove_result(Core, {prove, Command}); -process_command(_Core, {error, {_, Em, E}}) -> erlog_io:format_error([Em:format_error(E)]); -process_command(Core, {select, Value}) -> erlog_logic:select_bindings(Value, Core). \ No newline at end of file diff --git a/src/core/erlog_core.erl b/src/core/erlog.erl similarity index 65% rename from src/core/erlog_core.erl rename to src/core/erlog.erl index 8928711..3a3fafc 100644 --- a/src/core/erlog_core.erl +++ b/src/core/erlog.erl @@ -26,14 +26,14 @@ %% to test for, and create new variables with than using funny atom %% names like '$1' (yuch!), and we need LOTS of variables. --module(erlog_core). +-module(erlog). -behaviour(gen_server). -vsn('0.7'). -include("erlog_int.hrl"). %% Interface to server. --export([start_link/0]). +-export([start_link/0, execute/2]). %% Gen server callbacs. -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). @@ -45,6 +45,8 @@ state = normal :: normal | list() %state for solution selecting. atom or list of params. }). +execute(Worker, Command) -> gen_server:call(Worker, {execute, Command}). + start_link() -> gen_server:start_link(?MODULE, [], []). @@ -57,9 +59,15 @@ init(_) -> ]), {ok, #state{db = Db1}}. -handle_call(Command, _From, State) -> - {Res, NewState} = process_command(Command, State), - {reply, Res, NewState}. +handle_call({execute, Command}, _From, State = #state{state = normal}) -> %in normal mode + Res = case erlog_scan:tokens([], Command, 1) of + {done, Result, _Rest} -> run_command(Result, State); % command is finished, run. + {more, _} -> {ok, more} % unfinished command. Ask for ending. + end, + {reply, Res, State}; +handle_call({execute, Command}, _From, State) -> %in selection solutions mode + Res = preprocess_command({select, Command}, State), + {reply, Res, State}. handle_cast(halt, St) -> {stop, normal, St}. @@ -75,6 +83,35 @@ code_change(_, _, St) -> {ok, St}. %%%=================================================================== %%% Internal functions %%%=================================================================== +%% @private +%% Run scanned command +run_command(Command, State) -> + case erlog_parse:parse_prolog_term(Command) of + {ok, halt} -> {ok, halt}; + PrologCmd -> preprocess_command(PrologCmd, State) + end. + +%% @private +%% Preprocess command +preprocess_command({ok, Command}, State) when is_list(Command) -> + {{ok, Db0}, NewState1} = process_command(get_db, State), + case erlog_logic:reconsult_files(Command, Db0) of + {ok, Db1} -> + {{ok, _Db}, NewState2} = process_command({set_db, Db1}, NewState1), + {<<"Yes">>, NewState2}; + {error, {L, Pm, Pe}} -> + {erlog_io:format_error([L, Pm:format_error(Pe)]), NewState1}; + {Error, Message} when Error == error; Error == erlog_error -> + {erlog_io:format_error([Message]), NewState1} + end; +preprocess_command({ok, Command}, State) -> + {Res, State} = process_command({prove, Command}, State), + {erlog_logic:shell_prove_result(Res), State}; +preprocess_command({error, {_, Em, E}}, State) -> {erlog_io:format_error([Em:format_error(E)]), State}; +preprocess_command({select, Value}, State) -> + {Next, State} = process_command(next, State), + {erlog_logic:select_bindings(Value, Next), State}. + %% @private %% Process command, modify state. Return {Result, NewState} -spec process_command(tuple() | atom(), State :: #state{}) -> tuple(). @@ -83,7 +120,7 @@ process_command({prove, Goal}, State) -> process_command(next, State = #state{state = normal}) -> {fail, State}; process_command(next, State = #state{state = [Vs, Cps], db = Db}) -> - {prove_result(catch erlog_int:fail(Cps, Db), Vs), State}; + {erlog_logic:prove_result(catch erlog_int:fail(Cps, Db), Vs), State}; process_command({consult, File}, State = #state{db = Db}) -> case erlog_file:consult(File, Db) of {ok, Db1} -> ok; %TODO Db1? @@ -108,29 +145,11 @@ process_command(halt, State) -> prove_goal(Goal0, State = #state{db = Db}) -> Vs = erlog_logic:vars_in(Goal0), %% Goal may be a list of goals, ensure proper goal. - Goal1 = unlistify(Goal0), + Goal1 = erlog_logic:unlistify(Goal0), %% Must use 'catch' here as 'try' does not do last-call %% optimisation. - case prove_result(catch erlog_int:prove_goal(Goal1, Db), Vs) of + case erlog_logic:prove_result(catch erlog_int:prove_goal(Goal1, Db), Vs) of {succeed, Res, Args} -> {{succeed, Res}, State#state{state = Args}}; OtherRes -> {OtherRes, State#state{state = normal}} - end. - -%% @private -unlistify([G]) -> G; -unlistify([G | Gs]) -> {',', G, unlistify(Gs)}; -unlistify([]) -> true; -unlistify(G) -> G. %In case it wasn't a list. - -%% @private -prove_result({succeed, Cps, Bs, _Vn, _Db1}, Vs) -> - {succeed, erlog_int:dderef(Vs, Bs), [Vs, Cps]}; -prove_result({fail, _Db1}, _Vs) -> - fail; -prove_result({erlog_error, Error, _Db1}, _Vs) -> - {error, Error}; -prove_result({erlog_error, Error}, _Vs) -> %No new database - {error, Error}; -prove_result({'EXIT', Error}, _Vs) -> - {'EXIT', Error}. \ No newline at end of file + end. \ No newline at end of file diff --git a/src/core/erlog_logic.erl b/src/core/erlog_logic.erl index 43c28db..6a23145 100644 --- a/src/core/erlog_logic.erl +++ b/src/core/erlog_logic.erl @@ -20,7 +20,23 @@ -include("erlog_int.hrl"). --export([vars_in/1, is_legal_term/1, reconsult_files/2, shell_prove_result/2, select_bindings/2]). +-export([vars_in/1, is_legal_term/1, reconsult_files/2, select_bindings/2, shell_prove_result/1, prove_result/2, unlistify/1]). + +%% @private +unlistify([G | Gs]) -> {',', G, unlistify(Gs)}; +unlistify([]) -> true; +unlistify(G) -> G. %In case it wasn't a list. + +prove_result({succeed, Cps, Bs, _Vn, _Db1}, Vs) -> + {succeed, erlog_int:dderef(Vs, Bs), [Vs, Cps]}; +prove_result({fail, _Db1}, _Vs) -> + fail; +prove_result({erlog_error, Error, _Db1}, _Vs) -> + {error, Error}; +prove_result({erlog_error, Error}, _Vs) -> %No new database + {error, Error}; +prove_result({'EXIT', Error}, _Vs) -> + {'EXIT', Error}. reconsult_files([], Db) -> {ok, Db}; reconsult_files([F | Fs], Db0) -> @@ -31,13 +47,10 @@ reconsult_files([F | Fs], Db0) -> end; reconsult_files(Other, _Db) -> {error, {type_error, list, Other}}. -shell_prove_result(Core, Command) -> - case gen_server:call(Core, Command) of - {succeed, Vs} -> show_bindings(Vs); - fail -> <<"No">>; - {error, Error} -> erlog_io:format_error([Error]); - {'EXIT', Error} -> erlog_io:format_error("EXIT", [Error]) - end. +shell_prove_result({succeed, Vs}) -> show_bindings(Vs); +shell_prove_result(fail) -> <<"No">>; +shell_prove_result({error, Error}) -> erlog_io:format_error([Error]); +shell_prove_result({'EXIT', Error}) -> erlog_io:format_error("EXIT", [Error]). %% show_bindings(VarList, Pid) %% Show the bindings and query user for next solution. @@ -49,10 +62,10 @@ show_bindings(Vs) -> end, [], Vs), %format reply {Out, select}. -select_bindings(Selection, Core) -> +select_bindings(Selection, Next) -> case string:chr(Selection, $;) of - 0 -> {Core, <<"Yes">>}; - _ -> shell_prove_result(Core, gen_server:call(Core, next)) + 0 -> <<"Yes">>; + _ -> shell_prove_result(Next) end. %% vars_in(Term) -> [{Name,Var}]. diff --git a/src/core/lang/erlog_parse.erl b/src/core/lang/erlog_parse.erl index ba36371..66363d7 100644 --- a/src/core/lang/erlog_parse.erl +++ b/src/core/lang/erlog_parse.erl @@ -314,16 +314,14 @@ infix_op(_Op) -> no. parse_prolog_term(Commands) -> case Commands of - {ok, Ts} -> - case erlog_parse:term(Ts) of - {ok, T} -> {ok, T}; - {error, Pe} -> {error, Pe} - end; - {ok, Ts, _} -> % TODO remove me. This is for erlog_io:read_stream. - case erlog_parse:term(Ts) of - {ok, T} -> {ok, T}; - {error, Pe} -> {error, Pe} - end; + {ok, Ts} -> parse(Ts); + {ok, Ts, _} -> parse(Ts); {error, Se, _} -> {error, Se}; {eof, _} -> {ok, end_of_file} %Prolog does this + end. + +parse(Ts) -> + case erlog_parse:term(Ts) of + {ok, T} -> {ok, T}; + {error, Pe} -> {error, Pe} end. \ No newline at end of file diff --git a/src/io/erlog_shell.erl b/src/io/erlog_shell.erl index bd42ea8..57dd13e 100644 --- a/src/io/erlog_shell.erl +++ b/src/io/erlog_shell.erl @@ -103,7 +103,7 @@ handle_cast(accept, State = #state{socket = ListenSocket}) -> erlog_shell_sup:start_socket(), Version = list_to_binary(erlang:system_info(version)), gen_tcp:send(AcceptSocket, [<<<<"Erlog Shell V">>/binary, Version/binary, <<" (abort with ^G)\n| ?- ">>/binary>>]), - {ok, Pid} = erlog_core:start_link(), + {ok, Pid} = erlog:start_link(), {noreply, State#state{socket = AcceptSocket, core = Pid}}; handle_cast(_Request, State) -> {noreply, State}. @@ -122,8 +122,8 @@ handle_cast(_Request, State) -> {noreply, NewState :: #state{}} | {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), NewState :: #state{}}). -handle_info({tcp, _, CommandRaw}, State = #state{line = Line, core = Core, spike = Spike, socket = Socket}) -> - try erlog:execute(CommandRaw, Spike, Core) of +handle_info({tcp, _, CommandRaw}, State = #state{line = Line, core = Core, socket = Socket}) -> + try erlog:execute(Core, CommandRaw) of {ok, halt} -> gen_tcp:send(Socket, <<"Ok.\n">>), {stop, normal, State}; @@ -158,8 +158,9 @@ handle_info(_Info, State) -> %%-------------------------------------------------------------------- -spec(terminate(Reason :: (normal | shutdown | {shutdown, term()} | term()), State :: #state{}) -> term()). -terminate(_Reason, #state{socket = Socket}) -> %TODO destroy core +terminate(_Reason, #state{socket = Socket, core = Core}) -> gen_tcp:close(Socket), + gen_server:cast(Core, halt), ok. %%-------------------------------------------------------------------- From 082cdc2ad001481a1a4ac910514dd1236af6adb6 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 17 Jun 2014 22:36:26 +0000 Subject: [PATCH 016/251] fix rte --- src/core/erlog.erl | 18 +++++++++--------- src/io/erlog_shell.erl | 2 +- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 3a3fafc..5150916 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -60,14 +60,14 @@ init(_) -> {ok, #state{db = Db1}}. handle_call({execute, Command}, _From, State = #state{state = normal}) -> %in normal mode - Res = case erlog_scan:tokens([], Command, 1) of - {done, Result, _Rest} -> run_command(Result, State); % command is finished, run. - {more, _} -> {ok, more} % unfinished command. Ask for ending. - end, - {reply, Res, State}; + {Res, NewState} = case erlog_scan:tokens([], Command, 1) of + {done, Result, _Rest} -> run_command(Result, State); % command is finished, run. + {more, _} -> {ok, more} % unfinished command. Ask for ending. + end, + {reply, Res, NewState}; handle_call({execute, Command}, _From, State) -> %in selection solutions mode - Res = preprocess_command({select, Command}, State), - {reply, Res, State}. + {Res, NewState} = preprocess_command({select, Command}, State), + {reply, Res, NewState}. handle_cast(halt, St) -> {stop, normal, St}. @@ -105,8 +105,8 @@ preprocess_command({ok, Command}, State) when is_list(Command) -> {erlog_io:format_error([Message]), NewState1} end; preprocess_command({ok, Command}, State) -> - {Res, State} = process_command({prove, Command}, State), - {erlog_logic:shell_prove_result(Res), State}; + {Res, NewState} = process_command({prove, Command}, State), + {erlog_logic:shell_prove_result(Res), NewState}; preprocess_command({error, {_, Em, E}}, State) -> {erlog_io:format_error([Em:format_error(E)]), State}; preprocess_command({select, Value}, State) -> {Next, State} = process_command(next, State), diff --git a/src/io/erlog_shell.erl b/src/io/erlog_shell.erl index 57dd13e..fb7605f 100644 --- a/src/io/erlog_shell.erl +++ b/src/io/erlog_shell.erl @@ -123,7 +123,7 @@ handle_cast(_Request, State) -> {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), NewState :: #state{}}). handle_info({tcp, _, CommandRaw}, State = #state{line = Line, core = Core, socket = Socket}) -> - try erlog:execute(Core, CommandRaw) of + try erlog:execute(Core, lists:append(Line, CommandRaw)) of {ok, halt} -> gen_tcp:send(Socket, <<"Ok.\n">>), {stop, normal, State}; From 8e1c119685edd7000144c735c1c6436d7ae626c8 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 17 Jun 2014 23:52:08 +0000 Subject: [PATCH 017/251] partly refactored db module, add callback interface --- include/erlog_int.hrl | 89 +++++++++++ src/core/erlog.erl | 4 +- src/core/lang/erlog_bips.erl | 230 +++++++++++----------------- src/core/lang/erlog_dcg.erl | 22 +-- src/core/lang/erlog_lists.erl | 69 ++++----- src/io/erlog_shell.erl | 2 + src/storage/erlog_ets.erl | 24 ++- src/{core => storage}/erlog_int.erl | 49 +----- src/storage/erlog_storage.erl | 29 ++++ 9 files changed, 263 insertions(+), 255 deletions(-) rename src/{core => storage}/erlog_int.erl (97%) create mode 100644 src/storage/erlog_storage.erl diff --git a/include/erlog_int.hrl b/include/erlog_int.hrl index fcf7741..c46617d 100644 --- a/include/erlog_int.hrl +++ b/include/erlog_int.hrl @@ -21,6 +21,95 @@ -define(IS_ATOMIC(T), (not (is_tuple(T) orelse (is_list(T) andalso T /= [])))). -define(IS_FUNCTOR(T), (is_tuple(T) andalso (tuple_size(T) >= 2) andalso is_atom(element(1, T)))). +%% The old is_constant/1 ? +-define(IS_CONSTANT(T), (not (is_tuple(T) orelse is_list(T)))). + %% Define the choice point record -record(cp, {type, label, data, next, bs, vn}). -record(cut, {label, next}). + +-define(ERLOG_BIPS, + [ + %% Term unification and comparison + {'=', 2}, + {'\\=', 2}, + {'@>', 2}, + {'@>=', 2}, + {'==', 2}, + {'\\==', 2}, + {'@<', 2}, + {'@=<', 2}, + %% Term creation and decomposition. + {arg, 3}, + {copy_term, 2}, + {functor, 3}, + {'=..', 2}, + %% Type testing. + {atom, 1}, + {atomic, 1}, + {compound, 1}, + {integer, 1}, + {float, 1}, + {number, 1}, + {nonvar, 1}, + {var, 1}, + %% Atom processing. + {atom_chars, 2}, + {atom_length, 2}, + %% Arithmetic evaluation and comparison + {'is', 2}, + {'>', 2}, + {'>=', 2}, + {'=:=', 2}, + {'=\\=', 2}, + {'<', 2}, + {'=<', 2} + ]). + +-define(ERLOG_DCG, + [ + {{expand_term, 2}, erlog_dcg, expand_term_2}, + {{phrase, 3}, erlog_dcg, phrase_3} + ]). + +-define(ERLOG_LISTS, + [ + {{append, 3}, ?MODULE, append_3}, + {{insert, 3}, ?MODULE, insert_3}, + {{member, 2}, ?MODULE, member_2}, + {{memberchk, 2}, ?MODULE, memberchk_2}, + {{reverse, 2}, ?MODULE, reverse_2}, + {{sort, 2}, ?MODULE, sort_2} + ]). + +-define(ERLOG_INT, + [ + %% Logic and control. + {call, 1}, + {',', 2}, + {'!', 0}, + {';', 2}, + {fail, 0}, + {'->', 2}, + {'\\+', 1}, + {once, 1}, + {repeat, 0}, + {true, 0}, + %% Clause creation and destruction. + {abolish, 1}, + {assert, 1}, + {asserta, 1}, + {assertz, 1}, + {retract, 1}, + {retractall, 1}, + %% Clause retrieval and information. + {clause, 2}, + {current_predicate, 1}, + {predicate_property, 2}, + %% All solutions + %% External interface + {ecall, 2}, + %% Non-standard but useful + {display, 1} + ] +). \ No newline at end of file diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 5150916..e97ecab 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -105,6 +105,7 @@ preprocess_command({ok, Command}, State) when is_list(Command) -> {erlog_io:format_error([Message]), NewState1} end; preprocess_command({ok, Command}, State) -> + io:format("prove command ~p~n", [Command]), {Res, NewState} = process_command({prove, Command}, State), {erlog_logic:shell_prove_result(Res), NewState}; preprocess_command({error, {_, Em, E}}, State) -> {erlog_io:format_error([Em:format_error(E)]), State}; @@ -143,6 +144,7 @@ process_command(halt, State) -> %% @private prove_goal(Goal0, State = #state{db = Db}) -> + io:format("db = ~p~n", [Db]), Vs = erlog_logic:vars_in(Goal0), %% Goal may be a list of goals, ensure proper goal. Goal1 = erlog_logic:unlistify(Goal0), @@ -150,6 +152,6 @@ prove_goal(Goal0, State = #state{db = Db}) -> %% optimisation. case erlog_logic:prove_result(catch erlog_int:prove_goal(Goal1, Db), Vs) of {succeed, Res, Args} -> - {{succeed, Res}, State#state{state = Args}}; + {{succeed, Res}, State}; OtherRes -> {OtherRes, State#state{state = normal}} end. \ No newline at end of file diff --git a/src/core/lang/erlog_bips.erl b/src/core/lang/erlog_bips.erl index 2bf853f..a65c034 100644 --- a/src/core/lang/erlog_bips.erl +++ b/src/core/lang/erlog_bips.erl @@ -31,55 +31,11 @@ -import(lists, [map/2, foldl/3]). -%% We use these a lot so we import them for cleaner code. --import(erlog_int, [prove_body/5, unify_prove_body/7, unify_prove_body/9, fail/2, -add_binding/3, make_vars/2, -deref/2, dderef/2, dderef_list/2, unify/3, -term_instance/2, -add_built_in/2, add_compiled_proc/4, -asserta_clause/2, assertz_clause/2]). - %% load(Database) -> Database. %% Assert predicates into the database. load(Db0) -> - foldl(fun(Head, Db) -> add_built_in(Head, Db) end, Db0, - [ - %% Term unification and comparison - {'=', 2}, - {'\\=', 2}, - {'@>', 2}, - {'@>=', 2}, - {'==', 2}, - {'\\==', 2}, - {'@<', 2}, - {'@=<', 2}, - %% Term creation and decomposition. - {arg, 3}, - {copy_term, 2}, - {functor, 3}, - {'=..', 2}, - %% Type testing. - {atom, 1}, - {atomic, 1}, - {compound, 1}, - {integer, 1}, - {float, 1}, - {number, 1}, - {nonvar, 1}, - {var, 1}, - %% Atom processing. - {atom_chars, 2}, - {atom_length, 2}, - %% Arithmetic evaluation and comparison - {'is', 2}, - {'>', 2}, - {'>=', 2}, - {'=:=', 2}, - {'=\\=', 2}, - {'<', 2}, - {'=<', 2} - ]). + foldl(fun(Head, Db) -> erlog_int:add_built_in(Head, Db) end, Db0, ?ERLOG_BIPS). %% prove_goal(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> %% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase} | @@ -89,11 +45,11 @@ load(Db0) -> %% Term unification and comparison prove_goal({'=', L, R}, Next, Cps, Bs, Vn, Db) -> - unify_prove_body(L, R, Next, Cps, Bs, Vn, Db); + erlog_int:unify_prove_body(L, R, Next, Cps, Bs, Vn, Db); prove_goal({'\\=', L, R}, Next, Cps, Bs0, Vn, Db) -> - case unify(L, R, Bs0) of - {succeed, _Bs1} -> fail(Cps, Db); - fail -> prove_body(Next, Cps, Bs0, Vn, Db) + case erlog_int:unify(L, R, Bs0) of + {succeed, _Bs1} -> erlog_int:fail(Cps, Db); + fail -> erlog_int:prove_body(Next, Cps, Bs0, Vn, Db) end; prove_goal({'@>', L, R}, Next, Cps, Bs, Vn, Db) -> term_test_prove_body('>', L, R, Next, Cps, Bs, Vn, Db); @@ -109,68 +65,68 @@ prove_goal({'@=<', L, R}, Next, Cps, Bs, Vn, Db) -> term_test_prove_body('=<', L, R, Next, Cps, Bs, Vn, Db); %% Term creation and decomposition. prove_goal({arg, I, Ct, A}, Next, Cps, Bs, Vn, Db) -> - prove_arg(deref(I, Bs), deref(Ct, Bs), A, Next, Cps, Bs, Vn, Db); + prove_arg(erlog_int:deref(I, Bs), erlog_int:deref(Ct, Bs), A, Next, Cps, Bs, Vn, Db); prove_goal({copy_term, T0, C}, Next, Cps, Bs, Vn0, Db) -> %% Use term_instance to create the copy, can ignore orddict it creates. - {T, _Nbs, Vn1} = term_instance(dderef(T0, Bs), Vn0), - unify_prove_body(T, C, Next, Cps, Bs, Vn1, Db); + {T, _Nbs, Vn1} = erlog_int:term_instance(erlog_int:dderef(T0, Bs), Vn0), + erlog_int:unify_prove_body(T, C, Next, Cps, Bs, Vn1, Db); prove_goal({functor, T, F, A}, Next, Cps, Bs, Vn, Db) -> - prove_functor(dderef(T, Bs), F, A, Next, Cps, Bs, Vn, Db); + prove_functor(erlog_int:dderef(T, Bs), F, A, Next, Cps, Bs, Vn, Db); prove_goal({'=..', T, L}, Next, Cps, Bs, Vn, Db) -> - prove_univ(dderef(T, Bs), L, Next, Cps, Bs, Vn, Db); + prove_univ(erlog_int:dderef(T, Bs), L, Next, Cps, Bs, Vn, Db); %% Type testing. prove_goal({atom, T0}, Next, Cps, Bs, Vn, Db) -> - case deref(T0, Bs) of - T when is_atom(T) -> prove_body(Next, Cps, Bs, Vn, Db); - _Other -> fail(Cps, Db) + case erlog_int:deref(T0, Bs) of + T when is_atom(T) -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db); + _Other -> erlog_int:fail(Cps, Db) end; prove_goal({atomic, T0}, Next, Cps, Bs, Vn, Db) -> - case deref(T0, Bs) of - T when ?IS_ATOMIC(T) -> prove_body(Next, Cps, Bs, Vn, Db); - _Other -> fail(Cps, Db) + case erlog_int:deref(T0, Bs) of + T when ?IS_ATOMIC(T) -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db); + _Other -> erlog_int:fail(Cps, Db) end; prove_goal({compound, T0}, Next, Cps, Bs, Vn, Db) -> - case deref(T0, Bs) of - T when ?IS_ATOMIC(T) -> fail(Cps, Db); - _Other -> prove_body(Next, Cps, Bs, Vn, Db) + case erlog_int:deref(T0, Bs) of + T when ?IS_ATOMIC(T) -> erlog_int:fail(Cps, Db); + _Other -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db) end; prove_goal({integer, T0}, Next, Cps, Bs, Vn, Db) -> - case deref(T0, Bs) of - T when is_integer(T) -> prove_body(Next, Cps, Bs, Vn, Db); - _Other -> fail(Cps, Db) + case erlog_int:deref(T0, Bs) of + T when is_integer(T) -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db); + _Other -> erlog_int:fail(Cps, Db) end; prove_goal({float, T0}, Next, Cps, Bs, Vn, Db) -> - case deref(T0, Bs) of - T when is_float(T) -> prove_body(Next, Cps, Bs, Vn, Db); - _Other -> fail(Cps, Db) + case erlog_int:deref(T0, Bs) of + T when is_float(T) -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db); + _Other -> erlog_int:fail(Cps, Db) end; prove_goal({number, T0}, Next, Cps, Bs, Vn, Db) -> - case deref(T0, Bs) of - T when is_number(T) -> prove_body(Next, Cps, Bs, Vn, Db); - _Other -> fail(Cps, Db) + case erlog_int:deref(T0, Bs) of + T when is_number(T) -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db); + _Other -> erlog_int:fail(Cps, Db) end; prove_goal({nonvar, T0}, Next, Cps, Bs, Vn, Db) -> - case deref(T0, Bs) of - {_} -> fail(Cps, Db); - _Other -> prove_body(Next, Cps, Bs, Vn, Db) + case erlog_int:deref(T0, Bs) of + {_} -> erlog_int:fail(Cps, Db); + _Other -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db) end; prove_goal({var, T0}, Next, Cps, Bs, Vn, Db) -> - case deref(T0, Bs) of - {_} -> prove_body(Next, Cps, Bs, Vn, Db); - _Other -> fail(Cps, Db) + case erlog_int:deref(T0, Bs) of + {_} -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db); + _Other -> erlog_int:fail(Cps, Db) end; %% Atom processing. prove_goal({atom_chars, A, L}, Next, Cps, Bs, Vn, Db) -> prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db); prove_goal({atom_length, A0, L0}, Next, Cps, Bs, Vn, Db) -> - case dderef(A0, Bs) of + case erlog_int:dderef(A0, Bs) of A when is_atom(A) -> Alen = length(atom_to_list(A)), %No of chars in atom - case dderef(L0, Bs) of + case erlog_int:dderef(L0, Bs) of L when is_integer(L) -> - unify_prove_body(Alen, L, Next, Cps, Bs, Vn, Db); + erlog_int:unify_prove_body(Alen, L, Next, Cps, Bs, Vn, Db); {_} = Var -> - unify_prove_body(Alen, Var, Next, Cps, Bs, Vn, Db); + erlog_int:unify_prove_body(Alen, Var, Next, Cps, Bs, Vn, Db); Other -> erlog_int:type_error(integer, Other, Db) end; {_} -> erlog_int:instantiation_error(Db); @@ -178,8 +134,8 @@ prove_goal({atom_length, A0, L0}, Next, Cps, Bs, Vn, Db) -> end; %% Arithmetic evalution and comparison. prove_goal({is, N, E0}, Next, Cps, Bs, Vn, Db) -> - E = eval_arith(deref(E0, Bs), Bs, Db), - unify_prove_body(N, E, Next, Cps, Bs, Vn, Db); + E = eval_arith(erlog_int:deref(E0, Bs), Bs, Db), + erlog_int:unify_prove_body(N, E, Next, Cps, Bs, Vn, Db); prove_goal({'>', L, R}, Next, Cps, Bs, Vn, Db) -> arith_test_prove_body('>', L, R, Next, Cps, Bs, Vn, Db); prove_goal({'>=', L, R}, Next, Cps, Bs, Vn, Db) -> @@ -197,9 +153,9 @@ prove_goal({'=<', L, R}, Next, Cps, Bs, Vn, Db) -> %% void. term_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db) -> - case erlang:Test(dderef(L, Bs), dderef(R, Bs)) of - true -> prove_body(Next, Cps, Bs, Vn, Db); - false -> fail(Cps, Db) + case erlang:Test(erlog_int:dderef(L, Bs), erlog_int:dderef(R, Bs)) of + true -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db); + false -> erlog_int:fail(Cps, Db) end. %% prove_arg(Index, Term, Arg, Next, ChoicePoints, VarNum, Database) -> void. @@ -207,14 +163,14 @@ term_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db) -> prove_arg(I, [H | T], A, Next, Cps, Bs, Vn, Db) when is_integer(I) -> %% He, he, he! - if I == 1 -> unify_prove_body(H, A, Next, Cps, Bs, Vn, Db); - I == 2 -> unify_prove_body(T, A, Next, Cps, Bs, Vn, Db); + if I == 1 -> erlog_int:unify_prove_body(H, A, Next, Cps, Bs, Vn, Db); + I == 2 -> erlog_int:unify_prove_body(T, A, Next, Cps, Bs, Vn, Db); true -> {fail, Db} end; prove_arg(I, Ct, A, Next, Cps, Bs, Vn, Db) when is_integer(I), tuple_size(Ct) >= 2 -> if I > 1, I + 1 =< tuple_size(Ct) -> - unify_prove_body(element(I + 1, Ct), A, Next, Cps, Bs, Vn, Db); + erlog_int:unify_prove_body(element(I + 1, Ct), A, Next, Cps, Bs, Vn, Db); true -> {fail, Db} end; prove_arg(I, Ct, _, _, _, _, _, Db) -> @@ -227,24 +183,24 @@ prove_arg(I, Ct, _, _, _, _, _, Db) -> %% Prove the call functor(T, F, A), Term has been dereferenced. prove_functor(T, F, A, Next, Cps, Bs, Vn, Db) when tuple_size(T) >= 2 -> - unify_prove_body(F, element(1, T), A, tuple_size(T) - 1, Next, Cps, Bs, Vn, Db); + erlog_int:unify_prove_body(F, element(1, T), A, tuple_size(T) - 1, Next, Cps, Bs, Vn, Db); prove_functor(T, F, A, Next, Cps, Bs, Vn, Db) when ?IS_ATOMIC(T) -> - unify_prove_body(F, T, A, 0, Next, Cps, Bs, Vn, Db); + erlog_int:unify_prove_body(F, T, A, 0, Next, Cps, Bs, Vn, Db); prove_functor([_ | _], F, A, Next, Cps, Bs, Vn, Db) -> %% Just the top level here. - unify_prove_body(F, '.', A, 2, Next, Cps, Bs, Vn, Db); + erlog_int:unify_prove_body(F, '.', A, 2, Next, Cps, Bs, Vn, Db); prove_functor({_} = Var, F0, A0, Next, Cps, Bs0, Vn0, Db) -> - case {dderef(F0, Bs0), dderef(A0, Bs0)} of + case {erlog_int:dderef(F0, Bs0), erlog_int:dderef(A0, Bs0)} of {'.', 2} -> %He, he, he! - Bs1 = add_binding(Var, [{Vn0} | {Vn0 + 1}], Bs0), - prove_body(Next, Cps, Bs1, Vn0 + 2, Db); + Bs1 = erlog_int:add_binding(Var, [{Vn0} | {Vn0 + 1}], Bs0), + erlog_int:prove_body(Next, Cps, Bs1, Vn0 + 2, Db); {F1, 0} when ?IS_ATOMIC(F1) -> - Bs1 = add_binding(Var, F1, Bs0), - prove_body(Next, Cps, Bs1, Vn0, Db); + Bs1 = erlog_int:add_binding(Var, F1, Bs0), + erlog_int:prove_body(Next, Cps, Bs1, Vn0, Db); {F1, A1} when is_atom(F1), is_integer(A1), A1 > 0 -> - As = make_vars(A1, Vn0), - Bs1 = add_binding(Var, list_to_tuple([F1 | As]), Bs0), - prove_body(Next, Cps, Bs1, Vn0 + A1, Db); %!!! + As = erlog_int:make_vars(A1, Vn0), + Bs1 = erlog_int:add_binding(Var, list_to_tuple([F1 | As]), Bs0), + erlog_int:prove_body(Next, Cps, Bs1, Vn0 + A1, Db); %!!! %% Now the error cases. {{_}, _} -> erlog_int:instantiation_error(Db); {F1, A1} when is_atom(F1) -> erlog_int:type_error(integer, A1, Db); @@ -256,23 +212,23 @@ prove_functor({_} = Var, F0, A0, Next, Cps, Bs0, Vn0, Db) -> prove_univ(T, L, Next, Cps, Bs, Vn, Db) when tuple_size(T) >= 2 -> Es = tuple_to_list(T), - unify_prove_body(Es, L, Next, Cps, Bs, Vn, Db); + erlog_int:unify_prove_body(Es, L, Next, Cps, Bs, Vn, Db); prove_univ(T, L, Next, Cps, Bs, Vn, Db) when ?IS_ATOMIC(T) -> - unify_prove_body([T], L, Next, Cps, Bs, Vn, Db); + erlog_int:unify_prove_body([T], L, Next, Cps, Bs, Vn, Db); prove_univ([Lh | Lt], L, Next, Cps, Bs, Vn, Db) -> %% He, he, he! - unify_prove_body(['.', Lh, Lt], L, Next, Cps, Bs, Vn, Db); + erlog_int:unify_prove_body(['.', Lh, Lt], L, Next, Cps, Bs, Vn, Db); prove_univ({_} = Var, L, Next, Cps, Bs0, Vn, Db) -> - case dderef(L, Bs0) of + case erlog_int:dderef(L, Bs0) of ['.', Lh, Lt] -> %He, he, he! - Bs1 = add_binding(Var, [Lh | Lt], Bs0), - prove_body(Next, Cps, Bs1, Vn, Db); + Bs1 = erlog_int:add_binding(Var, [Lh | Lt], Bs0), + erlog_int:prove_body(Next, Cps, Bs1, Vn, Db); [A] when ?IS_ATOMIC(A) -> - Bs1 = add_binding(Var, A, Bs0), - prove_body(Next, Cps, Bs1, Vn, Db); + Bs1 = erlog_int:add_binding(Var, A, Bs0), + erlog_int:prove_body(Next, Cps, Bs1, Vn, Db); [F | As] when is_atom(F), length(As) > 0 -> - Bs1 = add_binding(Var, list_to_tuple([F | As]), Bs0), - prove_body(Next, Cps, Bs1, Vn, Db); + Bs1 = erlog_int:add_binding(Var, list_to_tuple([F | As]), Bs0), + erlog_int:prove_body(Next, Cps, Bs1, Vn, Db); %% Now the error cases. [{_} | _] -> erlog_int:instantiation_error(Db); {_} -> erlog_int:instantiation_error(Db); @@ -285,14 +241,14 @@ prove_univ({_} = Var, L, Next, Cps, Bs0, Vn, Db) -> prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db) -> %% After a suggestion by Sean Cribbs. - case dderef(A, Bs) of + case erlog_int:dderef(A, Bs) of Atom when is_atom(Atom) -> AtomList = [list_to_atom([C]) || C <- atom_to_list(Atom)], - unify_prove_body(L, AtomList, Next, Cps, Bs, Vn, Db); + erlog_int:unify_prove_body(L, AtomList, Next, Cps, Bs, Vn, Db); {_} = Var -> %% Error #3: List is neither a list nor a partial list. %% Handled in dderef_list/2. - List = dderef_list(L, Bs), + List = erlog_int:dderef_list(L, Bs), %% Error #1, #4: List is a list or partial list with an %% element which is a variable or not one char atom. Fun = fun({_}) -> erlog_int:instantiation_error(Db); @@ -304,7 +260,7 @@ prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db) -> end, Chars = lists:map(Fun, List), Atom = list_to_atom(Chars), - unify_prove_body(Var, Atom, Next, Cps, Bs, Vn, Db); + erlog_int:unify_prove_body(Var, Atom, Next, Cps, Bs, Vn, Db); Other -> %% Error #2: Atom is neither a variable nor an atom erlog_int:type_error(atom, Other, Db) @@ -314,10 +270,10 @@ prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db) -> %% void. arith_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db) -> - case erlang:Test(eval_arith(deref(L, Bs), Bs, Db), - eval_arith(deref(R, Bs), Bs, Db)) of - true -> prove_body(Next, Cps, Bs, Vn, Db); - false -> fail(Cps, Db) + case erlang:Test(eval_arith(erlog_int:deref(L, Bs), Bs, Db), + eval_arith(erlog_int:deref(R, Bs), Bs, Db)) of + true -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db); + false -> erlog_int:fail(Cps, Db) end. %% eval_arith(ArithExpr, Bindings, Database) -> Number. @@ -326,40 +282,40 @@ arith_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db) -> %% work. Must be called deferenced. eval_arith({'+', A, B}, Bs, Db) -> - eval_arith(deref(A, Bs), Bs, Db) + eval_arith(deref(B, Bs), Bs, Db); + eval_arith(erlog_int:deref(A, Bs), Bs, Db) + eval_arith(erlog_int:deref(B, Bs), Bs, Db); eval_arith({'-', A, B}, Bs, Db) -> - eval_arith(deref(A, Bs), Bs, Db) - eval_arith(deref(B, Bs), Bs, Db); + eval_arith(erlog_int:deref(A, Bs), Bs, Db) - eval_arith(erlog_int:deref(B, Bs), Bs, Db); eval_arith({'*', A, B}, Bs, Db) -> - eval_arith(deref(A, Bs), Bs, Db) * eval_arith(deref(B, Bs), Bs, Db); + eval_arith(erlog_int:deref(A, Bs), Bs, Db) * eval_arith(erlog_int:deref(B, Bs), Bs, Db); eval_arith({'/', A, B}, Bs, Db) -> - eval_arith(deref(A, Bs), Bs, Db) / eval_arith(deref(B, Bs), Bs, Db); + eval_arith(erlog_int:deref(A, Bs), Bs, Db) / eval_arith(erlog_int:deref(B, Bs), Bs, Db); eval_arith({'**', A, B}, Bs, Db) -> - math:pow(eval_arith(deref(A, Bs), Bs, Db), - eval_arith(deref(B, Bs), Bs, Db)); + math:pow(eval_arith(erlog_int:deref(A, Bs), Bs, Db), + eval_arith(erlog_int:deref(B, Bs), Bs, Db)); eval_arith({'//', A, B}, Bs, Db) -> - eval_int(deref(A, Bs), Bs, Db) div eval_int(deref(B, Bs), Bs, Db); + eval_int(erlog_int:deref(A, Bs), Bs, Db) div eval_int(erlog_int:deref(B, Bs), Bs, Db); eval_arith({'mod', A, B}, Bs, Db) -> - eval_int(deref(A, Bs), Bs, Db) rem eval_int(deref(B, Bs), Bs, Db); + eval_int(erlog_int:deref(A, Bs), Bs, Db) rem eval_int(erlog_int:deref(B, Bs), Bs, Db); eval_arith({'/\\', A, B}, Bs, Db) -> - eval_int(deref(A, Bs), Bs, Db) band eval_int(deref(B, Bs), Bs, Db); + eval_int(erlog_int:deref(A, Bs), Bs, Db) band eval_int(erlog_int:deref(B, Bs), Bs, Db); eval_arith({'\\/', A, B}, Bs, Db) -> - eval_int(deref(A, Bs), Bs, Db) bor eval_int(deref(B, Bs), Bs, Db); + eval_int(erlog_int:deref(A, Bs), Bs, Db) bor eval_int(erlog_int:deref(B, Bs), Bs, Db); eval_arith({'<<', A, B}, Bs, Db) -> - eval_int(deref(A, Bs), Bs, Db) bsl eval_int(deref(B, Bs), Bs, Db); + eval_int(erlog_int:deref(A, Bs), Bs, Db) bsl eval_int(erlog_int:deref(B, Bs), Bs, Db); eval_arith({'>>', A, B}, Bs, Db) -> - eval_int(deref(A, Bs), Bs, Db) bsr eval_int(deref(B, Bs), Bs, Db); + eval_int(erlog_int:deref(A, Bs), Bs, Db) bsr eval_int(erlog_int:deref(B, Bs), Bs, Db); eval_arith({'\\', A}, Bs, Db) -> - bnot eval_int(deref(A, Bs), Bs, Db); + bnot eval_int(erlog_int:deref(A, Bs), Bs, Db); eval_arith({'+', A}, Bs, Db) -> - + eval_arith(deref(A, Bs), Bs, Db); + + eval_arith(erlog_int:deref(A, Bs), Bs, Db); eval_arith({'-', A}, Bs, Db) -> - - eval_arith(deref(A, Bs), Bs, Db); + - eval_arith(erlog_int:deref(A, Bs), Bs, Db); eval_arith({'abs', A}, Bs, Db) -> - abs(eval_arith(deref(A, Bs), Bs, Db)); + abs(eval_arith(erlog_int:deref(A, Bs), Bs, Db)); eval_arith({'float', A}, Bs, Db) -> - float(eval_arith(deref(A, Bs), Bs, Db)); + float(eval_arith(erlog_int:deref(A, Bs), Bs, Db)); eval_arith({'truncate', A}, Bs, Db) -> - trunc(eval_arith(deref(A, Bs), Bs, Db)); + trunc(eval_arith(erlog_int:deref(A, Bs), Bs, Db)); eval_arith(N, _Bs, _Db) when is_number(N) -> N; %Just a number %% Error cases. eval_arith({_}, _Bs, Db) -> erlog_int:instantiation_error(Db); diff --git a/src/core/lang/erlog_dcg.erl b/src/core/lang/erlog_dcg.erl index 2be44b1..bf21089 100644 --- a/src/core/lang/erlog_dcg.erl +++ b/src/core/lang/erlog_dcg.erl @@ -26,21 +26,11 @@ -import(lists, [foldl/3]). -%% We use these a lot so we import them for cleaner code. --import(erlog_int, [prove_body/5, unify_prove_body/7, unify_prove_body/9, fail/2, -add_binding/3, make_vars/2, deref/2, dderef/2, dderef_list/2, unify/3, -term_instance/2, add_built_in/2, add_compiled_proc/4, asserta_clause/2, assertz_clause/2]). - load(Db0) -> %% Compiled DCG predicates. - Db1 = foldl(fun({Head, M, F}, Db) -> add_compiled_proc(Head, M, F, Db) end, - Db0, - [ - {{expand_term, 2}, erlog_dcg, expand_term_2}, - {{phrase, 3}, erlog_dcg, phrase_3} - ]), + Db1 = foldl(fun({Head, M, F}, Db) -> erlog_int:add_compiled_proc(Head, M, F, Db) end, Db0, ?ERLOG_DCG), %% Interpreted DCG predicates. - foldl(fun(Clause, Db) -> assertz_clause(Clause, Db) end, Db1, + foldl(fun(Clause, Db) -> erlog_int:assertz_clause(Clause, Db) end, Db1, [ %% 'C'([H|T], H, T). %% {'C',[{1}|{2}],{1},{2}}, %For DCGs @@ -58,9 +48,9 @@ load(Db0) -> %% Call the expand_term/2 predicate. expand_term_2(Goal, Next, Cps, Bs, Vn0, Db) -> - {expand_term, DCGRule, A2} = dderef(Goal, Bs), + {expand_term, DCGRule, A2} = erlog_int:dderef(Goal, Bs), {Exp, Vn1} = expand_term(DCGRule, Vn0), - unify_prove_body(A2, Exp, Next, Cps, Bs, Vn1, Db). + erlog_int:unify_prove_body(A2, Exp, Next, Cps, Bs, Vn1, Db). %% phrase_3(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> void. %% Call the phrase/3 preidicate. We could easily do this in prolog @@ -69,11 +59,11 @@ expand_term_2(Goal, Next, Cps, Bs, Vn0, Db) -> %% phrase(GRBody, S0, S) -> dcg_body(GRBody, S0, S, Goal), call(Goal). phrase_3(Goal, Next0, Cps, Bs, Vn0, Db) -> - {phrase, GRBody, S0, S} = dderef(Goal, Bs), + {phrase, GRBody, S0, S} = erlog_int:dderef(Goal, Bs), {Body, Vn1} = dcg_body(GRBody, S0, S, Vn0), %% io:format("~p\n", [Body]), Next1 = [{call, Body} | Next0], %Evaluate body - prove_body(Next1, Cps, Bs, Vn1, Db). + erlog_int:prove_body(Next1, Cps, Bs, Vn1, Db). %% expand_term(Term) -> {ExpTerm}. %% expand_term(Term, VarNum) -> {ExpTerm,NewVarNum}. diff --git a/src/core/lang/erlog_lists.erl b/src/core/lang/erlog_lists.erl index f6f997f..cb96d19 100644 --- a/src/core/lang/erlog_lists.erl +++ b/src/core/lang/erlog_lists.erl @@ -35,31 +35,14 @@ -import(lists, [map/2, foldl/3]). -%% We use these a lot so we import them for cleaner code. --import(erlog_int, [prove_body/5, unify_prove_body/7, unify_prove_body/9, fail/2, -add_binding/3, make_vars/2, -deref/2, dderef/2, dderef_list/2, unify/3, -term_instance/2, -add_built_in/2, add_compiled_proc/4, -asserta_clause/2, assertz_clause/2]). - %% load(Database) -> Database. %% Assert predicates into the database. load(Db0) -> %% Compiled common list library. - Db1 = foldl(fun({Head, M, F}, Db) -> - add_compiled_proc(Head, M, F, Db) end, Db0, - [ - {{append, 3}, ?MODULE, append_3}, - {{insert, 3}, ?MODULE, insert_3}, - {{member, 2}, ?MODULE, member_2}, - {{memberchk, 2}, ?MODULE, memberchk_2}, - {{reverse, 2}, ?MODULE, reverse_2}, - {{sort, 2}, ?MODULE, sort_2} - ]), + Db1 = foldl(fun({Head, M, F}, Db) -> erlog_int:add_compiled_proc(Head, M, F, Db) end, Db0, ?ERLOG_LISTS), %% Finally interpreted common list library. - foldl(fun(Clause, Db) -> assertz_clause(Clause, Db) end, Db1, + foldl(fun(Clause, Db) -> erlog_int:assertz_clause(Clause, Db) end, Db1, [ %% insert(L, X, [X|L]). insert([H|L], X, [H|L1]) :- insert(L, X, L1). %% delete([X|L], X, L). delete([H|L], X, [H|L1]) :- delete(L, X, L1). @@ -76,30 +59,30 @@ load(Db0) -> %% Here we attempt to compile indexing in the first argument. append_3({append, A1, L, A3}, Next0, Cps, Bs0, Vn, Db) -> - case deref(A1, Bs0) of + case erlog_int:deref(A1, Bs0) of [] -> %Cannot backtrack - unify_prove_body(L, A3, Next0, Cps, Bs0, Vn, Db); + erlog_int:unify_prove_body(L, A3, Next0, Cps, Bs0, Vn, Db); [H | T] -> %Cannot backtrack L1 = {Vn}, Next1 = [{append, T, L, L1} | Next0], - unify_prove_body(A3, [H | L1], Next1, Cps, Bs0, Vn + 1, Db); + erlog_int:unify_prove_body(A3, [H | L1], Next1, Cps, Bs0, Vn + 1, Db); {_} = Var -> %This can backtrack FailFun = fun(LCp, LCps, LDb) -> fail_append_3(LCp, LCps, LDb, Var, L, A3) end, Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, - Bs1 = add_binding(Var, [], Bs0), - unify_prove_body(L, A3, Next0, [Cp | Cps], Bs1, Vn, Db); - _ -> fail(Cps, Db) %Will fail here! + Bs1 = erlog_int:add_binding(Var, [], Bs0), + erlog_int:unify_prove_body(L, A3, Next0, [Cp | Cps], Bs1, Vn, Db); + _ -> erlog_int:fail(Cps, Db) %Will fail here! end. fail_append_3(#cp{next = Next0, bs = Bs0, vn = Vn}, Cps, Db, A1, L, A3) -> H = {Vn}, T = {Vn + 1}, L1 = {Vn + 2}, - Bs1 = add_binding(A1, [H | T], Bs0), %A1 always a variable here. + Bs1 = erlog_int:add_binding(A1, [H | T], Bs0), %A1 always a variable here. Next1 = [{append, T, L, L1} | Next0], - unify_prove_body(A3, [H | L1], Next1, Cps, Bs1, Vn + 3, Db). + erlog_int:unify_prove_body(A3, [H | L1], Next1, Cps, Bs1, Vn + 3, Db). %% insert_3(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% insert(L, X, [X|L]). @@ -110,14 +93,14 @@ insert_3({insert, A1, A2, A3}, Next, Cps, Bs, Vn, Db) -> fail_insert_3(LCp, LCps, LDb, A1, A2, A3) end, Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, - unify_prove_body(A3, [A2 | A1], Next, [Cp | Cps], Bs, Vn, Db). + erlog_int:unify_prove_body(A3, [A2 | A1], Next, [Cp | Cps], Bs, Vn, Db). fail_insert_3(#cp{next = Next0, bs = Bs, vn = Vn}, Cps, Db, A1, X, A3) -> H = {Vn}, L = {Vn + 1}, L1 = {Vn + 2}, Next1 = [{insert, L, X, L1} | Next0], - unify_prove_body(A1, [H | L], A3, [H | L1], Next1, Cps, Bs, Vn + 3, Db). + erlog_int:unify_prove_body(A1, [H | L], A3, [H | L1], Next1, Cps, Bs, Vn + 3, Db). %% member_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% member(X, [X|_]). @@ -129,13 +112,13 @@ member_2({member, A1, A2}, Next, Cps, Bs, Vn, Db) -> end, Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, T = {Vn}, - unify_prove_body(A2, [A1 | T], Next, [Cp | Cps], Bs, Vn + 1, Db). + erlog_int:unify_prove_body(A2, [A1 | T], Next, [Cp | Cps], Bs, Vn + 1, Db). fail_member_2(#cp{next = Next0, bs = Bs, vn = Vn}, Cps, Db, A1, A2) -> H = {Vn}, T = {Vn + 1}, Next1 = [{member, A1, T} | Next0], - unify_prove_body(A2, [H | T], Next1, Cps, Bs, Vn + 2, Db). + erlog_int:unify_prove_body(A2, [H | T], Next1, Cps, Bs, Vn + 2, Db). %% memberchk_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% memberchk(X, [X|_]) :- !. @@ -144,16 +127,16 @@ fail_member_2(#cp{next = Next0, bs = Bs, vn = Vn}, Cps, Db, A1, A2) -> %% and match directly. Should we give a type error? memberchk_2({memberchk, A1, A2}, Next, Cps, Bs0, Vn, Db) -> - case deref(A2, Bs0) of + case erlog_int:deref(A2, Bs0) of [H | T] -> - case unify(A1, H, Bs0) of + case erlog_int:unify(A1, H, Bs0) of {succeed, Bs1} -> - prove_body(Next, Cps, Bs1, Vn, Db); + erlog_int:prove_body(Next, Cps, Bs1, Vn, Db); fail -> memberchk_2({memberchk, A1, T}, Next, Cps, Bs0, Vn, Db) end; {_} -> erlog_int:instantiation_error(); - _ -> fail(Cps, Db) + _ -> erlog_int:fail(Cps, Db) end. %% reverse_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. @@ -162,9 +145,9 @@ memberchk_2({memberchk, A1, A2}, Next, Cps, Bs0, Vn, Db) -> %% Here we attempt to compile indexing in the first argument. reverse_2({reverse, A1, A2}, Next0, Cps, Bs0, Vn, Db) -> - case deref(A1, Bs0) of + case erlog_int:deref(A1, Bs0) of [] -> - unify_prove_body(A2, [], Next0, Cps, Bs0, Vn, Db); + erlog_int:unify_prove_body(A2, [], Next0, Cps, Bs0, Vn, Db); [H | T] -> L = {Vn}, L1 = A2, @@ -179,9 +162,9 @@ reverse_2({reverse, A1, A2}, Next0, Cps, Bs0, Vn, Db) -> fail_reverse_2(LCp, LCps, LDb, Var, A2) end, Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, - Bs1 = add_binding(Var, [], Bs0), - unify_prove_body(A2, [], Next0, [Cp | Cps], Bs1, Vn, Db); - _ -> fail(Cps, Db) %Will fail here! + Bs1 = erlog_int:add_binding(Var, [], Bs0), + erlog_int:unify_prove_body(A2, [], Next0, [Cp | Cps], Bs1, Vn, Db); + _ -> erlog_int:fail(Cps, Db) %Will fail here! end. fail_reverse_2(#cp{next = Next, bs = Bs0, vn = Vn}, Cps, Db, A1, A2) -> @@ -189,7 +172,7 @@ fail_reverse_2(#cp{next = Next, bs = Bs0, vn = Vn}, Cps, Db, A1, A2) -> T = {Vn + 1}, L1 = A2, L = {Vn + 2}, - Bs1 = add_binding(A1, [H | T], Bs0), + Bs1 = erlog_int:add_binding(A1, [H | T], Bs0), %%Next1 = [{reverse,T,L},{apperse,L,[H],L1}|Next], %%prove_body(Next1, Cps, Bs1, Vn+3, Db). Next1 = [{append, L, [H], L1} | Next], @@ -200,5 +183,5 @@ fail_reverse_2(#cp{next = Next, bs = Bs0, vn = Vn}, Cps, Db, A1, A2) -> sort_2({sort, L0, S}, Next, Cps, Bs, Vn, Db) -> %% This may throw an erlog error, we don't catch it here. - L1 = lists:usort(dderef_list(L0, Bs)), - unify_prove_body(S, L1, Next, Cps, Bs, Vn, Db). + L1 = lists:usort(erlog_int:dderef_list(L0, Bs)), + erlog_int:unify_prove_body(S, L1, Next, Cps, Bs, Vn, Db). diff --git a/src/io/erlog_shell.erl b/src/io/erlog_shell.erl index fb7605f..4a2e8f6 100644 --- a/src/io/erlog_shell.erl +++ b/src/io/erlog_shell.erl @@ -182,10 +182,12 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== % process reply from prolog process_reply(State = #state{socket = Socket}, {Res, select}) -> + io:format("Reply = ~p~n", [Res]), gen_tcp:send(Socket, Res), gen_tcp:send(Socket, <<"\n: ">>), {noreply, State#state{spike = select, line = []}}; process_reply(State = #state{socket = Socket}, Res) -> + io:format("Reply = ~p~n", [Res]), gen_tcp:send(Socket, Res), gen_tcp:send(Socket, <<"\n| ?- ">>), {noreply, State#state{spike = normal, line = []}}. \ No newline at end of file diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index f9da374..9cbff55 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -20,20 +20,16 @@ -include("erlog_int.hrl"). --compile(export_all). - -export([assert/1, all_1/6, keys_2/6, match_2/6]). -import(lists, [foldl/3]). --import(erlog_int, [add_compiled_proc/4, dderef/2, unify/3, -prove_body/5, unify_prove_body/7, fail/2]). %% assert(Database) -> Database. %% Assert predicates into the database. assert(Db) -> foldl(fun({Head, M, F}, LDb) -> - add_compiled_proc(Head, M, F, LDb) end, Db, + erlog_int:add_compiled_proc(Head, M, F, LDb) end, Db, [ {{ets_all, 1}, ?MODULE, all_1}, {{ets_keys, 2}, ?MODULE, keys_2}, @@ -47,16 +43,16 @@ assert(Db) -> all_1({ets_all, Var}, Next, Cps, Bs, Vn, Db) -> Tabs = ets:all(), - unify_prove_body(Var, Tabs, Next, Cps, Bs, Vn, Db). + erlog_int:unify_prove_body(Var, Tabs, Next, Cps, Bs, Vn, Db). %% keys_2(Goal, Next, ChoicePoints, Bindings, VarNum, Database) -> void(). %% Goal = {ets_keys,Table,Key}. %% Return the keys in an ETS database one at a time over backtracking. keys_2({ets_keys, Tab0, KeyVar}, Next, Cps, Bs, Vn, Db) -> - Tab1 = dderef(Tab0, Bs), + Tab1 = erlog_int:dderef(Tab0, Bs), case ets:first(Tab1) of - '$end_of_table' -> fail(Cps, Db); + '$end_of_table' -> erlog_int:fail(Cps, Db); Key -> keys_loop(Tab1, Key, KeyVar, Next, Cps, Bs, Vn, Db) end. @@ -65,11 +61,11 @@ keys_loop(Tab, Key, KeyVar, Next, Cps, Bs, Vn, Db) -> keys_fail(LCp, LCps, LDb, Tab, Key, KeyVar) end, C = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, - unify_prove_body(KeyVar, Key, Next, [C | Cps], Bs, Vn, Db). + erlog_int:unify_prove_body(KeyVar, Key, Next, [C | Cps], Bs, Vn, Db). keys_fail(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db, Tab, PrevKey, KeyVar) -> case ets:next(Tab, PrevKey) of - '$end_of_table' -> fail(Cps, Db); + '$end_of_table' -> erlog_int:fail(Cps, Db); Key -> keys_loop(Tab, Key, KeyVar, Next, Cps, Bs, Vn, Db) end. @@ -80,8 +76,8 @@ keys_fail(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db, Tab, PrevKey, KeyVar) -> %% object matched. match_2({ets_match, Tab0, Pat0}, Next, Cps, Bs, Vn, Db) -> - Tab1 = dderef(Tab0, Bs), - Pat1 = dderef(Pat0, Bs), + Tab1 = erlog_int:dderef(Tab0, Bs), + Pat1 = erlog_int:dderef(Pat0, Bs), {Epat, Vs} = ets_pat(Pat1), match_2_loop(ets:match(Tab1, Epat, 10), Next, Cps, Bs, Vn, Db, Epat, Vs). @@ -90,11 +86,11 @@ match_2_loop({[M | Ms], Cont}, Next, Cps, Bs, Vn, Db, Epat, Vs) -> match_2_fail(LCp, LCps, LDb, Epat, Vs, {Ms, Cont}) end, Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, - unify_prove_body(Vs, M, Next, [Cp | Cps], Bs, Vn, Db); + erlog_int:unify_prove_body(Vs, M, Next, [Cp | Cps], Bs, Vn, Db); match_2_loop({[], Cont}, Next, Cps, Bs, Vn, Db, Epat, Vs) -> match_2_loop(ets:match(Cont), Next, Cps, Bs, Vn, Db, Epat, Vs); match_2_loop('$end_of_table', _Next, Cps, _Bs, _Vn, Db, _Epat, _Vs) -> - fail(Cps, Db). + erlog_int:fail(Cps, Db). match_2_fail(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db, Epat, Vs, Ms) -> match_2_loop(Ms, Next, Cps, Bs, Vn, Db, Epat, Vs). diff --git a/src/core/erlog_int.erl b/src/storage/erlog_int.erl similarity index 97% rename from src/core/erlog_int.erl rename to src/storage/erlog_int.erl index a29a76c..bf152a6 100644 --- a/src/core/erlog_int.erl +++ b/src/storage/erlog_int.erl @@ -125,6 +125,8 @@ -module(erlog_int). +-include("erlog_int.hrl"). + %% Main execution functions. -export([prove_goal/2, prove_body/5, fail/2]). -export([unify_prove_body/7, unify_prove_body/9]). @@ -146,18 +148,9 @@ -import(lists, [map/2, foldl/3]). -%% Some standard type macros. - -%% The old is_constant/1 ? --define(IS_CONSTANT(T), (not (is_tuple(T) orelse is_list(T)))). - -%% -define(IS_ATOMIC(T), (is_atom(T) orelse is_number(T) orelse (T == []))). --define(IS_ATOMIC(T), (not (is_tuple(T) orelse (is_list(T) andalso T /= [])))). --define(IS_FUNCTOR(T), ((tuple_size(T) >= 2) andalso is_atom(element(1, T)))). - %% Define the database to use. ONE of the follwing must be defined. -%%-define(ETS,true). +%%-define(ETS,true). %TODO get rid of this! %%-define(DB, orddict). -define(DB, dict). @@ -168,40 +161,7 @@ built_in_db() -> Db0 = new_db(), %% First add the Erlang built-ins. - foldl(fun(Head, Db) -> add_built_in(Head, Db) end, Db0, - [ %TODO move me to hrl - %% Logic and control. - {call, 1}, - {',', 2}, - {'!', 0}, - {';', 2}, - {fail, 0}, - {'->', 2}, - {'\\+', 1}, - {once, 1}, - {repeat, 0}, - {true, 0}, - %% Clause creation and destruction. - {abolish, 1}, - {assert, 1}, - {asserta, 1}, - {assertz, 1}, - {retract, 1}, - {retractall, 1}, - %% Clause retrieval and information. - {clause, 2}, - {current_predicate, 1}, - {predicate_property, 2}, - %% All solutions - %% External interface - {ecall, 2}, - %% Non-standard but useful - {display, 1} - ]). - -%% Define the choice point record --record(cp, {type, label, data, next, bs, vn}). --record(cut, {label, next}). + foldl(fun(Head, Db) -> add_built_in(Head, Db) end, Db0, ?ERLOG_INT). %% prove_goal(Goal, Database) -> Succeed | Fail. %% This is the main entry point into the interpreter. Check that @@ -715,6 +675,7 @@ new_db() -> ?DB:new(). %% Add Functor as a built-in in the database. add_built_in(Functor, Db) -> + io:format("add_built_in ~p~n", [Functor]), ?DB:store(Functor, built_in, Db). %% add_compiled_proc(Functor, Module, Function, Database) -> NewDatabase. diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl new file mode 100644 index 0000000..7aa1507 --- /dev/null +++ b/src/storage/erlog_storage.erl @@ -0,0 +1,29 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 17. июн 2014 23:07 +%%%------------------------------------------------------------------- +-module(erlog_storage). +-author("tihon"). + +-callback add_built_in(Functor) -> ok | {error, Reason}. + +-callback add_compiled_proc(Functor, M, F) -> ok | {error, Reason}. + +-callback assertz_clause(Head, Body) -> ok | {error, Reason}. + +-callback asserta_clause(Head, Body) -> ok | {error, Reason}. + +-callback retract_clause(F, Ct) -> ok | {error, Reason}. + +-callback abolish_clauses(Func) -> ok | {error, Reason}. + +-callback get_procedure(Func) -> ok | {error, Reason}. + +-callback get_procedure_type(Func) -> ok | {error, Reason}. + +-callback get_interp_functors() -> ok | {error, Reason}. + From d247128fb1752d86f1da94e4238f284ac7a17f96 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 19 Jun 2014 00:40:00 +0000 Subject: [PATCH 018/251] refactored erlog_int, added callback and implementation for ets and dict --- include/erlog_int.hrl | 2 + src/core/erlog.erl | 32 +- .../erlog_int.erl => core/erlog_core.erl} | 652 ++++-------------- src/core/erlog_logic.erl | 2 +- src/core/lang/erlog_bips.erl | 231 +++---- src/core/lang/erlog_dcg.erl | 24 +- src/core/lang/erlog_errors.erl | 92 +++ src/core/lang/erlog_lists.erl | 67 +- src/io/erlog_file.erl | 18 +- src/io/erlog_shell_sup.erl | 4 +- src/main/erlog_boot.erl | 33 - src/storage/erlog_dict.erl | 106 +++ src/storage/erlog_ets.erl | 227 +++--- src/storage/erlog_memory.erl | 183 +++++ src/storage/erlog_storage.erl | 19 +- 15 files changed, 810 insertions(+), 882 deletions(-) rename src/{storage/erlog_int.erl => core/erlog_core.erl} (70%) create mode 100644 src/core/lang/erlog_errors.erl delete mode 100644 src/main/erlog_boot.erl create mode 100644 src/storage/erlog_dict.erl create mode 100644 src/storage/erlog_memory.erl diff --git a/include/erlog_int.hrl b/include/erlog_int.hrl index c46617d..a136632 100644 --- a/include/erlog_int.hrl +++ b/include/erlog_int.hrl @@ -24,6 +24,8 @@ %% The old is_constant/1 ? -define(IS_CONSTANT(T), (not (is_tuple(T) orelse is_list(T)))). +-define(FAIL(Bs, Cps, Db), erlog_errors:fail(Cps, Db)). + %% Define the choice point record -record(cp, {type, label, data, next, bs, vn}). -record(cut, {label, next}). diff --git a/src/core/erlog.erl b/src/core/erlog.erl index e97ecab..77594d3 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -33,7 +33,7 @@ -include("erlog_int.hrl"). %% Interface to server. --export([start_link/0, execute/2]). +-export([start_link/2, start_link/0, execute/2]). %% Gen server callbacs. -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). @@ -47,17 +47,29 @@ execute(Worker, Command) -> gen_server:call(Worker, {execute, Command}). +-spec start_link() -> pid(). start_link() -> gen_server:start_link(?MODULE, [], []). -init(_) -> - Db0 = erlog_int:built_in_db(), %Basic interpreter predicates - Db1 = lists:foldl(fun(Mod, Db) -> Mod:load(Db) end, Db0, - [erlog_bips, %Built in predicates - erlog_dcg, %DCG predicates - erlog_lists %Common lists library +-spec start_link(Database :: atom(), State :: term()) -> pid(). +start_link(Database, State) -> + gen_server:start_link(?MODULE, [Database, State], []). + +init([]) -> % use built in database + Db = erlog_memory:start_link(erlog_ets, undefined), %default database is ets module + %TODO monitor database? + %Load basic interpreter predicates + lists:foreach(fun(Mod) -> Mod:load(Db) end, + [ + erlog_bips, %Built in predicates + erlog_dcg, %DCG predicates + erlog_lists %Common lists library ]), - {ok, #state{db = Db1}}. + {ok, #state{db = Db}}; +init([Database, State]) -> % use custom database implementation %TODO made state return in callbacks? + Db = erlog_memory:start_link(Database, State), %TODO monitor database? +%% TODO load db + {ok, #state{db = Db}}. handle_call({execute, Command}, _From, State = #state{state = normal}) -> %in normal mode {Res, NewState} = case erlog_scan:tokens([], Command, 1) of @@ -121,7 +133,7 @@ process_command({prove, Goal}, State) -> process_command(next, State = #state{state = normal}) -> {fail, State}; process_command(next, State = #state{state = [Vs, Cps], db = Db}) -> - {erlog_logic:prove_result(catch erlog_int:fail(Cps, Db), Vs), State}; + {erlog_logic:prove_result(catch erlog_errors:fail(Cps, Db), Vs), State}; process_command({consult, File}, State = #state{db = Db}) -> case erlog_file:consult(File, Db) of {ok, Db1} -> ok; %TODO Db1? @@ -150,7 +162,7 @@ prove_goal(Goal0, State = #state{db = Db}) -> Goal1 = erlog_logic:unlistify(Goal0), %% Must use 'catch' here as 'try' does not do last-call %% optimisation. - case erlog_logic:prove_result(catch erlog_int:prove_goal(Goal1, Db), Vs) of + case erlog_logic:prove_result(catch erlog_core:prove_goal(Goal1, Db), Vs) of {succeed, Res, Args} -> {{succeed, Res}, State}; OtherRes -> {OtherRes, State#state{state = normal}} diff --git a/src/storage/erlog_int.erl b/src/core/erlog_core.erl similarity index 70% rename from src/storage/erlog_int.erl rename to src/core/erlog_core.erl index bf152a6..d1328c5 100644 --- a/src/storage/erlog_int.erl +++ b/src/core/erlog_core.erl @@ -123,50 +123,44 @@ %% to go back to but this would entail a more interactive %% body_instance. --module(erlog_int). +-module(erlog_core). -include("erlog_int.hrl"). %% Main execution functions. --export([prove_goal/2, prove_body/5, fail/2]). --export([unify_prove_body/7, unify_prove_body/9]). +-export( +[ + unify/3, + dderef_list/2, + make_vars/2, + prove_goal/2, + unify_prove_body/9, + prove_body/5, + unify_clauses/8, + retract_clauses/8, + prove_predicates/7, + prove_goal_clauses/7, + pred_ind/1, + well_form_body/3 +]). %% Bindings, unification and dereferncing. --export([new_bindings/0, add_binding/3, make_vars/2]). --export([deref/2, deref_list/2, dderef/2, dderef_list/2, unify/3, functor/1]). +-export([functor/1]). %% Creating term and body instances. -export([term_instance/2]). %% Adding to database. --export([asserta_clause/2, assertz_clause/2, abolish_clauses/2]). --export([add_built_in/2, add_compiled_proc/4]). --export([new_db/0, built_in_db/0]). +-export([built_in_db/1]). %TODO? -%% Error types. --export([erlog_error/1, erlog_error/2, type_error/2, type_error/3, - instantiation_error/0, instantiation_error/1, permission_error/4]). - -%%-compile(export_all). - --import(lists, [map/2, foldl/3]). - -%% Define the database to use. ONE of the follwing must be defined. - -%%-define(ETS,true). %TODO get rid of this! -%%-define(DB, orddict). --define(DB, dict). - -%% built_in_db() -> Database. +%% built_in_db(Db) -> Database. %% Create an initial clause database containing the built-in %% predicates and predefined library predicates. -built_in_db() -> - Db0 = new_db(), - %% First add the Erlang built-ins. - foldl(fun(Head, Db) -> add_built_in(Head, Db) end, Db0, ?ERLOG_INT). +built_in_db(Db) -> + %% Add the Erlang built-ins. + lists:foreach(fun(Head, Db) -> Db:add_built_in(Head, Db) end, ?ERLOG_INT). %% prove_goal(Goal, Database) -> Succeed | Fail. %% This is the main entry point into the interpreter. Check that %% everything is consistent then prove the goal as a call. - prove_goal(Goal0, Db) -> %% put(erlog_cut, orddict:new()), %% put(erlog_cps, orddict:new()), @@ -175,14 +169,93 @@ prove_goal(Goal0, Db) -> {Goal1, Bs, Vn} = initial_goal(Goal0), prove_body([{call, Goal1}], [], Bs, Vn, Db). --define(FAIL(Bs, Cps, Db), - begin - put(erlog_cps, orddict:update_counter(length(Cps), 1, get(erlog_cps))), - put(erlog_var, orddict:update_counter(dict:size(Bs), 1, get(erlog_var))), - fail(Cps, Db) - end). --undef(FAIL). --define(FAIL(Bs, Cps, Db), fail(Cps, Db)). +%% prove_body(Body, ChoicePoints, Bindings, VarNum, Database) -> +%% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase}. +%% Prove the goals in a body. Remove the first goal and try to prove +%% it. Return when there are no more goals. This is how proving a +%% goal/body succeeds. +prove_body([G | Gs], Cps, Bs0, Vn0, Db0) -> + %%io:fwrite("PB: ~p\n", [{G,Gs,Cps}]), + prove_goal(G, Gs, Cps, Bs0, Vn0, Db0); +prove_body([], Cps, Bs, Vn, Db) -> + %%io:fwrite("Cps: ~p\nCut: ~p\nVar: ~p\nVar: ~p\n", + %% [get(erlog_cps),get(erlog_cut),get(erlog_var),dict:size(Bs)]), + %%io:fwrite("PB: ~p\n", [Cps]), + {succeed, Cps, Bs, Vn, Db}. %No more body + +%% unify_prove_body(Term1, Term2, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Unify Term1 = Term2, on success prove body Next else fail. +unify_prove_body(T1, T2, Next, Cps, Bs0, Vn, Db) -> + case unify(T1, T2, Bs0) of + {succeed, Bs1} -> prove_body(Next, Cps, Bs1, Vn, Db); + fail -> ?FAIL(Bs0, Cps, Db) + end. + +%% unify_prove_body(A1, B1, A2, B2, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Unify A1 = B1, A2 = B2, on success prove body Next else fail. +unify_prove_body(A1, B1, A2, B2, Next, Cps, Bs0, Vn, Db) -> + case unify(A1, B1, Bs0) of + {succeed, Bs1} -> unify_prove_body(A2, B2, Next, Cps, Bs1, Vn, Db); + fail -> ?FAIL(Bs0, Cps, Db) + end. + +%% deref(Term, Bindings) -> Term. %TODO ets and others? +%% Dereference a variable, else just return the term. +deref({V} = T0, Bs) -> + case ?BIND:find(V, Bs) of + {ok, T1} -> deref(T1, Bs); + error -> T0 + end; +deref(T, _) -> T. %Not a variable, return it. + +%% deref_list(List, Bindings) -> List. +%% Dereference the top-level checking that it is a list. +deref_list([], _) -> []; %It already is a list +deref_list([_ | _] = L, _) -> L; +deref_list({V}, Bs) -> + case dict:find(V, Bs) of + {ok, L} -> deref_list(L, Bs); + error -> erlog_errors:instantiation_error() + end; +deref_list(Other, _) -> erlog_errors:type_error(list, Other). + +%% dderef(Term, Bindings) -> Term. +%% Do a deep dereference. Completely dereference all the variables +%% occuring in a term, even those occuring in a variables value. +dderef(A, _) when ?IS_CONSTANT(A) -> A; +dderef([], _) -> []; +dderef([H0 | T0], Bs) -> + [dderef(H0, Bs) | dderef(T0, Bs)]; +dderef({V} = Var, Bs) -> + case ?BIND:find(V, Bs) of + {ok, T} -> dderef(T, Bs); + error -> Var + end; +dderef(T, Bs) when is_tuple(T) -> + Es0 = tuple_to_list(T), + Es1 = dderef(Es0, Bs), + list_to_tuple(Es1). + +%% dderef_list(List, Bindings) -> List. +%% Dereference all variables to any depth but check that the +%% top-level is a list. +dderef_list([], _Bs) -> []; +dderef_list([H | T], Bs) -> + [dderef(H, Bs) | dderef_list(T, Bs)]; +dderef_list({V}, Bs) -> + case ?BIND:find(V, Bs) of + {ok, L} -> dderef_list(L, Bs); + error -> erlog_errors:instantiation_error() + end; +dderef_list(Other, _Bs) -> erlog_errors:type_error(list, Other). + +%% make_vars(Count, VarNum) -> [Var]. +%% Make a list of new variables starting at VarNum. %TODO move me to core? +make_vars(0, _) -> []; +make_vars(I, Vn) -> + [{Vn} | make_vars(I - 1, Vn + 1)]. %% prove_goal(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> %% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase} | @@ -248,18 +321,18 @@ prove_goal(repeat, Next, Cps, Bs, Vn, Db) -> prove_goal({abolish, Pi0}, Next, Cps, Bs, Vn, Db) -> case dderef(Pi0, Bs) of {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> - prove_body(Next, Cps, Bs, Vn, abolish_clauses({N, A}, Db)); - Pi -> type_error(predicate_indicator, Pi, Db) + prove_body(Next, Cps, Bs, Vn, Db:abolish_clauses({N, A}, Db)); + Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) end; prove_goal({assert, C0}, Next, Cps, Bs, Vn, Db) -> C = dderef(C0, Bs), - prove_body(Next, Cps, Bs, Vn, assertz_clause(C, Db)); + prove_body(Next, Cps, Bs, Vn, erlog_memory:assertz_clause(Db, C)); prove_goal({asserta, C0}, Next, Cps, Bs, Vn, Db) -> C = dderef(C0, Bs), - prove_body(Next, Cps, Bs, Vn, asserta_clause(C, Db)); + prove_body(Next, Cps, Bs, Vn, erlog_memory:asserta_clause(Db, C)); prove_goal({assertz, C0}, Next, Cps, Bs, Vn, Db) -> C = dderef(C0, Bs), - prove_body(Next, Cps, Bs, Vn, assertz_clause(C, Db)); + prove_body(Next, Cps, Bs, Vn, erlog_memory:assertz_clause(Db, C)); prove_goal({retract, C0}, Next, Cps, Bs, Vn, Db) -> C = dderef(C0, Bs), prove_retract(C, Next, Cps, Bs, Vn, Db); @@ -272,12 +345,12 @@ prove_goal({current_predicate, Pi0}, Next, Cps, Bs, Vn, Db) -> prove_current_predicate(Pi, Next, Cps, Bs, Vn, Db); prove_goal({predicate_property, H0, P}, Next, Cps, Bs, Vn, Db) -> H = dderef(H0, Bs), - case catch get_procedure_type(functor(H), Db) of + case catch erlog_memory:get_procedure_type(Db, functor(H)) of built_in -> unify_prove_body(P, built_in, Next, Cps, Bs, Vn, Db); compiled -> unify_prove_body(P, compiled, Next, Cps, Bs, Vn, Db); interpreted -> unify_prove_body(P, interpreted, Next, Cps, Bs, Vn, Db); undefined -> ?FAIL(Bs, Cps, Db); - {erlog_error, E} -> erlog_error(E, Db) + {erlog_error, E} -> erlog_errors:erlog_error(E, Db) end; %% External interface prove_goal({ecall, C0, Val}, Next, Cps, Bs, Vn, Db) -> @@ -294,7 +367,7 @@ prove_goal({ecall, C0, Val}, Next, Cps, Bs, Vn, Db) -> L = tuple_to_list(T), fun() -> apply(M, hd(L), tl(L)) end; Fun when is_function(Fun) -> Fun; - Other -> type_error(callable, Other, Db) + Other -> erlog_errors:type_error(callable, Other, Db) end, prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db); %% Non-standard but useful. @@ -305,47 +378,15 @@ prove_goal({display, T}, Next, Cps, Bs, Vn, Db) -> %% Now look up the database. prove_goal(G, Next, Cps, Bs, Vn, Db) -> %%io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), - case catch get_procedure(functor(G), Db) of + case catch erlog_memory:get_procedure(Db, functor(G)) of built_in -> erlog_bips:prove_goal(G, Next, Cps, Bs, Vn, Db); {code, {Mod, Func}} -> Mod:Func(G, Next, Cps, Bs, Vn, Db); {clauses, Cs} -> prove_goal_clauses(G, Cs, Next, Cps, Bs, Vn, Db); undefined -> ?FAIL(Bs, Cps, Db); %% Getting built_in here is an error! - {erlog_error, E} -> erlog_error(E, Db) %Fill in more error data + {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data end. -fail_disjunction(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db) -> - prove_body(Next, Cps, Bs, Vn, Db). - -fail_if_then_else(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db) -> - prove_body(Next, Cps, Bs, Vn, Db). - -%% fail(ChoicePoints, Database) -> {fail,Database}. -%% cut(Label, Last, Next, ChoicePoints, Bindings, VarNum, Database) -> void. -%% -%% The functions which manipulate the choice point stack. fail -%% backtracks to next choicepoint skipping cut labels cut steps -%% backwards over choice points until matching cut. - -fail([#cp{type = goal_clauses} = Cp | Cps], Db) -> - fail_goal_clauses(Cp, Cps, Db); -fail([#cp{type = disjunction} = Cp | Cps], Db) -> - fail_disjunction(Cp, Cps, Db); -fail([#cp{type = if_then_else} = Cp | Cps], Db) -> - fail_if_then_else(Cp, Cps, Db); -fail([#cp{type = clause} = Cp | Cps], Db) -> - fail_clause(Cp, Cps, Db); -fail([#cp{type = retract} = Cp | Cps], Db) -> - fail_retract(Cp, Cps, Db); -fail([#cp{type = current_predicate} = Cp | Cps], Db) -> - fail_current_predicate(Cp, Cps, Db); -fail([#cp{type = ecall} = Cp | Cps], Db) -> - fail_ecall(Cp, Cps, Db); -fail([#cp{type = compiled, data = F} = Cp | Cps], Db) -> - F(Cp, Cps, Db); -fail([#cut{} | Cps], Db) -> - fail(Cps, Db); %Fail over cut points. -fail([], Db) -> {fail, Db}. cut(Label, Last, Next, [#cut{label = Label} | Cps] = Cps0, Bs, Vn, Db) -> if Last -> prove_body(Next, Cps, Bs, Vn, Db); @@ -385,34 +426,14 @@ cut(Label, Last, Next, [_Cp | Cps], Bs, Vn, Db) -> check_goal(G0, Next, Bs, Db, Cut, Label) -> case dderef(G0, Bs) of - {_} -> instantiation_error(Db); %Must have something to call + {_} -> erlog_errors:instantiation_error(Db); %Must have something to call G1 -> case catch {ok, well_form_goal(G1, Next, Cut, Label)} of - {erlog_error, E} -> erlog_error(E, Db); + {erlog_error, E} -> erlog_errors:erlog_error(E, Db); {ok, GC} -> GC %Body and cut end end. -%% unify_prove_body(Term1, Term2, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Unify Term1 = Term2, on success prove body Next else fail. - -unify_prove_body(T1, T2, Next, Cps, Bs0, Vn, Db) -> - case unify(T1, T2, Bs0) of - {succeed, Bs1} -> prove_body(Next, Cps, Bs1, Vn, Db); - fail -> ?FAIL(Bs0, Cps, Db) - end. - -%% unify_prove_body(A1, B1, A2, B2, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Unify A1 = B1, A2 = B2, on success prove body Next else fail. - -unify_prove_body(A1, B1, A2, B2, Next, Cps, Bs0, Vn, Db) -> - case unify(A1, B1, Bs0) of - {succeed, Bs1} -> unify_prove_body(A2, B2, Next, Cps, Bs1, Vn, Db); - fail -> ?FAIL(Bs0, Cps, Db) - end. - %% prove_ecall(Generator, Value, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Call an external (Erlang) generator and handle return value, either @@ -428,21 +449,18 @@ prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db) -> fail -> ?FAIL(Bs, Cps, Db) %No more end. -fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> - prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db). - %% prove_clause(Head, Body, Next, ChoicePoints, Bindings, VarNum, DataBase) -> %% void. %% Unify clauses matching with functor from Head with both Head and Body. prove_clause(H, B, Next, Cps, Bs, Vn, Db) -> Functor = functor(H), - case get_procedure(Functor, Db) of + case erlog_memory:get_procedure(Db, Functor) of {clauses, Cs} -> unify_clauses(H, B, Cs, Next, Cps, Bs, Vn, Db); {code, _} -> - permission_error(access, private_procedure, pred_ind(Functor), Db); + erlog_errors:permission_error(access, private_procedure, pred_ind(Functor), Db); built_in -> - permission_error(access, private_procedure, pred_ind(Functor), Db); + erlog_errors:permission_error(access, private_procedure, pred_ind(Functor), Db); undefined -> ?FAIL(Bs, Cps, Db) end. @@ -477,9 +495,6 @@ unify_clause(Ch, Cb, {_Tag, H0, {B0, _}}, Bs0, Vn0) -> fail -> fail end. -fail_clause(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> - unify_clauses(Ch, Cb, Cs, Next, Cps, Bs, Vn, Db). - %% prove_current_predicate(PredInd, Next, ChoicePoints, Bindings, VarNum, DataBase) -> %% void. %% Match functors of existing user (interpreted) predicate with PredInd. @@ -488,9 +503,9 @@ prove_current_predicate(Pi, Next, Cps, Bs, Vn, Db) -> case Pi of {'/', _, _} -> ok; {_} -> ok; - Other -> type_error(predicate_indicator, Other) + Other -> erlog_errors:type_error(predicate_indicator, Other) end, - Fs = get_interp_functors(Db), + Fs = Db:get_interp_functors(Db), prove_predicates(Pi, Fs, Next, Cps, Bs, Vn, Db). prove_predicates(Pi, [F | Fs], Next, Cps, Bs, Vn, Db) -> @@ -498,13 +513,9 @@ prove_predicates(Pi, [F | Fs], Next, Cps, Bs, Vn, Db) -> unify_prove_body(Pi, pred_ind(F), Next, [Cp | Cps], Bs, Vn, Db); prove_predicates(_Pi, [], _Next, Cps, _Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db). -fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> - prove_predicates(Pi, Fs, Next, Cps, Bs, Vn, Db). - %% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to prove Goal using Clauses which all have the same functor. - prove_goal_clauses(G, [C], Next, Cps, Bs, Vn, Db) -> %% Must be smart here and test whether we need to add a cut point. %% C has the structure {Tag,Head,{Body,BodyHasCut}}. @@ -533,11 +544,7 @@ prove_goal_clause(G, {_Tag, H0, {B0, _}}, Next, Cps, Bs0, Vn0, Db) -> fail -> ?FAIL(Bs0, Cps, Db) end. -fail_goal_clauses(#cp{data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> - prove_goal_clauses(G, Cs, Next, Cps, Bs, Vn, Db). - %% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db). - cut_goal_clauses(true, Next, #cp{label = _}, Cps, Bs, Vn, Db) -> %% Just remove the choice point completely and continue. prove_body(Next, Cps, Bs, Vn, Db); @@ -557,12 +564,12 @@ prove_retract(H, Next, Cps, Bs, Vn, Db) -> prove_retract(H, B, Next, Cps, Bs, Vn, Db) -> Functor = functor(H), - case get_procedure(Functor, Db) of + case Db:get_procedure(Functor, Db) of {clauses, Cs} -> retract_clauses(H, B, Cs, Next, Cps, Bs, Vn, Db); {code, _} -> - permission_error(modify, static_procedure, pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, pred_ind(Functor), Db); built_in -> - permission_error(modify, static_procedure, pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, pred_ind(Functor), Db); undefined -> ?FAIL(Bs, Cps, Db) end. @@ -574,34 +581,22 @@ retract_clauses(Ch, Cb, [C | Cs], Next, Cps, Bs0, Vn0, Db0) -> case unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> %% We have found a right clause so now retract it. - Db1 = retract_clause(functor(Ch), element(1, C), Db0), + Db1 = Db0:retract_clause(functor(Ch), element(1, C), Db0), Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, prove_body(Next, [Cp | Cps], Bs1, Vn1, Db1); fail -> retract_clauses(Ch, Cb, Cs, Next, Cps, Bs0, Vn0, Db0) end; retract_clauses(_Ch, _Cb, [], _Next, Cps, _Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db). -fail_retract(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> - retract_clauses(Ch, Cb, Cs, Next, Cps, Bs, Vn, Db). - -%% prove_body(Body, ChoicePoints, Bindings, VarNum, Database) -> -%% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase}. -%% Prove the goals in a body. Remove the first goal and try to prove -%% it. Return when there are no more goals. This is how proving a -%% goal/body succeeds. - -prove_body([G | Gs], Cps, Bs0, Vn0, Db0) -> - %%io:fwrite("PB: ~p\n", [{G,Gs,Cps}]), - prove_goal(G, Gs, Cps, Bs0, Vn0, Db0); -prove_body([], Cps, Bs, Vn, Db) -> - %%io:fwrite("Cps: ~p\nCut: ~p\nVar: ~p\nVar: ~p\n", - %% [get(erlog_cps),get(erlog_cut),get(erlog_var),dict:size(Bs)]), - %%io:fwrite("PB: ~p\n", [Cps]), - {succeed, Cps, Bs, Vn, Db}. %No more body +unify_args(_, _, Bs, I, S) when I > S -> {succeed, Bs}; +unify_args(S1, S2, Bs0, I, S) -> + case unify(element(I, S1), element(I, S2), Bs0) of + {succeed, Bs1} -> unify_args(S1, S2, Bs1, I + 1, S); + fail -> fail + end. %% unify(Term, Term, Bindings) -> {succeed,NewBindings} | fail. %% Unify two terms with a set of bindings. - unify(T10, T20, Bs0) -> case {deref(T10, Bs0), deref(T20, Bs0)} of {T1, T2} when ?IS_CONSTANT(T1), T1 == T2 -> @@ -621,329 +616,16 @@ unify(T10, T20, Bs0) -> _Other -> fail end. -unify_args(_, _, Bs, I, S) when I > S -> {succeed, Bs}; -unify_args(S1, S2, Bs0, I, S) -> - case unify(element(I, S1), element(I, S2), Bs0) of - {succeed, Bs1} -> unify_args(S1, S2, Bs1, I + 1, S); - fail -> fail - end. - -%% make_vars(Count, VarNum) -> [Var]. -%% Make a list of new variables starting at VarNum. - -make_vars(0, _) -> []; -make_vars(I, Vn) -> - [{Vn} | make_vars(I - 1, Vn + 1)]. - -%% Errors -%% To keep dialyzer quiet. --spec type_error(_, _) -> no_return(). --spec type_error(_, _, _) -> no_return(). --spec instantiation_error() -> no_return(). --spec instantiation_error(_) -> no_return(). --spec permission_error(_, _, _, _) -> no_return(). --spec erlog_error(_) -> no_return(). --spec erlog_error(_, _) -> no_return(). - -type_error(Type, Value, Db) -> erlog_error({type_error, Type, Value}, Db). -type_error(Type, Value) -> erlog_error({type_error, Type, Value}). - -instantiation_error(Db) -> erlog_error(instantiation_error, Db). -instantiation_error() -> erlog_error(instantiation_error). - -permission_error(Op, Type, Value, Db) -> - erlog_error({permission_error, Op, Type, Value}, Db). - -erlog_error(E, Db) -> throw({erlog_error, E, Db}). -erlog_error(E) -> throw({erlog_error, E}). - --ifdef(DB). %TODO resolve me -%% Database -%% The database is a dict where the key is the functor pair {Name,Arity}. -%% The value is: built_in | -%% {clauses,NextTag,[{Tag,Head,Body}]} | -%% {code,{Module,Function}}. -%% Built-ins are defined by the system and cannot manipulated by user -%% code. -%% We are a little paranoid here and do our best to ensure consistency -%% in the database by checking input arguments even if we know they -%% come from "good" code. - -new_db() -> ?DB:new(). - -%% add_built_in(Functor, Database) -> NewDatabase. -%% Add Functor as a built-in in the database. - -add_built_in(Functor, Db) -> - io:format("add_built_in ~p~n", [Functor]), - ?DB:store(Functor, built_in, Db). - -%% add_compiled_proc(Functor, Module, Function, Database) -> NewDatabase. -%% Add Functor as a compiled procedure with code in Module:Function. No -%% checking. - -add_compiled_proc(Functor, M, F, Db) -> - ?DB:update(Functor, - fun(built_in) -> - permission_error(modify, static_procedure, pred_ind(Functor), Db); - (_) -> {code, {M, F}} - end, {code, {M, F}}, Db). - -%% assertz_clause(Clause, Database) -> NewDatabase. -%% assertz_clause(Head, Body, Database) -> NewDatabase. -%% Assert a clause into the database first checking that it is well -%% formed. - -assertz_clause({':-', H, B}, Db) -> assertz_clause(H, B, Db); -assertz_clause(H, Db) -> assertz_clause(H, true, Db). - -assertz_clause(Head, Body0, Db) -> - {Functor, Body} = case catch {ok, functor(Head), - well_form_body(Body0, false, sture)} of - {erlog_error, E} -> erlog_error(E, Db); - {ok, F, B} -> {F, B} - end, - ?DB:update(Functor, - fun(built_in) -> - permission_error(modify, static_procedure, pred_ind(Functor), Db); - ({code, _}) -> - permission_error(modify, static_procedure, pred_ind(Functor), Db); - ({clauses, T, Cs}) -> {clauses, T + 1, Cs ++ [{T, Head, Body}]} - end, {clauses, 1, [{0, Head, Body}]}, Db). - -%% asserta_clause(Clause, Database) -> NewDatabase. -%% asserta_clause(Head, Body, Database) -> NewDatabase. -%% Assert a clause into the database first checking that it is well -%% formed. - -asserta_clause({':-', H, B}, Db) -> asserta_clause(H, B, Db); -asserta_clause(H, Db) -> asserta_clause(H, true, Db). - -asserta_clause(Head, Body0, Db) -> - {Functor, Body} = case catch {ok, functor(Head), - well_form_body(Body0, false, sture)} of - {erlog_error, E} -> erlog_error(E, Db); - {ok, F, B} -> {F, B} - end, - ?DB:update(Functor, - fun(built_in) -> - permission_error(modify, static_procedure, pred_ind(Functor), Db); - ({code, _}) -> - permission_error(modify, static_procedure, pred_ind(Functor), Db); - ({clauses, T, Cs}) -> {clauses, T + 1, [{T, Head, Body} | Cs]} - end, {clauses, 1, [{0, Head, Body}]}, Db). - -%% retract_clause(Functor, ClauseTag, Database) -> NewDatabase. -%% Retract (remove) the clause with tag ClauseTag from the list of -%% clauses of Functor. - -retract_clause(F, Ct, Db) -> - case ?DB:find(F, Db) of - {ok, built_in} -> - permission_error(modify, static_procedure, pred_ind(F), Db); - {ok, {code, _}} -> - permission_error(modify, static_procedure, pred_ind(F), Db); - {ok, {clauses, Nt, Cs}} -> - ?DB:store(F, {clauses, Nt, lists:keydelete(Ct, 1, Cs)}, Db); - error -> Db %Do nothing - end. - -%% abolish_clauses(Functor, Database) -> NewDatabase. - -abolish_clauses(Func, Db) -> - case ?DB:find(Func, Db) of - {ok, built_in} -> - permission_error(modify, static_procedure, pred_ind(Func), Db); - {ok, {code, _}} -> ?DB:erase(Func, Db); - {ok, {clauses, _, _}} -> ?DB:erase(Func, Db); - error -> Db %Do nothing - end. - -%% get_procedure(Functor, Database) -> -%% built_in | {code,{Mod,Func}} | {clauses,[Clause]} | undefined. -%% Return the procedure type and data for a functor. - -get_procedure(Func, Db) -> - case ?DB:find(Func, Db) of - {ok, built_in} -> built_in; %A built-in - {ok, {code, {_M, _F}} = P} -> P; %Compiled (perhaps someday) - {ok, {clauses, _T, Cs}} -> {clauses, Cs}; %Interpreted clauses - error -> undefined %Undefined - end. - -%% get_procedure_type(Functor, Database) -> -%% built_in | compiled | interpreted | undefined. -%% Return the procedure type for a functor. - -get_procedure_type(Func, Db) -> - case ?DB:find(Func, Db) of - {ok, built_in} -> built_in; %A built-in - {ok, {code, _}} -> compiled; %Compiled (perhaps someday) - {ok, {clauses, _, _}} -> interpreted; %Interpreted clauses - error -> undefined %Undefined - end. - -%% get_interp_functors(Database) -> [Functor]. - -get_interp_functors(Db) -> - ?DB:fold(fun(_Func, built_in, Fs) -> Fs; - (Func, {code, _}, Fs) -> [Func | Fs]; - (Func, {clauses, _, _}, Fs) -> [Func | Fs] - end, [], Db). --endif. - --ifdef(ETS). -%% The database is an ets table where the key is the functor pair {Name,Arity}. -%% The value is: {Functor,built_in} | -%% {Functor,clauses,NextTag,[{Tag,Head,Body}]} | -%% {Functor,code,{Module,Function}}. -%% Built-ins are defined by the system and cannot manipulated by user -%% code. -%% We are a little paranoid here and do our best to ensure consistency -%% in the database by checking input arguments even if we know they -%% come from "good" code. - -new_db() -> ets:new(erlog_database, [set, protected, {keypos, 1}]). - -%% add_built_in(Functor, Database) -> NewDatabase. -%% Add Functor as a built-in in the database. - -add_built_in(Functor, Db) -> - ets:insert(Db, {Functor, built_in}), - Db. - -%% add_compiled_proc(Functor, Module, Function, Database) -> NewDatabase. -%% Add Functor as a compiled procedure with code in Module:Function. No -%% checking. - -add_compiled_proc(Functor, M, F, Db) -> - case ets:lookup(Db, Functor) of - [{_, built_in}] -> - permission_error(modify, static_procedure, pred_ind(Functor), Db); - [_] -> ets:insert(Db, {Functor, code, {M, F}}); - [] -> ets:insert(Db, {Functor, code, {M, F}}) - end, - Db. - -%% assertz_clause(Clause, Database) -> NewDatabase. -%% assertz_clause(Head, Body, Database) -> NewDatabase. -%% Assert a clause into the database first checking that it is well -%% formed. - -assertz_clause({':-', H, B}, Db) -> assertz_clause(H, B, Db); -assertz_clause(H, Db) -> assertz_clause(H, true, Db). - -assertz_clause(Head, Body0, Db) -> - {Functor, Body} = case catch {ok, functor(Head), - well_form_body(Body0, false, sture)} of - {erlog_error, E} -> erlog_error(E, Db); - {ok, F, B} -> {F, B} - end, - case ets:lookup(Db, Functor) of - [{_, built_in}] -> permission_error(pred_ind(Functor), Db); - [{_, code, _}] -> permission_error(pred_ind(Functor), Db); - [{_, clauses, Tag, Cs}] -> - ets:insert(Db, {Functor, clauses, Tag + 1, Cs ++ [{Tag, Head, Body}]}); - [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) - end, - Db. - -%% asserta_clause(Clause, Database) -> NewDatabase. -%% asserta_clause(Head, Body, Database) -> NewDatabase. -%% Assert a clause into the database first checking that it is well -%% formed. - -asserta_clause({':-', H, B}, Db) -> asserta_clause(H, B, Db); -asserta_clause(H, Db) -> asserta_clause(H, true, Db). - -asserta_clause(Head, Body0, Db) -> - {Functor, Body} = case catch {ok, functor(Head), - well_form_body(Body0, false, sture)} of - {erlog_error, E} -> erlog_error(E, Db); - {ok, F, B} -> {F, B} - end, - case ets:lookup(Db, Functor) of - [{_, built_in}] -> permission_error(pred_ind(Functor), Db); - [{_, code, _}] -> permission_error(pred_ind(Functor), Db); - [{_, clauses, Tag, Cs}] -> - ets:insert(Db, {Functor, clauses, Tag + 1, [{Tag, Head, Body} | Cs]}); - [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) - end, - Db. - -%% retract_clause(Functor, ClauseTag, Database) -> NewDatabase. -%% Retract (remove) the clause with tag ClauseTag from the list of -%% clauses of Functor. - -retract_clause(F, Ct, Db) -> - case ets:lookup(Db, F) of - [{_, built_in}] -> - permission_error(modify, static_procedure, pred_ind(F), Db); - [{_, code, _}] -> - permission_error(modify, static_procedure, pred_ind(F), Db); - [{_, clauses, Nt, Cs}] -> - ets:insert(Db, {F, clauses, Nt, lists:keydelete(Ct, 1, Cs)}); - [] -> ok %Do nothing - end, - Db. - -%% abolish_clauses(Functor, Database) -> NewDatabase. - -abolish_clauses(Func, Db) -> - case ets:lookup(Db, Func) of - [{_, built_in}] -> - permission_error(modify, static_procedure, pred_ind(F), Db); - [{_, code, _}] -> ets:delete(Db, Func); - [{_, clauses, _, _}] -> ets:delete(Db, Func); - [] -> ok %Do nothing - end, - Db. - -%% get_procedure(Functor, Database) -> -%% built_in | {code,{Mod,Func}} | {clauses,[Clause]} | undefined. -%% Return the procedure type and data for a functor. - -get_procedure(Func, Db) -> - case ets:lookup(Db, Func) of - [{_, built_in}] -> built_in; - [{_, code, C}] -> {code, C}; - [{_, clauses, _, Cs}] -> {clauses, Cs}; - [] -> undefined - end. - -%% get_procedure_type(Functor, Database) -> -%% built_in | compiled | interpreted | undefined. -%% Return the procedure type for a functor. - -get_procedure_type(Func, Db) -> - case ets:lookup(Db, Func) of - [{_, built_in}] -> built_in; %A built-in - [{_, code, C}] -> compiled; %Compiled (perhaps someday) - [{_, clauses, _, Cs}] -> interpreted; %Interpreted clauses - [] -> undefined %Undefined - end. - -%% get_interp_functors(Database) -> [Functor]. - -get_interp_functors(Db) -> - ets:foldl(fun({_, built_in}, Fs) -> Fs; - ({Func, code, _}, Fs) -> [Func | Fs]; - ({Func, clauses, _, _}, Fs) -> [Func | Fs] - end, [], Db). --endif. - %% functor(Goal) -> {Name,Arity}. - functor(T) when ?IS_FUNCTOR(T) -> {element(1, T), tuple_size(T) - 1}; functor(T) when is_atom(T) -> {T, 0}; -functor(T) -> type_error(callable, T). +functor(T) -> erlog_errors:type_error(callable, T). %% well_form_body(Body, HasCutAfter, CutLabel) -> {Body,HasCut}. %% well_form_body(Body, Tail, HasCutAfter, CutLabel) -> {Body,HasCut}. %% Check that Body is well-formed, flatten conjunctions, fix cuts and %% add explicit call to top-level variables. - well_form_body(Body, Cut, Label) -> well_form_body(Body, [], Cut, Label). well_form_body({',', L, R}, Tail0, Cut0, Label) -> @@ -981,7 +663,6 @@ well_form_body(Goal, Tail, Cut, _Label) -> %% well_form_goal(Goal, Tail, HasCutAfter, CutLabel) -> {Body,HasCut}. %% Check that Goal is well-formed, flatten conjunctions, fix cuts and %% add explicit call to top-level variables. - well_form_goal({',', L, R}, Tail0, Cut0, Label) -> {Tail1, Cut1} = well_form_goal(R, Tail0, Cut0, Label), well_form_goal(L, Tail1, Cut1, Label); @@ -1019,7 +700,6 @@ well_form_goal(Goal, Tail, Cut, _Label) -> %% replacing integer variables with overlapping integer ranges. Don't %% check Term as it should already be checked. Use orddict as there %% will seldom be many variables and it it fast to setup. - term_instance(A, Vn) -> term_instance(A, orddict:new(), Vn). term_instance([], Rs, Vn) -> {[], Rs, Vn}; @@ -1181,7 +861,7 @@ pred_ind({N, A}) -> {'/', N, A}. %% Bindings %% Bindings are kept in a dict where the key is the variable name. -%%-define(BIND, orddict). +%%-define(BIND, orddict). %TODO ets and others? -define(BIND, dict). new_bindings() -> ?BIND:new(). @@ -1192,60 +872,6 @@ add_binding({V}, Val, Bs0) -> get_binding({V}, Bs) -> ?BIND:find(V, Bs). -%% deref(Term, Bindings) -> Term. -%% Dereference a variable, else just return the term. - -deref({V} = T0, Bs) -> - case ?BIND:find(V, Bs) of - {ok, T1} -> deref(T1, Bs); - error -> T0 - end; -deref(T, _) -> T. %Not a variable, return it. - -%% deref_list(List, Bindings) -> List. -%% Dereference the top-level checking that it is a list. - -deref_list([], _) -> []; %It already is a list -deref_list([_ | _] = L, _) -> L; -deref_list({V}, Bs) -> - case ?BIND:find(V, Bs) of - {ok, L} -> deref_list(L, Bs); - error -> instantiation_error() - end; -deref_list(Other, _) -> type_error(list, Other). - -%% dderef(Term, Bindings) -> Term. -%% Do a deep dereference. Completely dereference all the variables -%% occuring in a term, even those occuring in a variables value. - -dderef(A, _) when ?IS_CONSTANT(A) -> A; -dderef([], _) -> []; -dderef([H0 | T0], Bs) -> - [dderef(H0, Bs) | dderef(T0, Bs)]; -dderef({V} = Var, Bs) -> - case ?BIND:find(V, Bs) of - {ok, T} -> dderef(T, Bs); - error -> Var - end; -dderef(T, Bs) when is_tuple(T) -> - Es0 = tuple_to_list(T), - Es1 = dderef(Es0, Bs), - list_to_tuple(Es1). - -%% dderef_list(List, Bindings) -> List. -%% Dereference all variables to any depth but check that the -%% top-level is a list. - -dderef_list([], _Bs) -> []; -dderef_list([H | T], Bs) -> - [dderef(H, Bs) | dderef_list(T, Bs)]; -dderef_list({V}, Bs) -> - case ?BIND:find(V, Bs) of - {ok, L} -> dderef_list(L, Bs); - error -> instantiation_error() - end; -dderef_list(Other, _Bs) -> type_error(list, Other). - %% initial_goal(Goal) -> {Goal,Bindings,NewVarNum}. %% initial_goal(Goal, Bindings, VarNum) -> {Goal,NewBindings,NewVarNum}. %% Check term for well-formedness as an Erlog term and replace '_' @@ -1272,4 +898,4 @@ initial_goal(S, Bs0, Vn0) when ?IS_FUNCTOR(S) -> {As1, Bs1, Vn1} = initial_goal(As0, Bs0, Vn0), {list_to_tuple([element(1, S) | As1]), Bs1, Vn1}; initial_goal(T, Bs, Vn) when ?IS_ATOMIC(T) -> {T, Bs, Vn}; -initial_goal(T, _Bs, _Vn) -> type_error(callable, T). +initial_goal(T, _Bs, _Vn) -> erlog_errors:type_error(callable, T). \ No newline at end of file diff --git a/src/core/erlog_logic.erl b/src/core/erlog_logic.erl index 6a23145..d275cd7 100644 --- a/src/core/erlog_logic.erl +++ b/src/core/erlog_logic.erl @@ -28,7 +28,7 @@ unlistify([]) -> true; unlistify(G) -> G. %In case it wasn't a list. prove_result({succeed, Cps, Bs, _Vn, _Db1}, Vs) -> - {succeed, erlog_int:dderef(Vs, Bs), [Vs, Cps]}; + {succeed, erlog_core:dderef(Vs, Bs), [Vs, Cps]}; prove_result({fail, _Db1}, _Vs) -> fail; prove_result({erlog_error, Error, _Db1}, _Vs) -> diff --git a/src/core/lang/erlog_bips.erl b/src/core/lang/erlog_bips.erl index a65c034..62b3725 100644 --- a/src/core/lang/erlog_bips.erl +++ b/src/core/lang/erlog_bips.erl @@ -29,13 +29,10 @@ %%-compile(export_all). --import(lists, [map/2, foldl/3]). - %% load(Database) -> Database. %% Assert predicates into the database. - -load(Db0) -> - foldl(fun(Head, Db) -> erlog_int:add_built_in(Head, Db) end, Db0, ?ERLOG_BIPS). +load(Db) -> + lists:foreach(fun(Head) -> erlog_memory:add_built_in(Db, Head) end, ?ERLOG_BIPS). %% prove_goal(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> %% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase} | @@ -45,11 +42,11 @@ load(Db0) -> %% Term unification and comparison prove_goal({'=', L, R}, Next, Cps, Bs, Vn, Db) -> - erlog_int:unify_prove_body(L, R, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body(L, R, Next, Cps, Bs, Vn, Db); prove_goal({'\\=', L, R}, Next, Cps, Bs0, Vn, Db) -> - case erlog_int:unify(L, R, Bs0) of - {succeed, _Bs1} -> erlog_int:fail(Cps, Db); - fail -> erlog_int:prove_body(Next, Cps, Bs0, Vn, Db) + case erlog_core:unify(L, R, Bs0) of + {succeed, _Bs1} -> erlog_errors:fail(Cps, Db); + fail -> erlog_core:prove_body(Next, Cps, Bs0, Vn, Db) end; prove_goal({'@>', L, R}, Next, Cps, Bs, Vn, Db) -> term_test_prove_body('>', L, R, Next, Cps, Bs, Vn, Db); @@ -65,77 +62,77 @@ prove_goal({'@=<', L, R}, Next, Cps, Bs, Vn, Db) -> term_test_prove_body('=<', L, R, Next, Cps, Bs, Vn, Db); %% Term creation and decomposition. prove_goal({arg, I, Ct, A}, Next, Cps, Bs, Vn, Db) -> - prove_arg(erlog_int:deref(I, Bs), erlog_int:deref(Ct, Bs), A, Next, Cps, Bs, Vn, Db); + prove_arg(erlog_core:deref(I, Bs), erlog_core:deref(Ct, Bs), A, Next, Cps, Bs, Vn, Db); prove_goal({copy_term, T0, C}, Next, Cps, Bs, Vn0, Db) -> %% Use term_instance to create the copy, can ignore orddict it creates. - {T, _Nbs, Vn1} = erlog_int:term_instance(erlog_int:dderef(T0, Bs), Vn0), - erlog_int:unify_prove_body(T, C, Next, Cps, Bs, Vn1, Db); + {T, _Nbs, Vn1} = erlog_core:term_instance(erlog_core:dderef(T0, Bs), Vn0), + erlog_core:unify_prove_body(T, C, Next, Cps, Bs, Vn1, Db); prove_goal({functor, T, F, A}, Next, Cps, Bs, Vn, Db) -> - prove_functor(erlog_int:dderef(T, Bs), F, A, Next, Cps, Bs, Vn, Db); + prove_functor(erlog_core:dderef(T, Bs), F, A, Next, Cps, Bs, Vn, Db); prove_goal({'=..', T, L}, Next, Cps, Bs, Vn, Db) -> - prove_univ(erlog_int:dderef(T, Bs), L, Next, Cps, Bs, Vn, Db); + prove_univ(erlog_core:dderef(T, Bs), L, Next, Cps, Bs, Vn, Db); %% Type testing. prove_goal({atom, T0}, Next, Cps, Bs, Vn, Db) -> - case erlog_int:deref(T0, Bs) of - T when is_atom(T) -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db); - _Other -> erlog_int:fail(Cps, Db) + case erlog_core:deref(T0, Bs) of + T when is_atom(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db); + _Other -> erlog_errors:fail(Cps, Db) end; prove_goal({atomic, T0}, Next, Cps, Bs, Vn, Db) -> - case erlog_int:deref(T0, Bs) of - T when ?IS_ATOMIC(T) -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db); - _Other -> erlog_int:fail(Cps, Db) + case erlog_core:deref(T0, Bs) of + T when ?IS_ATOMIC(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db); + _Other -> erlog_errors:fail(Cps, Db) end; prove_goal({compound, T0}, Next, Cps, Bs, Vn, Db) -> - case erlog_int:deref(T0, Bs) of - T when ?IS_ATOMIC(T) -> erlog_int:fail(Cps, Db); - _Other -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db) + case erlog_core:deref(T0, Bs) of + T when ?IS_ATOMIC(T) -> erlog_errors:fail(Cps, Db); + _Other -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db) end; prove_goal({integer, T0}, Next, Cps, Bs, Vn, Db) -> - case erlog_int:deref(T0, Bs) of - T when is_integer(T) -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db); - _Other -> erlog_int:fail(Cps, Db) + case erlog_core:deref(T0, Bs) of + T when is_integer(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db); + _Other -> erlog_errors:fail(Cps, Db) end; prove_goal({float, T0}, Next, Cps, Bs, Vn, Db) -> - case erlog_int:deref(T0, Bs) of - T when is_float(T) -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db); - _Other -> erlog_int:fail(Cps, Db) + case erlog_core:deref(T0, Bs) of + T when is_float(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db); + _Other -> erlog_errors:fail(Cps, Db) end; prove_goal({number, T0}, Next, Cps, Bs, Vn, Db) -> - case erlog_int:deref(T0, Bs) of - T when is_number(T) -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db); - _Other -> erlog_int:fail(Cps, Db) + case erlog_core:deref(T0, Bs) of + T when is_number(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db); + _Other -> erlog_errors:fail(Cps, Db) end; prove_goal({nonvar, T0}, Next, Cps, Bs, Vn, Db) -> - case erlog_int:deref(T0, Bs) of - {_} -> erlog_int:fail(Cps, Db); - _Other -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db) + case erlog_core:deref(T0, Bs) of + {_} -> erlog_errors:fail(Cps, Db); + _Other -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db) end; prove_goal({var, T0}, Next, Cps, Bs, Vn, Db) -> - case erlog_int:deref(T0, Bs) of - {_} -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db); - _Other -> erlog_int:fail(Cps, Db) + case erlog_core:deref(T0, Bs) of + {_} -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db); + _Other -> erlog_errors:fail(Cps, Db) end; %% Atom processing. prove_goal({atom_chars, A, L}, Next, Cps, Bs, Vn, Db) -> prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db); prove_goal({atom_length, A0, L0}, Next, Cps, Bs, Vn, Db) -> - case erlog_int:dderef(A0, Bs) of + case erlog_core:dderef(A0, Bs) of A when is_atom(A) -> Alen = length(atom_to_list(A)), %No of chars in atom - case erlog_int:dderef(L0, Bs) of + case erlog_core:dderef(L0, Bs) of L when is_integer(L) -> - erlog_int:unify_prove_body(Alen, L, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body(Alen, L, Next, Cps, Bs, Vn, Db); {_} = Var -> - erlog_int:unify_prove_body(Alen, Var, Next, Cps, Bs, Vn, Db); - Other -> erlog_int:type_error(integer, Other, Db) + erlog_core:unify_prove_body(Alen, Var, Next, Cps, Bs, Vn, Db); + Other -> erlog_errors:type_error(integer, Other, Db) end; - {_} -> erlog_int:instantiation_error(Db); - Other -> erlog_int:type_error(atom, Other, Db) + {_} -> erlog_errors:instantiation_error(Db); + Other -> erlog_errors:type_error(atom, Other, Db) end; %% Arithmetic evalution and comparison. prove_goal({is, N, E0}, Next, Cps, Bs, Vn, Db) -> - E = eval_arith(erlog_int:deref(E0, Bs), Bs, Db), - erlog_int:unify_prove_body(N, E, Next, Cps, Bs, Vn, Db); + E = eval_arith(erlog_core:deref(E0, Bs), Bs, Db), + erlog_core:unify_prove_body(N, E, Next, Cps, Bs, Vn, Db); prove_goal({'>', L, R}, Next, Cps, Bs, Vn, Db) -> arith_test_prove_body('>', L, R, Next, Cps, Bs, Vn, Db); prove_goal({'>=', L, R}, Next, Cps, Bs, Vn, Db) -> @@ -153,9 +150,9 @@ prove_goal({'=<', L, R}, Next, Cps, Bs, Vn, Db) -> %% void. term_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db) -> - case erlang:Test(erlog_int:dderef(L, Bs), erlog_int:dderef(R, Bs)) of - true -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db); - false -> erlog_int:fail(Cps, Db) + case erlang:Test(erlog_core:dderef(L, Bs), erlog_core:dderef(R, Bs)) of + true -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db); + false -> erlog_errors:fail(Cps, Db) end. %% prove_arg(Index, Term, Arg, Next, ChoicePoints, VarNum, Database) -> void. @@ -163,48 +160,48 @@ term_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db) -> prove_arg(I, [H | T], A, Next, Cps, Bs, Vn, Db) when is_integer(I) -> %% He, he, he! - if I == 1 -> erlog_int:unify_prove_body(H, A, Next, Cps, Bs, Vn, Db); - I == 2 -> erlog_int:unify_prove_body(T, A, Next, Cps, Bs, Vn, Db); + if I == 1 -> erlog_core:unify_prove_body(H, A, Next, Cps, Bs, Vn, Db); + I == 2 -> erlog_core:unify_prove_body(T, A, Next, Cps, Bs, Vn, Db); true -> {fail, Db} end; prove_arg(I, Ct, A, Next, Cps, Bs, Vn, Db) when is_integer(I), tuple_size(Ct) >= 2 -> if I > 1, I + 1 =< tuple_size(Ct) -> - erlog_int:unify_prove_body(element(I + 1, Ct), A, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body(element(I + 1, Ct), A, Next, Cps, Bs, Vn, Db); true -> {fail, Db} end; prove_arg(I, Ct, _, _, _, _, _, Db) -> %%Type failure just generates an error. - if not(is_integer(I)) -> erlog_int:type_error(integer, I, Db); - true -> erlog_int:type_error(compound, Ct, Db) + if not(is_integer(I)) -> erlog_errors:type_error(integer, I, Db); + true -> erlog_errors:type_error(compound, Ct, Db) end. %% prove_functor(Term, Functor, Arity, Next, ChoicePoints, Bindings, VarNum, Database) -> void. %% Prove the call functor(T, F, A), Term has been dereferenced. prove_functor(T, F, A, Next, Cps, Bs, Vn, Db) when tuple_size(T) >= 2 -> - erlog_int:unify_prove_body(F, element(1, T), A, tuple_size(T) - 1, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body(F, element(1, T), A, tuple_size(T) - 1, Next, Cps, Bs, Vn, Db); prove_functor(T, F, A, Next, Cps, Bs, Vn, Db) when ?IS_ATOMIC(T) -> - erlog_int:unify_prove_body(F, T, A, 0, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body(F, T, A, 0, Next, Cps, Bs, Vn, Db); prove_functor([_ | _], F, A, Next, Cps, Bs, Vn, Db) -> %% Just the top level here. - erlog_int:unify_prove_body(F, '.', A, 2, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body(F, '.', A, 2, Next, Cps, Bs, Vn, Db); prove_functor({_} = Var, F0, A0, Next, Cps, Bs0, Vn0, Db) -> - case {erlog_int:dderef(F0, Bs0), erlog_int:dderef(A0, Bs0)} of + case {erlog_core:dderef(F0, Bs0), erlog_core:dderef(A0, Bs0)} of {'.', 2} -> %He, he, he! - Bs1 = erlog_int:add_binding(Var, [{Vn0} | {Vn0 + 1}], Bs0), - erlog_int:prove_body(Next, Cps, Bs1, Vn0 + 2, Db); + Bs1 = erlog_core:add_binding(Var, [{Vn0} | {Vn0 + 1}], Bs0), + erlog_core:prove_body(Next, Cps, Bs1, Vn0 + 2, Db); {F1, 0} when ?IS_ATOMIC(F1) -> - Bs1 = erlog_int:add_binding(Var, F1, Bs0), - erlog_int:prove_body(Next, Cps, Bs1, Vn0, Db); + Bs1 = erlog_core:add_binding(Var, F1, Bs0), + erlog_core:prove_body(Next, Cps, Bs1, Vn0, Db); {F1, A1} when is_atom(F1), is_integer(A1), A1 > 0 -> - As = erlog_int:make_vars(A1, Vn0), - Bs1 = erlog_int:add_binding(Var, list_to_tuple([F1 | As]), Bs0), - erlog_int:prove_body(Next, Cps, Bs1, Vn0 + A1, Db); %!!! + As = erlog_core:make_vars(A1, Vn0), + Bs1 = erlog_core:add_binding(Var, list_to_tuple([F1 | As]), Bs0), + erlog_core:prove_body(Next, Cps, Bs1, Vn0 + A1, Db); %!!! %% Now the error cases. - {{_}, _} -> erlog_int:instantiation_error(Db); - {F1, A1} when is_atom(F1) -> erlog_int:type_error(integer, A1, Db); - {F1, _} -> erlog_int:type_error(atom, F1, Db) + {{_}, _} -> erlog_errors:instantiation_error(Db); + {F1, A1} when is_atom(F1) -> erlog_errors:type_error(integer, A1, Db); + {F1, _} -> erlog_errors:type_error(atom, F1, Db) end. %% prove_univ(Term, List, Next, ChoicePoints, Bindings, VarNum, Database) -> void. @@ -212,27 +209,27 @@ prove_functor({_} = Var, F0, A0, Next, Cps, Bs0, Vn0, Db) -> prove_univ(T, L, Next, Cps, Bs, Vn, Db) when tuple_size(T) >= 2 -> Es = tuple_to_list(T), - erlog_int:unify_prove_body(Es, L, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body(Es, L, Next, Cps, Bs, Vn, Db); prove_univ(T, L, Next, Cps, Bs, Vn, Db) when ?IS_ATOMIC(T) -> - erlog_int:unify_prove_body([T], L, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body([T], L, Next, Cps, Bs, Vn, Db); prove_univ([Lh | Lt], L, Next, Cps, Bs, Vn, Db) -> %% He, he, he! - erlog_int:unify_prove_body(['.', Lh, Lt], L, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body(['.', Lh, Lt], L, Next, Cps, Bs, Vn, Db); prove_univ({_} = Var, L, Next, Cps, Bs0, Vn, Db) -> - case erlog_int:dderef(L, Bs0) of + case erlog_core:dderef(L, Bs0) of ['.', Lh, Lt] -> %He, he, he! - Bs1 = erlog_int:add_binding(Var, [Lh | Lt], Bs0), - erlog_int:prove_body(Next, Cps, Bs1, Vn, Db); + Bs1 = erlog_core:add_binding(Var, [Lh | Lt], Bs0), + erlog_core:prove_body(Next, Cps, Bs1, Vn, Db); [A] when ?IS_ATOMIC(A) -> - Bs1 = erlog_int:add_binding(Var, A, Bs0), - erlog_int:prove_body(Next, Cps, Bs1, Vn, Db); + Bs1 = erlog_core:add_binding(Var, A, Bs0), + erlog_core:prove_body(Next, Cps, Bs1, Vn, Db); [F | As] when is_atom(F), length(As) > 0 -> - Bs1 = erlog_int:add_binding(Var, list_to_tuple([F | As]), Bs0), - erlog_int:prove_body(Next, Cps, Bs1, Vn, Db); + Bs1 = erlog_core:add_binding(Var, list_to_tuple([F | As]), Bs0), + erlog_core:prove_body(Next, Cps, Bs1, Vn, Db); %% Now the error cases. - [{_} | _] -> erlog_int:instantiation_error(Db); - {_} -> erlog_int:instantiation_error(Db); - Other -> erlog_int:type_error(list, Other, Db) + [{_} | _] -> erlog_errors:instantiation_error(Db); + {_} -> erlog_errors:instantiation_error(Db); + Other -> erlog_errors:type_error(list, Other, Db) end. %% prove_atom_chars(Atom, List, Next, ChoicePoints, Bindings, VarNum, Database) -> @@ -241,39 +238,39 @@ prove_univ({_} = Var, L, Next, Cps, Bs0, Vn, Db) -> prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db) -> %% After a suggestion by Sean Cribbs. - case erlog_int:dderef(A, Bs) of + case erlog_core:dderef(A, Bs) of Atom when is_atom(Atom) -> AtomList = [list_to_atom([C]) || C <- atom_to_list(Atom)], - erlog_int:unify_prove_body(L, AtomList, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body(L, AtomList, Next, Cps, Bs, Vn, Db); {_} = Var -> %% Error #3: List is neither a list nor a partial list. %% Handled in dderef_list/2. - List = erlog_int:dderef_list(L, Bs), + List = erlog_core:dderef_list(L, Bs), %% Error #1, #4: List is a list or partial list with an %% element which is a variable or not one char atom. - Fun = fun({_}) -> erlog_int:instantiation_error(Db); + Fun = fun({_}) -> erlog_errors:instantiation_error(Db); (Atom) -> case is_atom(Atom) andalso atom_to_list(Atom) of [C] -> C; - _ -> erlog_int:type_error(character, Atom, Db) + _ -> erlog_errors:type_error(character, Atom, Db) end end, Chars = lists:map(Fun, List), Atom = list_to_atom(Chars), - erlog_int:unify_prove_body(Var, Atom, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body(Var, Atom, Next, Cps, Bs, Vn, Db); Other -> %% Error #2: Atom is neither a variable nor an atom - erlog_int:type_error(atom, Other, Db) + erlog_errors:type_error(atom, Other, Db) end. %% arith_test_prove_body(Test, Left, Right, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. arith_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db) -> - case erlang:Test(eval_arith(erlog_int:deref(L, Bs), Bs, Db), - eval_arith(erlog_int:deref(R, Bs), Bs, Db)) of - true -> erlog_int:prove_body(Next, Cps, Bs, Vn, Db); - false -> erlog_int:fail(Cps, Db) + case erlang:Test(eval_arith(erlog_core:deref(L, Bs), Bs, Db), + eval_arith(erlog_core:deref(R, Bs), Bs, Db)) of + true -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db); + false -> erlog_errors:fail(Cps, Db) end. %% eval_arith(ArithExpr, Bindings, Database) -> Number. @@ -282,49 +279,49 @@ arith_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db) -> %% work. Must be called deferenced. eval_arith({'+', A, B}, Bs, Db) -> - eval_arith(erlog_int:deref(A, Bs), Bs, Db) + eval_arith(erlog_int:deref(B, Bs), Bs, Db); + eval_arith(erlog_core:deref(A, Bs), Bs, Db) + eval_arith(erlog_core:deref(B, Bs), Bs, Db); eval_arith({'-', A, B}, Bs, Db) -> - eval_arith(erlog_int:deref(A, Bs), Bs, Db) - eval_arith(erlog_int:deref(B, Bs), Bs, Db); + eval_arith(erlog_core:deref(A, Bs), Bs, Db) - eval_arith(erlog_core:deref(B, Bs), Bs, Db); eval_arith({'*', A, B}, Bs, Db) -> - eval_arith(erlog_int:deref(A, Bs), Bs, Db) * eval_arith(erlog_int:deref(B, Bs), Bs, Db); + eval_arith(erlog_core:deref(A, Bs), Bs, Db) * eval_arith(erlog_core:deref(B, Bs), Bs, Db); eval_arith({'/', A, B}, Bs, Db) -> - eval_arith(erlog_int:deref(A, Bs), Bs, Db) / eval_arith(erlog_int:deref(B, Bs), Bs, Db); + eval_arith(erlog_core:deref(A, Bs), Bs, Db) / eval_arith(erlog_core:deref(B, Bs), Bs, Db); eval_arith({'**', A, B}, Bs, Db) -> - math:pow(eval_arith(erlog_int:deref(A, Bs), Bs, Db), - eval_arith(erlog_int:deref(B, Bs), Bs, Db)); + math:pow(eval_arith(erlog_core:deref(A, Bs), Bs, Db), + eval_arith(erlog_core:deref(B, Bs), Bs, Db)); eval_arith({'//', A, B}, Bs, Db) -> - eval_int(erlog_int:deref(A, Bs), Bs, Db) div eval_int(erlog_int:deref(B, Bs), Bs, Db); + eval_int(erlog_core:deref(A, Bs), Bs, Db) div eval_int(erlog_core:deref(B, Bs), Bs, Db); eval_arith({'mod', A, B}, Bs, Db) -> - eval_int(erlog_int:deref(A, Bs), Bs, Db) rem eval_int(erlog_int:deref(B, Bs), Bs, Db); + eval_int(erlog_core:deref(A, Bs), Bs, Db) rem eval_int(erlog_core:deref(B, Bs), Bs, Db); eval_arith({'/\\', A, B}, Bs, Db) -> - eval_int(erlog_int:deref(A, Bs), Bs, Db) band eval_int(erlog_int:deref(B, Bs), Bs, Db); + eval_int(erlog_core:deref(A, Bs), Bs, Db) band eval_int(erlog_core:deref(B, Bs), Bs, Db); eval_arith({'\\/', A, B}, Bs, Db) -> - eval_int(erlog_int:deref(A, Bs), Bs, Db) bor eval_int(erlog_int:deref(B, Bs), Bs, Db); + eval_int(erlog_core:deref(A, Bs), Bs, Db) bor eval_int(erlog_core:deref(B, Bs), Bs, Db); eval_arith({'<<', A, B}, Bs, Db) -> - eval_int(erlog_int:deref(A, Bs), Bs, Db) bsl eval_int(erlog_int:deref(B, Bs), Bs, Db); + eval_int(erlog_core:deref(A, Bs), Bs, Db) bsl eval_int(erlog_core:deref(B, Bs), Bs, Db); eval_arith({'>>', A, B}, Bs, Db) -> - eval_int(erlog_int:deref(A, Bs), Bs, Db) bsr eval_int(erlog_int:deref(B, Bs), Bs, Db); + eval_int(erlog_core:deref(A, Bs), Bs, Db) bsr eval_int(erlog_core:deref(B, Bs), Bs, Db); eval_arith({'\\', A}, Bs, Db) -> - bnot eval_int(erlog_int:deref(A, Bs), Bs, Db); + bnot eval_int(erlog_core:deref(A, Bs), Bs, Db); eval_arith({'+', A}, Bs, Db) -> - + eval_arith(erlog_int:deref(A, Bs), Bs, Db); + + eval_arith(erlog_core:deref(A, Bs), Bs, Db); eval_arith({'-', A}, Bs, Db) -> - - eval_arith(erlog_int:deref(A, Bs), Bs, Db); + - eval_arith(erlog_core:deref(A, Bs), Bs, Db); eval_arith({'abs', A}, Bs, Db) -> - abs(eval_arith(erlog_int:deref(A, Bs), Bs, Db)); + abs(eval_arith(erlog_core:deref(A, Bs), Bs, Db)); eval_arith({'float', A}, Bs, Db) -> - float(eval_arith(erlog_int:deref(A, Bs), Bs, Db)); + float(eval_arith(erlog_core:deref(A, Bs), Bs, Db)); eval_arith({'truncate', A}, Bs, Db) -> - trunc(eval_arith(erlog_int:deref(A, Bs), Bs, Db)); + trunc(eval_arith(erlog_core:deref(A, Bs), Bs, Db)); eval_arith(N, _Bs, _Db) when is_number(N) -> N; %Just a number %% Error cases. -eval_arith({_}, _Bs, Db) -> erlog_int:instantiation_error(Db); +eval_arith({_}, _Bs, Db) -> erlog_errors:instantiation_error(Db); eval_arith(N, _Bs, Db) when is_tuple(N) -> Pi = pred_ind(element(1, N), tuple_size(N) - 1), - erlog_int:type_error(evaluable, Pi, Db); + erlog_errors:type_error(evaluable, Pi, Db); eval_arith([_ | _], _Bs, Db) -> - erlog_int:type_error(evaluable, pred_ind('.', 2), Db); -eval_arith(O, _Bs, Db) -> erlog_int:type_error(evaluable, O, Db). + erlog_errors:type_error(evaluable, pred_ind('.', 2), Db); +eval_arith(O, _Bs, Db) -> erlog_errors:type_error(evaluable, O, Db). %% eval_int(IntegerExpr, Bindings, Database) -> Integer. %% Evaluate an integer expression, include the database for errors. @@ -332,7 +329,7 @@ eval_arith(O, _Bs, Db) -> erlog_int:type_error(evaluable, O, Db). eval_int(E0, Bs, Db) -> E = eval_arith(E0, Bs, Db), if is_integer(E) -> E; - true -> erlog_int:type_error(integer, E, Db) + true -> erlog_errors:type_error(integer, E, Db) end. -pred_ind(N, A) -> {'/', N, A}. +pred_ind(N, A) -> {'/', N, A}. \ No newline at end of file diff --git a/src/core/lang/erlog_dcg.erl b/src/core/lang/erlog_dcg.erl index bf21089..3581322 100644 --- a/src/core/lang/erlog_dcg.erl +++ b/src/core/lang/erlog_dcg.erl @@ -24,13 +24,11 @@ -export([expand_term_2/6, phrase_3/6]). -export([load/1]). --import(lists, [foldl/3]). - -load(Db0) -> +load(Db) -> %% Compiled DCG predicates. - Db1 = foldl(fun({Head, M, F}, Db) -> erlog_int:add_compiled_proc(Head, M, F, Db) end, Db0, ?ERLOG_DCG), + lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_DCG), %% Interpreted DCG predicates. - foldl(fun(Clause, Db) -> erlog_int:assertz_clause(Clause, Db) end, Db1, + lists:foldl(fun(Clause, Db) -> erlog_memory:assertz_clause(Db, Clause) end, Db, [ %% 'C'([H|T], H, T). %% {'C',[{1}|{2}],{1},{2}}, %For DCGs @@ -46,29 +44,26 @@ load(Db0) -> %% expand_term_2(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> %% void %% Call the expand_term/2 predicate. - expand_term_2(Goal, Next, Cps, Bs, Vn0, Db) -> - {expand_term, DCGRule, A2} = erlog_int:dderef(Goal, Bs), + {expand_term, DCGRule, A2} = erlog_core:dderef(Goal, Bs), {Exp, Vn1} = expand_term(DCGRule, Vn0), - erlog_int:unify_prove_body(A2, Exp, Next, Cps, Bs, Vn1, Db). + erlog_core:unify_prove_body(A2, Exp, Next, Cps, Bs, Vn1, Db). %% phrase_3(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> void. %% Call the phrase/3 preidicate. We could easily do this in prolog %% except for that it calls dcg_body/4 which is not exported. %% %% phrase(GRBody, S0, S) -> dcg_body(GRBody, S0, S, Goal), call(Goal). - phrase_3(Goal, Next0, Cps, Bs, Vn0, Db) -> - {phrase, GRBody, S0, S} = erlog_int:dderef(Goal, Bs), + {phrase, GRBody, S0, S} = erlog_core:dderef(Goal, Bs), {Body, Vn1} = dcg_body(GRBody, S0, S, Vn0), %% io:format("~p\n", [Body]), Next1 = [{call, Body} | Next0], %Evaluate body - erlog_int:prove_body(Next1, Cps, Bs, Vn1, Db). + erlog_core:prove_body(Next1, Cps, Bs, Vn1, Db). %% expand_term(Term) -> {ExpTerm}. %% expand_term(Term, VarNum) -> {ExpTerm,NewVarNum}. %% Handle DCG expansion. We do NOT work backwards. - expand_term(Term) -> {Exp, _} = expand_term(Term, 0), Exp. @@ -87,7 +82,6 @@ expand_term(Term, Vn) -> {Term, Vn}. %% dcg_body and dcg_goal do smae the thing except the dcg_body %% guarantees the output variable is the one we specify. It may %% insert an explicit '=' to get this. - dcg_rule(DCGRule, Vn0) -> S0 = {Vn0}, S = {Vn0 + 1}, @@ -107,7 +101,7 @@ dcg_rule({'-->', H, B}, S0, S, Vn0) -> dcg_non_term(A, S0, S) when is_atom(A) -> {A, S0, S}; dcg_non_term(T, S0, S) when ?IS_FUNCTOR(T) -> list_to_tuple(tuple_to_list(T) ++ [S0, S]); -dcg_non_term(Other, _, _) -> erlog_int:type_error(callable, Other). +dcg_non_term(Other, _, _) -> erlog_errors:type_error(callable, Other). dcg_body({',', G0, B0}, S0, S, Vn0) -> S1 = {Vn0}, @@ -151,4 +145,4 @@ dcg_goal(NonT, S0, S, Vn) -> {Goal, S, Vn}. dcg_terminals(Lits, S0, S, Vn) -> %Without 'C'/3 - {{'=', S0, Lits ++ S}, Vn}. + {{'=', S0, Lits ++ S}, Vn}. \ No newline at end of file diff --git a/src/core/lang/erlog_errors.erl b/src/core/lang/erlog_errors.erl new file mode 100644 index 0000000..b3dcb68 --- /dev/null +++ b/src/core/lang/erlog_errors.erl @@ -0,0 +1,92 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 18. июн 2014 23:16 +%%%------------------------------------------------------------------- +-module(erlog_errors). +-author("tihon"). + +-include("erlog_int.hrl"). + +%% API +-export([type_error/3, instantiation_error/1, permission_error/4, + type_error/2, instantiation_error/0, erlog_error/2, erlog_error/1, fail/2]). + +%% Errors +%% To keep dialyzer quiet. +-spec type_error(_, _) -> no_return(). +-spec type_error(_, _, _) -> no_return(). +-spec instantiation_error() -> no_return(). +-spec instantiation_error(_) -> no_return(). +-spec permission_error(_, _, _, _) -> no_return(). +-spec erlog_error(_) -> no_return(). +-spec erlog_error(_, _) -> no_return(). + +type_error(Type, Value, Db) -> erlog_error({type_error, Type, Value}, Db). +type_error(Type, Value) -> erlog_error({type_error, Type, Value}). + +instantiation_error(Db) -> erlog_error(instantiation_error, Db). +instantiation_error() -> erlog_error(instantiation_error). + +permission_error(Op, Type, Value, Db) -> + erlog_error({permission_error, Op, Type, Value}, Db). + +erlog_error(E, Db) -> throw({erlog_error, E, Db}). +erlog_error(E) -> throw({erlog_error, E}). + +%% fail(ChoicePoints, Database) -> {fail,Database}. +%% cut(Label, Last, Next, ChoicePoints, Bindings, VarNum, Database) -> void. +%% +%% The functions which manipulate the choice point stack. fail +%% backtracks to next choicepoint skipping cut labels cut steps +%% backwards over choice points until matching cut. +fail([#cp{type = goal_clauses} = Cp | Cps], Db) -> + fail_goal_clauses(Cp, Cps, Db); +fail([#cp{type = disjunction} = Cp | Cps], Db) -> + fail_disjunction(Cp, Cps, Db); +fail([#cp{type = if_then_else} = Cp | Cps], Db) -> + fail_if_then_else(Cp, Cps, Db); +fail([#cp{type = clause} = Cp | Cps], Db) -> + fail_clause(Cp, Cps, Db); +fail([#cp{type = retract} = Cp | Cps], Db) -> + fail_retract(Cp, Cps, Db); +fail([#cp{type = current_predicate} = Cp | Cps], Db) -> + fail_current_predicate(Cp, Cps, Db); +fail([#cp{type = ecall} = Cp | Cps], Db) -> + fail_ecall(Cp, Cps, Db); +fail([#cp{type = compiled, data = F} = Cp | Cps], Db) -> + F(Cp, Cps, Db); +fail([#cut{} | Cps], Db) -> + fail(Cps, Db); %Fail over cut points. +fail([], Db) -> {fail, Db}. + +%% @private +fail_disjunction(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db) -> + erlog_core:prove_body(Next, Cps, Bs, Vn, Db). + +%% @private +fail_if_then_else(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db) -> + erlog_core:prove_body(Next, Cps, Bs, Vn, Db). + +%% @private +fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> + erlog_core:prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db). + +%% @private +fail_clause(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> + erlog_core:unify_clauses(Ch, Cb, Cs, Next, Cps, Bs, Vn, Db). + +%% @private +fail_retract(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> + erlog_core:retract_clauses(Ch, Cb, Cs, Next, Cps, Bs, Vn, Db). + +%% @private +fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> + erlog_core:prove_predicates(Pi, Fs, Next, Cps, Bs, Vn, Db). + +%% @private +fail_goal_clauses(#cp{data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> + erlog_core:prove_goal_clauses(G, Cs, Next, Cps, Bs, Vn, Db). \ No newline at end of file diff --git a/src/core/lang/erlog_lists.erl b/src/core/lang/erlog_lists.erl index cb96d19..cfb8cac 100644 --- a/src/core/lang/erlog_lists.erl +++ b/src/core/lang/erlog_lists.erl @@ -31,18 +31,13 @@ %% Library functions. -export([append_3/6, insert_3/6, member_2/6, memberchk_2/6, reverse_2/6, sort_2/6]). -%%-compile(export_all). - --import(lists, [map/2, foldl/3]). - %% load(Database) -> Database. %% Assert predicates into the database. - -load(Db0) -> +load(Db) -> %% Compiled common list library. - Db1 = foldl(fun({Head, M, F}, Db) -> erlog_int:add_compiled_proc(Head, M, F, Db) end, Db0, ?ERLOG_LISTS), + lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_LISTS), %% Finally interpreted common list library. - foldl(fun(Clause, Db) -> erlog_int:assertz_clause(Clause, Db) end, Db1, + lists:foreach(fun(Clause) -> erlog_memory:assertz_clause(Clause, Db) end, [ %% insert(L, X, [X|L]). insert([H|L], X, [H|L1]) :- insert(L, X, L1). %% delete([X|L], X, L). delete([H|L], X, [H|L1]) :- delete(L, X, L1). @@ -57,97 +52,92 @@ load(Db0) -> %% append([], L, L). %% append([H|T], L, [H|L1]) :- append(T, L, L1). %% Here we attempt to compile indexing in the first argument. - append_3({append, A1, L, A3}, Next0, Cps, Bs0, Vn, Db) -> - case erlog_int:deref(A1, Bs0) of + case erlog_core:deref(A1, Bs0) of [] -> %Cannot backtrack - erlog_int:unify_prove_body(L, A3, Next0, Cps, Bs0, Vn, Db); + erlog_core:unify_prove_body(L, A3, Next0, Cps, Bs0, Vn, Db); [H | T] -> %Cannot backtrack L1 = {Vn}, Next1 = [{append, T, L, L1} | Next0], - erlog_int:unify_prove_body(A3, [H | L1], Next1, Cps, Bs0, Vn + 1, Db); + erlog_core:unify_prove_body(A3, [H | L1], Next1, Cps, Bs0, Vn + 1, Db); {_} = Var -> %This can backtrack FailFun = fun(LCp, LCps, LDb) -> fail_append_3(LCp, LCps, LDb, Var, L, A3) end, Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, - Bs1 = erlog_int:add_binding(Var, [], Bs0), - erlog_int:unify_prove_body(L, A3, Next0, [Cp | Cps], Bs1, Vn, Db); - _ -> erlog_int:fail(Cps, Db) %Will fail here! + Bs1 = erlog_core:add_binding(Var, [], Bs0), + erlog_core:unify_prove_body(L, A3, Next0, [Cp | Cps], Bs1, Vn, Db); + _ -> erlog_errors:fail(Cps, Db) %Will fail here! end. fail_append_3(#cp{next = Next0, bs = Bs0, vn = Vn}, Cps, Db, A1, L, A3) -> H = {Vn}, T = {Vn + 1}, L1 = {Vn + 2}, - Bs1 = erlog_int:add_binding(A1, [H | T], Bs0), %A1 always a variable here. + Bs1 = erlog_core:add_binding(A1, [H | T], Bs0), %A1 always a variable here. Next1 = [{append, T, L, L1} | Next0], - erlog_int:unify_prove_body(A3, [H | L1], Next1, Cps, Bs1, Vn + 3, Db). + erlog_core:unify_prove_body(A3, [H | L1], Next1, Cps, Bs1, Vn + 3, Db). %% insert_3(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% insert(L, X, [X|L]). %% insert([H|L], X, [H|L1]) :- insert(L, X, L1). - insert_3({insert, A1, A2, A3}, Next, Cps, Bs, Vn, Db) -> FailFun = fun(LCp, LCps, LDb) -> fail_insert_3(LCp, LCps, LDb, A1, A2, A3) end, Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, - erlog_int:unify_prove_body(A3, [A2 | A1], Next, [Cp | Cps], Bs, Vn, Db). + erlog_core:unify_prove_body(A3, [A2 | A1], Next, [Cp | Cps], Bs, Vn, Db). fail_insert_3(#cp{next = Next0, bs = Bs, vn = Vn}, Cps, Db, A1, X, A3) -> H = {Vn}, L = {Vn + 1}, L1 = {Vn + 2}, Next1 = [{insert, L, X, L1} | Next0], - erlog_int:unify_prove_body(A1, [H | L], A3, [H | L1], Next1, Cps, Bs, Vn + 3, Db). + erlog_core:unify_prove_body(A1, [H | L], A3, [H | L1], Next1, Cps, Bs, Vn + 3, Db). %% member_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% member(X, [X|_]). %% member(X, [_|T]) :- member(X, T). - member_2({member, A1, A2}, Next, Cps, Bs, Vn, Db) -> FailFun = fun(LCp, LCps, LDb) -> fail_member_2(LCp, LCps, LDb, A1, A2) end, Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, T = {Vn}, - erlog_int:unify_prove_body(A2, [A1 | T], Next, [Cp | Cps], Bs, Vn + 1, Db). + erlog_core:unify_prove_body(A2, [A1 | T], Next, [Cp | Cps], Bs, Vn + 1, Db). fail_member_2(#cp{next = Next0, bs = Bs, vn = Vn}, Cps, Db, A1, A2) -> H = {Vn}, T = {Vn + 1}, Next1 = [{member, A1, T} | Next0], - erlog_int:unify_prove_body(A2, [H | T], Next1, Cps, Bs, Vn + 2, Db). + erlog_core:unify_prove_body(A2, [H | T], Next1, Cps, Bs, Vn + 2, Db). %% memberchk_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% memberchk(X, [X|_]) :- !. %% memberchk(X, [_|T]) :- member(X, T). %% We don't build the list and we never backtrack so we can be smart %% and match directly. Should we give a type error? - memberchk_2({memberchk, A1, A2}, Next, Cps, Bs0, Vn, Db) -> - case erlog_int:deref(A2, Bs0) of + case erlog_core:deref(A2, Bs0) of [H | T] -> - case erlog_int:unify(A1, H, Bs0) of + case erlog_core:unify(A1, H, Bs0) of {succeed, Bs1} -> - erlog_int:prove_body(Next, Cps, Bs1, Vn, Db); + erlog_core:prove_body(Next, Cps, Bs1, Vn, Db); fail -> memberchk_2({memberchk, A1, T}, Next, Cps, Bs0, Vn, Db) end; - {_} -> erlog_int:instantiation_error(); - _ -> erlog_int:fail(Cps, Db) + {_} -> erlog_errors:instantiation_error(); + _ -> erlog_errors:fail(Cps, Db) end. %% reverse_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% reverse([], []). %% reverse([H|L1], L) :- reverse(L1, L2), append(L2, [H], L). %% Here we attempt to compile indexing in the first argument. - reverse_2({reverse, A1, A2}, Next0, Cps, Bs0, Vn, Db) -> - case erlog_int:deref(A1, Bs0) of + case erlog_core:deref(A1, Bs0) of [] -> - erlog_int:unify_prove_body(A2, [], Next0, Cps, Bs0, Vn, Db); + erlog_core:unify_prove_body(A2, [], Next0, Cps, Bs0, Vn, Db); [H | T] -> L = {Vn}, L1 = A2, @@ -162,9 +152,9 @@ reverse_2({reverse, A1, A2}, Next0, Cps, Bs0, Vn, Db) -> fail_reverse_2(LCp, LCps, LDb, Var, A2) end, Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, - Bs1 = erlog_int:add_binding(Var, [], Bs0), - erlog_int:unify_prove_body(A2, [], Next0, [Cp | Cps], Bs1, Vn, Db); - _ -> erlog_int:fail(Cps, Db) %Will fail here! + Bs1 = erlog_core:add_binding(Var, [], Bs0), + erlog_core:unify_prove_body(A2, [], Next0, [Cp | Cps], Bs1, Vn, Db); + _ -> erlog_errors:fail(Cps, Db) %Will fail here! end. fail_reverse_2(#cp{next = Next, bs = Bs0, vn = Vn}, Cps, Db, A1, A2) -> @@ -172,7 +162,7 @@ fail_reverse_2(#cp{next = Next, bs = Bs0, vn = Vn}, Cps, Db, A1, A2) -> T = {Vn + 1}, L1 = A2, L = {Vn + 2}, - Bs1 = erlog_int:add_binding(A1, [H | T], Bs0), + Bs1 = erlog_core:add_binding(A1, [H | T], Bs0), %%Next1 = [{reverse,T,L},{apperse,L,[H],L1}|Next], %%prove_body(Next1, Cps, Bs1, Vn+3, Db). Next1 = [{append, L, [H], L1} | Next], @@ -180,8 +170,7 @@ fail_reverse_2(#cp{next = Next, bs = Bs0, vn = Vn}, Cps, Db, A1, A2) -> %% sort_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% sort(List, SortedList). - sort_2({sort, L0, S}, Next, Cps, Bs, Vn, Db) -> %% This may throw an erlog error, we don't catch it here. - L1 = lists:usort(erlog_int:dderef_list(L0, Bs)), - erlog_int:unify_prove_body(S, L1, Next, Cps, Bs, Vn, Db). + L1 = lists:usort(erlog_core:dderef_list(L0, Bs)), + erlog_core:unify_prove_body(S, L1, Next, Cps, Bs, Vn, Db). \ No newline at end of file diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index e95a3a6..81dd64d 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -28,16 +28,16 @@ %% Load/reload an Erlog file into the interpreter. Reloading will %% abolish old definitons of clauses. -consult(File, Db0) -> +consult(File, Db) -> case erlog_io:read_file(File) of {ok, Terms} -> - consult_terms(fun consult_assert/2, Db0, Terms); + consult_terms(fun consult_assert/2, Db, Terms); Error -> Error end. consult_assert(Term0, Db) -> Term1 = erlog_dcg:expand_term(Term0), - {ok, erlog_int:assertz_clause(Term1, Db)}. %TODO redefining database? + {ok, erlog_memory:assertz_clause(Db, Term1)}. reconsult(File, Db0) -> case erlog_io:read_file(File) of @@ -49,15 +49,15 @@ reconsult(File, Db0) -> Error -> Error end. -reconsult_assert(Term0, {Db0, Seen}) -> +reconsult_assert(Term0, {Db, Seen}) -> Term1 = erlog_dcg:expand_term(Term0), Func = functor(Term1), case lists:member(Func, Seen) of true -> - {ok, {erlog_int:assertz_clause(Term1, Db0), Seen}}; + {ok, {erlog_memory:assertz_clause(Db, Term1), Seen}}; false -> - Db1 = erlog_int:abolish_clauses(Func, Db0), - {ok, {erlog_int:assertz_clause(Term1, Db1), [Func | Seen]}} + erlog_memory:abolish_clauses(Db, Func), + {ok, {erlog_memory:assertz_clause(Db, Term1), [Func | Seen]}} end. %% consult_terms(InsertFun, Database, Terms) -> @@ -76,5 +76,5 @@ consult_terms(Ifun, Db0, [T | Ts]) -> end; consult_terms(_Ifun, Db, []) -> {ok, Db}. -functor({':-', H, _B}) -> erlog_int:functor(H); -functor(T) -> erlog_int:functor(T). +functor({':-', H, _B}) -> erlog_core:functor(H); +functor(T) -> erlog_core:functor(T). diff --git a/src/io/erlog_shell_sup.erl b/src/io/erlog_shell_sup.erl index 5fd22bb..11fdd07 100644 --- a/src/io/erlog_shell_sup.erl +++ b/src/io/erlog_shell_sup.erl @@ -12,7 +12,7 @@ -behaviour(supervisor). %% API --export([start_link/0, process_connection/1, start_socket/0]). +-export([start_link/0, start_socket/0]). %% Supervisor callbacks -export([init/1]). @@ -22,8 +22,6 @@ %%%=================================================================== %%% API functions %%%=================================================================== -% for rpc for server-server integration -process_connection(Args) -> supervisor:start_child(?MODULE, [Args]). %TODO fix me % for console start_socket() -> supervisor:start_child(?MODULE, []). diff --git a/src/main/erlog_boot.erl b/src/main/erlog_boot.erl deleted file mode 100644 index 8ec17f0..0000000 --- a/src/main/erlog_boot.erl +++ /dev/null @@ -1,33 +0,0 @@ -%% Copyright (c) 2008-2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - -%% File : erlog_boot.erl -%% Author : Robert Virding -%% Purpose : Erlog boot module. - -%% This little beauty allows you to start Erlang with the Erlog shell -%% running and still has ^G and user_drv enabled. Use it as follows: -%% -%% erl -noshell -noinput -s erlog_boot start -%% -%% NOTE order of commands important, must be -noshell -noinput! Add -%% -pa to find modules if necessary. -%% -%% Thanks to Attila Babo for showing me how to do this. - --module(erlog_boot). - --export([start/0]). - -start() -> user_drv:start(['tty_sl -c -e', {erlog_shell, start, []}]). diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl new file mode 100644 index 0000000..3aac85c --- /dev/null +++ b/src/storage/erlog_dict.erl @@ -0,0 +1,106 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 18. июн 2014 18:00 +%%%------------------------------------------------------------------- +-module(erlog_dict). +-author("tihon"). + +-behaviour(erlog_storage). + +%% erlog callbacks +-export([add_built_in/2, + add_compiled_proc/2, + assertz_clause/2, + asserta_clause/2, + retract_clause/2, + abolish_clauses/2, + get_procedure/2, + get_procedure_type/2, + get_interp_functors/1]). + +%% API +-export([]). + +add_built_in(Db, Functor) -> + {ok, dict:store(Functor, built_in, Db)}. + +add_compiled_proc(Db, {Functor, M, F}) -> + {ok, dict:update(Functor, + fun(built_in) -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + (_) -> {code, {M, F}} + end, {code, {M, F}}, Db)}. + +assertz_clause(Db, {Head, Body0}) -> %TODO по максимуму совместить с asserta_clause + {Functor, Body} = case catch {ok, erlog_core:functor(Head), + erlog_core:well_form_body(Body0, false, sture)} of + {erlog_error, E} -> erlog_errors:erlog_error(E, Db); + {ok, F, B} -> {F, B} + end, + dict:update(Functor, + fun(built_in) -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + ({code, _}) -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + ({clauses, T, Cs}) -> {clauses, T + 1, Cs ++ [{T, Head, Body}]} + end, {clauses, 1, [{0, Head, Body}]}, Db). + +asserta_clause(Db, {Head, Body0}) -> + {Functor, Body} = case catch {ok, erlog_core:functor(Head), + erlog_core:well_form_body(Body0, false, sture)} of + {erlog_error, E} -> erlog_errors:erlog_error(E, Db); + {ok, F, B} -> {F, B} + end, + dict:update(Functor, + fun(built_in) -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + ({code, _}) -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + ({clauses, T, Cs}) -> {clauses, T + 1, [{T, Head, Body} | Cs]} + end, {clauses, 1, [{0, Head, Body}]}, Db). + +retract_clause(Db, {Functor, Ct}) -> + case dict:find(Functor, Db) of + {ok, built_in} -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + {ok, {code, _}} -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + {ok, {clauses, Nt, Cs}} -> + dict:store(Functor, {clauses, Nt, lists:keydelete(Ct, 1, Cs)}, Db); + error -> Db %Do nothing + end. + +abolish_clauses(Db, Functor) -> + case dict:find(Functor, Db) of + {ok, built_in} -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + {ok, {code, _}} -> dict:erase(Functor, Db); + {ok, {clauses, _, _}} -> dict:erase(Functor, Db); + error -> Db %Do nothing + end. + +get_procedure(Db, Functor) -> + case dict:find(Functor, Db) of + {ok, built_in} -> built_in; %A built-in + {ok, {code, {_M, _F}} = P} -> P; %Compiled (perhaps someday) + {ok, {clauses, _T, Cs}} -> {clauses, Cs}; %Interpreted clauses + error -> undefined %Undefined + end. + +get_procedure_type(Db, Functor) -> + case dict:find(Functor, Db) of + {ok, built_in} -> built_in; %A built-in + {ok, {code, _}} -> compiled; %Compiled (perhaps someday) + {ok, {clauses, _, _}} -> interpreted; %Interpreted clauses + error -> undefined %Undefined + end. + +get_interp_functors(Db) -> + dict:fold(fun(_Func, built_in, Fs) -> Fs; + (Func, {code, _}, Fs) -> [Func | Fs]; + (Func, {clauses, _, _}, Fs) -> [Func | Fs] + end, [], Db). diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 9cbff55..2621989 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -1,145 +1,108 @@ -%% Copyright (c) 2008-2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - -%% File : erlog_ets.erl -%% Author : Robert Virding -%% Purpose : ETS interface for Erlog. +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 18. июн 2014 18:00 +%%%------------------------------------------------------------------- -module(erlog_ets). --include("erlog_int.hrl"). - --export([assert/1, all_1/6, keys_2/6, match_2/6]). - --import(lists, [foldl/3]). - -%% assert(Database) -> Database. -%% Assert predicates into the database. - -assert(Db) -> - foldl(fun({Head, M, F}, LDb) -> - erlog_int:add_compiled_proc(Head, M, F, LDb) end, Db, - [ - {{ets_all, 1}, ?MODULE, all_1}, - {{ets_keys, 2}, ?MODULE, keys_2}, - {{ets_match, 2}, ?MODULE, match_2} - ]). +-behaviour(erlog_storage). +-include("erlog_int.hrl"). -%% all_1(Goal, Next, ChoicePoints, Bindings, VarNum, Database) -> void(). -%% Goal = {ets_all,Tables}. -%% Return all the ETS databases. - -all_1({ets_all, Var}, Next, Cps, Bs, Vn, Db) -> - Tabs = ets:all(), - erlog_int:unify_prove_body(Var, Tabs, Next, Cps, Bs, Vn, Db). - -%% keys_2(Goal, Next, ChoicePoints, Bindings, VarNum, Database) -> void(). -%% Goal = {ets_keys,Table,Key}. -%% Return the keys in an ETS database one at a time over backtracking. - -keys_2({ets_keys, Tab0, KeyVar}, Next, Cps, Bs, Vn, Db) -> - Tab1 = erlog_int:dderef(Tab0, Bs), - case ets:first(Tab1) of - '$end_of_table' -> erlog_int:fail(Cps, Db); - Key -> keys_loop(Tab1, Key, KeyVar, Next, Cps, Bs, Vn, Db) - end. - -keys_loop(Tab, Key, KeyVar, Next, Cps, Bs, Vn, Db) -> - FailFun = fun(LCp, LCps, LDb) -> - keys_fail(LCp, LCps, LDb, Tab, Key, KeyVar) +%% erlog callbacks +-export([add_built_in/2, + add_compiled_proc/2, + assertz_clause/2, + asserta_clause/2, + retract_clause/2, + abolish_clauses/2, + get_procedure/2, + get_procedure_type/2, + get_interp_functors/1]). + +add_built_in(Db, Functor) -> + true = ets:insert(Db, {Functor, built_in}), + {ok, Db}. + +add_compiled_proc(Db, {Functor, M, F}) -> + case ets:lookup(Db, Functor) of + [{_, built_in}] -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + [_] -> ets:insert(Db, {Functor, code, {M, F}}); + [] -> ets:insert(Db, {Functor, code, {M, F}}) end, - C = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, - erlog_int:unify_prove_body(KeyVar, Key, Next, [C | Cps], Bs, Vn, Db). - -keys_fail(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db, Tab, PrevKey, KeyVar) -> - case ets:next(Tab, PrevKey) of - '$end_of_table' -> erlog_int:fail(Cps, Db); - Key -> keys_loop(Tab, Key, KeyVar, Next, Cps, Bs, Vn, Db) + {ok, Db}. + +assertz_clause(Db, {Head, Body0}) -> %TODO по максимуму совместить с asserta_clause + {Functor, Body} = case catch {ok, erlog_core:functor(Head), + erlog_core:well_form_body(Body0, false, sture)} of + {erlog_error, E} -> erlog_errors:erlog_error(E, Db); + {ok, F, B} -> {F, B} + end, + case ets:lookup(Db, Functor) of + [{_, built_in}] -> erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + [{_, code, _}] -> erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + [{_, clauses, Tag, Cs}] -> + ets:insert(Db, {Functor, clauses, Tag + 1, Cs ++ [{Tag, Head, Body}]}); + [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) end. -%% match_2(Goal, Next, ChoicePoints, Bindings, VarNum, Database) -> void(). -%% Goal = {ets_match,Table,Pattern}. -%% Match objects in an ETS database one at a time over backtracking -%% using Pattern in goal. Variables in Pattern are bound for each -%% object matched. - -match_2({ets_match, Tab0, Pat0}, Next, Cps, Bs, Vn, Db) -> - Tab1 = erlog_int:dderef(Tab0, Bs), - Pat1 = erlog_int:dderef(Pat0, Bs), - {Epat, Vs} = ets_pat(Pat1), - match_2_loop(ets:match(Tab1, Epat, 10), Next, Cps, Bs, Vn, Db, Epat, Vs). - -match_2_loop({[M | Ms], Cont}, Next, Cps, Bs, Vn, Db, Epat, Vs) -> - FailFun = fun(LCp, LCps, LDb) -> - match_2_fail(LCp, LCps, LDb, Epat, Vs, {Ms, Cont}) - end, - Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, - erlog_int:unify_prove_body(Vs, M, Next, [Cp | Cps], Bs, Vn, Db); -match_2_loop({[], Cont}, Next, Cps, Bs, Vn, Db, Epat, Vs) -> - match_2_loop(ets:match(Cont), Next, Cps, Bs, Vn, Db, Epat, Vs); -match_2_loop('$end_of_table', _Next, Cps, _Bs, _Vn, Db, _Epat, _Vs) -> - erlog_int:fail(Cps, Db). - -match_2_fail(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db, Epat, Vs, Ms) -> - match_2_loop(Ms, Next, Cps, Bs, Vn, Db, Epat, Vs). - -%% ets_pat(Term) -> {EtsPattern,VarList}. -%% Convert a term into an ETS pattern replacing variables with the ETS -%% pattern variables. Also return a list of variables in the same -%% order as ETS will return the list of values. This is slightly -%% tricky as the order they are in ETS which is not the same as term -%% order so they can not be easily sorted. Sigh! +asserta_clause(Db, {Head, Body0}) -> + {Functor, Body} = case catch {ok, erlog_core:functor(Head), + erlog_core:well_form_body(Body0, false, sture)} of + {erlog_error, E} -> erlog_errors:erlog_error(E, Db); + {ok, F, B} -> {F, B} + end, + case ets:lookup(Db, Functor) of + [{_, built_in}] -> erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + [{_, code, _}] -> erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + [{_, clauses, Tag, Cs}] -> + ets:insert(Db, {Functor, clauses, Tag + 1, [{Tag, Head, Body} | Cs]}); + [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) + end. -ets_pat(Pat) -> - {Epat, _Vn, Vs0} = ets_pat(Pat, 11, []), - Vs1 = [V || {V, _Ev} <- Vs0], - {Epat, Vs1}. +retract_clause(Db, {Functor, Ct}) -> + case ets:lookup(Db, Functor) of + [{_, built_in}] -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + [{_, code, _}] -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + [{_, clauses, Nt, Cs}] -> + ets:insert(Db, {Functor, clauses, Nt, lists:keydelete(Ct, 1, Cs)}); + [] -> ok %Do nothing + end. -ets_pat({_} = V, Vn, Vs) -> - case find(V, Vs) of - {yes, Ev} -> {Ev, Vn, Vs}; - no -> - Ev = ets_var(Vn), - {Ev, Vn - 1, [{V, Ev} | Vs]} - end; -ets_pat([H0 | T0], Vn0, Vs0) -> - {T1, Vn1, Vs1} = ets_pat(T0, Vn0, Vs0), %Right to left! - {H1, Vn2, Vs2} = ets_pat(H0, Vn1, Vs1), - {[H1 | T1], Vn2, Vs2}; -ets_pat(P, Vn0, Vs0) when is_tuple(P), size(P) >= 2 -> - {As, Vn1, Vs1} = ets_pat_arg(P, Vn0, Vs0, size(P), []), - {list_to_tuple([element(1, P) | As]), Vn1, Vs1}; -ets_pat(P, Vn, Vs) -> {P, Vn, Vs}. %Constant +abolish_clauses(Db, Functor) -> + case ets:lookup(Db, Functor) of + [{_, built_in}] -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + [{_, code, _}] -> ets:delete(Db, Functor); + [{_, clauses, _, _}] -> ets:delete(Db, Functor); + [] -> ok %Do nothing + end. -ets_pat_arg(_P, Vn, Vs, 1, As) -> {As, Vn, Vs}; -ets_pat_arg(P, Vn0, Vs0, I, As) -> - {A, Vn1, Vs1} = ets_pat(element(I, P), Vn0, Vs0), - ets_pat_arg(P, Vn1, Vs1, I - 1, [A | As]). +get_procedure(Db, Functor) -> + case ets:lookup(Db, Functor) of + [{_, built_in}] -> built_in; + [{_, code, C}] -> {code, C}; + [{_, clauses, _, Cs}] -> {clauses, Cs}; + [] -> undefined + end. -find(V, [{V, Ev} | _Vs]) -> {yes, Ev}; -find(V, [_P | Vs]) -> find(V, Vs); -find(_V, []) -> no. +get_procedure_type(Db, Functor) -> + case ets:lookup(Db, Functor) of + [{_, built_in}] -> built_in; %A built-in + [{_, code, _C}] -> compiled; %Compiled (perhaps someday) + [{_, clauses, _, _Cs}] -> interpreted; %Interpreted clauses + [] -> undefined %Undefined + end. -ets_var(1) -> '$1'; -ets_var(2) -> '$2'; -ets_var(3) -> '$3'; -ets_var(4) -> '$4'; -ets_var(5) -> '$5'; -ets_var(6) -> '$6'; -ets_var(7) -> '$7'; -ets_var(8) -> '$8'; -ets_var(9) -> '$9'; -ets_var(10) -> '$10'; -ets_var(11) -> '$11'. +get_interp_functors(Db) -> + ets:foldl(fun({_, built_in}, Fs) -> Fs; + ({Func, code, _}, Fs) -> [Func | Fs]; + ({Func, clauses, _, _}, Fs) -> [Func | Fs] + end, [], Db). diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl new file mode 100644 index 0000000..57b350a --- /dev/null +++ b/src/storage/erlog_memory.erl @@ -0,0 +1,183 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 18. июн 2014 21:48 +%%%------------------------------------------------------------------- +-module(erlog_memory). +-author("tihon"). + +-behaviour(gen_server). + +-include("erlog_int.hrl"). + +%% API +-export([start_link/2, add_compiled_proc/2, assertz_clause/3, asserta_clause/3, + retract_clause/3, abolish_clauses/2, get_procedure/2, get_procedure_type/2, + get_interp_functors/1, assertz_clause/2, asserta_clause/2]). + +-export([add_built_in/2]). + +%% gen_server callbacks +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). + +-define(SERVER, ?MODULE). + +-record(state, +{ + database :: atom(), % callback module + state :: term() % callback state +}). + +%%%=================================================================== +%%% API +%%%=================================================================== +add_built_in(Database, Element) -> gen_server:call(Database, {add_built_in, Element}). + +add_compiled_proc(Database, Proc) -> gen_server:call(Database, {add_compiled_proc, Proc}). + +assertz_clause(Database, {':-', Head, Body}) -> assertz_clause(Database, Head, Body); +assertz_clause(Database, Head) -> assertz_clause(Database, Head, true). +assertz_clause(Database, Head, Body) -> gen_server:call(Database, {assertz_clause, {Head, Body}}). + +asserta_clause(Database, {':-', H, B}) -> asserta_clause(Database, H, B); +asserta_clause(Database, H) -> asserta_clause(Database, H, true). +asserta_clause(Database, Head, Body) -> gen_server:call(Database, {asserta_clause, {Head, Body}}). + +retract_clause(Database, F, Ct) -> gen_server:call(Database, {retract_clause, {F, Ct}}). + +abolish_clauses(Database, Func) -> gen_server:call(Database, {abolish_clauses, Func}). + +get_procedure(Database, Func) -> gen_server:call(Database, {get_procedure, Func}). + +get_procedure_type(Database, Func) -> gen_server:call(Database, {get_procedure_type, Func}). + +get_interp_functors(Database) -> gen_server:call(Database, get_interp_functors). + +%%-------------------------------------------------------------------- +%% @doc +%% Starts the server +%% +%% @end +%%-------------------------------------------------------------------- +-spec(start_link(Database :: atom(), State :: term()) -> + {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). +start_link(Database, State) -> + gen_server:start_link(?MODULE, [Database, State], []). + +%%%=================================================================== +%%% gen_server callbacks +%%%=================================================================== + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Initializes the server +%% +%% @spec init(Args) -> {ok, State} | +%% {ok, State, Timeout} | +%% ignore | +%% {stop, Reason} +%% @end +%%-------------------------------------------------------------------- +-spec(init(Args :: term()) -> + {ok, State :: #state{}} | {ok, State :: #state{}, timeout() | hibernate} | + {stop, Reason :: term()} | ignore). +init([Database, State]) when is_atom(Database) -> + {ok, #state{database = Database, state = State}}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Handling call messages +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_call(Request :: term(), From :: {pid(), Tag :: term()}, + State :: #state{}) -> + {reply, Reply :: term(), NewState :: #state{}} | + {reply, Reply :: term(), NewState :: #state{}, timeout() | hibernate} | + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | + {stop, Reason :: term(), NewState :: #state{}}). +handle_call({Fun, Params}, _From, State = #state{state = State, database = Database}) -> + {Res, NewState} = Database:Fun(State, Params), + {reply, Res, State#state{state = NewState}}; +handle_call(Fun, _From, State = #state{state = State, database = Database}) -> + {Res, NewState} = Database:Fun(State), + {reply, Res, State#state{state = NewState}}; +handle_call(_Request, _From, State) -> + {reply, ok, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Handling cast messages +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_cast(Request :: term(), State :: #state{}) -> + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), NewState :: #state{}}). +handle_cast(_Request, State) -> + {noreply, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Handling all non call/cast messages +%% +%% @spec handle_info(Info, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} +%% @end +%%-------------------------------------------------------------------- +-spec(handle_info(Info :: timeout() | term(), State :: #state{}) -> + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), NewState :: #state{}}). +handle_info(_Info, State) -> + {noreply, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% This function is called by a gen_server when it is about to +%% terminate. It should be the opposite of Module:init/1 and do any +%% necessary cleaning up. When it returns, the gen_server terminates +%% with Reason. The return value is ignored. +%% +%% @spec terminate(Reason, State) -> void() +%% @end +%%-------------------------------------------------------------------- +-spec(terminate(Reason :: (normal | shutdown | {shutdown, term()} | term()), + State :: #state{}) -> term()). +terminate(_Reason, _State) -> + ok. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Convert process state when code is changed +%% +%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState} +%% @end +%%-------------------------------------------------------------------- +-spec(code_change(OldVsn :: term() | {down, term()}, State :: #state{}, + Extra :: term()) -> + {ok, NewState :: #state{}} | {error, Reason :: term()}). +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%%=================================================================== +%%% Internal functions +%%%=================================================================== diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl index 7aa1507..76adf1e 100644 --- a/src/storage/erlog_storage.erl +++ b/src/storage/erlog_storage.erl @@ -9,21 +9,20 @@ -module(erlog_storage). -author("tihon"). --callback add_built_in(Functor) -> ok | {error, Reason}. +-callback add_built_in(State, Functor) -> {ok, NewState} | {error, Reason}. --callback add_compiled_proc(Functor, M, F) -> ok | {error, Reason}. +-callback add_compiled_proc(State, {Functor, M, F}) -> {ok, NewState} | {error, Reason}. --callback assertz_clause(Head, Body) -> ok | {error, Reason}. +-callback assertz_clause(State, {Head, Body}) -> {ok, NewState} | {error, Reason}. --callback asserta_clause(Head, Body) -> ok | {error, Reason}. +-callback asserta_clause(State, {Head, Body}) -> {ok, NewState} | {error, Reason}. --callback retract_clause(F, Ct) -> ok | {error, Reason}. +-callback retract_clause(State, {F, Ct}) -> {ok, NewState} | {error, Reason}. --callback abolish_clauses(Func) -> ok | {error, Reason}. +-callback abolish_clauses(State, Func) -> {ok, NewState} | {error, Reason}. --callback get_procedure(Func) -> ok | {error, Reason}. +-callback get_procedure(State, Func) -> {atom, NewState} | {term(), NewState} | {error, Reason}. --callback get_procedure_type(Func) -> ok | {error, Reason}. - --callback get_interp_functors() -> ok | {error, Reason}. +-callback get_procedure_type(State, Func) -> {atom(), NewState} | {error, Reason}. +-callback get_interp_functors(State) -> {list(), NewState} | {error, Reason}. \ No newline at end of file From 0a10905e7575ccd281a9996563c23c25485a64a9 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 19 Jun 2014 00:54:48 +0000 Subject: [PATCH 019/251] refactor in asserta-z --- include/erlog_int.hrl | 2 +- src/core/erlog.erl | 1 + src/core/erlog_core.erl | 7 +++--- src/storage/erlog_dict.erl | 48 ++++++++++++++++++-------------------- src/storage/erlog_ets.erl | 46 +++++++++++++++++------------------- 5 files changed, 49 insertions(+), 55 deletions(-) diff --git a/include/erlog_int.hrl b/include/erlog_int.hrl index a136632..87059bb 100644 --- a/include/erlog_int.hrl +++ b/include/erlog_int.hrl @@ -84,7 +84,7 @@ {{sort, 2}, ?MODULE, sort_2} ]). --define(ERLOG_INT, +-define(ERLOG_CORE, [ %% Logic and control. {call, 1}, diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 77594d3..bd54016 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -61,6 +61,7 @@ init([]) -> % use built in database %Load basic interpreter predicates lists:foreach(fun(Mod) -> Mod:load(Db) end, [ + erlog_core, %Core predicates erlog_bips, %Built in predicates erlog_dcg, %DCG predicates erlog_lists %Common lists library diff --git a/src/core/erlog_core.erl b/src/core/erlog_core.erl index d1328c5..93e61a8 100644 --- a/src/core/erlog_core.erl +++ b/src/core/erlog_core.erl @@ -148,15 +148,14 @@ %% Creating term and body instances. -export([term_instance/2]). %% Adding to database. --export([built_in_db/1]). %TODO? +-export([load/1]). %TODO? %% built_in_db(Db) -> Database. %% Create an initial clause database containing the built-in %% predicates and predefined library predicates. -built_in_db(Db) -> - %% Add the Erlang built-ins. - lists:foreach(fun(Head, Db) -> Db:add_built_in(Head, Db) end, ?ERLOG_INT). +load(Db) -> + lists:foreach(fun(Head) -> erlog_memory:add_built_in(Db, Head) end, ?ERLOG_CORE). %% Add the Erlang built-ins. %% prove_goal(Goal, Database) -> Succeed | Fail. %% This is the main entry point into the interpreter. Check that diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 3aac85c..0e48650 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -35,33 +35,17 @@ add_compiled_proc(Db, {Functor, M, F}) -> (_) -> {code, {M, F}} end, {code, {M, F}}, Db)}. -assertz_clause(Db, {Head, Body0}) -> %TODO по максимуму совместить с asserta_clause - {Functor, Body} = case catch {ok, erlog_core:functor(Head), - erlog_core:well_form_body(Body0, false, sture)} of - {erlog_error, E} -> erlog_errors:erlog_error(E, Db); - {ok, F, B} -> {F, B} - end, - dict:update(Functor, - fun(built_in) -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); - ({code, _}) -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); - ({clauses, T, Cs}) -> {clauses, T + 1, Cs ++ [{T, Head, Body}]} - end, {clauses, 1, [{0, Head, Body}]}, Db). +assertz_clause(Db, {Head, Body0}) -> + clause(Head, Body0, Db, + fun(T, Body, Cs) -> + {clauses, T + 1, Cs ++ [{T, Head, Body}]} + end). asserta_clause(Db, {Head, Body0}) -> - {Functor, Body} = case catch {ok, erlog_core:functor(Head), - erlog_core:well_form_body(Body0, false, sture)} of - {erlog_error, E} -> erlog_errors:erlog_error(E, Db); - {ok, F, B} -> {F, B} - end, - dict:update(Functor, - fun(built_in) -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); - ({code, _}) -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); - ({clauses, T, Cs}) -> {clauses, T + 1, [{T, Head, Body} | Cs]} - end, {clauses, 1, [{0, Head, Body}]}, Db). + clause(Head, Body0, Db, + fun(T, Body, Cs) -> + {clauses, T + 1, [{T, Head, Body} | Cs]} + end). retract_clause(Db, {Functor, Ct}) -> case dict:find(Functor, Db) of @@ -104,3 +88,17 @@ get_interp_functors(Db) -> (Func, {code, _}, Fs) -> [Func | Fs]; (Func, {clauses, _, _}, Fs) -> [Func | Fs] end, [], Db). + +clause(Head, Body0, Db, ClauseFun) -> + {Functor, Body} = case catch {ok, erlog_core:functor(Head), + erlog_core:well_form_body(Body0, false, sture)} of + {erlog_error, E} -> erlog_errors:erlog_error(E, Db); + {ok, F, B} -> {F, B} + end, + dict:update(Functor, + fun(built_in) -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + ({code, _}) -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + ({clauses, T, Cs}) -> ClauseFun(T, Body, Cs) + end, {clauses, 1, [{0, Head, Body}]}, Db). \ No newline at end of file diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 2621989..1a97a9c 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -37,33 +37,17 @@ add_compiled_proc(Db, {Functor, M, F}) -> end, {ok, Db}. -assertz_clause(Db, {Head, Body0}) -> %TODO по максимуму совместить с asserta_clause - {Functor, Body} = case catch {ok, erlog_core:functor(Head), - erlog_core:well_form_body(Body0, false, sture)} of - {erlog_error, E} -> erlog_errors:erlog_error(E, Db); - {ok, F, B} -> {F, B} - end, - case ets:lookup(Db, Functor) of - [{_, built_in}] -> erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); - [{_, code, _}] -> erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); - [{_, clauses, Tag, Cs}] -> - ets:insert(Db, {Functor, clauses, Tag + 1, Cs ++ [{Tag, Head, Body}]}); - [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) - end. +assertz_clause(Db, {Head, Body0}) -> + clause(Head, Body0, Db, + fun(Functor, Tag, Cs, Body) -> + ets:insert(Db, {Functor, clauses, Tag + 1, Cs ++ [{Tag, Head, Body}]}) + end). asserta_clause(Db, {Head, Body0}) -> - {Functor, Body} = case catch {ok, erlog_core:functor(Head), - erlog_core:well_form_body(Body0, false, sture)} of - {erlog_error, E} -> erlog_errors:erlog_error(E, Db); - {ok, F, B} -> {F, B} - end, - case ets:lookup(Db, Functor) of - [{_, built_in}] -> erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); - [{_, code, _}] -> erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); - [{_, clauses, Tag, Cs}] -> - ets:insert(Db, {Functor, clauses, Tag + 1, [{Tag, Head, Body} | Cs]}); - [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) - end. + clause(Head, Body0, Db, + fun(Functor, Tag, Cs, Body) -> + ets:insert(Db, {Functor, clauses, Tag + 1, [{Tag, Head, Body} | Cs]}) + end). retract_clause(Db, {Functor, Ct}) -> case ets:lookup(Db, Functor) of @@ -106,3 +90,15 @@ get_interp_functors(Db) -> ({Func, code, _}, Fs) -> [Func | Fs]; ({Func, clauses, _, _}, Fs) -> [Func | Fs] end, [], Db). + +clause(Head, Body0, Db, ClauseFun) -> + {Functor, Body} = case catch {ok, erlog_core:functor(Head), erlog_core:well_form_body(Body0, false, sture)} of + {erlog_error, E} -> erlog_errors:erlog_error(E, Db); + {ok, F, B} -> {F, B} + end, + case ets:lookup(Db, Functor) of + [{_, built_in}] -> erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + [{_, code, _}] -> erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + [{_, clauses, Tag, Cs}] -> ClauseFun(Functor, Tag, Cs, Body); + [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) + end. \ No newline at end of file From fac660db4649fce89ee2de986924a4442b55bea8 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 19 Jun 2014 01:21:33 +0000 Subject: [PATCH 020/251] refactoring and fixes in implementation --- src/core/erlog.erl | 32 +++++++++------- src/core/erlog_core.erl | 15 ++++---- src/core/lang/erlog_dcg.erl | 2 +- src/core/lang/erlog_lists.erl | 2 +- src/storage/erlog_dict.erl | 71 +++++++++++++++++------------------ src/storage/erlog_ets.erl | 40 +++++++++++--------- src/storage/erlog_storage.erl | 18 ++++----- 7 files changed, 93 insertions(+), 87 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index bd54016..a875925 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -56,20 +56,12 @@ start_link(Database, State) -> gen_server:start_link(?MODULE, [Database, State], []). init([]) -> % use built in database - Db = erlog_memory:start_link(erlog_ets, undefined), %default database is ets module - %TODO monitor database? - %Load basic interpreter predicates - lists:foreach(fun(Mod) -> Mod:load(Db) end, - [ - erlog_core, %Core predicates - erlog_bips, %Built in predicates - erlog_dcg, %DCG predicates - erlog_lists %Common lists library - ]), + {ok, Db} = erlog_memory:start_link(erlog_ets, undefined), %default database is ets module + load_built_in(Db), {ok, #state{db = Db}}; -init([Database, State]) -> % use custom database implementation %TODO made state return in callbacks? - Db = erlog_memory:start_link(Database, State), %TODO monitor database? -%% TODO load db +init([Database, State]) -> % use custom database implementation + {ok, Db} = erlog_memory:start_link(Database, State), + load_built_in(Db), {ok, #state{db = Db}}. handle_call({execute, Command}, _From, State = #state{state = normal}) -> %in normal mode @@ -96,6 +88,18 @@ code_change(_, _, St) -> {ok, St}. %%%=================================================================== %%% Internal functions %%%=================================================================== +%% @private +load_built_in(Database) -> + link(Database), %TODO some better solution to clean database, close it properly and free memory after erlog terminates + %Load basic interpreter predicates + lists:foreach(fun(Mod) -> Mod:load(Database) end, + [ + erlog_core, %Core predicates + erlog_bips, %Built in predicates + erlog_dcg, %DCG predicates + erlog_lists %Common lists library + ]). + %% @private %% Run scanned command run_command(Command, State) -> @@ -164,7 +168,7 @@ prove_goal(Goal0, State = #state{db = Db}) -> %% Must use 'catch' here as 'try' does not do last-call %% optimisation. case erlog_logic:prove_result(catch erlog_core:prove_goal(Goal1, Db), Vs) of - {succeed, Res, Args} -> + {succeed, Res, Args} -> %TODO Args? {{succeed, Res}, State}; OtherRes -> {OtherRes, State#state{state = normal}} end. \ No newline at end of file diff --git a/src/core/erlog_core.erl b/src/core/erlog_core.erl index 93e61a8..359633b 100644 --- a/src/core/erlog_core.erl +++ b/src/core/erlog_core.erl @@ -127,9 +127,11 @@ -include("erlog_int.hrl"). +%%-define(BIND, orddict). %TODO ets and others? +-define(BIND, dict). + %% Main execution functions. --export( -[ +-export([ unify/3, dderef_list/2, make_vars/2, @@ -141,8 +143,8 @@ prove_predicates/7, prove_goal_clauses/7, pred_ind/1, - well_form_body/3 -]). + well_form_body/3, + deref_list/2]). %% Bindings, unification and dereferncing. -export([functor/1]). %% Creating term and body instances. @@ -211,7 +213,7 @@ deref(T, _) -> T. %Not a variable, return it. %% deref_list(List, Bindings) -> List. %% Dereference the top-level checking that it is a list. -deref_list([], _) -> []; %It already is a list +deref_list([], _) -> []; %It already is a list %TODO where it is used? deref_list([_ | _] = L, _) -> L; deref_list({V}, Bs) -> case dict:find(V, Bs) of @@ -860,9 +862,6 @@ pred_ind({N, A}) -> {'/', N, A}. %% Bindings %% Bindings are kept in a dict where the key is the variable name. -%%-define(BIND, orddict). %TODO ets and others? --define(BIND, dict). - new_bindings() -> ?BIND:new(). add_binding({V}, Val, Bs0) -> diff --git a/src/core/lang/erlog_dcg.erl b/src/core/lang/erlog_dcg.erl index 3581322..2d8cf6e 100644 --- a/src/core/lang/erlog_dcg.erl +++ b/src/core/lang/erlog_dcg.erl @@ -28,7 +28,7 @@ load(Db) -> %% Compiled DCG predicates. lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_DCG), %% Interpreted DCG predicates. - lists:foldl(fun(Clause, Db) -> erlog_memory:assertz_clause(Db, Clause) end, Db, + lists:foreach(fun(Clause) -> erlog_memory:assertz_clause(Db, Clause) end, [ %% 'C'([H|T], H, T). %% {'C',[{1}|{2}],{1},{2}}, %For DCGs diff --git a/src/core/lang/erlog_lists.erl b/src/core/lang/erlog_lists.erl index cfb8cac..4c1ce8e 100644 --- a/src/core/lang/erlog_lists.erl +++ b/src/core/lang/erlog_lists.erl @@ -37,7 +37,7 @@ load(Db) -> %% Compiled common list library. lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_LISTS), %% Finally interpreted common list library. - lists:foreach(fun(Clause) -> erlog_memory:assertz_clause(Clause, Db) end, + lists:foreach(fun(Clause) -> erlog_memory:assertz_clause(Db, Clause) end, [ %% insert(L, X, [X|L]). insert([H|L], X, [H|L1]) :- insert(L, X, L1). %% delete([X|L], X, L). delete([H|L], X, [H|L1]) :- delete(L, X, L1). diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 0e48650..213655f 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -36,62 +36,61 @@ add_compiled_proc(Db, {Functor, M, F}) -> end, {code, {M, F}}, Db)}. assertz_clause(Db, {Head, Body0}) -> - clause(Head, Body0, Db, + {clause(Head, Body0, Db, fun(T, Body, Cs) -> {clauses, T + 1, Cs ++ [{T, Head, Body}]} - end). + end), Db}. asserta_clause(Db, {Head, Body0}) -> - clause(Head, Body0, Db, + {clause(Head, Body0, Db, fun(T, Body, Cs) -> {clauses, T + 1, [{T, Head, Body} | Cs]} - end). + end), Db}. retract_clause(Db, {Functor, Ct}) -> - case dict:find(Functor, Db) of - {ok, built_in} -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); - {ok, {code, _}} -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); - {ok, {clauses, Nt, Cs}} -> - dict:store(Functor, {clauses, Nt, lists:keydelete(Ct, 1, Cs)}, Db); - error -> Db %Do nothing - end. + {ok, case dict:find(Functor, Db) of + {ok, built_in} -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + {ok, {code, _}} -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + {ok, {clauses, Nt, Cs}} -> + dict:store(Functor, {clauses, Nt, lists:keydelete(Ct, 1, Cs)}, Db); + error -> Db %Do nothing + end}. abolish_clauses(Db, Functor) -> - case dict:find(Functor, Db) of - {ok, built_in} -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); - {ok, {code, _}} -> dict:erase(Functor, Db); - {ok, {clauses, _, _}} -> dict:erase(Functor, Db); - error -> Db %Do nothing - end. + {ok, case dict:find(Functor, Db) of + {ok, built_in} -> + erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + {ok, {code, _}} -> dict:erase(Functor, Db); + {ok, {clauses, _, _}} -> dict:erase(Functor, Db); + error -> Db %Do nothing + end}. get_procedure(Db, Functor) -> - case dict:find(Functor, Db) of - {ok, built_in} -> built_in; %A built-in - {ok, {code, {_M, _F}} = P} -> P; %Compiled (perhaps someday) - {ok, {clauses, _T, Cs}} -> {clauses, Cs}; %Interpreted clauses - error -> undefined %Undefined - end. + {case dict:find(Functor, Db) of + {ok, built_in} -> built_in; %A built-in + {ok, {code, {_M, _F}} = P} -> P; %Compiled (perhaps someday) + {ok, {clauses, _T, Cs}} -> {clauses, Cs}; %Interpreted clauses + error -> undefined %Undefined + end, Db}. get_procedure_type(Db, Functor) -> - case dict:find(Functor, Db) of - {ok, built_in} -> built_in; %A built-in - {ok, {code, _}} -> compiled; %Compiled (perhaps someday) - {ok, {clauses, _, _}} -> interpreted; %Interpreted clauses - error -> undefined %Undefined - end. + {case dict:find(Functor, Db) of + {ok, built_in} -> built_in; %A built-in + {ok, {code, _}} -> compiled; %Compiled (perhaps someday) + {ok, {clauses, _, _}} -> interpreted; %Interpreted clauses + error -> undefined %Undefined + end, Db}. get_interp_functors(Db) -> - dict:fold(fun(_Func, built_in, Fs) -> Fs; + {dict:fold(fun(_Func, built_in, Fs) -> Fs; (Func, {code, _}, Fs) -> [Func | Fs]; (Func, {clauses, _, _}, Fs) -> [Func | Fs] - end, [], Db). + end, [], Db), Db}. clause(Head, Body0, Db, ClauseFun) -> - {Functor, Body} = case catch {ok, erlog_core:functor(Head), - erlog_core:well_form_body(Body0, false, sture)} of + {Functor, Body} = case catch {ok, erlog_core:functor(Head), erlog_core:well_form_body(Body0, false, sture)} of {erlog_error, E} -> erlog_errors:erlog_error(E, Db); {ok, F, B} -> {F, B} end, diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 1a97a9c..41b7a9e 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -41,13 +41,15 @@ assertz_clause(Db, {Head, Body0}) -> clause(Head, Body0, Db, fun(Functor, Tag, Cs, Body) -> ets:insert(Db, {Functor, clauses, Tag + 1, Cs ++ [{Tag, Head, Body}]}) - end). + end), + {ok, Db}. asserta_clause(Db, {Head, Body0}) -> clause(Head, Body0, Db, fun(Functor, Tag, Cs, Body) -> ets:insert(Db, {Functor, clauses, Tag + 1, [{Tag, Head, Body} | Cs]}) - end). + end), + {ok, Db}. retract_clause(Db, {Functor, Ct}) -> case ets:lookup(Db, Functor) of @@ -58,7 +60,8 @@ retract_clause(Db, {Functor, Ct}) -> [{_, clauses, Nt, Cs}] -> ets:insert(Db, {Functor, clauses, Nt, lists:keydelete(Ct, 1, Cs)}); [] -> ok %Do nothing - end. + end, + {ok, Db}. abolish_clauses(Db, Functor) -> case ets:lookup(Db, Functor) of @@ -67,29 +70,30 @@ abolish_clauses(Db, Functor) -> [{_, code, _}] -> ets:delete(Db, Functor); [{_, clauses, _, _}] -> ets:delete(Db, Functor); [] -> ok %Do nothing - end. + end, + {ok, Db}. get_procedure(Db, Functor) -> - case ets:lookup(Db, Functor) of - [{_, built_in}] -> built_in; - [{_, code, C}] -> {code, C}; - [{_, clauses, _, Cs}] -> {clauses, Cs}; - [] -> undefined - end. + {case ets:lookup(Db, Functor) of + [{_, built_in}] -> built_in; + [{_, code, C}] -> {code, C}; + [{_, clauses, _, Cs}] -> {clauses, Cs}; + [] -> undefined + end, Db}. get_procedure_type(Db, Functor) -> - case ets:lookup(Db, Functor) of - [{_, built_in}] -> built_in; %A built-in - [{_, code, _C}] -> compiled; %Compiled (perhaps someday) - [{_, clauses, _, _Cs}] -> interpreted; %Interpreted clauses - [] -> undefined %Undefined - end. + {case ets:lookup(Db, Functor) of + [{_, built_in}] -> built_in; %A built-in + [{_, code, _C}] -> compiled; %Compiled (perhaps someday) + [{_, clauses, _, _Cs}] -> interpreted; %Interpreted clauses + [] -> undefined %Undefined + end, Db}. get_interp_functors(Db) -> - ets:foldl(fun({_, built_in}, Fs) -> Fs; + {ets:foldl(fun({_, built_in}, Fs) -> Fs; ({Func, code, _}, Fs) -> [Func | Fs]; ({Func, clauses, _, _}, Fs) -> [Func | Fs] - end, [], Db). + end, [], Db), Db}. clause(Head, Body0, Db, ClauseFun) -> {Functor, Body} = case catch {ok, erlog_core:functor(Head), erlog_core:well_form_body(Body0, false, sture)} of diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl index 76adf1e..321b0a8 100644 --- a/src/storage/erlog_storage.erl +++ b/src/storage/erlog_storage.erl @@ -9,20 +9,20 @@ -module(erlog_storage). -author("tihon"). --callback add_built_in(State, Functor) -> {ok, NewState} | {error, Reason}. +-callback add_built_in(State :: term(), Functor :: term()) -> {ok, NewState :: term()}. --callback add_compiled_proc(State, {Functor, M, F}) -> {ok, NewState} | {error, Reason}. +-callback add_compiled_proc(State :: term(), Param :: term()) -> {ok, NewState :: term()}. --callback assertz_clause(State, {Head, Body}) -> {ok, NewState} | {error, Reason}. +-callback assertz_clause(State :: term(), Param :: term()) -> {ok, NewState :: term()}. --callback asserta_clause(State, {Head, Body}) -> {ok, NewState} | {error, Reason}. +-callback asserta_clause(State :: term(), Param :: term()) -> {ok, NewState :: term()}. --callback retract_clause(State, {F, Ct}) -> {ok, NewState} | {error, Reason}. +-callback retract_clause(State :: term(), Param :: term()) -> {ok, NewState :: term()}. --callback abolish_clauses(State, Func) -> {ok, NewState} | {error, Reason}. +-callback abolish_clauses(State :: term(), Func :: term()) -> {ok, NewState :: term()}. --callback get_procedure(State, Func) -> {atom, NewState} | {term(), NewState} | {error, Reason}. +-callback get_procedure(State :: term(), Func :: term()) -> {atom, NewState :: term()} | {term(), NewState :: term()}. --callback get_procedure_type(State, Func) -> {atom(), NewState} | {error, Reason}. +-callback get_procedure_type(State :: term(), Func :: term()) -> {atom(), NewState :: term()}. --callback get_interp_functors(State) -> {list(), NewState} | {error, Reason}. \ No newline at end of file +-callback get_interp_functors(State :: term()) -> {list(), NewState :: term()}. \ No newline at end of file From b58d2d1f77fe6706634a31c7c856911f9fb1416a Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 20 Jun 2014 15:47:06 +0000 Subject: [PATCH 021/251] fix errors and update docs --- README.md | 9 ++++++++- src/core/erlog.erl | 16 +++++++--------- src/core/erlog_core.erl | 9 ++++----- src/storage/erlog_dict.erl | 5 ++++- src/storage/erlog_ets.erl | 5 ++++- src/storage/erlog_memory.erl | 19 +++++++++++-------- src/storage/erlog_storage.erl | 3 +++ 7 files changed, 41 insertions(+), 25 deletions(-) diff --git a/README.md b/README.md index ae7d314..e10cc23 100644 --- a/README.md +++ b/README.md @@ -24,4 +24,11 @@ Process prolog terms, using your core: erlog:execute(Worker, Command). Where: `Command` is a command, ended with dot, -`Worker` is a pid of your prolog logic core. \ No newline at end of file +`Worker` is a pid of your prolog logic core. + +#### Custom database server: +Erlog now supports using your own database, instead of using ets and dicts. Just implement `erlog_storage` callback interface +and pass your module name with your implementation to `erlog:start_link/1`. +Example: + + erlog:start_link(mysql_storage_impl_module). \ No newline at end of file diff --git a/src/core/erlog.erl b/src/core/erlog.erl index a875925..8acb191 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -33,7 +33,7 @@ -include("erlog_int.hrl"). %% Interface to server. --export([start_link/2, start_link/0, execute/2]). +-export([start_link/1, start_link/0, execute/2]). %% Gen server callbacs. -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). @@ -51,16 +51,16 @@ execute(Worker, Command) -> gen_server:call(Worker, {execute, Command}). start_link() -> gen_server:start_link(?MODULE, [], []). --spec start_link(Database :: atom(), State :: term()) -> pid(). -start_link(Database, State) -> - gen_server:start_link(?MODULE, [Database, State], []). +-spec start_link(Database :: atom()) -> pid(). +start_link(Database) -> + gen_server:start_link(?MODULE, [Database], []). init([]) -> % use built in database - {ok, Db} = erlog_memory:start_link(erlog_ets, undefined), %default database is ets module + {ok, Db} = erlog_memory:start_link(erlog_ets), %default database is ets module load_built_in(Db), {ok, #state{db = Db}}; -init([Database, State]) -> % use custom database implementation - {ok, Db} = erlog_memory:start_link(Database, State), +init(Database) -> % use custom database implementation + {ok, Db} = erlog_memory:start_link(Database), load_built_in(Db), {ok, #state{db = Db}}. @@ -122,7 +122,6 @@ preprocess_command({ok, Command}, State) when is_list(Command) -> {erlog_io:format_error([Message]), NewState1} end; preprocess_command({ok, Command}, State) -> - io:format("prove command ~p~n", [Command]), {Res, NewState} = process_command({prove, Command}, State), {erlog_logic:shell_prove_result(Res), NewState}; preprocess_command({error, {_, Em, E}}, State) -> {erlog_io:format_error([Em:format_error(E)]), State}; @@ -161,7 +160,6 @@ process_command(halt, State) -> %% @private prove_goal(Goal0, State = #state{db = Db}) -> - io:format("db = ~p~n", [Db]), Vs = erlog_logic:vars_in(Goal0), %% Goal may be a list of goals, ensure proper goal. Goal1 = erlog_logic:unlistify(Goal0), diff --git a/src/core/erlog_core.erl b/src/core/erlog_core.erl index 359633b..bc774d1 100644 --- a/src/core/erlog_core.erl +++ b/src/core/erlog_core.erl @@ -144,13 +144,13 @@ prove_goal_clauses/7, pred_ind/1, well_form_body/3, - deref_list/2]). + deref_list/2, unify_prove_body/7, dderef/2]). %% Bindings, unification and dereferncing. -export([functor/1]). %% Creating term and body instances. -export([term_instance/2]). %% Adding to database. --export([load/1]). %TODO? +-export([load/1]). %% built_in_db(Db) -> Database. %% Create an initial clause database containing the built-in @@ -253,7 +253,7 @@ dderef_list({V}, Bs) -> dderef_list(Other, _Bs) -> erlog_errors:type_error(list, Other). %% make_vars(Count, VarNum) -> [Var]. -%% Make a list of new variables starting at VarNum. %TODO move me to core? +%% Make a list of new variables starting at VarNum. make_vars(0, _) -> []; make_vars(I, Vn) -> [{Vn} | make_vars(I - 1, Vn + 1)]. @@ -378,7 +378,7 @@ prove_goal({display, T}, Next, Cps, Bs, Vn, Db) -> prove_body(Next, Cps, Bs, Vn, Db); %% Now look up the database. prove_goal(G, Next, Cps, Bs, Vn, Db) -> - %%io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), +%% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), case catch erlog_memory:get_procedure(Db, functor(G)) of built_in -> erlog_bips:prove_goal(G, Next, Cps, Bs, Vn, Db); {code, {Mod, Func}} -> Mod:Func(G, Next, Cps, Bs, Vn, Db); @@ -424,7 +424,6 @@ cut(Label, Last, Next, [_Cp | Cps], Bs, Vn, Db) -> %% check_goal(Goal, Next, Bindings, Database, CutAfter, CutLabel) -> %% {WellFormedBody,HasCut}. %% Check to see that Goal is bound and ensure that it is well-formed. - check_goal(G0, Next, Bs, Db, Cut, Label) -> case dderef(G0, Bs) of {_} -> erlog_errors:instantiation_error(Db); %Must have something to call diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 213655f..0fe927d 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -12,7 +12,8 @@ -behaviour(erlog_storage). %% erlog callbacks --export([add_built_in/2, +-export([new/0, + add_built_in/2, add_compiled_proc/2, assertz_clause/2, asserta_clause/2, @@ -25,6 +26,8 @@ %% API -export([]). +new() -> dict:new(). + add_built_in(Db, Functor) -> {ok, dict:store(Functor, built_in, Db)}. diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 41b7a9e..77711ff 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -14,7 +14,8 @@ -include("erlog_int.hrl"). %% erlog callbacks --export([add_built_in/2, +-export([new/0, + add_built_in/2, add_compiled_proc/2, assertz_clause/2, asserta_clause/2, @@ -24,6 +25,8 @@ get_procedure_type/2, get_interp_functors/1]). +new() -> ets:new(eets, []). + add_built_in(Db, Functor) -> true = ets:insert(Db, {Functor, built_in}), {ok, Db}. diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 57b350a..d5b486a 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -14,7 +14,7 @@ -include("erlog_int.hrl"). %% API --export([start_link/2, add_compiled_proc/2, assertz_clause/3, asserta_clause/3, +-export([start_link/1, add_compiled_proc/2, assertz_clause/3, asserta_clause/3, retract_clause/3, abolish_clauses/2, get_procedure/2, get_procedure_type/2, get_interp_functors/1, assertz_clause/2, asserta_clause/2]). @@ -55,7 +55,9 @@ retract_clause(Database, F, Ct) -> gen_server:call(Database, {retract_clause, {F abolish_clauses(Database, Func) -> gen_server:call(Database, {abolish_clauses, Func}). -get_procedure(Database, Func) -> gen_server:call(Database, {get_procedure, Func}). +get_procedure(Database, Func) -> io:format("get_procedure, functor = ~p~n", [Func]), + io:format("Database ~p~n", [Database]), + gen_server:call(Database, {get_procedure, Func}). get_procedure_type(Database, Func) -> gen_server:call(Database, {get_procedure_type, Func}). @@ -67,10 +69,10 @@ get_interp_functors(Database) -> gen_server:call(Database, get_interp_functors). %% %% @end %%-------------------------------------------------------------------- --spec(start_link(Database :: atom(), State :: term()) -> +-spec(start_link(Database :: atom()) -> {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). -start_link(Database, State) -> - gen_server:start_link(?MODULE, [Database, State], []). +start_link(Database) -> + gen_server:start_link(?MODULE, [Database], []). %%%=================================================================== %%% gen_server callbacks @@ -90,7 +92,8 @@ start_link(Database, State) -> -spec(init(Args :: term()) -> {ok, State :: #state{}} | {ok, State :: #state{}, timeout() | hibernate} | {stop, Reason :: term()} | ignore). -init([Database, State]) when is_atom(Database) -> +init([Database]) when is_atom(Database) -> + State = Database:new(), {ok, #state{database = Database, state = State}}. %%-------------------------------------------------------------------- @@ -108,8 +111,8 @@ init([Database, State]) when is_atom(Database) -> {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | {stop, Reason :: term(), NewState :: #state{}}). -handle_call({Fun, Params}, _From, State = #state{state = State, database = Database}) -> - {Res, NewState} = Database:Fun(State, Params), +handle_call({Fun, Params}, _From, State = #state{state = DbState, database = Database}) -> + {Res, NewState} = Database:Fun(DbState, Params), {reply, Res, State#state{state = NewState}}; handle_call(Fun, _From, State = #state{state = State, database = Database}) -> {Res, NewState} = Database:Fun(State), diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl index 321b0a8..c16b878 100644 --- a/src/storage/erlog_storage.erl +++ b/src/storage/erlog_storage.erl @@ -9,6 +9,9 @@ -module(erlog_storage). -author("tihon"). + +-callback new() -> {ok, State :: term()}. + -callback add_built_in(State :: term(), Functor :: term()) -> {ok, NewState :: term()}. -callback add_compiled_proc(State :: term(), Param :: term()) -> {ok, NewState :: term()}. From 7f711a65794797922ac862dc434dd6cc500d60f8 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 20 Jun 2014 19:24:30 +0000 Subject: [PATCH 022/251] improve docs, fix erlang-erlang commands --- README.md | 12 +++++++++++- src/core/erlog.erl | 12 +++++++++++- src/storage/erlog_memory.erl | 4 +--- 3 files changed, 23 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index e10cc23..5328fae 100644 --- a/README.md +++ b/README.md @@ -24,7 +24,17 @@ Process prolog terms, using your core: erlog:execute(Worker, Command). Where: `Command` is a command, ended with dot, -`Worker` is a pid of your prolog logic core. +`Worker` is a pid of your prolog logic core. +Full Example: + + (erlog@127.0.0.1)1> {ok, Pid} = erlog:start_link(). + {ok,<0.961.0>} + (erlog@127.0.0.1)2> erlog:execute(Pid, "assert(father('victor', 'andrey'))."). + <<"Yes">> + (erlog@127.0.0.1)3> erlog:execute(Pid, "father('victor', 'andrey')."). + <<"Yes">> + (erlog@127.0.0.1)4> erlog:execute(Pid, "father('victor', 'vasya')."). + <<"No">> #### Custom database server: Erlog now supports using your own database, instead of using ets and dicts. Just implement `erlog_storage` callback interface diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 8acb191..2a1b1cf 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -45,7 +45,7 @@ state = normal :: normal | list() %state for solution selecting. atom or list of params. }). -execute(Worker, Command) -> gen_server:call(Worker, {execute, Command}). +execute(Worker, Command) -> gen_server:call(Worker, {execute, trim_command(Command)}). -spec start_link() -> pid(). start_link() -> @@ -65,6 +65,8 @@ init(Database) -> % use custom database implementation {ok, #state{db = Db}}. handle_call({execute, Command}, _From, State = #state{state = normal}) -> %in normal mode + + {Res, NewState} = case erlog_scan:tokens([], Command, 1) of {done, Result, _Rest} -> run_command(Result, State); % command is finished, run. {more, _} -> {ok, more} % unfinished command. Ask for ending. @@ -169,4 +171,12 @@ prove_goal(Goal0, State = #state{db = Db}) -> {succeed, Res, Args} -> %TODO Args? {{succeed, Res}, State}; OtherRes -> {OtherRes, State#state{state = normal}} + end. + +%% @private +%% Adds "\r\n" to command. We need this, as erlog_scan reply more on commands without such ending +trim_command(Command) -> + case lists:suffix([13, 10], Command) of + true -> Command; + _ -> lists:append(Command, [13, 10]) end. \ No newline at end of file diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index d5b486a..65680bc 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -55,9 +55,7 @@ retract_clause(Database, F, Ct) -> gen_server:call(Database, {retract_clause, {F abolish_clauses(Database, Func) -> gen_server:call(Database, {abolish_clauses, Func}). -get_procedure(Database, Func) -> io:format("get_procedure, functor = ~p~n", [Func]), - io:format("Database ~p~n", [Database]), - gen_server:call(Database, {get_procedure, Func}). +get_procedure(Database, Func) -> gen_server:call(Database, {get_procedure, Func}). get_procedure_type(Database, Func) -> gen_server:call(Database, {get_procedure_type, Func}). From fce86b5ca8410f004ce753e898f585a3023852f7 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 21 Jun 2014 01:05:36 +0000 Subject: [PATCH 023/251] made selecting result --- src/core/erlog.erl | 45 +++++++++++++++++++++++------------------ src/core/erlog_core.erl | 1 - 2 files changed, 25 insertions(+), 21 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 2a1b1cf..91a6ec7 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -42,7 +42,7 @@ -record(state, { db, %database - state = normal :: normal | list() %state for solution selecting. atom or list of params. + state = normal :: normal | list() %state for solution selecting. }). execute(Worker, Command) -> gen_server:call(Worker, {execute, trim_command(Command)}). @@ -65,16 +65,21 @@ init(Database) -> % use custom database implementation {ok, #state{db = Db}}. handle_call({execute, Command}, _From, State = #state{state = normal}) -> %in normal mode - - - {Res, NewState} = case erlog_scan:tokens([], Command, 1) of - {done, Result, _Rest} -> run_command(Result, State); % command is finished, run. - {more, _} -> {ok, more} % unfinished command. Ask for ending. - end, + {Res, UpdateState} = case erlog_scan:tokens([], Command, 1) of + {done, Result, _Rest} -> run_command(Result, State); % command is finished, run. + {more, _} -> {{ok, more}, State} % unfinished command. Ask for ending. + end, + NewState = case Res of % change state, depending on reply + {_, select} -> UpdateState; + _ -> UpdateState#state{state = normal} + end, {reply, Res, NewState}; handle_call({execute, Command}, _From, State) -> %in selection solutions mode - {Res, NewState} = preprocess_command({select, Command}, State), - {reply, Res, NewState}. + {Reply, NewState} = case preprocess_command({select, Command}, State) of % change state, depending on reply + {{_, select} = Res, UpdatedState} -> {Res, UpdatedState}; + {Res, UpdatedState} -> {Res, UpdatedState#state{state = normal}} + end, + {reply, Reply, NewState}. handle_cast(halt, St) -> {stop, normal, St}. @@ -124,31 +129,32 @@ preprocess_command({ok, Command}, State) when is_list(Command) -> {erlog_io:format_error([Message]), NewState1} end; preprocess_command({ok, Command}, State) -> - {Res, NewState} = process_command({prove, Command}, State), - {erlog_logic:shell_prove_result(Res), NewState}; + {Result, NewState} = process_command({prove, Command}, State), + {erlog_logic:shell_prove_result(Result), NewState}; preprocess_command({error, {_, Em, E}}, State) -> {erlog_io:format_error([Em:format_error(E)]), State}; preprocess_command({select, Value}, State) -> - {Next, State} = process_command(next, State), - {erlog_logic:select_bindings(Value, Next), State}. + {Next, NewState} = process_command(next, State), + {erlog_logic:select_bindings(Value, Next), NewState}. %% @private %% Process command, modify state. Return {Result, NewState} -spec process_command(tuple() | atom(), State :: #state{}) -> tuple(). process_command({prove, Goal}, State) -> prove_goal(Goal, State); -process_command(next, State = #state{state = normal}) -> +process_command(next, State = #state{state = normal}) -> % can't select solution, when not in select mode {fail, State}; process_command(next, State = #state{state = [Vs, Cps], db = Db}) -> - {erlog_logic:prove_result(catch erlog_errors:fail(Cps, Db), Vs), State}; + {Atom, Res, _} = erlog_logic:prove_result(catch erlog_errors:fail(Cps, Db), Vs), + {{Atom, Res}, State}; process_command({consult, File}, State = #state{db = Db}) -> case erlog_file:consult(File, Db) of - {ok, Db1} -> ok; %TODO Db1? + {ok, Db1} -> ok; %TODO remove all Db passing and returning in functions, which do not need db {Err, Error} when Err == erlog_error; Err == error -> {{error, Error}, State} end; process_command({reconsult, File}, State = #state{db = Db}) -> case erlog_file:reconsult(File, Db) of - {ok, Db1} -> ok; %TODO Db1? + {ok, Db1} -> ok; {Err, Error} when Err == erlog_error; Err == error -> {{error, Error}, State} end; @@ -168,9 +174,8 @@ prove_goal(Goal0, State = #state{db = Db}) -> %% Must use 'catch' here as 'try' does not do last-call %% optimisation. case erlog_logic:prove_result(catch erlog_core:prove_goal(Goal1, Db), Vs) of - {succeed, Res, Args} -> %TODO Args? - {{succeed, Res}, State}; - OtherRes -> {OtherRes, State#state{state = normal}} + {succeed, Res, Args} -> {{succeed, Res}, State#state{state = Args}}; + OtherRes -> {OtherRes, State} end. %% @private diff --git a/src/core/erlog_core.erl b/src/core/erlog_core.erl index bc774d1..eab577e 100644 --- a/src/core/erlog_core.erl +++ b/src/core/erlog_core.erl @@ -874,7 +874,6 @@ get_binding({V}, Bs) -> %% Check term for well-formedness as an Erlog term and replace '_' %% variables with unique numbered variables. Error on non-well-formed %% goals. - initial_goal(Goal) -> initial_goal(Goal, new_bindings(), 0). initial_goal({'_'}, Bs, Vn) -> {{Vn}, Bs, Vn + 1}; %Anonymous variable From 3423945703fe08088829e2c09dae10b62fe96068 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 21 Jun 2014 02:15:51 +0000 Subject: [PATCH 024/251] fix solution selecting --- src/core/erlog.erl | 8 +++++--- src/core/erlog_core.erl | 2 +- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 91a6ec7..71101db 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -59,7 +59,7 @@ init([]) -> % use built in database {ok, Db} = erlog_memory:start_link(erlog_ets), %default database is ets module load_built_in(Db), {ok, #state{db = Db}}; -init(Database) -> % use custom database implementation +init([Database]) -> % use custom database implementation {ok, Db} = erlog_memory:start_link(Database), load_built_in(Db), {ok, #state{db = Db}}. @@ -144,8 +144,10 @@ process_command({prove, Goal}, State) -> process_command(next, State = #state{state = normal}) -> % can't select solution, when not in select mode {fail, State}; process_command(next, State = #state{state = [Vs, Cps], db = Db}) -> - {Atom, Res, _} = erlog_logic:prove_result(catch erlog_errors:fail(Cps, Db), Vs), - {{Atom, Res}, State}; + case erlog_logic:prove_result(catch erlog_errors:fail(Cps, Db), Vs) of + {Atom, Res, Args} -> {{Atom, Res}, State#state{state = Args}}; + Other -> {Other, State} + end; process_command({consult, File}, State = #state{db = Db}) -> case erlog_file:consult(File, Db) of {ok, Db1} -> ok; %TODO remove all Db passing and returning in functions, which do not need db diff --git a/src/core/erlog_core.erl b/src/core/erlog_core.erl index eab577e..9c47b1f 100644 --- a/src/core/erlog_core.erl +++ b/src/core/erlog_core.erl @@ -230,7 +230,7 @@ dderef([], _) -> []; dderef([H0 | T0], Bs) -> [dderef(H0, Bs) | dderef(T0, Bs)]; dderef({V} = Var, Bs) -> - case ?BIND:find(V, Bs) of + case ?BIND:find(V, Bs) of %TODO check, why dict instead erlog_storage {ok, T} -> dderef(T, Bs); error -> Var end; From 500b3ecc87ee6cb5a368e1d07064c351aca8e6ce Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 24 Jun 2014 09:00:24 +0000 Subject: [PATCH 025/251] added params passing to erlog_storage impl, update readme --- README.md | 8 ++++++-- src/core/erlog.erl | 13 +++++++------ src/storage/erlog_dict.erl | 4 +++- src/storage/erlog_ets.erl | 4 +++- src/storage/erlog_memory.erl | 9 ++++++++- src/storage/erlog_storage.erl | 3 ++- 6 files changed, 29 insertions(+), 12 deletions(-) diff --git a/README.md b/README.md index 5328fae..aa963d2 100644 --- a/README.md +++ b/README.md @@ -38,7 +38,11 @@ Full Example: #### Custom database server: Erlog now supports using your own database, instead of using ets and dicts. Just implement `erlog_storage` callback interface -and pass your module name with your implementation to `erlog:start_link/1`. +and pass your module name with your implementation to `erlog:start_link/2`. Example: - erlog:start_link(mysql_storage_impl_module). \ No newline at end of file + erlog:start_link(mysql_storage_impl_module, []). +You can pass your parameters to your database implementation: + + erlog:start_link(dbModule, Params). +Where `Params` is a list of your args, need to be passed to `dbModule:new/1` function. \ No newline at end of file diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 71101db..ce2ae06 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -33,7 +33,7 @@ -include("erlog_int.hrl"). %% Interface to server. --export([start_link/1, start_link/0, execute/2]). +-export([start_link/2, start_link/0, execute/2]). %% Gen server callbacs. -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). @@ -51,16 +51,17 @@ execute(Worker, Command) -> gen_server:call(Worker, {execute, trim_command(Comma start_link() -> gen_server:start_link(?MODULE, [], []). --spec start_link(Database :: atom()) -> pid(). -start_link(Database) -> - gen_server:start_link(?MODULE, [Database], []). +%% Database is your callback module. Params will be send to it's new(Params) callback +-spec start_link(Database :: atom(), Params :: list()) -> pid(). +start_link(Database, Params) -> + gen_server:start_link(?MODULE, [Database, Params], []). init([]) -> % use built in database {ok, Db} = erlog_memory:start_link(erlog_ets), %default database is ets module load_built_in(Db), {ok, #state{db = Db}}; -init([Database]) -> % use custom database implementation - {ok, Db} = erlog_memory:start_link(Database), +init([Database, Params]) -> % use custom database implementation + {ok, Db} = erlog_memory:start_link(Database, Params), load_built_in(Db), {ok, #state{db = Db}}. diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 0fe927d..0a27cb5 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -12,7 +12,7 @@ -behaviour(erlog_storage). %% erlog callbacks --export([new/0, +-export([new/0, new/1, add_built_in/2, add_compiled_proc/2, assertz_clause/2, @@ -28,6 +28,8 @@ new() -> dict:new(). +new(_) -> dict:new(). + add_built_in(Db, Functor) -> {ok, dict:store(Functor, built_in, Db)}. diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 77711ff..b3bdafd 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -14,7 +14,7 @@ -include("erlog_int.hrl"). %% erlog callbacks --export([new/0, +-export([new/0, new/1, add_built_in/2, add_compiled_proc/2, assertz_clause/2, @@ -27,6 +27,8 @@ new() -> ets:new(eets, []). +new(_) -> ets:new(eets, []). + add_built_in(Db, Functor) -> true = ets:insert(Db, {Functor, built_in}), {ok, Db}. diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 65680bc..a6393be 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -14,7 +14,7 @@ -include("erlog_int.hrl"). %% API --export([start_link/1, add_compiled_proc/2, assertz_clause/3, asserta_clause/3, +-export([start_link/1, start_link/2, add_compiled_proc/2, assertz_clause/3, asserta_clause/3, retract_clause/3, abolish_clauses/2, get_procedure/2, get_procedure_type/2, get_interp_functors/1, assertz_clause/2, asserta_clause/2]). @@ -71,6 +71,10 @@ get_interp_functors(Database) -> gen_server:call(Database, get_interp_functors). {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). start_link(Database) -> gen_server:start_link(?MODULE, [Database], []). +-spec(start_link(Database :: atom(), Params :: list()) -> + {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). +start_link(Database, Params) -> + gen_server:start_link(?MODULE, [Database, Params], []). %%%=================================================================== %%% gen_server callbacks @@ -92,6 +96,9 @@ start_link(Database) -> {stop, Reason :: term()} | ignore). init([Database]) when is_atom(Database) -> State = Database:new(), + {ok, #state{database = Database, state = State}}; +init([Database, Params]) when is_atom(Database) -> + State = Database:new(Params), {ok, #state{database = Database, state = State}}. %%-------------------------------------------------------------------- diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl index c16b878..2efa30b 100644 --- a/src/storage/erlog_storage.erl +++ b/src/storage/erlog_storage.erl @@ -9,9 +9,10 @@ -module(erlog_storage). -author("tihon"). - -callback new() -> {ok, State :: term()}. +-callback new(Params :: list()) -> {ok, State :: term()}. + -callback add_built_in(State :: term(), Functor :: term()) -> {ok, NewState :: term()}. -callback add_compiled_proc(State :: term(), Param :: term()) -> {ok, NewState :: term()}. From 2dc13466059674b4aee77e3ee6983ac2a96e7fd2 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 25 Jun 2014 02:52:14 +0000 Subject: [PATCH 026/251] fix interfase return new --- .gitignore | 1 + src/storage/erlog_dict.erl | 4 ++-- src/storage/erlog_ets.erl | 4 ++-- src/storage/erlog_memory.erl | 4 ++-- 4 files changed, 7 insertions(+), 6 deletions(-) diff --git a/.gitignore b/.gitignore index 40350db..43ee753 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,4 @@ ebin erlog_scan.erl *.dump rel/erlog +.rebar diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 0a27cb5..4c60096 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -26,9 +26,9 @@ %% API -export([]). -new() -> dict:new(). +new() -> {ok, dict:new()}. -new(_) -> dict:new(). +new(_) -> {ok, dict:new()}. add_built_in(Db, Functor) -> {ok, dict:store(Functor, built_in, Db)}. diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index b3bdafd..9a1021e 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -25,9 +25,9 @@ get_procedure_type/2, get_interp_functors/1]). -new() -> ets:new(eets, []). +new() -> {ok, ets:new(eets, [])}. -new(_) -> ets:new(eets, []). +new(_) -> {ok, ets:new(eets, [])}. add_built_in(Db, Functor) -> true = ets:insert(Db, {Functor, built_in}), diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index a6393be..dc244be 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -95,10 +95,10 @@ start_link(Database, Params) -> {ok, State :: #state{}} | {ok, State :: #state{}, timeout() | hibernate} | {stop, Reason :: term()} | ignore). init([Database]) when is_atom(Database) -> - State = Database:new(), + {ok, State} = Database:new(), {ok, #state{database = Database, state = State}}; init([Database, Params]) when is_atom(Database) -> - State = Database:new(Params), + {ok, State} = Database:new(Params), {ok, #state{database = Database, state = State}}. %%-------------------------------------------------------------------- From 540b1444d6f42c4c367b797dd5dddc2475832707 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 25 Jun 2014 19:17:21 +0000 Subject: [PATCH 027/251] made consulter function passing --- README.md | 19 +++++++++--- src/core/erlog.erl | 38 ++++++++++++++--------- src/{io => interface}/erlog_shell.erl | 0 src/{io => interface}/erlog_shell_sup.erl | 0 src/io/erlog_file.erl | 25 ++++++++------- src/io/erlog_io.erl | 8 ++--- src/storage/erlog_memory.erl | 4 ++- 7 files changed, 57 insertions(+), 37 deletions(-) rename src/{io => interface}/erlog_shell.erl (100%) rename src/{io => interface}/erlog_shell_sup.erl (100%) diff --git a/README.md b/README.md index aa963d2..7463ff7 100644 --- a/README.md +++ b/README.md @@ -38,11 +38,22 @@ Full Example: #### Custom database server: Erlog now supports using your own database, instead of using ets and dicts. Just implement `erlog_storage` callback interface -and pass your module name with your implementation to `erlog:start_link/2`. +and pass your module name with your implementation to `erlog:start_link/1`. Example: - erlog:start_link(mysql_storage_impl_module, []). + Proplist = [{database, mysql_storage_impl_module}], + erlog:start_link(Proplist). You can pass your parameters to your database implementation: - erlog:start_link(dbModule, Params). -Where `Params` is a list of your args, need to be passed to `dbModule:new/1` function. \ No newline at end of file + Proplist = [{database, dbModule}, {arguments, Params}], + erlog:start_link(Proplist). +Where `Params` is a list of your args, need to be passed to `dbModule:new/1` function. + +#### Custom file consulter: +Basic file consulting takes `FileName` as argument and loads file from your filesystem. +But if your production-system needs to consult files from database, of shared filesystem, or something else - you can create +your own function for consulting files and pass it to erlog: + + F = fun(Filename) -> my_hadoop_server:get_file(Filename) end, + Proplist = [{database, dbModule}, {arguments, Params}, {f_consulter, F}], + erlog:start_link(Proplist). \ No newline at end of file diff --git a/src/core/erlog.erl b/src/core/erlog.erl index ce2ae06..19e4ace 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -33,7 +33,7 @@ -include("erlog_int.hrl"). %% Interface to server. --export([start_link/2, start_link/0, execute/2]). +-export([start_link/1, start_link/0, execute/2]). %% Gen server callbacs. -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). @@ -41,7 +41,8 @@ %% Erlang server code. -record(state, { - db, %database + db :: atom(), %database + f_consulter :: fun(), %file consulter state = normal :: normal | list() %state for solution selecting. }). @@ -52,18 +53,25 @@ start_link() -> gen_server:start_link(?MODULE, [], []). %% Database is your callback module. Params will be send to it's new(Params) callback --spec start_link(Database :: atom(), Params :: list()) -> pid(). -start_link(Database, Params) -> - gen_server:start_link(?MODULE, [Database, Params], []). +-spec start_link(Params :: proplists:proplist()) -> pid(). +start_link(Params) -> + gen_server:start_link(?MODULE, Params, []). init([]) -> % use built in database {ok, Db} = erlog_memory:start_link(erlog_ets), %default database is ets module load_built_in(Db), - {ok, #state{db = Db}}; -init([Database, Params]) -> % use custom database implementation - {ok, Db} = erlog_memory:start_link(Database, Params), + F = fun erlog_io:read_file/1, %set default consult function + {ok, #state{db = Db, f_consulter = F}}; +init(Params) -> % use custom database implementation + Database = proplists:get_value(database, Params), + Args = proplists:get_value(arguments, Params), + FileCon = case proplists:get_value(f_consulter, Params) of %get function from params or default + undefined -> fun erlog_io:read_file/1; + Other -> Other + end, + {ok, Db} = erlog_memory:start_link(Database, Args), load_built_in(Db), - {ok, #state{db = Db}}. + {ok, #state{db = Db, f_consulter = FileCon}}. handle_call({execute, Command}, _From, State = #state{state = normal}) -> %in normal mode {Res, UpdateState} = case erlog_scan:tokens([], Command, 1) of @@ -118,9 +126,9 @@ run_command(Command, State) -> %% @private %% Preprocess command -preprocess_command({ok, Command}, State) when is_list(Command) -> +preprocess_command({ok, Command}, State = #state{f_consulter = Fun}) when is_list(Command) -> {{ok, Db0}, NewState1} = process_command(get_db, State), - case erlog_logic:reconsult_files(Command, Db0) of + case erlog_logic:reconsult_files(Command, Db0) of %TODO fun {ok, Db1} -> {{ok, _Db}, NewState2} = process_command({set_db, Db1}, NewState1), {<<"Yes">>, NewState2}; @@ -149,14 +157,14 @@ process_command(next, State = #state{state = [Vs, Cps], db = Db}) -> {Atom, Res, Args} -> {{Atom, Res}, State#state{state = Args}}; Other -> {Other, State} end; -process_command({consult, File}, State = #state{db = Db}) -> - case erlog_file:consult(File, Db) of +process_command({consult, File}, State = #state{db = Db, f_consulter = Fun}) -> + case erlog_file:consult(Fun, File, Db) of %TODO fun {ok, Db1} -> ok; %TODO remove all Db passing and returning in functions, which do not need db {Err, Error} when Err == erlog_error; Err == error -> {{error, Error}, State} end; -process_command({reconsult, File}, State = #state{db = Db}) -> - case erlog_file:reconsult(File, Db) of +process_command({reconsult, File}, State = #state{db = Db, f_consulter = Fun}) -> + case erlog_file:reconsult(Fun, File, Db) of %TODO fun {ok, Db1} -> ok; {Err, Error} when Err == erlog_error; Err == error -> {{error, Error}, State} diff --git a/src/io/erlog_shell.erl b/src/interface/erlog_shell.erl similarity index 100% rename from src/io/erlog_shell.erl rename to src/interface/erlog_shell.erl diff --git a/src/io/erlog_shell_sup.erl b/src/interface/erlog_shell_sup.erl similarity index 100% rename from src/io/erlog_shell_sup.erl rename to src/interface/erlog_shell_sup.erl diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index 81dd64d..b71265c 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -18,7 +18,7 @@ -module(erlog_file). --export([consult/2, reconsult/2]). +-export([consult/3, reconsult/3]). %% consult(File, Database) -> @@ -27,20 +27,15 @@ %% {ok,NewDatabase} | {error,Error} | {erlog_error,Error}. %% Load/reload an Erlog file into the interpreter. Reloading will %% abolish old definitons of clauses. - -consult(File, Db) -> - case erlog_io:read_file(File) of +consult(Fun, File, Db) -> + case Fun(File) of %default is erlog_io:read_file/1 {ok, Terms} -> consult_terms(fun consult_assert/2, Db, Terms); Error -> Error end. -consult_assert(Term0, Db) -> - Term1 = erlog_dcg:expand_term(Term0), - {ok, erlog_memory:assertz_clause(Db, Term1)}. - -reconsult(File, Db0) -> - case erlog_io:read_file(File) of +reconsult(Fun, File, Db0) -> + case Fun(File) of %default is erlog_io:read_file/1 {ok, Terms} -> case consult_terms(fun reconsult_assert/2, {Db0, []}, Terms) of {ok, {Db1, _Seen1}} -> {ok, Db1}; @@ -49,6 +44,12 @@ reconsult(File, Db0) -> Error -> Error end. +%% @private +consult_assert(Term0, Db) -> + Term1 = erlog_dcg:expand_term(Term0), + {ok, erlog_memory:assertz_clause(Db, Term1)}. + +%% @private reconsult_assert(Term0, {Db, Seen}) -> Term1 = erlog_dcg:expand_term(Term0), Func = functor(Term1), @@ -60,6 +61,7 @@ reconsult_assert(Term0, {Db, Seen}) -> {ok, {erlog_memory:assertz_clause(Db, Term1), [Func | Seen]}} end. +%% @private %% consult_terms(InsertFun, Database, Terms) -> %% {ok,NewDatabase} | {erlog_error,Error}. %% Add terms to the database using InsertFun. Ignore directives and @@ -76,5 +78,6 @@ consult_terms(Ifun, Db0, [T | Ts]) -> end; consult_terms(_Ifun, Db, []) -> {ok, Db}. +%% @private functor({':-', H, _B}) -> erlog_core:functor(H); -functor(T) -> erlog_core:functor(T). +functor(T) -> erlog_core:functor(T). \ No newline at end of file diff --git a/src/io/erlog_io.erl b/src/io/erlog_io.erl index 8c67a96..1be8126 100644 --- a/src/io/erlog_io.erl +++ b/src/io/erlog_io.erl @@ -32,6 +32,8 @@ -export([write/1, write/2, write1/1, writeq/1, writeq/2, writeq1/1, write_canonical/1, write_canonical/2, write_canonical1/1]). +-record(ops, {op = false, q = true}). + scan_file(File) -> case file:open(File, [read]) of {ok, Fd} -> @@ -57,7 +59,6 @@ scan_stream(Fd, L0) -> %% read_file(FileName) -> {ok,[Term]} | {error,Error}. %% Read a file containing Prolog terms. This has been taken from 'io' %% but cleaned up using try. - read_file(File) -> case file:open(File, [read]) of {ok, Fd} -> @@ -79,14 +80,11 @@ read_stream(Fd, L0) -> scan_erlog_term(Io, Prompt, Line) -> io:request(Io, {get_until, Prompt, erlog_scan, tokens, [Line]}). --record(ops, {op = false, q = true}). - %% write([IoDevice], Term) -> ok. %% writeq([IoDevice], Term) -> ok. %% write_canonical([IoDevice], Term) -> ok. %% A very simple write function. Does not pretty-print but can handle %% operators. The xxx1 verions return an iolist of the characters. - write(T) -> write(standard_io, T). write(Io, T) -> io:put_chars(Io, write1(T)). @@ -107,7 +105,6 @@ write_canonical1(T) -> write1(T, 1200, #ops{op = false, q = true}). %% write1(Term, Precedence, Ops) -> iolist(). %% The function which does the actual writing. - write1(T, Prec, Ops) when is_atom(T) -> write1_atom(T, Prec, Ops); write1(T, _, _) when is_number(T) -> io_lib:write(T); write1({V}, _, _) when is_integer(V) -> "_" ++ integer_to_list(V); @@ -152,7 +149,6 @@ write1(T, _, _) -> %Else use default Erlang. %% write1_prec(OutString, OpPrecedence, Precedence) -> iolist(). %% Encase OutString with (..) if op precedence higher than %% precedence. - write1_prec(Out, OpP, Prec) when OpP > Prec -> [$(, Out, $)]; write1_prec(Out, _, _) -> Out. diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index dc244be..20a7d98 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -71,8 +71,10 @@ get_interp_functors(Database) -> gen_server:call(Database, get_interp_functors). {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). start_link(Database) -> gen_server:start_link(?MODULE, [Database], []). --spec(start_link(Database :: atom(), Params :: list()) -> +-spec(start_link(Database :: atom(), Params :: list() | atom()) -> {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). +start_link(Database, undefined) -> + start_link(Database); start_link(Database, Params) -> gen_server:start_link(?MODULE, [Database, Params], []). From db7fcc5b4631f88259960c3efcff1e1bb8d4c84e Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 25 Jun 2014 19:19:10 +0000 Subject: [PATCH 028/251] fix mass reconsult --- src/core/erlog.erl | 6 +++--- src/core/erlog_logic.erl | 12 ++++++------ 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 19e4ace..63b0382 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -128,7 +128,7 @@ run_command(Command, State) -> %% Preprocess command preprocess_command({ok, Command}, State = #state{f_consulter = Fun}) when is_list(Command) -> {{ok, Db0}, NewState1} = process_command(get_db, State), - case erlog_logic:reconsult_files(Command, Db0) of %TODO fun + case erlog_logic:reconsult_files(Command, Db0, Fun) of {ok, Db1} -> {{ok, _Db}, NewState2} = process_command({set_db, Db1}, NewState1), {<<"Yes">>, NewState2}; @@ -158,13 +158,13 @@ process_command(next, State = #state{state = [Vs, Cps], db = Db}) -> Other -> {Other, State} end; process_command({consult, File}, State = #state{db = Db, f_consulter = Fun}) -> - case erlog_file:consult(Fun, File, Db) of %TODO fun + case erlog_file:consult(Fun, File, Db) of {ok, Db1} -> ok; %TODO remove all Db passing and returning in functions, which do not need db {Err, Error} when Err == erlog_error; Err == error -> {{error, Error}, State} end; process_command({reconsult, File}, State = #state{db = Db, f_consulter = Fun}) -> - case erlog_file:reconsult(Fun, File, Db) of %TODO fun + case erlog_file:reconsult(Fun, File, Db) of {ok, Db1} -> ok; {Err, Error} when Err == erlog_error; Err == error -> {{error, Error}, State} diff --git a/src/core/erlog_logic.erl b/src/core/erlog_logic.erl index d275cd7..d86a3a1 100644 --- a/src/core/erlog_logic.erl +++ b/src/core/erlog_logic.erl @@ -20,7 +20,7 @@ -include("erlog_int.hrl"). --export([vars_in/1, is_legal_term/1, reconsult_files/2, select_bindings/2, shell_prove_result/1, prove_result/2, unlistify/1]). +-export([vars_in/1, is_legal_term/1, reconsult_files/3, select_bindings/2, shell_prove_result/1, prove_result/2, unlistify/1]). %% @private unlistify([G | Gs]) -> {',', G, unlistify(Gs)}; @@ -38,14 +38,14 @@ prove_result({erlog_error, Error}, _Vs) -> %No new database prove_result({'EXIT', Error}, _Vs) -> {'EXIT', Error}. -reconsult_files([], Db) -> {ok, Db}; -reconsult_files([F | Fs], Db0) -> - case erlog_file:reconsult(F, Db0) of - {ok, Db1} -> reconsult_files(Fs, Db1); +reconsult_files([], Db, _Fun) -> {ok, Db}; +reconsult_files([F | Fs], Db0, Fun) -> + case erlog_file:reconsult(Fun, F, Db0) of + {ok, Db1} -> reconsult_files(Fs, Db1, Fun); {erlog_error, Error} -> {erlog_error, Error}; {error, Error} -> {error, Error} end; -reconsult_files(Other, _Db) -> {error, {type_error, list, Other}}. +reconsult_files(Other, _Db, _Fun) -> {error, {type_error, list, Other}}. shell_prove_result({succeed, Vs}) -> show_bindings(Vs); shell_prove_result(fail) -> <<"No">>; From d0f2350b6d05f00b58da207ff5ec1b6a44f1fe01 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 1 Jul 2014 00:21:23 +0000 Subject: [PATCH 029/251] fix error with unexported functions --- src/core/erlog_core.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/erlog_core.erl b/src/core/erlog_core.erl index 9c47b1f..ae468a4 100644 --- a/src/core/erlog_core.erl +++ b/src/core/erlog_core.erl @@ -144,7 +144,7 @@ prove_goal_clauses/7, pred_ind/1, well_form_body/3, - deref_list/2, unify_prove_body/7, dderef/2]). + deref_list/2, unify_prove_body/7, dderef/2, deref/2, add_binding/3]). %% Bindings, unification and dereferncing. -export([functor/1]). %% Creating term and body instances. From c741698cf4b054b21d18898d982fa12b3673c0e7 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 1 Jul 2014 17:54:45 +0000 Subject: [PATCH 030/251] fix one function clause in preprocess_command when loading a file --- src/core/erlog.erl | 11 ++++++----- src/io/erlog_file.erl | 1 + 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 63b0382..e7cb13d 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -127,9 +127,10 @@ run_command(Command, State) -> %% @private %% Preprocess command preprocess_command({ok, Command}, State = #state{f_consulter = Fun}) when is_list(Command) -> - {{ok, Db0}, NewState1} = process_command(get_db, State), + {Db0, NewState1} = process_command(get_db, State), %TODO remove db passing! + io:format("Reconsult files with command ~p~n", [Command]), case erlog_logic:reconsult_files(Command, Db0, Fun) of - {ok, Db1} -> + {ok, Db1} -> %TODO remove db passing! {{ok, _Db}, NewState2} = process_command({set_db, Db1}, NewState1), {<<"Yes">>, NewState2}; {error, {L, Pm, Pe}} -> @@ -157,15 +158,15 @@ process_command(next, State = #state{state = [Vs, Cps], db = Db}) -> {Atom, Res, Args} -> {{Atom, Res}, State#state{state = Args}}; Other -> {Other, State} end; -process_command({consult, File}, State = #state{db = Db, f_consulter = Fun}) -> +process_command({consult, File}, State = #state{db = Db, f_consulter = Fun}) -> %TODO consult unused? case erlog_file:consult(Fun, File, Db) of {ok, Db1} -> ok; %TODO remove all Db passing and returning in functions, which do not need db {Err, Error} when Err == erlog_error; Err == error -> {{error, Error}, State} end; -process_command({reconsult, File}, State = #state{db = Db, f_consulter = Fun}) -> +process_command({reconsult, File}, State = #state{db = Db, f_consulter = Fun}) -> %TODO reconsult unused? case erlog_file:reconsult(Fun, File, Db) of - {ok, Db1} -> ok; + {ok, Db1} -> ok; %TODO remove db passing! {Err, Error} when Err == erlog_error; Err == error -> {{error, Error}, State} end; diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index b71265c..1e3ef52 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -66,6 +66,7 @@ reconsult_assert(Term0, {Db, Seen}) -> %% {ok,NewDatabase} | {erlog_error,Error}. %% Add terms to the database using InsertFun. Ignore directives and %% queries. +-spec consult_terms(fun(), pid(), list()) -> tuple. consult_terms(Ifun, Db, [{':-', _} | Ts]) -> consult_terms(Ifun, Db, Ts); consult_terms(Ifun, Db, [{'?-', _} | Ts]) -> From 9ab113d563718049043d6fe0b190c25c6601711d Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 2 Jul 2014 00:44:50 +0000 Subject: [PATCH 031/251] fix consulting file error --- src/core/lang/erlog_parse.erl | 11 ++++------- src/io/erlog_file.erl | 2 +- src/io/erlog_io.erl | 12 +++++++++++- 3 files changed, 16 insertions(+), 9 deletions(-) diff --git a/src/core/lang/erlog_parse.erl b/src/core/lang/erlog_parse.erl index 66363d7..54a70ee 100644 --- a/src/core/lang/erlog_parse.erl +++ b/src/core/lang/erlog_parse.erl @@ -312,13 +312,10 @@ infix_op('**') -> {yes, 199, 200, 199}; %xfx 200 infix_op('^') -> {yes, 199, 200, 200}; %xfy 200 infix_op(_Op) -> no. -parse_prolog_term(Commands) -> - case Commands of - {ok, Ts} -> parse(Ts); - {ok, Ts, _} -> parse(Ts); - {error, Se, _} -> {error, Se}; - {eof, _} -> {ok, end_of_file} %Prolog does this - end. +parse_prolog_term({ok, Ts}) -> parse(Ts); +parse_prolog_term({ok, Ts, _}) -> parse(Ts); +parse_prolog_term({error, Se, _}) -> {error, Se}; +parse_prolog_term({eof, _}) -> {ok, end_of_file}. %Prolog does this parse(Ts) -> case erlog_parse:term(Ts) of diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index 1e3ef52..d10275c 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -66,7 +66,7 @@ reconsult_assert(Term0, {Db, Seen}) -> %% {ok,NewDatabase} | {erlog_error,Error}. %% Add terms to the database using InsertFun. Ignore directives and %% queries. --spec consult_terms(fun(), pid(), list()) -> tuple. +-spec consult_terms(fun(), pid(), list()) -> tuple(). consult_terms(Ifun, Db, [{':-', _} | Ts]) -> consult_terms(Ifun, Db, Ts); consult_terms(Ifun, Db, [{'?-', _} | Ts]) -> diff --git a/src/io/erlog_io.erl b/src/io/erlog_io.erl index 1be8126..b0329b9 100644 --- a/src/io/erlog_io.erl +++ b/src/io/erlog_io.erl @@ -75,7 +75,17 @@ read_file(File) -> end. read_stream(Fd, L0) -> - erlog_parse:parse_prolog_term(scan_erlog_term(Fd, '', L0)). + case scan_erlog_term(Fd, '', L0) of + {ok, Toks, L1} -> + case erlog_parse:term(Toks, L0) of + {ok, end_of_file} -> []; %Prolog does this. + {ok, Term} -> + [Term | read_stream(Fd, L1)]; + {error, What} -> throw({error, What}) + end; + {error, Error, _} -> throw({error, Error}); + {eof, _} -> [] + end. scan_erlog_term(Io, Prompt, Line) -> io:request(Io, {get_until, Prompt, erlog_scan, tokens, [Line]}). From b0e4bef3f308d8b800141a549287137870ded47c Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 2 Jul 2014 01:13:27 +0000 Subject: [PATCH 032/251] update readme --- README.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/README.md b/README.md index 7463ff7..ac886c6 100644 --- a/README.md +++ b/README.md @@ -49,6 +49,10 @@ You can pass your parameters to your database implementation: erlog:start_link(Proplist). Where `Params` is a list of your args, need to be passed to `dbModule:new/1` function. +#### Consulting files +To consult files use brakes and filename with path `["/home/prolog_user/prolog_code/examples/family.pl"]`. +__Remember!__ For proper consulting files with default consulter, files should end with empty line! + #### Custom file consulter: Basic file consulting takes `FileName` as argument and loads file from your filesystem. But if your production-system needs to consult files from database, of shared filesystem, or something else - you can create From ef11ef10c8078eac71d5ed0d3299c3e4f76162cf Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 2 Jul 2014 01:55:06 +0000 Subject: [PATCH 033/251] fix files consilting, remove db passing from reconsulting --- src/core/erlog.erl | 26 ++++++++++---------------- src/core/erlog_logic.erl | 9 +++++---- src/io/erlog_file.erl | 28 +++++++++++++++------------- 3 files changed, 30 insertions(+), 33 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index e7cb13d..c336e56 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -66,8 +66,8 @@ init(Params) -> % use custom database implementation Database = proplists:get_value(database, Params), Args = proplists:get_value(arguments, Params), FileCon = case proplists:get_value(f_consulter, Params) of %get function from params or default - undefined -> fun erlog_io:read_file/1; - Other -> Other + undefined -> fun erlog_io:read_file/1; + Other -> Other end, {ok, Db} = erlog_memory:start_link(Database, Args), load_built_in(Db), @@ -126,17 +126,15 @@ run_command(Command, State) -> %% @private %% Preprocess command -preprocess_command({ok, Command}, State = #state{f_consulter = Fun}) when is_list(Command) -> - {Db0, NewState1} = process_command(get_db, State), %TODO remove db passing! +preprocess_command({ok, Command}, State = #state{f_consulter = Fun, db = Db}) when is_list(Command) -> io:format("Reconsult files with command ~p~n", [Command]), - case erlog_logic:reconsult_files(Command, Db0, Fun) of - {ok, Db1} -> %TODO remove db passing! - {{ok, _Db}, NewState2} = process_command({set_db, Db1}, NewState1), - {<<"Yes">>, NewState2}; + case erlog_logic:reconsult_files(Command, Db, Fun) of + ok -> + {<<"Yes">>, State}; {error, {L, Pm, Pe}} -> - {erlog_io:format_error([L, Pm:format_error(Pe)]), NewState1}; + {erlog_io:format_error([L, Pm:format_error(Pe)]), State}; {Error, Message} when Error == error; Error == erlog_error -> - {erlog_io:format_error([Message]), NewState1} + {erlog_io:format_error([Message]), State} end; preprocess_command({ok, Command}, State) -> {Result, NewState} = process_command({prove, Command}, State), @@ -160,20 +158,16 @@ process_command(next, State = #state{state = [Vs, Cps], db = Db}) -> end; process_command({consult, File}, State = #state{db = Db, f_consulter = Fun}) -> %TODO consult unused? case erlog_file:consult(Fun, File, Db) of - {ok, Db1} -> ok; %TODO remove all Db passing and returning in functions, which do not need db + ok -> ok; {Err, Error} when Err == erlog_error; Err == error -> {{error, Error}, State} end; process_command({reconsult, File}, State = #state{db = Db, f_consulter = Fun}) -> %TODO reconsult unused? case erlog_file:reconsult(Fun, File, Db) of - {ok, Db1} -> ok; %TODO remove db passing! + ok -> ok; {Err, Error} when Err == erlog_error; Err == error -> {{error, Error}, State} end; -process_command(get_db, State = #state{db = Db}) -> - {Db, State}; -process_command({set_db, NewDb}, State = #state{db = Db}) -> % set new db, return old - {{ok, Db}, State#state{db = NewDb}}; process_command(halt, State) -> gen_server:cast(self(), halt), {ok, State}. diff --git a/src/core/erlog_logic.erl b/src/core/erlog_logic.erl index d86a3a1..1712f91 100644 --- a/src/core/erlog_logic.erl +++ b/src/core/erlog_logic.erl @@ -38,10 +38,11 @@ prove_result({erlog_error, Error}, _Vs) -> %No new database prove_result({'EXIT', Error}, _Vs) -> {'EXIT', Error}. -reconsult_files([], Db, _Fun) -> {ok, Db}; -reconsult_files([F | Fs], Db0, Fun) -> - case erlog_file:reconsult(Fun, F, Db0) of - {ok, Db1} -> reconsult_files(Fs, Db1, Fun); +-spec reconsult_files(list(), pid(), fun()) -> ok | tuple(). +reconsult_files([], _Db, _Fun) -> ok; +reconsult_files([F | Fs], Db, Fun) -> + case erlog_file:reconsult(Fun, F, Db) of + ok -> reconsult_files(Fs, Db, Fun); {erlog_error, Error} -> {erlog_error, Error}; {error, Error} -> {error, Error} end; diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index d10275c..b47c888 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -27,6 +27,7 @@ %% {ok,NewDatabase} | {error,Error} | {erlog_error,Error}. %% Load/reload an Erlog file into the interpreter. Reloading will %% abolish old definitons of clauses. +-spec consult(fun(), File :: string(), Db :: pid()) -> ok | tuple(). consult(Fun, File, Db) -> case Fun(File) of %default is erlog_io:read_file/1 {ok, Terms} -> @@ -34,11 +35,12 @@ consult(Fun, File, Db) -> Error -> Error end. -reconsult(Fun, File, Db0) -> +-spec reconsult(fun(), File :: string(), Db :: pid()) -> ok | tuple(). +reconsult(Fun, File, Db) -> case Fun(File) of %default is erlog_io:read_file/1 {ok, Terms} -> - case consult_terms(fun reconsult_assert/2, {Db0, []}, Terms) of - {ok, {Db1, _Seen1}} -> {ok, Db1}; + case consult_terms(fun reconsult_assert/2, {Db, []}, Terms) of + ok -> ok; Error -> Error end; Error -> Error @@ -66,18 +68,18 @@ reconsult_assert(Term0, {Db, Seen}) -> %% {ok,NewDatabase} | {erlog_error,Error}. %% Add terms to the database using InsertFun. Ignore directives and %% queries. --spec consult_terms(fun(), pid(), list()) -> tuple(). -consult_terms(Ifun, Db, [{':-', _} | Ts]) -> - consult_terms(Ifun, Db, Ts); -consult_terms(Ifun, Db, [{'?-', _} | Ts]) -> - consult_terms(Ifun, Db, Ts); -consult_terms(Ifun, Db0, [T | Ts]) -> - case catch Ifun(T, Db0) of - {ok, Db1} -> consult_terms(Ifun, Db1, Ts); - {erlog_error, E, _Db1} -> {erlog_error, E}; +-spec consult_terms(fun(), any(), list()) -> ok | tuple(). +consult_terms(Ifun, Params, [{':-', _} | Ts]) -> + consult_terms(Ifun, Params, Ts); +consult_terms(Ifun, Params, [{'?-', _} | Ts]) -> + consult_terms(Ifun, Params, Ts); +consult_terms(Ifun, Params, [Term | Ts]) -> + case catch Ifun(Term, Params) of + {ok, _} -> consult_terms(Ifun, Params, Ts); + {erlog_error, E, _} -> {erlog_error, E}; {erlog_error, E} -> {erlog_error, E} end; -consult_terms(_Ifun, Db, []) -> {ok, Db}. +consult_terms(_, _, []) -> ok. %% @private functor({':-', H, _B}) -> erlog_core:functor(H); From dffe6ad379445b457731cace3f611169347ef4b8 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 4 Jul 2014 01:21:31 +0000 Subject: [PATCH 034/251] fix errors, pass 1 test --- src/core/erlog.erl | 1 - src/core/erlog_core.erl | 30 +++++++++++++++++------------- src/io/erlog_file.erl | 15 ++++++++++----- src/storage/erlog_ets.erl | 2 +- 4 files changed, 28 insertions(+), 20 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index c336e56..c343155 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -127,7 +127,6 @@ run_command(Command, State) -> %% @private %% Preprocess command preprocess_command({ok, Command}, State = #state{f_consulter = Fun, db = Db}) when is_list(Command) -> - io:format("Reconsult files with command ~p~n", [Command]), case erlog_logic:reconsult_files(Command, Db, Fun) of ok -> {<<"Yes">>, State}; diff --git a/src/core/erlog_core.erl b/src/core/erlog_core.erl index ae468a4..0cb6851 100644 --- a/src/core/erlog_core.erl +++ b/src/core/erlog_core.erl @@ -175,9 +175,9 @@ prove_goal(Goal0, Db) -> %% Prove the goals in a body. Remove the first goal and try to prove %% it. Return when there are no more goals. This is how proving a %% goal/body succeeds. -prove_body([G | Gs], Cps, Bs0, Vn0, Db0) -> +prove_body([G | Gs], Cps, Bs0, Vn0, Db) -> %%io:fwrite("PB: ~p\n", [{G,Gs,Cps}]), - prove_goal(G, Gs, Cps, Bs0, Vn0, Db0); + prove_goal(G, Gs, Cps, Bs0, Vn0, Db); prove_body([], Cps, Bs, Vn, Db) -> %%io:fwrite("Cps: ~p\nCut: ~p\nVar: ~p\nVar: ~p\n", %% [get(erlog_cps),get(erlog_cut),get(erlog_var),dict:size(Bs)]), @@ -202,7 +202,7 @@ unify_prove_body(A1, B1, A2, B2, Next, Cps, Bs0, Vn, Db) -> fail -> ?FAIL(Bs0, Cps, Db) end. -%% deref(Term, Bindings) -> Term. %TODO ets and others? +%% deref(Term, Bindings) -> Term. %% Dereference a variable, else just return the term. deref({V} = T0, Bs) -> case ?BIND:find(V, Bs) of @@ -322,18 +322,22 @@ prove_goal(repeat, Next, Cps, Bs, Vn, Db) -> prove_goal({abolish, Pi0}, Next, Cps, Bs, Vn, Db) -> case dderef(Pi0, Bs) of {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> - prove_body(Next, Cps, Bs, Vn, Db:abolish_clauses({N, A}, Db)); + erlog_memory:abolish_clauses(Db, {N, A}), + prove_body(Next, Cps, Bs, Vn, Db); Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) end; prove_goal({assert, C0}, Next, Cps, Bs, Vn, Db) -> C = dderef(C0, Bs), - prove_body(Next, Cps, Bs, Vn, erlog_memory:assertz_clause(Db, C)); + erlog_memory:assertz_clause(Db, C), + prove_body(Next, Cps, Bs, Vn, Db); prove_goal({asserta, C0}, Next, Cps, Bs, Vn, Db) -> C = dderef(C0, Bs), - prove_body(Next, Cps, Bs, Vn, erlog_memory:asserta_clause(Db, C)); + erlog_memory:asserta_clause(Db, C), + prove_body(Next, Cps, Bs, Vn, Db); prove_goal({assertz, C0}, Next, Cps, Bs, Vn, Db) -> C = dderef(C0, Bs), - prove_body(Next, Cps, Bs, Vn, erlog_memory:assertz_clause(Db, C)); + erlog_memory:assertz_clause(Db, C), + prove_body(Next, Cps, Bs, Vn, Db); prove_goal({retract, C0}, Next, Cps, Bs, Vn, Db) -> C = dderef(C0, Bs), prove_retract(C, Next, Cps, Bs, Vn, Db); @@ -505,7 +509,7 @@ prove_current_predicate(Pi, Next, Cps, Bs, Vn, Db) -> {_} -> ok; Other -> erlog_errors:type_error(predicate_indicator, Other) end, - Fs = Db:get_interp_functors(Db), + Fs = erlog_memory:get_interp_functors(Db), prove_predicates(Pi, Fs, Next, Cps, Bs, Vn, Db). prove_predicates(Pi, [F | Fs], Next, Cps, Bs, Vn, Db) -> @@ -564,7 +568,7 @@ prove_retract(H, Next, Cps, Bs, Vn, Db) -> prove_retract(H, B, Next, Cps, Bs, Vn, Db) -> Functor = functor(H), - case Db:get_procedure(Functor, Db) of + case erlog_memory:get_procedure(Db, Functor) of {clauses, Cs} -> retract_clauses(H, B, Cs, Next, Cps, Bs, Vn, Db); {code, _} -> erlog_errors:permission_error(modify, static_procedure, pred_ind(Functor), Db); @@ -577,14 +581,14 @@ prove_retract(H, B, Next, Cps, Bs, Vn, Db) -> %% void. %% Try to retract Head and Body using Clauses which all have the same functor. -retract_clauses(Ch, Cb, [C | Cs], Next, Cps, Bs0, Vn0, Db0) -> +retract_clauses(Ch, Cb, [C | Cs], Next, Cps, Bs0, Vn0, Db) -> %TODO foreach vs handmaid recursion? case unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> %% We have found a right clause so now retract it. - Db1 = Db0:retract_clause(functor(Ch), element(1, C), Db0), + erlog_memory:retract_clause(Db, functor(Ch), element(1, C)), Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, - prove_body(Next, [Cp | Cps], Bs1, Vn1, Db1); - fail -> retract_clauses(Ch, Cb, Cs, Next, Cps, Bs0, Vn0, Db0) + prove_body(Next, [Cp | Cps], Bs1, Vn1, Db); + fail -> retract_clauses(Ch, Cb, Cs, Next, Cps, Bs0, Vn0, Db) end; retract_clauses(_Ch, _Cb, [], _Next, Cps, _Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db). diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index b47c888..633ef45 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -47,20 +47,25 @@ reconsult(Fun, File, Db) -> end. %% @private +-spec consult_assert(Term0 :: term(), Db :: pid()) -> {ok, Db :: pid()}. consult_assert(Term0, Db) -> Term1 = erlog_dcg:expand_term(Term0), - {ok, erlog_memory:assertz_clause(Db, Term1)}. + erlog_memory:assertz_clause(Db, Term1), + {ok, Db}. %TODO refactor consult_terms not to pass DB everywhere! %% @private +-spec reconsult_assert(Term0 :: term(), {Db :: pid(), Seen :: list()}) -> {ok, {Db :: pid(), list()}}. reconsult_assert(Term0, {Db, Seen}) -> Term1 = erlog_dcg:expand_term(Term0), Func = functor(Term1), case lists:member(Func, Seen) of true -> - {ok, {erlog_memory:assertz_clause(Db, Term1), Seen}}; + erlog_memory:assertz_clause(Db, Term1), + {ok, {Db, Seen}}; %TODO refactor consult_terms not to pass DB everywhere! false -> erlog_memory:abolish_clauses(Db, Func), - {ok, {erlog_memory:assertz_clause(Db, Term1), [Func | Seen]}} + erlog_memory:assertz_clause(Db, Term1), + {ok, {Db, [Func | Seen]}} end. %% @private @@ -69,13 +74,13 @@ reconsult_assert(Term0, {Db, Seen}) -> %% Add terms to the database using InsertFun. Ignore directives and %% queries. -spec consult_terms(fun(), any(), list()) -> ok | tuple(). -consult_terms(Ifun, Params, [{':-', _} | Ts]) -> +consult_terms(Ifun, Params, [{':-', _} | Ts]) -> %TODO refactor me to make interface for Params unifyed! (or may be lists:foreach will be better this hand made recursion) consult_terms(Ifun, Params, Ts); consult_terms(Ifun, Params, [{'?-', _} | Ts]) -> consult_terms(Ifun, Params, Ts); consult_terms(Ifun, Params, [Term | Ts]) -> case catch Ifun(Term, Params) of - {ok, _} -> consult_terms(Ifun, Params, Ts); + {ok, UpdParams} -> consult_terms(Ifun, UpdParams, Ts); {erlog_error, E, _} -> {erlog_error, E}; {erlog_error, E} -> {erlog_error, E} end; diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 9a1021e..331a3c8 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -45,7 +45,7 @@ add_compiled_proc(Db, {Functor, M, F}) -> assertz_clause(Db, {Head, Body0}) -> clause(Head, Body0, Db, fun(Functor, Tag, Cs, Body) -> - ets:insert(Db, {Functor, clauses, Tag + 1, Cs ++ [{Tag, Head, Body}]}) + ets:insert(Db, {Functor, clauses, Tag + 1, Cs ++ [{Tag, Head, Body}]}), end), {ok, Db}. From f507cdb8e47306530317eb90861457c031366810 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 4 Jul 2014 01:31:38 +0000 Subject: [PATCH 035/251] fix cte --- src/storage/erlog_ets.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 331a3c8..9a1021e 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -45,7 +45,7 @@ add_compiled_proc(Db, {Functor, M, F}) -> assertz_clause(Db, {Head, Body0}) -> clause(Head, Body0, Db, fun(Functor, Tag, Cs, Body) -> - ets:insert(Db, {Functor, clauses, Tag + 1, Cs ++ [{Tag, Head, Body}]}), + ets:insert(Db, {Functor, clauses, Tag + 1, Cs ++ [{Tag, Head, Body}]}) end), {ok, Db}. From 5a62008dcb5755b5d3c904d0c1734e28afcaa22a Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 5 Jul 2014 18:31:30 +0000 Subject: [PATCH 036/251] add consult and reconsult --- include/erlog_int.hrl | 6 +- src/core/erlog.erl | 20 +-- src/core/erlog_core.erl | 251 +++++++++++++++++---------------- src/core/erlog_logic.erl | 2 +- src/core/lang/erlog_bips.erl | 208 +++++++++++++-------------- src/core/lang/erlog_dcg.erl | 10 +- src/core/lang/erlog_errors.erl | 66 ++++----- src/core/lang/erlog_lists.erl | 66 ++++----- 8 files changed, 316 insertions(+), 313 deletions(-) diff --git a/include/erlog_int.hrl b/include/erlog_int.hrl index 87059bb..058f275 100644 --- a/include/erlog_int.hrl +++ b/include/erlog_int.hrl @@ -24,8 +24,6 @@ %% The old is_constant/1 ? -define(IS_CONSTANT(T), (not (is_tuple(T) orelse is_list(T)))). --define(FAIL(Bs, Cps, Db), erlog_errors:fail(Cps, Db)). - %% Define the choice point record -record(cp, {type, label, data, next, bs, vn}). -record(cut, {label, next}). @@ -112,6 +110,8 @@ %% External interface {ecall, 2}, %% Non-standard but useful - {display, 1} + {display, 1}, + %% File utils + {consult, 1} ] ). \ No newline at end of file diff --git a/src/core/erlog.erl b/src/core/erlog.erl index c343155..498b700 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -150,35 +150,23 @@ process_command({prove, Goal}, State) -> prove_goal(Goal, State); process_command(next, State = #state{state = normal}) -> % can't select solution, when not in select mode {fail, State}; -process_command(next, State = #state{state = [Vs, Cps], db = Db}) -> - case erlog_logic:prove_result(catch erlog_errors:fail(Cps, Db), Vs) of +process_command(next, State = #state{state = [Vs, Cps], db = Db, f_consulter = Fcon}) -> + case erlog_logic:prove_result(catch erlog_errors:fail(Cps, Db, Fcon), Vs) of {Atom, Res, Args} -> {{Atom, Res}, State#state{state = Args}}; Other -> {Other, State} end; -process_command({consult, File}, State = #state{db = Db, f_consulter = Fun}) -> %TODO consult unused? - case erlog_file:consult(Fun, File, Db) of - ok -> ok; - {Err, Error} when Err == erlog_error; Err == error -> - {{error, Error}, State} - end; -process_command({reconsult, File}, State = #state{db = Db, f_consulter = Fun}) -> %TODO reconsult unused? - case erlog_file:reconsult(Fun, File, Db) of - ok -> ok; - {Err, Error} when Err == erlog_error; Err == error -> - {{error, Error}, State} - end; process_command(halt, State) -> gen_server:cast(self(), halt), {ok, State}. %% @private -prove_goal(Goal0, State = #state{db = Db}) -> +prove_goal(Goal0, State = #state{db = Db, f_consulter = Fcon}) -> Vs = erlog_logic:vars_in(Goal0), %% Goal may be a list of goals, ensure proper goal. Goal1 = erlog_logic:unlistify(Goal0), %% Must use 'catch' here as 'try' does not do last-call %% optimisation. - case erlog_logic:prove_result(catch erlog_core:prove_goal(Goal1, Db), Vs) of + case erlog_logic:prove_result(catch erlog_core:prove_goal(Goal1, Db, Fcon), Vs) of {succeed, Res, Args} -> {{succeed, Res}, State#state{state = Args}}; OtherRes -> {OtherRes, State} end. diff --git a/src/core/erlog_core.erl b/src/core/erlog_core.erl index 0cb6851..15af238 100644 --- a/src/core/erlog_core.erl +++ b/src/core/erlog_core.erl @@ -135,16 +135,16 @@ unify/3, dderef_list/2, make_vars/2, - prove_goal/2, - unify_prove_body/9, - prove_body/5, - unify_clauses/8, - retract_clauses/8, - prove_predicates/7, - prove_goal_clauses/7, + prove_goal/3, + unify_prove_body/10, + prove_body/6, + unify_clauses/9, + retract_clauses/9, + prove_predicates/8, + prove_goal_clauses/8, pred_ind/1, well_form_body/3, - deref_list/2, unify_prove_body/7, dderef/2, deref/2, add_binding/3]). + deref_list/2, unify_prove_body/8, dderef/2, deref/2, add_binding/3]). %% Bindings, unification and dereferncing. -export([functor/1]). %% Creating term and body instances. @@ -162,23 +162,23 @@ load(Db) -> %% prove_goal(Goal, Database) -> Succeed | Fail. %% This is the main entry point into the interpreter. Check that %% everything is consistent then prove the goal as a call. -prove_goal(Goal0, Db) -> +prove_goal(Goal0, Db, Fcon) -> %% put(erlog_cut, orddict:new()), %% put(erlog_cps, orddict:new()), %% put(erlog_var, orddict:new()), %% Check term and build new instance of term with bindings. {Goal1, Bs, Vn} = initial_goal(Goal0), - prove_body([{call, Goal1}], [], Bs, Vn, Db). + prove_body([{call, Goal1}], [], Bs, Vn, Db, Fcon). %TODO use lists:foldr instead! %% prove_body(Body, ChoicePoints, Bindings, VarNum, Database) -> %% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase}. %% Prove the goals in a body. Remove the first goal and try to prove %% it. Return when there are no more goals. This is how proving a %% goal/body succeeds. -prove_body([G | Gs], Cps, Bs0, Vn0, Db) -> +prove_body([G | Gs], Cps, Bs0, Vn0, Db, Fcon) -> %TODO use lists:foldr instead! %%io:fwrite("PB: ~p\n", [{G,Gs,Cps}]), - prove_goal(G, Gs, Cps, Bs0, Vn0, Db); -prove_body([], Cps, Bs, Vn, Db) -> + prove_goal(G, Gs, Cps, Bs0, Vn0, Db, Fcon); +prove_body([], Cps, Bs, Vn, Db, _) -> %%io:fwrite("Cps: ~p\nCut: ~p\nVar: ~p\nVar: ~p\n", %% [get(erlog_cps),get(erlog_cut),get(erlog_var),dict:size(Bs)]), %%io:fwrite("PB: ~p\n", [Cps]), @@ -187,19 +187,19 @@ prove_body([], Cps, Bs, Vn, Db) -> %% unify_prove_body(Term1, Term2, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Unify Term1 = Term2, on success prove body Next else fail. -unify_prove_body(T1, T2, Next, Cps, Bs0, Vn, Db) -> +unify_prove_body(T1, T2, Next, Cps, Bs0, Vn, Db, Fcon) -> case unify(T1, T2, Bs0) of - {succeed, Bs1} -> prove_body(Next, Cps, Bs1, Vn, Db); - fail -> ?FAIL(Bs0, Cps, Db) + {succeed, Bs1} -> prove_body(Next, Cps, Bs1, Vn, Db, Fcon); + fail -> erlog_errors:fail(Cps, Db, Fcon) end. %% unify_prove_body(A1, B1, A2, B2, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Unify A1 = B1, A2 = B2, on success prove body Next else fail. -unify_prove_body(A1, B1, A2, B2, Next, Cps, Bs0, Vn, Db) -> +unify_prove_body(A1, B1, A2, B2, Next, Cps, Bs0, Vn, Db, Fcon) -> case unify(A1, B1, Bs0) of - {succeed, Bs1} -> unify_prove_body(A2, B2, Next, Cps, Bs1, Vn, Db); - fail -> ?FAIL(Bs0, Cps, Db) + {succeed, Bs1} -> unify_prove_body(A2, B2, Next, Cps, Bs1, Vn, Db, Fcon); + fail -> erlog_errors:fail(Cps, Db, Fcon) end. %% deref(Term, Bindings) -> Term. @@ -268,97 +268,97 @@ make_vars(I, Vn) -> %% Logic and control. Conjunctions are handled in prove_body and true %% has been compiled away. -prove_goal({call, G}, Next0, Cps, Bs, Vn, Db) -> +prove_goal({call, G}, Next0, Cps, Bs, Vn, Db, Fcon) -> %TODO refactor this hell! %% Only add cut CP to Cps if goal contains a cut. Label = Vn, case check_goal(G, Next0, Bs, Db, false, Label) of {Next1, true} -> %% Must increment Vn to avoid clashes!!! Cut = #cut{label = Label}, - prove_body(Next1, [Cut | Cps], Bs, Vn + 1, Db); - {Next1, false} -> prove_body(Next1, Cps, Bs, Vn + 1, Db) + prove_body(Next1, [Cut | Cps], Bs, Vn + 1, Db, Fcon); + {Next1, false} -> prove_body(Next1, Cps, Bs, Vn + 1, Db, Fcon) end; -prove_goal({{cut}, Label, Last}, Next, Cps, Bs, Vn, Db) -> +prove_goal({{cut}, Label, Last}, Next, Cps, Bs, Vn, Db, Fcon) -> %% Cut succeeds and trims back to cut ancestor. - cut(Label, Last, Next, Cps, Bs, Vn, Db); -prove_goal({{disj}, R}, Next, Cps, Bs, Vn, Db) -> + cut(Label, Last, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({{disj}, R}, Next, Cps, Bs, Vn, Db, Fcon) -> %% There is no L here, it has already been prepended to Next. Cp = #cp{type = disjunction, next = R, bs = Bs, vn = Vn}, - prove_body(Next, [Cp | Cps], Bs, Vn, Db); -prove_goal(fail, _Next, Cps, _Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db); -prove_goal({{if_then}, Label}, Next, Cps, Bs, Vn, Db) -> + prove_body(Next, [Cp | Cps], Bs, Vn, Db, Fcon); +prove_goal(fail, _Next, Cps, _Bs, _Vn, Db, Fcon) -> erlog_errors:fail(Cps, Db, Fcon); +prove_goal({{if_then}, Label}, Next, Cps, Bs, Vn, Db, Fcon) -> %% We effetively implement ( C -> T ) with ( C, !, T ) but cuts in %% C are local to C. %% There is no ( C, !, T ) here, it has already been prepended to Next. %%io:fwrite("PG(->): ~p\n", [{Next}]), Cut = #cut{label = Label}, - prove_body(Next, [Cut | Cps], Bs, Vn, Db); -prove_goal({{if_then_else}, Else, Label}, Next, Cps, Bs, Vn, Db) -> + prove_body(Next, [Cut | Cps], Bs, Vn, Db, Fcon); +prove_goal({{if_then_else}, Else, Label}, Next, Cps, Bs, Vn, Db, Fcon) -> %% Need to push a choicepoint to fail back to inside Cond and a cut %% to cut back to before Then when Cond succeeds. #cp{type=if_then_else} %% functions as both as is always removed whatever the outcome. %% There is no ( C, !, T ) here, it has already been prepended to Next. Cp = #cp{type = if_then_else, label = Label, next = Else, bs = Bs, vn = Vn}, %%io:fwrite("PG(->;): ~p\n", [{Next,Else,[Cp|Cps]}]), - prove_body(Next, [Cp | Cps], Bs, Vn, Db); -prove_goal({'\\+', G}, Next0, Cps, Bs, Vn, Db) -> + prove_body(Next, [Cp | Cps], Bs, Vn, Db, Fcon); +prove_goal({'\\+', G}, Next0, Cps, Bs, Vn, Db, Fcon) -> %% We effectively implementing \+ G with ( G -> fail ; true ). Label = Vn, {Next1, _} = check_goal(G, [{{cut}, Label, true}, fail], Bs, Db, true, Label), Cp = #cp{type = if_then_else, label = Label, next = Next0, bs = Bs, vn = Vn}, %%io:fwrite("PG(\\+): ~p\n", [{G1,[Cp|Cps]]), %% Must increment Vn to avoid clashes!!! - prove_body(Next1, [Cp | Cps], Bs, Vn + 1, Db); -prove_goal({{once}, Label}, Next, Cps, Bs, Vn, Db) -> + prove_body(Next1, [Cp | Cps], Bs, Vn + 1, Db, Fcon); +prove_goal({{once}, Label}, Next, Cps, Bs, Vn, Db, Fcon) -> %% We effetively implement once(G) with ( G, ! ) but cuts in %% G are local to G. %% There is no ( G, ! ) here, it has already been prepended to Next. Cut = #cut{label = Label}, - prove_body(Next, [Cut | Cps], Bs, Vn, Db); -prove_goal(repeat, Next, Cps, Bs, Vn, Db) -> + prove_body(Next, [Cut | Cps], Bs, Vn, Db, Fcon); +prove_goal(repeat, Next, Cps, Bs, Vn, Db, Fcon) -> Cp = #cp{type = disjunction, next = [repeat | Next], bs = Bs, vn = Vn}, - prove_body(Next, [Cp | Cps], Bs, Vn, Db); + prove_body(Next, [Cp | Cps], Bs, Vn, Db, Fcon); %% Clause creation and destruction. -prove_goal({abolish, Pi0}, Next, Cps, Bs, Vn, Db) -> +prove_goal({abolish, Pi0}, Next, Cps, Bs, Vn, Db, Fcon) -> case dderef(Pi0, Bs) of {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> erlog_memory:abolish_clauses(Db, {N, A}), - prove_body(Next, Cps, Bs, Vn, Db); + prove_body(Next, Cps, Bs, Vn, Db, Fcon); Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) end; -prove_goal({assert, C0}, Next, Cps, Bs, Vn, Db) -> +prove_goal({assert, C0}, Next, Cps, Bs, Vn, Db, Fcon) -> C = dderef(C0, Bs), erlog_memory:assertz_clause(Db, C), - prove_body(Next, Cps, Bs, Vn, Db); -prove_goal({asserta, C0}, Next, Cps, Bs, Vn, Db) -> + prove_body(Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({asserta, C0}, Next, Cps, Bs, Vn, Db, Fcon) -> C = dderef(C0, Bs), erlog_memory:asserta_clause(Db, C), - prove_body(Next, Cps, Bs, Vn, Db); -prove_goal({assertz, C0}, Next, Cps, Bs, Vn, Db) -> + prove_body(Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({assertz, C0}, Next, Cps, Bs, Vn, Db, Fcon) -> C = dderef(C0, Bs), erlog_memory:assertz_clause(Db, C), - prove_body(Next, Cps, Bs, Vn, Db); -prove_goal({retract, C0}, Next, Cps, Bs, Vn, Db) -> + prove_body(Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({retract, C0}, Next, Cps, Bs, Vn, Db, Fcon) -> C = dderef(C0, Bs), - prove_retract(C, Next, Cps, Bs, Vn, Db); + prove_retract(C, Next, Cps, Bs, Vn, Db, Fcon); %% Clause retrieval and information -prove_goal({clause, H0, B}, Next, Cps, Bs, Vn, Db) -> +prove_goal({clause, H0, B}, Next, Cps, Bs, Vn, Db, Fcon) -> H1 = dderef(H0, Bs), - prove_clause(H1, B, Next, Cps, Bs, Vn, Db); -prove_goal({current_predicate, Pi0}, Next, Cps, Bs, Vn, Db) -> + prove_clause(H1, B, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({current_predicate, Pi0}, Next, Cps, Bs, Vn, Db, Fcon) -> Pi = dderef(Pi0, Bs), - prove_current_predicate(Pi, Next, Cps, Bs, Vn, Db); -prove_goal({predicate_property, H0, P}, Next, Cps, Bs, Vn, Db) -> + prove_current_predicate(Pi, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({predicate_property, H0, P}, Next, Cps, Bs, Vn, Db, Fcon) -> H = dderef(H0, Bs), case catch erlog_memory:get_procedure_type(Db, functor(H)) of - built_in -> unify_prove_body(P, built_in, Next, Cps, Bs, Vn, Db); - compiled -> unify_prove_body(P, compiled, Next, Cps, Bs, Vn, Db); - interpreted -> unify_prove_body(P, interpreted, Next, Cps, Bs, Vn, Db); - undefined -> ?FAIL(Bs, Cps, Db); + built_in -> unify_prove_body(P, built_in, Next, Cps, Bs, Vn, Db, Fcon); + compiled -> unify_prove_body(P, compiled, Next, Cps, Bs, Vn, Db, Fcon); + interpreted -> unify_prove_body(P, interpreted, Next, Cps, Bs, Vn, Db, Fcon); + undefined -> erlog_errors:fail(Cps, Db, Fcon); {erlog_error, E} -> erlog_errors:erlog_error(E, Db) end; %% External interface -prove_goal({ecall, C0, Val}, Next, Cps, Bs, Vn, Db) -> +prove_goal({ecall, C0, Val}, Next, Cps, Bs, Vn, Db, Fcon) -> %% Build the initial call. %%io:fwrite("PG(ecall): ~p\n ~p\n ~p\n", [dderef(C0, Bs),Next,Cps]), Efun = case dderef(C0, Bs) of @@ -374,37 +374,52 @@ prove_goal({ecall, C0, Val}, Next, Cps, Bs, Vn, Db) -> Fun when is_function(Fun) -> Fun; Other -> erlog_errors:type_error(callable, Other, Db) end, - prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db); + prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db, Fcon); %% Non-standard but useful. -prove_goal({display, T}, Next, Cps, Bs, Vn, Db) -> +prove_goal({display, T}, Next, Cps, Bs, Vn, Db, Fcon) -> %% A very simple display procedure. io:fwrite("~p\n", [dderef(T, Bs)]), - prove_body(Next, Cps, Bs, Vn, Db); + prove_body(Next, Cps, Bs, Vn, Db, Fcon); +%% File utils +prove_goal({consult, Name}, Next, Cps, Bs, Vn, Db, Fcon) -> + case erlog_file:consult(Fcon, Name, Db) of + ok -> ok; + {Err, Error} when Err == erlog_error; Err == error -> + erlog_errors:erlog_error(Error, Db) + end, + prove_body(Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({reconsult, Name}, Next, Cps, Bs, Vn, Db, Fcon) -> + case erlog_file:reconsult(Fcon, Name, Db) of + ok -> ok; + {Err, Error} when Err == erlog_error; Err == error -> + erlog_errors:erlog_error(Error, Db) + end, + prove_body(Next, Cps, Bs, Vn, Db, Fcon); %% Now look up the database. -prove_goal(G, Next, Cps, Bs, Vn, Db) -> +prove_goal(G, Next, Cps, Bs, Vn, Db, Fcon) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), case catch erlog_memory:get_procedure(Db, functor(G)) of - built_in -> erlog_bips:prove_goal(G, Next, Cps, Bs, Vn, Db); - {code, {Mod, Func}} -> Mod:Func(G, Next, Cps, Bs, Vn, Db); - {clauses, Cs} -> prove_goal_clauses(G, Cs, Next, Cps, Bs, Vn, Db); - undefined -> ?FAIL(Bs, Cps, Db); + built_in -> erlog_bips:prove_goal(G, Next, Cps, Bs, Vn, Db, Fcon); + {code, {Mod, Func}} -> Mod:Func(G, Next, Cps, Bs, Vn, Db, Fcon); + {clauses, Cs} -> prove_goal_clauses(G, Cs, Next, Cps, Bs, Vn, Db, Fcon); + undefined -> erlog_errors:fail(Cps, Db, Fcon); %% Getting built_in here is an error! {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data end. -cut(Label, Last, Next, [#cut{label = Label} | Cps] = Cps0, Bs, Vn, Db) -> - if Last -> prove_body(Next, Cps, Bs, Vn, Db); - true -> prove_body(Next, Cps0, Bs, Vn, Db) +cut(Label, Last, Next, [#cut{label = Label} | Cps] = Cps0, Bs, Vn, Db, Fcon) -> + if Last -> prove_body(Next, Cps, Bs, Vn, Db, Fcon); + true -> prove_body(Next, Cps0, Bs, Vn, Db, Fcon) end; -cut(Label, Last, Next, [#cp{type = if_then_else, label = Label} | Cps] = Cps0, Bs, Vn, Db) -> - if Last -> prove_body(Next, Cps, Bs, Vn, Db); - true -> prove_body(Next, Cps0, Bs, Vn, Db) +cut(Label, Last, Next, [#cp{type = if_then_else, label = Label} | Cps] = Cps0, Bs, Vn, Db, Fcon) -> + if Last -> prove_body(Next, Cps, Bs, Vn, Db, Fcon); + true -> prove_body(Next, Cps0, Bs, Vn, Db, Fcon) end; -cut(Label, Last, Next, [#cp{type = goal_clauses, label = Label} = Cp | Cps], Bs, Vn, Db) -> - cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db); -cut(Label, Last, Next, [_Cp | Cps], Bs, Vn, Db) -> - cut(Label, Last, Next, Cps, Bs, Vn, Db). +cut(Label, Last, Next, [#cp{type = goal_clauses, label = Label} = Cp | Cps], Bs, Vn, Db, Fcon) -> + cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db, Fcon); +cut(Label, Last, Next, [_Cp | Cps], Bs, Vn, Db, Fcon) -> + cut(Label, Last, Next, Cps, Bs, Vn, Db, Fcon). %% cut(Label, Last, Next, Cps, Bs, Vn, Db) -> %% cut(Label, Last, Next, Cps, Bs, Vn, Db, 1). @@ -443,49 +458,49 @@ check_goal(G0, Next, Bs, Db, Cut, Label) -> %% Call an external (Erlang) generator and handle return value, either %% succeed or fail. -prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db) -> +prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db, Fcon) -> case Efun() of {succeed, Ret, Cont} -> %Succeed and more choices Cp = #cp{type = ecall, data = {Cont, Val}, next = Next, bs = Bs, vn = Vn}, - unify_prove_body(Val, Ret, Next, [Cp | Cps], Bs, Vn, Db); + unify_prove_body(Val, Ret, Next, [Cp | Cps], Bs, Vn, Db, Fcon); {succeed_last, Ret} -> %Succeed but last choice - unify_prove_body(Val, Ret, Next, Cps, Bs, Vn, Db); - fail -> ?FAIL(Bs, Cps, Db) %No more + unify_prove_body(Val, Ret, Next, Cps, Bs, Vn, Db, Fcon); + fail -> erlog_errors:fail(Cps, Db, Fcon) %No more end. %% prove_clause(Head, Body, Next, ChoicePoints, Bindings, VarNum, DataBase) -> %% void. %% Unify clauses matching with functor from Head with both Head and Body. -prove_clause(H, B, Next, Cps, Bs, Vn, Db) -> +prove_clause(H, B, Next, Cps, Bs, Vn, Db, Fcon) -> Functor = functor(H), case erlog_memory:get_procedure(Db, Functor) of - {clauses, Cs} -> unify_clauses(H, B, Cs, Next, Cps, Bs, Vn, Db); + {clauses, Cs} -> unify_clauses(H, B, Cs, Next, Cps, Bs, Vn, Db, Fcon); {code, _} -> erlog_errors:permission_error(access, private_procedure, pred_ind(Functor), Db); built_in -> erlog_errors:permission_error(access, private_procedure, pred_ind(Functor), Db); - undefined -> ?FAIL(Bs, Cps, Db) + undefined -> erlog_errors:fail(Cps, Db, Fcon) end. %% unify_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to unify Head and Body using Clauses which all have the same functor. -unify_clauses(Ch, Cb, [C], Next, Cps, Bs0, Vn0, Db) -> +unify_clauses(Ch, Cb, [C], Next, Cps, Bs0, Vn0, Db, Fcon) -> %% No choice point on last clause case unify_clause(Ch, Cb, C, Bs0, Vn0) of - {succeed, Bs1, Vn1} -> prove_body(Next, Cps, Bs1, Vn1, Db); - fail -> ?FAIL(Bs0, Cps, Db) + {succeed, Bs1, Vn1} -> prove_body(Next, Cps, Bs1, Vn1, Db, Fcon); + fail -> erlog_errors:fail(Cps, Db, Fcon) end; -unify_clauses(Ch, Cb, [C | Cs], Next, Cps, Bs0, Vn0, Db) -> +unify_clauses(Ch, Cb, [C | Cs], Next, Cps, Bs0, Vn0, Db, Fcon) -> case unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> Cp = #cp{type = clause, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, - prove_body(Next, [Cp | Cps], Bs1, Vn1, Db); - fail -> unify_clauses(Ch, Cb, Cs, Next, Cps, Bs0, Vn0, Db) + prove_body(Next, [Cp | Cps], Bs1, Vn1, Db, Fcon); + fail -> unify_clauses(Ch, Cb, Cs, Next, Cps, Bs0, Vn0, Db, Fcon) end; -unify_clauses(_Ch, _Cb, [], _Next, Cps, _Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db). +unify_clauses(_Ch, _Cb, [], _Next, Cps, _Bs, _Vn, Db, Fcon) -> erlog_errors:fail(Cps, Db, Fcon). unify_clause(Ch, Cb, {_Tag, H0, {B0, _}}, Bs0, Vn0) -> {H1, Rs1, Vn1} = term_instance(H0, Vn0), %Unique vars on head first @@ -503,40 +518,40 @@ unify_clause(Ch, Cb, {_Tag, H0, {B0, _}}, Bs0, Vn0) -> %% void. %% Match functors of existing user (interpreted) predicate with PredInd. -prove_current_predicate(Pi, Next, Cps, Bs, Vn, Db) -> +prove_current_predicate(Pi, Next, Cps, Bs, Vn, Db, Fcon) -> case Pi of {'/', _, _} -> ok; {_} -> ok; Other -> erlog_errors:type_error(predicate_indicator, Other) end, Fs = erlog_memory:get_interp_functors(Db), - prove_predicates(Pi, Fs, Next, Cps, Bs, Vn, Db). + prove_predicates(Pi, Fs, Next, Cps, Bs, Vn, Db, Fcon). -prove_predicates(Pi, [F | Fs], Next, Cps, Bs, Vn, Db) -> +prove_predicates(Pi, [F | Fs], Next, Cps, Bs, Vn, Db, Fcon) -> Cp = #cp{type = current_predicate, data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, - unify_prove_body(Pi, pred_ind(F), Next, [Cp | Cps], Bs, Vn, Db); -prove_predicates(_Pi, [], _Next, Cps, _Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db). + unify_prove_body(Pi, pred_ind(F), Next, [Cp | Cps], Bs, Vn, Db, Fcon); +prove_predicates(_Pi, [], _Next, Cps, _Bs, _Vn, Db, Fcon) -> erlog_errors:fail(Cps, Db, Fcon). %% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to prove Goal using Clauses which all have the same functor. -prove_goal_clauses(G, [C], Next, Cps, Bs, Vn, Db) -> +prove_goal_clauses(G, [C], Next, Cps, Bs, Vn, Db, Fcon) -> %% Must be smart here and test whether we need to add a cut point. %% C has the structure {Tag,Head,{Body,BodyHasCut}}. case element(2, element(3, C)) of true -> Cut = #cut{label = Vn}, - prove_goal_clause(G, C, Next, [Cut | Cps], Bs, Vn, Db); + prove_goal_clause(G, C, Next, [Cut | Cps], Bs, Vn, Db, Fcon); false -> - prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db) + prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db, Fcon) end; %% prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db); -prove_goal_clauses(G, [C | Cs], Next, Cps, Bs, Vn, Db) -> +prove_goal_clauses(G, [C | Cs], Next, Cps, Bs, Vn, Db, Fcon) -> Cp = #cp{type = goal_clauses, label = Vn, data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, - prove_goal_clause(G, C, Next, [Cp | Cps], Bs, Vn, Db); -prove_goal_clauses(_G, [], _Next, Cps, _Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db). + prove_goal_clause(G, C, Next, [Cp | Cps], Bs, Vn, Db, Fcon); +prove_goal_clauses(_G, [], _Next, Cps, _Bs, _Vn, Db, Fcon) -> erlog_errors:fail(Cps, Db, Fcon). -prove_goal_clause(G, {_Tag, H0, {B0, _}}, Next, Cps, Bs0, Vn0, Db) -> +prove_goal_clause(G, {_Tag, H0, {B0, _}}, Next, Cps, Bs0, Vn0, Db, Fcon) -> %% io:fwrite("PGC1: ~p\n", [{G,H0,B0}]), Label = Vn0, case unify_head(G, H0, Bs0, Vn0 + 1) of @@ -544,53 +559,53 @@ prove_goal_clause(G, {_Tag, H0, {B0, _}}, Next, Cps, Bs0, Vn0, Db) -> %% io:fwrite("PGC2: ~p\n", [{Rs0}]), {B1, _Rs2, Vn2} = body_instance(B0, Next, Rs0, Vn1, Label), %% io:fwrite("PGC3: ~p\n", [{B1,Next,Cps}]), - prove_body(B1, Cps, Bs1, Vn2, Db); - fail -> ?FAIL(Bs0, Cps, Db) + prove_body(B1, Cps, Bs1, Vn2, Db, Fcon); + fail -> erlog_errors:fail(Cps, Db, Fcon) end. %% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db). -cut_goal_clauses(true, Next, #cp{label = _}, Cps, Bs, Vn, Db) -> +cut_goal_clauses(true, Next, #cp{label = _}, Cps, Bs, Vn, Db, Fcon) -> %% Just remove the choice point completely and continue. - prove_body(Next, Cps, Bs, Vn, Db); -cut_goal_clauses(false, Next, #cp{label = L}, Cps, Bs, Vn, Db) -> + prove_body(Next, Cps, Bs, Vn, Db, Fcon); +cut_goal_clauses(false, Next, #cp{label = L}, Cps, Bs, Vn, Db, Fcon) -> %% Replace choice point with cut point then continue. Cut = #cut{label = L}, - prove_body(Next, [Cut | Cps], Bs, Vn, Db). + prove_body(Next, [Cut | Cps], Bs, Vn, Db, Fcon). %% prove_retract(Clause, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Retract clauses in database matching Clause. -prove_retract({':-', H, B}, Next, Cps, Bs, Vn, Db) -> - prove_retract(H, B, Next, Cps, Bs, Vn, Db); -prove_retract(H, Next, Cps, Bs, Vn, Db) -> - prove_retract(H, true, Next, Cps, Bs, Vn, Db). +prove_retract({':-', H, B}, Next, Cps, Bs, Vn, Db, Fcon) -> + prove_retract(H, B, Next, Cps, Bs, Vn, Db, Fcon); +prove_retract(H, Next, Cps, Bs, Vn, Db, Fcon) -> + prove_retract(H, true, Next, Cps, Bs, Vn, Db, Fcon). -prove_retract(H, B, Next, Cps, Bs, Vn, Db) -> +prove_retract(H, B, Next, Cps, Bs, Vn, Db, Fcon) -> Functor = functor(H), case erlog_memory:get_procedure(Db, Functor) of - {clauses, Cs} -> retract_clauses(H, B, Cs, Next, Cps, Bs, Vn, Db); + {clauses, Cs} -> retract_clauses(H, B, Cs, Next, Cps, Bs, Vn, Db, Fcon); {code, _} -> erlog_errors:permission_error(modify, static_procedure, pred_ind(Functor), Db); built_in -> erlog_errors:permission_error(modify, static_procedure, pred_ind(Functor), Db); - undefined -> ?FAIL(Bs, Cps, Db) + undefined -> erlog_errors:fail(Cps, Db, Fcon) end. %% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to retract Head and Body using Clauses which all have the same functor. -retract_clauses(Ch, Cb, [C | Cs], Next, Cps, Bs0, Vn0, Db) -> %TODO foreach vs handmaid recursion? +retract_clauses(Ch, Cb, [C | Cs], Next, Cps, Bs0, Vn0, Db, Fcon) -> %TODO foreach vs handmaid recursion? case unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> %% We have found a right clause so now retract it. erlog_memory:retract_clause(Db, functor(Ch), element(1, C)), Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, - prove_body(Next, [Cp | Cps], Bs1, Vn1, Db); - fail -> retract_clauses(Ch, Cb, Cs, Next, Cps, Bs0, Vn0, Db) + prove_body(Next, [Cp | Cps], Bs1, Vn1, Db, Fcon); + fail -> retract_clauses(Ch, Cb, Cs, Next, Cps, Bs0, Vn0, Db, Fcon) end; -retract_clauses(_Ch, _Cb, [], _Next, Cps, _Bs, _Vn, Db) -> ?FAIL(_Bs, Cps, Db). +retract_clauses(_Ch, _Cb, [], _Next, Cps, _Bs, _Vn, Db, Fcon) -> erlog_errors:fail(Cps, Db, Fcon). unify_args(_, _, Bs, I, S) when I > S -> {succeed, Bs}; unify_args(S1, S2, Bs0, I, S) -> diff --git a/src/core/erlog_logic.erl b/src/core/erlog_logic.erl index 1712f91..a7abaf0 100644 --- a/src/core/erlog_logic.erl +++ b/src/core/erlog_logic.erl @@ -39,7 +39,7 @@ prove_result({'EXIT', Error}, _Vs) -> {'EXIT', Error}. -spec reconsult_files(list(), pid(), fun()) -> ok | tuple(). -reconsult_files([], _Db, _Fun) -> ok; +reconsult_files([], _Db, _Fun) -> ok; %TODO lists:foldr instead! reconsult_files([F | Fs], Db, Fun) -> case erlog_file:reconsult(Fun, F, Db) of ok -> reconsult_files(Fs, Db, Fun); diff --git a/src/core/lang/erlog_bips.erl b/src/core/lang/erlog_bips.erl index 62b3725..5472d99 100644 --- a/src/core/lang/erlog_bips.erl +++ b/src/core/lang/erlog_bips.erl @@ -25,7 +25,7 @@ %% Main interface functions. -export([load/1]). --export([prove_goal/6]). +-export([prove_goal/7]). %%-compile(export_all). @@ -41,136 +41,136 @@ load(Db) -> %% to NextGoal. %% Term unification and comparison -prove_goal({'=', L, R}, Next, Cps, Bs, Vn, Db) -> - erlog_core:unify_prove_body(L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'\\=', L, R}, Next, Cps, Bs0, Vn, Db) -> +prove_goal({'=', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> + erlog_core:unify_prove_body(L, R, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({'\\=', L, R}, Next, Cps, Bs0, Vn, Db, Fcon) -> case erlog_core:unify(L, R, Bs0) of - {succeed, _Bs1} -> erlog_errors:fail(Cps, Db); - fail -> erlog_core:prove_body(Next, Cps, Bs0, Vn, Db) + {succeed, _Bs1} -> erlog_errors:fail(Cps, Db, Fcon); + fail -> erlog_core:prove_body(Next, Cps, Bs0, Vn, Db, Fcon) end; -prove_goal({'@>', L, R}, Next, Cps, Bs, Vn, Db) -> - term_test_prove_body('>', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'@>=', L, R}, Next, Cps, Bs, Vn, Db) -> - term_test_prove_body('>=', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'==', L, R}, Next, Cps, Bs, Vn, Db) -> - term_test_prove_body('==', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'\\==', L, R}, Next, Cps, Bs, Vn, Db) -> - term_test_prove_body('/=', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'@<', L, R}, Next, Cps, Bs, Vn, Db) -> - term_test_prove_body('<', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'@=<', L, R}, Next, Cps, Bs, Vn, Db) -> - term_test_prove_body('=<', L, R, Next, Cps, Bs, Vn, Db); +prove_goal({'@>', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> + term_test_prove_body('>', L, R, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({'@>=', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> + term_test_prove_body('>=', L, R, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({'==', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> + term_test_prove_body('==', L, R, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({'\\==', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> + term_test_prove_body('/=', L, R, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({'@<', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> + term_test_prove_body('<', L, R, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({'@=<', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> + term_test_prove_body('=<', L, R, Next, Cps, Bs, Vn, Db, Fcon); %% Term creation and decomposition. -prove_goal({arg, I, Ct, A}, Next, Cps, Bs, Vn, Db) -> - prove_arg(erlog_core:deref(I, Bs), erlog_core:deref(Ct, Bs), A, Next, Cps, Bs, Vn, Db); -prove_goal({copy_term, T0, C}, Next, Cps, Bs, Vn0, Db) -> +prove_goal({arg, I, Ct, A}, Next, Cps, Bs, Vn, Db, Fcon) -> + prove_arg(erlog_core:deref(I, Bs), erlog_core:deref(Ct, Bs), A, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({copy_term, T0, C}, Next, Cps, Bs, Vn0, Db, Fcon) -> %% Use term_instance to create the copy, can ignore orddict it creates. {T, _Nbs, Vn1} = erlog_core:term_instance(erlog_core:dderef(T0, Bs), Vn0), - erlog_core:unify_prove_body(T, C, Next, Cps, Bs, Vn1, Db); -prove_goal({functor, T, F, A}, Next, Cps, Bs, Vn, Db) -> - prove_functor(erlog_core:dderef(T, Bs), F, A, Next, Cps, Bs, Vn, Db); -prove_goal({'=..', T, L}, Next, Cps, Bs, Vn, Db) -> - prove_univ(erlog_core:dderef(T, Bs), L, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body(T, C, Next, Cps, Bs, Vn1, Db, Fcon); +prove_goal({functor, T, F, A}, Next, Cps, Bs, Vn, Db, Fcon) -> + prove_functor(erlog_core:dderef(T, Bs), F, A, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({'=..', T, L}, Next, Cps, Bs, Vn, Db, Fcon) -> + prove_univ(erlog_core:dderef(T, Bs), L, Next, Cps, Bs, Vn, Db, Fcon); %% Type testing. -prove_goal({atom, T0}, Next, Cps, Bs, Vn, Db) -> +prove_goal({atom, T0}, Next, Cps, Bs, Vn, Db, Fcon) -> case erlog_core:deref(T0, Bs) of - T when is_atom(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db); - _Other -> erlog_errors:fail(Cps, Db) + T when is_atom(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon); + _Other -> erlog_errors:fail(Cps, Db, Fcon) end; -prove_goal({atomic, T0}, Next, Cps, Bs, Vn, Db) -> +prove_goal({atomic, T0}, Next, Cps, Bs, Vn, Db, Fcon) -> case erlog_core:deref(T0, Bs) of - T when ?IS_ATOMIC(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db); - _Other -> erlog_errors:fail(Cps, Db) + T when ?IS_ATOMIC(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon); + _Other -> erlog_errors:fail(Cps, Db, Fcon) end; -prove_goal({compound, T0}, Next, Cps, Bs, Vn, Db) -> +prove_goal({compound, T0}, Next, Cps, Bs, Vn, Db, Fcon) -> case erlog_core:deref(T0, Bs) of - T when ?IS_ATOMIC(T) -> erlog_errors:fail(Cps, Db); - _Other -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db) + T when ?IS_ATOMIC(T) -> erlog_errors:fail(Cps, Db, Fcon); + _Other -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon) end; -prove_goal({integer, T0}, Next, Cps, Bs, Vn, Db) -> +prove_goal({integer, T0}, Next, Cps, Bs, Vn, Db, Fcon) -> case erlog_core:deref(T0, Bs) of - T when is_integer(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db); - _Other -> erlog_errors:fail(Cps, Db) + T when is_integer(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon); + _Other -> erlog_errors:fail(Cps, Db, Fcon) end; -prove_goal({float, T0}, Next, Cps, Bs, Vn, Db) -> +prove_goal({float, T0}, Next, Cps, Bs, Vn, Db, Fcon) -> case erlog_core:deref(T0, Bs) of - T when is_float(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db); - _Other -> erlog_errors:fail(Cps, Db) + T when is_float(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon); + _Other -> erlog_errors:fail(Cps, Db, Fcon) end; -prove_goal({number, T0}, Next, Cps, Bs, Vn, Db) -> +prove_goal({number, T0}, Next, Cps, Bs, Vn, Db, Fcon) -> case erlog_core:deref(T0, Bs) of - T when is_number(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db); - _Other -> erlog_errors:fail(Cps, Db) + T when is_number(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon); + _Other -> erlog_errors:fail(Cps, Db, Fcon) end; -prove_goal({nonvar, T0}, Next, Cps, Bs, Vn, Db) -> +prove_goal({nonvar, T0}, Next, Cps, Bs, Vn, Db, Fcon) -> case erlog_core:deref(T0, Bs) of - {_} -> erlog_errors:fail(Cps, Db); - _Other -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db) + {_} -> erlog_errors:fail(Cps, Db, Fcon); + _Other -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon) end; -prove_goal({var, T0}, Next, Cps, Bs, Vn, Db) -> +prove_goal({var, T0}, Next, Cps, Bs, Vn, Db, Fcon) -> case erlog_core:deref(T0, Bs) of - {_} -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db); - _Other -> erlog_errors:fail(Cps, Db) + {_} -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon); + _Other -> erlog_errors:fail(Cps, Db, Fcon) end; %% Atom processing. -prove_goal({atom_chars, A, L}, Next, Cps, Bs, Vn, Db) -> - prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db); -prove_goal({atom_length, A0, L0}, Next, Cps, Bs, Vn, Db) -> +prove_goal({atom_chars, A, L}, Next, Cps, Bs, Vn, Db, Fcon) -> + prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({atom_length, A0, L0}, Next, Cps, Bs, Vn, Db, Fcon) -> case erlog_core:dderef(A0, Bs) of A when is_atom(A) -> Alen = length(atom_to_list(A)), %No of chars in atom case erlog_core:dderef(L0, Bs) of L when is_integer(L) -> - erlog_core:unify_prove_body(Alen, L, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body(Alen, L, Next, Cps, Bs, Vn, Db, Fcon); {_} = Var -> - erlog_core:unify_prove_body(Alen, Var, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body(Alen, Var, Next, Cps, Bs, Vn, Db, Fcon); Other -> erlog_errors:type_error(integer, Other, Db) end; {_} -> erlog_errors:instantiation_error(Db); Other -> erlog_errors:type_error(atom, Other, Db) end; %% Arithmetic evalution and comparison. -prove_goal({is, N, E0}, Next, Cps, Bs, Vn, Db) -> +prove_goal({is, N, E0}, Next, Cps, Bs, Vn, Db, Fcon) -> E = eval_arith(erlog_core:deref(E0, Bs), Bs, Db), - erlog_core:unify_prove_body(N, E, Next, Cps, Bs, Vn, Db); -prove_goal({'>', L, R}, Next, Cps, Bs, Vn, Db) -> - arith_test_prove_body('>', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'>=', L, R}, Next, Cps, Bs, Vn, Db) -> - arith_test_prove_body('>=', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'=:=', L, R}, Next, Cps, Bs, Vn, Db) -> - arith_test_prove_body('==', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'=\\=', L, R}, Next, Cps, Bs, Vn, Db) -> - arith_test_prove_body('/=', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'<', L, R}, Next, Cps, Bs, Vn, Db) -> - arith_test_prove_body('<', L, R, Next, Cps, Bs, Vn, Db); -prove_goal({'=<', L, R}, Next, Cps, Bs, Vn, Db) -> - arith_test_prove_body('=<', L, R, Next, Cps, Bs, Vn, Db). + erlog_core:unify_prove_body(N, E, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({'>', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> + arith_test_prove_body('>', L, R, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({'>=', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> + arith_test_prove_body('>=', L, R, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({'=:=', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> + arith_test_prove_body('==', L, R, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({'=\\=', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> + arith_test_prove_body('/=', L, R, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({'<', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> + arith_test_prove_body('<', L, R, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({'=<', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> + arith_test_prove_body('=<', L, R, Next, Cps, Bs, Vn, Db, Fcon). %% term_test_prove_body(Test, Left, Right, Next, ChoicePoints, Bindings, Varnum, Database) -> %% void. -term_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db) -> +term_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db, Fcon) -> case erlang:Test(erlog_core:dderef(L, Bs), erlog_core:dderef(R, Bs)) of - true -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db); - false -> erlog_errors:fail(Cps, Db) + true -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon); + false -> erlog_errors:fail(Cps, Db, Fcon) end. %% prove_arg(Index, Term, Arg, Next, ChoicePoints, VarNum, Database) -> void. %% Prove the goal arg(I, Ct, Arg), Index and Term have been dereferenced. -prove_arg(I, [H | T], A, Next, Cps, Bs, Vn, Db) when is_integer(I) -> +prove_arg(I, [H | T], A, Next, Cps, Bs, Vn, Db, Fcon) when is_integer(I) -> %% He, he, he! - if I == 1 -> erlog_core:unify_prove_body(H, A, Next, Cps, Bs, Vn, Db); - I == 2 -> erlog_core:unify_prove_body(T, A, Next, Cps, Bs, Vn, Db); + if I == 1 -> erlog_core:unify_prove_body(H, A, Next, Cps, Bs, Vn, Db, Fcon); + I == 2 -> erlog_core:unify_prove_body(T, A, Next, Cps, Bs, Vn, Db, Fcon); true -> {fail, Db} end; -prove_arg(I, Ct, A, Next, Cps, Bs, Vn, Db) +prove_arg(I, Ct, A, Next, Cps, Bs, Vn, Db, Fcon) when is_integer(I), tuple_size(Ct) >= 2 -> if I > 1, I + 1 =< tuple_size(Ct) -> - erlog_core:unify_prove_body(element(I + 1, Ct), A, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body(element(I + 1, Ct), A, Next, Cps, Bs, Vn, Db, Fcon); true -> {fail, Db} end; -prove_arg(I, Ct, _, _, _, _, _, Db) -> +prove_arg(I, Ct, _, _, _, _, _, Db, _) -> %%Type failure just generates an error. if not(is_integer(I)) -> erlog_errors:type_error(integer, I, Db); true -> erlog_errors:type_error(compound, Ct, Db) @@ -179,25 +179,25 @@ prove_arg(I, Ct, _, _, _, _, _, Db) -> %% prove_functor(Term, Functor, Arity, Next, ChoicePoints, Bindings, VarNum, Database) -> void. %% Prove the call functor(T, F, A), Term has been dereferenced. -prove_functor(T, F, A, Next, Cps, Bs, Vn, Db) when tuple_size(T) >= 2 -> - erlog_core:unify_prove_body(F, element(1, T), A, tuple_size(T) - 1, Next, Cps, Bs, Vn, Db); -prove_functor(T, F, A, Next, Cps, Bs, Vn, Db) when ?IS_ATOMIC(T) -> - erlog_core:unify_prove_body(F, T, A, 0, Next, Cps, Bs, Vn, Db); -prove_functor([_ | _], F, A, Next, Cps, Bs, Vn, Db) -> +prove_functor(T, F, A, Next, Cps, Bs, Vn, Db, Fcon) when tuple_size(T) >= 2 -> + erlog_core:unify_prove_body(F, element(1, T), A, tuple_size(T) - 1, Next, Cps, Bs, Vn, Db, Fcon); +prove_functor(T, F, A, Next, Cps, Bs, Vn, Db, Fcon) when ?IS_ATOMIC(T) -> + erlog_core:unify_prove_body(F, T, A, 0, Next, Cps, Bs, Vn, Db, Fcon); +prove_functor([_ | _], F, A, Next, Cps, Bs, Vn, Db, Fcon) -> %% Just the top level here. - erlog_core:unify_prove_body(F, '.', A, 2, Next, Cps, Bs, Vn, Db); -prove_functor({_} = Var, F0, A0, Next, Cps, Bs0, Vn0, Db) -> + erlog_core:unify_prove_body(F, '.', A, 2, Next, Cps, Bs, Vn, Db, Fcon); +prove_functor({_} = Var, F0, A0, Next, Cps, Bs0, Vn0, Db, Fcon) -> case {erlog_core:dderef(F0, Bs0), erlog_core:dderef(A0, Bs0)} of {'.', 2} -> %He, he, he! Bs1 = erlog_core:add_binding(Var, [{Vn0} | {Vn0 + 1}], Bs0), - erlog_core:prove_body(Next, Cps, Bs1, Vn0 + 2, Db); + erlog_core:prove_body(Next, Cps, Bs1, Vn0 + 2, Db, Fcon); {F1, 0} when ?IS_ATOMIC(F1) -> Bs1 = erlog_core:add_binding(Var, F1, Bs0), - erlog_core:prove_body(Next, Cps, Bs1, Vn0, Db); + erlog_core:prove_body(Next, Cps, Bs1, Vn0, Db, Fcon); {F1, A1} when is_atom(F1), is_integer(A1), A1 > 0 -> As = erlog_core:make_vars(A1, Vn0), Bs1 = erlog_core:add_binding(Var, list_to_tuple([F1 | As]), Bs0), - erlog_core:prove_body(Next, Cps, Bs1, Vn0 + A1, Db); %!!! + erlog_core:prove_body(Next, Cps, Bs1, Vn0 + A1, Db, Fcon); %!!! %% Now the error cases. {{_}, _} -> erlog_errors:instantiation_error(Db); {F1, A1} when is_atom(F1) -> erlog_errors:type_error(integer, A1, Db); @@ -207,25 +207,25 @@ prove_functor({_} = Var, F0, A0, Next, Cps, Bs0, Vn0, Db) -> %% prove_univ(Term, List, Next, ChoicePoints, Bindings, VarNum, Database) -> void. %% Prove the goal Term =.. List, Term has already been dereferenced. -prove_univ(T, L, Next, Cps, Bs, Vn, Db) when tuple_size(T) >= 2 -> +prove_univ(T, L, Next, Cps, Bs, Vn, Db, Fcon) when tuple_size(T) >= 2 -> Es = tuple_to_list(T), - erlog_core:unify_prove_body(Es, L, Next, Cps, Bs, Vn, Db); -prove_univ(T, L, Next, Cps, Bs, Vn, Db) when ?IS_ATOMIC(T) -> - erlog_core:unify_prove_body([T], L, Next, Cps, Bs, Vn, Db); -prove_univ([Lh | Lt], L, Next, Cps, Bs, Vn, Db) -> + erlog_core:unify_prove_body(Es, L, Next, Cps, Bs, Vn, Db, Fcon); +prove_univ(T, L, Next, Cps, Bs, Vn, Db, Fcon) when ?IS_ATOMIC(T) -> + erlog_core:unify_prove_body([T], L, Next, Cps, Bs, Vn, Db, Fcon); +prove_univ([Lh | Lt], L, Next, Cps, Bs, Vn, Db, Fcon) -> %% He, he, he! - erlog_core:unify_prove_body(['.', Lh, Lt], L, Next, Cps, Bs, Vn, Db); -prove_univ({_} = Var, L, Next, Cps, Bs0, Vn, Db) -> + erlog_core:unify_prove_body(['.', Lh, Lt], L, Next, Cps, Bs, Vn, Db, Fcon); +prove_univ({_} = Var, L, Next, Cps, Bs0, Vn, Db, Fcon) -> case erlog_core:dderef(L, Bs0) of ['.', Lh, Lt] -> %He, he, he! Bs1 = erlog_core:add_binding(Var, [Lh | Lt], Bs0), - erlog_core:prove_body(Next, Cps, Bs1, Vn, Db); + erlog_core:prove_body(Next, Cps, Bs1, Vn, Db, Fcon); [A] when ?IS_ATOMIC(A) -> Bs1 = erlog_core:add_binding(Var, A, Bs0), - erlog_core:prove_body(Next, Cps, Bs1, Vn, Db); + erlog_core:prove_body(Next, Cps, Bs1, Vn, Db, Fcon); [F | As] when is_atom(F), length(As) > 0 -> Bs1 = erlog_core:add_binding(Var, list_to_tuple([F | As]), Bs0), - erlog_core:prove_body(Next, Cps, Bs1, Vn, Db); + erlog_core:prove_body(Next, Cps, Bs1, Vn, Db, Fcon); %% Now the error cases. [{_} | _] -> erlog_errors:instantiation_error(Db); {_} -> erlog_errors:instantiation_error(Db); @@ -236,12 +236,12 @@ prove_univ({_} = Var, L, Next, Cps, Bs0, Vn, Db) -> %% void. %% Prove the atom_chars(Atom, List). -prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db) -> +prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db, Fcon) -> %% After a suggestion by Sean Cribbs. case erlog_core:dderef(A, Bs) of Atom when is_atom(Atom) -> AtomList = [list_to_atom([C]) || C <- atom_to_list(Atom)], - erlog_core:unify_prove_body(L, AtomList, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body(L, AtomList, Next, Cps, Bs, Vn, Db, Fcon); {_} = Var -> %% Error #3: List is neither a list nor a partial list. %% Handled in dderef_list/2. @@ -257,7 +257,7 @@ prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db) -> end, Chars = lists:map(Fun, List), Atom = list_to_atom(Chars), - erlog_core:unify_prove_body(Var, Atom, Next, Cps, Bs, Vn, Db); + erlog_core:unify_prove_body(Var, Atom, Next, Cps, Bs, Vn, Db, Fcon); Other -> %% Error #2: Atom is neither a variable nor an atom erlog_errors:type_error(atom, Other, Db) @@ -266,11 +266,11 @@ prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db) -> %% arith_test_prove_body(Test, Left, Right, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. -arith_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db) -> +arith_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db, Fcon) -> case erlang:Test(eval_arith(erlog_core:deref(L, Bs), Bs, Db), eval_arith(erlog_core:deref(R, Bs), Bs, Db)) of - true -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db); - false -> erlog_errors:fail(Cps, Db) + true -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon); + false -> erlog_errors:fail(Cps, Db, Fcon) end. %% eval_arith(ArithExpr, Bindings, Database) -> Number. diff --git a/src/core/lang/erlog_dcg.erl b/src/core/lang/erlog_dcg.erl index 2d8cf6e..c0813fb 100644 --- a/src/core/lang/erlog_dcg.erl +++ b/src/core/lang/erlog_dcg.erl @@ -21,7 +21,7 @@ -include("erlog_int.hrl"). -export([expand_term/1, expand_term/2]). --export([expand_term_2/6, phrase_3/6]). +-export([expand_term_2/7, phrase_3/7]). -export([load/1]). load(Db) -> @@ -44,22 +44,22 @@ load(Db) -> %% expand_term_2(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> %% void %% Call the expand_term/2 predicate. -expand_term_2(Goal, Next, Cps, Bs, Vn0, Db) -> +expand_term_2(Goal, Next, Cps, Bs, Vn0, Db, Fcon) -> {expand_term, DCGRule, A2} = erlog_core:dderef(Goal, Bs), {Exp, Vn1} = expand_term(DCGRule, Vn0), - erlog_core:unify_prove_body(A2, Exp, Next, Cps, Bs, Vn1, Db). + erlog_core:unify_prove_body(A2, Exp, Next, Cps, Bs, Vn1, Db, Fcon). %% phrase_3(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> void. %% Call the phrase/3 preidicate. We could easily do this in prolog %% except for that it calls dcg_body/4 which is not exported. %% %% phrase(GRBody, S0, S) -> dcg_body(GRBody, S0, S, Goal), call(Goal). -phrase_3(Goal, Next0, Cps, Bs, Vn0, Db) -> +phrase_3(Goal, Next0, Cps, Bs, Vn0, Db, Fcon) -> {phrase, GRBody, S0, S} = erlog_core:dderef(Goal, Bs), {Body, Vn1} = dcg_body(GRBody, S0, S, Vn0), %% io:format("~p\n", [Body]), Next1 = [{call, Body} | Next0], %Evaluate body - erlog_core:prove_body(Next1, Cps, Bs, Vn1, Db). + erlog_core:prove_body(Next1, Cps, Bs, Vn1, Db, Fcon). %% expand_term(Term) -> {ExpTerm}. %% expand_term(Term, VarNum) -> {ExpTerm,NewVarNum}. diff --git a/src/core/lang/erlog_errors.erl b/src/core/lang/erlog_errors.erl index b3dcb68..d7f94a8 100644 --- a/src/core/lang/erlog_errors.erl +++ b/src/core/lang/erlog_errors.erl @@ -13,7 +13,7 @@ %% API -export([type_error/3, instantiation_error/1, permission_error/4, - type_error/2, instantiation_error/0, erlog_error/2, erlog_error/1, fail/2]). + type_error/2, instantiation_error/0, erlog_error/2, erlog_error/1, fail/3]). %% Errors %% To keep dialyzer quiet. @@ -43,50 +43,50 @@ erlog_error(E) -> throw({erlog_error, E}). %% The functions which manipulate the choice point stack. fail %% backtracks to next choicepoint skipping cut labels cut steps %% backwards over choice points until matching cut. -fail([#cp{type = goal_clauses} = Cp | Cps], Db) -> - fail_goal_clauses(Cp, Cps, Db); -fail([#cp{type = disjunction} = Cp | Cps], Db) -> - fail_disjunction(Cp, Cps, Db); -fail([#cp{type = if_then_else} = Cp | Cps], Db) -> - fail_if_then_else(Cp, Cps, Db); -fail([#cp{type = clause} = Cp | Cps], Db) -> - fail_clause(Cp, Cps, Db); -fail([#cp{type = retract} = Cp | Cps], Db) -> - fail_retract(Cp, Cps, Db); -fail([#cp{type = current_predicate} = Cp | Cps], Db) -> - fail_current_predicate(Cp, Cps, Db); -fail([#cp{type = ecall} = Cp | Cps], Db) -> - fail_ecall(Cp, Cps, Db); -fail([#cp{type = compiled, data = F} = Cp | Cps], Db) -> +fail([#cp{type = goal_clauses} = Cp | Cps], Db, Fcon) -> + fail_goal_clauses(Cp, Cps, Db, Fcon); +fail([#cp{type = disjunction} = Cp | Cps], Db, Fcon) -> + fail_disjunction(Cp, Cps, Db, Fcon); +fail([#cp{type = if_then_else} = Cp | Cps], Db, Fcon) -> + fail_if_then_else(Cp, Cps, Db, Fcon); +fail([#cp{type = clause} = Cp | Cps], Db, Fcon) -> + fail_clause(Cp, Cps, Db, Fcon); +fail([#cp{type = retract} = Cp | Cps], Db, Fcon) -> + fail_retract(Cp, Cps, Db, Fcon); +fail([#cp{type = current_predicate} = Cp | Cps], Db, Fcon) -> + fail_current_predicate(Cp, Cps, Db, Fcon); +fail([#cp{type = ecall} = Cp | Cps], Db, Fcon) -> + fail_ecall(Cp, Cps, Db, Fcon); +fail([#cp{type = compiled, data = F} = Cp | Cps], Db, _) -> F(Cp, Cps, Db); -fail([#cut{} | Cps], Db) -> - fail(Cps, Db); %Fail over cut points. -fail([], Db) -> {fail, Db}. +fail([#cut{} | Cps], Db, Fcon) -> + fail(Cps, Db, Fcon); %Fail over cut points. +fail([], Db, _) -> {fail, Db}. %% @private -fail_disjunction(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db) -> - erlog_core:prove_body(Next, Cps, Bs, Vn, Db). +fail_disjunction(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db, Fcon) -> + erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon). %% @private -fail_if_then_else(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db) -> - erlog_core:prove_body(Next, Cps, Bs, Vn, Db). +fail_if_then_else(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db, Fcon) -> + erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon). %% @private -fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> - erlog_core:prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db). +fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Cps, Db, Fcon) -> + erlog_core:prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db, Fcon). %% @private -fail_clause(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> - erlog_core:unify_clauses(Ch, Cb, Cs, Next, Cps, Bs, Vn, Db). +fail_clause(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db, Fcon) -> + erlog_core:unify_clauses(Ch, Cb, Cs, Next, Cps, Bs, Vn, Db, Fcon). %% @private -fail_retract(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> - erlog_core:retract_clauses(Ch, Cb, Cs, Next, Cps, Bs, Vn, Db). +fail_retract(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db, Fcon) -> + erlog_core:retract_clauses(Ch, Cb, Cs, Next, Cps, Bs, Vn, Db, Fcon). %% @private -fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> - erlog_core:prove_predicates(Pi, Fs, Next, Cps, Bs, Vn, Db). +fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Cps, Db, Fcon) -> + erlog_core:prove_predicates(Pi, Fs, Next, Cps, Bs, Vn, Db, Fcon). %% @private -fail_goal_clauses(#cp{data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db) -> - erlog_core:prove_goal_clauses(G, Cs, Next, Cps, Bs, Vn, Db). \ No newline at end of file +fail_goal_clauses(#cp{data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db, Fcon) -> + erlog_core:prove_goal_clauses(G, Cs, Next, Cps, Bs, Vn, Db, Fcon). \ No newline at end of file diff --git a/src/core/lang/erlog_lists.erl b/src/core/lang/erlog_lists.erl index 4c1ce8e..afb23dc 100644 --- a/src/core/lang/erlog_lists.erl +++ b/src/core/lang/erlog_lists.erl @@ -29,7 +29,7 @@ -export([load/1]). %% Library functions. --export([append_3/6, insert_3/6, member_2/6, memberchk_2/6, reverse_2/6, sort_2/6]). +-export([append_3/7, insert_3/7, member_2/7, memberchk_2/7, reverse_2/7, sort_2/7]). %% load(Database) -> Database. %% Assert predicates into the database. @@ -52,92 +52,92 @@ load(Db) -> %% append([], L, L). %% append([H|T], L, [H|L1]) :- append(T, L, L1). %% Here we attempt to compile indexing in the first argument. -append_3({append, A1, L, A3}, Next0, Cps, Bs0, Vn, Db) -> +append_3({append, A1, L, A3}, Next0, Cps, Bs0, Vn, Db, Fcon) -> case erlog_core:deref(A1, Bs0) of [] -> %Cannot backtrack - erlog_core:unify_prove_body(L, A3, Next0, Cps, Bs0, Vn, Db); + erlog_core:unify_prove_body(L, A3, Next0, Cps, Bs0, Vn, Db, Fcon); [H | T] -> %Cannot backtrack L1 = {Vn}, Next1 = [{append, T, L, L1} | Next0], - erlog_core:unify_prove_body(A3, [H | L1], Next1, Cps, Bs0, Vn + 1, Db); + erlog_core:unify_prove_body(A3, [H | L1], Next1, Cps, Bs0, Vn + 1, Db, Fcon); {_} = Var -> %This can backtrack FailFun = fun(LCp, LCps, LDb) -> - fail_append_3(LCp, LCps, LDb, Var, L, A3) + fail_append_3(LCp, LCps, LDb, Var, L, A3, Fcon) end, Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, Bs1 = erlog_core:add_binding(Var, [], Bs0), - erlog_core:unify_prove_body(L, A3, Next0, [Cp | Cps], Bs1, Vn, Db); - _ -> erlog_errors:fail(Cps, Db) %Will fail here! + erlog_core:unify_prove_body(L, A3, Next0, [Cp | Cps], Bs1, Vn, Db, Fcon); + _ -> erlog_errors:fail(Cps, Db, Fcon) %Will fail here! end. -fail_append_3(#cp{next = Next0, bs = Bs0, vn = Vn}, Cps, Db, A1, L, A3) -> +fail_append_3(#cp{next = Next0, bs = Bs0, vn = Vn}, Cps, Db, A1, L, A3, Fcon) -> H = {Vn}, T = {Vn + 1}, L1 = {Vn + 2}, Bs1 = erlog_core:add_binding(A1, [H | T], Bs0), %A1 always a variable here. Next1 = [{append, T, L, L1} | Next0], - erlog_core:unify_prove_body(A3, [H | L1], Next1, Cps, Bs1, Vn + 3, Db). + erlog_core:unify_prove_body(A3, [H | L1], Next1, Cps, Bs1, Vn + 3, Db, Fcon). %% insert_3(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% insert(L, X, [X|L]). %% insert([H|L], X, [H|L1]) :- insert(L, X, L1). -insert_3({insert, A1, A2, A3}, Next, Cps, Bs, Vn, Db) -> +insert_3({insert, A1, A2, A3}, Next, Cps, Bs, Vn, Db, Fcon) -> FailFun = fun(LCp, LCps, LDb) -> - fail_insert_3(LCp, LCps, LDb, A1, A2, A3) + fail_insert_3(LCp, LCps, LDb, A1, A2, A3, Fcon) end, Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, - erlog_core:unify_prove_body(A3, [A2 | A1], Next, [Cp | Cps], Bs, Vn, Db). + erlog_core:unify_prove_body(A3, [A2 | A1], Next, [Cp | Cps], Bs, Vn, Db, Fcon). -fail_insert_3(#cp{next = Next0, bs = Bs, vn = Vn}, Cps, Db, A1, X, A3) -> +fail_insert_3(#cp{next = Next0, bs = Bs, vn = Vn}, Cps, Db, A1, X, A3, Fcon) -> H = {Vn}, L = {Vn + 1}, L1 = {Vn + 2}, Next1 = [{insert, L, X, L1} | Next0], - erlog_core:unify_prove_body(A1, [H | L], A3, [H | L1], Next1, Cps, Bs, Vn + 3, Db). + erlog_core:unify_prove_body(A1, [H | L], A3, [H | L1], Next1, Cps, Bs, Vn + 3, Db, Fcon). %% member_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% member(X, [X|_]). %% member(X, [_|T]) :- member(X, T). -member_2({member, A1, A2}, Next, Cps, Bs, Vn, Db) -> +member_2({member, A1, A2}, Next, Cps, Bs, Vn, Db, Fcon) -> FailFun = fun(LCp, LCps, LDb) -> - fail_member_2(LCp, LCps, LDb, A1, A2) + fail_member_2(LCp, LCps, LDb, A1, A2, Fcon) end, Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, T = {Vn}, - erlog_core:unify_prove_body(A2, [A1 | T], Next, [Cp | Cps], Bs, Vn + 1, Db). + erlog_core:unify_prove_body(A2, [A1 | T], Next, [Cp | Cps], Bs, Vn + 1, Db, Fcon). -fail_member_2(#cp{next = Next0, bs = Bs, vn = Vn}, Cps, Db, A1, A2) -> +fail_member_2(#cp{next = Next0, bs = Bs, vn = Vn}, Cps, Db, A1, A2, Fcon) -> H = {Vn}, T = {Vn + 1}, Next1 = [{member, A1, T} | Next0], - erlog_core:unify_prove_body(A2, [H | T], Next1, Cps, Bs, Vn + 2, Db). + erlog_core:unify_prove_body(A2, [H | T], Next1, Cps, Bs, Vn + 2, Db, Fcon). %% memberchk_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% memberchk(X, [X|_]) :- !. %% memberchk(X, [_|T]) :- member(X, T). %% We don't build the list and we never backtrack so we can be smart %% and match directly. Should we give a type error? -memberchk_2({memberchk, A1, A2}, Next, Cps, Bs0, Vn, Db) -> +memberchk_2({memberchk, A1, A2}, Next, Cps, Bs0, Vn, Db, Fcon) -> case erlog_core:deref(A2, Bs0) of [H | T] -> case erlog_core:unify(A1, H, Bs0) of {succeed, Bs1} -> - erlog_core:prove_body(Next, Cps, Bs1, Vn, Db); + erlog_core:prove_body(Next, Cps, Bs1, Vn, Db, Fcon); fail -> - memberchk_2({memberchk, A1, T}, Next, Cps, Bs0, Vn, Db) + memberchk_2({memberchk, A1, T}, Next, Cps, Bs0, Vn, Db, Fcon) end; {_} -> erlog_errors:instantiation_error(); - _ -> erlog_errors:fail(Cps, Db) + _ -> erlog_errors:fail(Cps, Db, Fcon) end. %% reverse_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% reverse([], []). %% reverse([H|L1], L) :- reverse(L1, L2), append(L2, [H], L). %% Here we attempt to compile indexing in the first argument. -reverse_2({reverse, A1, A2}, Next0, Cps, Bs0, Vn, Db) -> +reverse_2({reverse, A1, A2}, Next0, Cps, Bs0, Vn, Db, Fcon) -> case erlog_core:deref(A1, Bs0) of [] -> - erlog_core:unify_prove_body(A2, [], Next0, Cps, Bs0, Vn, Db); + erlog_core:unify_prove_body(A2, [], Next0, Cps, Bs0, Vn, Db, Fcon); [H | T] -> L = {Vn}, L1 = A2, @@ -146,18 +146,18 @@ reverse_2({reverse, A1, A2}, Next0, Cps, Bs0, Vn, Db) -> %%prove_body(Next1, Cps, Bs0, Vn+1, Db); %% Smarter direct calling of local function. Next1 = [{append, L, [H], L1} | Next0], - reverse_2({reverse, T, L}, Next1, Cps, Bs0, Vn + 1, Db); + reverse_2({reverse, T, L}, Next1, Cps, Bs0, Vn + 1, Db, Fcon); {_} = Var -> FailFun = fun(LCp, LCps, LDb) -> - fail_reverse_2(LCp, LCps, LDb, Var, A2) + fail_reverse_2(LCp, LCps, LDb, Var, A2, Fcon) end, Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, Bs1 = erlog_core:add_binding(Var, [], Bs0), - erlog_core:unify_prove_body(A2, [], Next0, [Cp | Cps], Bs1, Vn, Db); - _ -> erlog_errors:fail(Cps, Db) %Will fail here! + erlog_core:unify_prove_body(A2, [], Next0, [Cp | Cps], Bs1, Vn, Db, Fcon); + _ -> erlog_errors:fail(Cps, Db, Fcon) %Will fail here! end. -fail_reverse_2(#cp{next = Next, bs = Bs0, vn = Vn}, Cps, Db, A1, A2) -> +fail_reverse_2(#cp{next = Next, bs = Bs0, vn = Vn}, Cps, Db, A1, A2, Fcon) -> H = {Vn}, T = {Vn + 1}, L1 = A2, @@ -166,11 +166,11 @@ fail_reverse_2(#cp{next = Next, bs = Bs0, vn = Vn}, Cps, Db, A1, A2) -> %%Next1 = [{reverse,T,L},{apperse,L,[H],L1}|Next], %%prove_body(Next1, Cps, Bs1, Vn+3, Db). Next1 = [{append, L, [H], L1} | Next], - reverse_2({reverse, T, L}, Next1, Cps, Bs1, Vn + 3, Db). + reverse_2({reverse, T, L}, Next1, Cps, Bs1, Vn + 3, Db, Fcon). %% sort_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% sort(List, SortedList). -sort_2({sort, L0, S}, Next, Cps, Bs, Vn, Db) -> +sort_2({sort, L0, S}, Next, Cps, Bs, Vn, Db, Fcon) -> %% This may throw an erlog error, we don't catch it here. L1 = lists:usort(erlog_core:dderef_list(L0, Bs)), - erlog_core:unify_prove_body(S, L1, Next, Cps, Bs, Vn, Db). \ No newline at end of file + erlog_core:unify_prove_body(S, L1, Next, Cps, Bs, Vn, Db, Fcon). \ No newline at end of file From b13291b008336479de00f0f7e6ba027d4a8cda3f Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 5 Jul 2014 18:35:54 +0000 Subject: [PATCH 037/251] added todo question --- src/core/erlog.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 498b700..e8c9b14 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -126,7 +126,7 @@ run_command(Command, State) -> %% @private %% Preprocess command -preprocess_command({ok, Command}, State = #state{f_consulter = Fun, db = Db}) when is_list(Command) -> +preprocess_command({ok, Command}, State = #state{f_consulter = Fun, db = Db}) when is_list(Command) -> %TODO may be remove me? case erlog_logic:reconsult_files(Command, Db, Fun) of ok -> {<<"Yes">>, State}; From 5492d48436b37a65eb3288faaec9fe12c8935b96 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 8 Jul 2014 01:14:54 +0000 Subject: [PATCH 038/251] added test --- .gitignore | 1 + src/io/erlog_file.erl | 3 +-- src/io/erlog_io.erl | 3 +-- test/erlog_test.erl | 37 +++++++++++++++++++++++++++++++++++++ test/prolog/t1.pl | 39 +++++++++++++++++++++++++++++++++++++++ 5 files changed, 79 insertions(+), 4 deletions(-) create mode 100644 test/erlog_test.erl create mode 100644 test/prolog/t1.pl diff --git a/.gitignore b/.gitignore index 43ee753..c6c071b 100644 --- a/.gitignore +++ b/.gitignore @@ -8,3 +8,4 @@ erlog_scan.erl *.dump rel/erlog .rebar +.eunit diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index 633ef45..f8852e7 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -30,8 +30,7 @@ -spec consult(fun(), File :: string(), Db :: pid()) -> ok | tuple(). consult(Fun, File, Db) -> case Fun(File) of %default is erlog_io:read_file/1 - {ok, Terms} -> - consult_terms(fun consult_assert/2, Db, Terms); + {ok, Terms} -> consult_terms(fun consult_assert/2, Db, Terms); Error -> Error end. diff --git a/src/io/erlog_io.erl b/src/io/erlog_io.erl index b0329b9..8364716 100644 --- a/src/io/erlog_io.erl +++ b/src/io/erlog_io.erl @@ -79,8 +79,7 @@ read_stream(Fd, L0) -> {ok, Toks, L1} -> case erlog_parse:term(Toks, L0) of {ok, end_of_file} -> []; %Prolog does this. - {ok, Term} -> - [Term | read_stream(Fd, L1)]; + {ok, Term} -> [Term | read_stream(Fd, L1)]; %TODO recurstion is not tail! {error, What} -> throw({error, What}) end; {error, Error, _} -> throw({error, Error}); diff --git a/test/erlog_test.erl b/test/erlog_test.erl new file mode 100644 index 0000000..c34edb9 --- /dev/null +++ b/test/erlog_test.erl @@ -0,0 +1,37 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 07. Июль 2014 21:46 +%%%------------------------------------------------------------------- +-module(erlog_test). +-author("tihon"). + +-include_lib("eunit/include/eunit.hrl"). + +run_all_test() -> + Names = get_absolute_names(get_prolog_files()), + ?debugMsg(Names), + lists:foreach(fun run_one/1, Names). + +-spec run_one(File :: string()) -> ok. +run_one(File) -> + {ok, ErlogWorker} = erlog:start_link(), + ?debugMsg(File), + Res = erlog:execute(ErlogWorker, string:join(["consult(", File, ")."], "\"")), + ?debugMsg(Res), + ?assertEqual(<<"Yes">>, Res), + Res1 = erlog:execute(ErlogWorker, "test_all."), + ?debugMsg(Res1), + ?assertEqual(<<"Yes">>, Res1), + ok. + +get_absolute_names(FileNames) -> + lists:foldl(fun(Name, Acc) -> [filename:absname("test/prolog/" ++ Name) | Acc] end, [], FileNames). + +-spec get_prolog_files() -> list(). +get_prolog_files() -> + {ok, FileNames} = file:list_dir("test/prolog"), + FileNames. \ No newline at end of file diff --git a/test/prolog/t1.pl b/test/prolog/t1.pl new file mode 100644 index 0000000..1378fb3 --- /dev/null +++ b/test/prolog/t1.pl @@ -0,0 +1,39 @@ +% ���� +% ���������: run(S). +% ������ ������� ����� �� ������ ���������� ������ f. +% ���������: run1(�). +% ������ ������� ���������� ������ f. + +f("p1", 100). +f("p2", 200). +f("p3", 300). + +run(_):- + retract(result(_)), + false. +run(_):- + assert(result(0)), + false. +run(_):- + f(_, Amnt), + retract(result(S)), + Snew is S + Amnt, + assert(result(Snew)), + false. +run(S):- + result(S). + +run1(C):- + calc_count([], 0, C). +calc_count(L, C, Cc):- + f(Key, _Amnt), + \+(append(_, [Key|_], L)), + Cn is C + 1, + calc_count([Key|L], Cn, Cc). +calc_count(_, C, C). + +test_all:- + run(600), + run1(3). + +% :- test_all. From 356c62b3cd16dc9dc7672a1f83985b1d0a91310b Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 11 Jul 2014 01:05:33 +0000 Subject: [PATCH 039/251] big core refactoring, added writeln/1 --- README.md | 31 ++- include/erlog_int.hrl | 20 +- src/core/erlog.erl | 83 +++--- src/core/erlog_core.erl | 254 +++++++++--------- src/core/erlog_errors.erl | 92 +++++++ src/core/{lang => }/erlog_parse.erl | 0 src/core/{lang => }/erlog_scan.xrl | 0 src/core/erlog_simple_printer.erl | 160 +++++++++++ src/core/lang/erlog_errors.erl | 92 ------- src/erlog_demo.erl | 75 ------ src/interface/remote/erlog_remote_eh.erl | 160 +++++++++++ .../erlog_remote_shell.erl} | 4 +- .../{ => remote}/erlog_shell_sup.erl | 8 +- src/{core/lang => libs}/erlog_bips.erl | 232 ++++++++-------- src/{core/lang => libs}/erlog_dcg.erl | 10 +- src/{core/lang => libs}/erlog_lists.erl | 74 ++--- 16 files changed, 797 insertions(+), 498 deletions(-) create mode 100644 src/core/erlog_errors.erl rename src/core/{lang => }/erlog_parse.erl (100%) rename src/core/{lang => }/erlog_scan.xrl (100%) create mode 100644 src/core/erlog_simple_printer.erl delete mode 100644 src/core/lang/erlog_errors.erl delete mode 100644 src/erlog_demo.erl create mode 100644 src/interface/remote/erlog_remote_eh.erl rename src/interface/{erlog_shell.erl => remote/erlog_remote_shell.erl} (98%) rename src/interface/{ => remote}/erlog_shell_sup.erl (90%) rename src/{core/lang => libs}/erlog_bips.erl (54%) rename src/{core/lang => libs}/erlog_dcg.erl (93%) rename src/{core/lang => libs}/erlog_lists.erl (62%) diff --git a/README.md b/README.md index ac886c6..b37c23a 100644 --- a/README.md +++ b/README.md @@ -38,26 +38,39 @@ Full Example: #### Custom database server: Erlog now supports using your own database, instead of using ets and dicts. Just implement `erlog_storage` callback interface -and pass your module name with your implementation to `erlog:start_link/1`. +and pass your module name with your implementation to `erlog:start_link/1` as __database__ to configuration list. Example: - Proplist = [{database, mysql_storage_impl_module}], - erlog:start_link(Proplist). + ConfList = [{database, mysql_storage_impl_module}], + erlog:start_link(ConfList). You can pass your parameters to your database implementation: - Proplist = [{database, dbModule}, {arguments, Params}], - erlog:start_link(Proplist). + ConfList = [{database, dbModule}, {arguments, Params}], + erlog:start_link(ConfList). Where `Params` is a list of your args, need to be passed to `dbModule:new/1` function. #### Consulting files To consult files use brakes and filename with path `["/home/prolog_user/prolog_code/examples/family.pl"]`. -__Remember!__ For proper consulting files with default consulter, files should end with empty line! +Erlog also supports calling `consult/1` and `reconsult/1` from prolog code: + + erlog:execute(Pid, "consult(\"/home/prolog_user/prolog_code/examples/family.pl\")."). +__Remember!__ For proper consulting files with default consulter, files should end with empty line! #### Custom file consulter: Basic file consulting takes `FileName` as argument and loads file from your filesystem. But if your production-system needs to consult files from database, of shared filesystem, or something else - you can create -your own function for consulting files and pass it to erlog: +your own function for consulting files and pass it to erlog. +Just add your function to configuration list as __f_consulter__: F = fun(Filename) -> my_hadoop_server:get_file(Filename) end, - Proplist = [{database, dbModule}, {arguments, Params}, {f_consulter, F}], - erlog:start_link(Proplist). \ No newline at end of file + ConfList = [{f_consulter, F}], + erlog:start_link(ConfList). + +#### Custom debugger handler: +If you wan't to use functions from debug library - you should define your own gen_event handler and pass it to erlog. +All debug events from such debug functions as `writeln/1` will be passed there. +See `erlog_simple_printer` as a default implementation of console printer as an example, or `erlog_remote_eh`, which is intended to print debug to remote client. +To configure your gen_event module - just pass module and arguments as __event_h__ in configuration: + + ConfList = [{event_h, {my_event_handler, Args}], + erlog:start_link(ConfList). \ No newline at end of file diff --git a/include/erlog_int.hrl b/include/erlog_int.hrl index 058f275..16cc4f7 100644 --- a/include/erlog_int.hrl +++ b/include/erlog_int.hrl @@ -28,6 +28,19 @@ -record(cp, {type, label, data, next, bs, vn}). -record(cut, {label, next}). +%% record for passing arguments to erlog_core:prove_goal +-record(param, +{ + goal, + next_goal, + choice, + bindings, + var_num, + database, + event_man, + f_consulter +}). + -define(ERLOG_BIPS, [ %% Term unification and comparison @@ -109,9 +122,10 @@ %% All solutions %% External interface {ecall, 2}, - %% Non-standard but useful - {display, 1}, %% File utils - {consult, 1} + {consult, 1}, + {reconsult, 1}, + %% Debug functions + {writeln, 1} ] ). \ No newline at end of file diff --git a/src/core/erlog.erl b/src/core/erlog.erl index e8c9b14..0534391 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -43,6 +43,7 @@ { db :: atom(), %database f_consulter :: fun(), %file consulter + e_man :: pid(), %event manager, used for debuging and other output (not for return) state = normal :: normal | list() %state for solution selecting. }). @@ -58,39 +59,35 @@ start_link(Params) -> gen_server:start_link(?MODULE, Params, []). init([]) -> % use built in database - {ok, Db} = erlog_memory:start_link(erlog_ets), %default database is ets module - load_built_in(Db), - F = fun erlog_io:read_file/1, %set default consult function - {ok, #state{db = Db, f_consulter = F}}; + {ok, Db} = init_database([]), %default database is ets module + F = init_consulter([]), + {ok, E} = gen_event:start_link(), + gen_event:add_handler(E, erlog_simple_printer, []), %set the default debug module + {ok, #state{db = Db, f_consulter = F, e_man = E}}; init(Params) -> % use custom database implementation - Database = proplists:get_value(database, Params), - Args = proplists:get_value(arguments, Params), - FileCon = case proplists:get_value(f_consulter, Params) of %get function from params or default - undefined -> fun erlog_io:read_file/1; - Other -> Other - end, - {ok, Db} = erlog_memory:start_link(Database, Args), - load_built_in(Db), - {ok, #state{db = Db, f_consulter = FileCon}}. + FileCon = init_consulter(Params), + {ok, Db} = init_database(Params), + {ok, E} = gen_event:start_link(), + case proplists:get_value(event_h, Params) of %register handler, if any + undefined -> ok; + {Module, Arguments} -> gen_event:add_handler(E, Module, Arguments) + end, + {ok, #state{db = Db, f_consulter = FileCon, e_man = E}}. handle_call({execute, Command}, _From, State = #state{state = normal}) -> %in normal mode - {Res, UpdateState} = case erlog_scan:tokens([], Command, 1) of - {done, Result, _Rest} -> run_command(Result, State); % command is finished, run. - {more, _} -> {{ok, more}, State} % unfinished command. Ask for ending. - end, - NewState = case Res of % change state, depending on reply - {_, select} -> UpdateState; - _ -> UpdateState#state{state = normal} - end, + {Res, _} = Repl = case erlog_scan:tokens([], Command, 1) of + {done, Result, _Rest} -> run_command(Result, State); % command is finished, run. + {more, _} -> {{ok, more}, State} % unfinished command. Report it and do nothing. + end, + NewState = change_state(Repl), {reply, Res, NewState}; handle_call({execute, Command}, _From, State) -> %in selection solutions mode - {Reply, NewState} = case preprocess_command({select, Command}, State) of % change state, depending on reply - {{_, select} = Res, UpdatedState} -> {Res, UpdatedState}; - {Res, UpdatedState} -> {Res, UpdatedState#state{state = normal}} - end, - {reply, Reply, NewState}. + {Res, _} = Repl = preprocess_command({select, Command}, State), + NewState = change_state(Repl), % change state, depending on reply + {reply, Res, NewState}. -handle_cast(halt, St) -> +handle_cast(halt, St = #state{e_man = E}) -> + gen_event:stop(E), %stom all handlers and event man {stop, normal, St}. handle_info(_, St) -> @@ -104,6 +101,32 @@ code_change(_, _, St) -> {ok, St}. %%%=================================================================== %%% Internal functions %%%=================================================================== +%% @private +% change state, depending on reply +change_state({{_, select}, State}) -> State; +change_state({_, State}) -> State#state{state = normal}. + +%% @private +%% Configurates database with arguments, populates it and returns. +-spec init_database(Params :: proplists:proplist()) -> {ok, Pid :: pid()}. +init_database(Params) -> + {ok, DbPid} = case proplists:get_value(database, Params) of + undefined -> erlog_memory:start_link(erlog_ets); + Module -> + Args = proplists:get_value(arguments, Params), + erlog_memory:start_link(Module, Args) + end, + load_built_in(DbPid), + {ok, DbPid}. + +%% @private +-spec init_consulter(Params :: proplists:proplist()) -> fun() | any(). +init_consulter(Params) -> + case proplists:get_value(f_consulter, Params) of %get function from params or default + undefined -> fun erlog_io:read_file/1; + Other -> Other + end. + %% @private load_built_in(Database) -> link(Database), %TODO some better solution to clean database, close it properly and free memory after erlog terminates @@ -151,7 +174,7 @@ process_command({prove, Goal}, State) -> process_command(next, State = #state{state = normal}) -> % can't select solution, when not in select mode {fail, State}; process_command(next, State = #state{state = [Vs, Cps], db = Db, f_consulter = Fcon}) -> - case erlog_logic:prove_result(catch erlog_errors:fail(Cps, Db, Fcon), Vs) of + case erlog_logic:prove_result(catch erlog_errors:fail(#param{choice = Cps, database = Db, f_consulter = Fcon}), Vs) of {Atom, Res, Args} -> {{Atom, Res}, State#state{state = Args}}; Other -> {Other, State} end; @@ -160,13 +183,13 @@ process_command(halt, State) -> {ok, State}. %% @private -prove_goal(Goal0, State = #state{db = Db, f_consulter = Fcon}) -> +prove_goal(Goal0, State = #state{db = Db, f_consulter = Fcon, e_man = Event}) -> Vs = erlog_logic:vars_in(Goal0), %% Goal may be a list of goals, ensure proper goal. Goal1 = erlog_logic:unlistify(Goal0), %% Must use 'catch' here as 'try' does not do last-call %% optimisation. - case erlog_logic:prove_result(catch erlog_core:prove_goal(Goal1, Db, Fcon), Vs) of + case erlog_logic:prove_result(catch erlog_core:prove_goal(Goal1, Db, Fcon, Event), Vs) of {succeed, Res, Args} -> {{succeed, Res}, State#state{state = Args}}; OtherRes -> {OtherRes, State} end. diff --git a/src/core/erlog_core.erl b/src/core/erlog_core.erl index 15af238..2377d14 100644 --- a/src/core/erlog_core.erl +++ b/src/core/erlog_core.erl @@ -135,16 +135,16 @@ unify/3, dderef_list/2, make_vars/2, - prove_goal/3, - unify_prove_body/10, - prove_body/6, - unify_clauses/9, - retract_clauses/9, - prove_predicates/8, - prove_goal_clauses/8, + prove_goal/4, + unify_prove_body/5, + prove_body/1, + unify_clauses/4, + retract_clauses/4, + prove_predicates/3, + prove_goal_clauses/3, pred_ind/1, well_form_body/3, - deref_list/2, unify_prove_body/8, dderef/2, deref/2, add_binding/3]). + deref_list/2, unify_prove_body/3, dderef/2, deref/2, add_binding/3]). %% Bindings, unification and dereferncing. -export([functor/1]). %% Creating term and body instances. @@ -162,44 +162,47 @@ load(Db) -> %% prove_goal(Goal, Database) -> Succeed | Fail. %% This is the main entry point into the interpreter. Check that %% everything is consistent then prove the goal as a call. -prove_goal(Goal0, Db, Fcon) -> +-spec prove_goal(Goal0 :: term(), Db :: pid(), Fcon :: fun(), Event :: pid()) -> term(). +prove_goal(Goal0, Db, Fcon, Event) -> %% put(erlog_cut, orddict:new()), %% put(erlog_cps, orddict:new()), %% put(erlog_var, orddict:new()), %% Check term and build new instance of term with bindings. {Goal1, Bs, Vn} = initial_goal(Goal0), - prove_body([{call, Goal1}], [], Bs, Vn, Db, Fcon). %TODO use lists:foldr instead! + Params = #param{goal = [{call, Goal1}], choice = [], bindings = Bs, var_num = Vn, + event_man = Event, database = Db, f_consulter = Fcon}, + prove_body(Params). %TODO use lists:foldr instead! %% prove_body(Body, ChoicePoints, Bindings, VarNum, Database) -> %% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase}. %% Prove the goals in a body. Remove the first goal and try to prove %% it. Return when there are no more goals. This is how proving a %% goal/body succeeds. -prove_body([G | Gs], Cps, Bs0, Vn0, Db, Fcon) -> %TODO use lists:foldr instead! +prove_body(Params = #param{goal = [G | Gs]}) -> %TODO use lists:foldr instead! %%io:fwrite("PB: ~p\n", [{G,Gs,Cps}]), - prove_goal(G, Gs, Cps, Bs0, Vn0, Db, Fcon); -prove_body([], Cps, Bs, Vn, Db, _) -> + prove_goal(Params#param{goal = G, next_goal = Gs}); +prove_body(#param{goal = [], choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> %%io:fwrite("Cps: ~p\nCut: ~p\nVar: ~p\nVar: ~p\n", %% [get(erlog_cps),get(erlog_cut),get(erlog_var),dict:size(Bs)]), %%io:fwrite("PB: ~p\n", [Cps]), - {succeed, Cps, Bs, Vn, Db}. %No more body + {succeed, Cps, Bs, Vn, Db}. %No more body %TODO why should we return database? %% unify_prove_body(Term1, Term2, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Unify Term1 = Term2, on success prove body Next else fail. -unify_prove_body(T1, T2, Next, Cps, Bs0, Vn, Db, Fcon) -> +unify_prove_body(T1, T2, Params = #param{next_goal = Next, bindings = Bs0}) -> case unify(T1, T2, Bs0) of - {succeed, Bs1} -> prove_body(Next, Cps, Bs1, Vn, Db, Fcon); - fail -> erlog_errors:fail(Cps, Db, Fcon) + {succeed, Bs1} -> prove_body(Params#param{goal = Next, bindings = Bs1}); + fail -> erlog_errors:fail(Params) end. %% unify_prove_body(A1, B1, A2, B2, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Unify A1 = B1, A2 = B2, on success prove body Next else fail. -unify_prove_body(A1, B1, A2, B2, Next, Cps, Bs0, Vn, Db, Fcon) -> +unify_prove_body(A1, B1, A2, B2, Params = #param{bindings = Bs0}) -> case unify(A1, B1, Bs0) of - {succeed, Bs1} -> unify_prove_body(A2, B2, Next, Cps, Bs1, Vn, Db, Fcon); - fail -> erlog_errors:fail(Cps, Db, Fcon) + {succeed, Bs1} -> unify_prove_body(A2, B2, Params#param{bindings = Bs1}); + fail -> erlog_errors:fail(Params) end. %% deref(Term, Bindings) -> Term. @@ -268,97 +271,98 @@ make_vars(I, Vn) -> %% Logic and control. Conjunctions are handled in prove_body and true %% has been compiled away. -prove_goal({call, G}, Next0, Cps, Bs, Vn, Db, Fcon) -> %TODO refactor this hell! +prove_goal(Param = #param{goal = {call, G}, next_goal = Next0, choice = Cps, + bindings = Bs, var_num = Vn, database = Db}) -> %% Only add cut CP to Cps if goal contains a cut. Label = Vn, case check_goal(G, Next0, Bs, Db, false, Label) of {Next1, true} -> %% Must increment Vn to avoid clashes!!! Cut = #cut{label = Label}, - prove_body(Next1, [Cut | Cps], Bs, Vn + 1, Db, Fcon); - {Next1, false} -> prove_body(Next1, Cps, Bs, Vn + 1, Db, Fcon) + prove_body(Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); + {Next1, false} -> prove_body(Param#param{goal = Next1, var_num = Vn + 1}) end; -prove_goal({{cut}, Label, Last}, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal(Param = #param{goal = {{cut}, Label, Last}}) -> %% Cut succeeds and trims back to cut ancestor. - cut(Label, Last, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({{disj}, R}, Next, Cps, Bs, Vn, Db, Fcon) -> + cut(Label, Last, Param); +prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> %% There is no L here, it has already been prepended to Next. Cp = #cp{type = disjunction, next = R, bs = Bs, vn = Vn}, - prove_body(Next, [Cp | Cps], Bs, Vn, Db, Fcon); -prove_goal(fail, _Next, Cps, _Bs, _Vn, Db, Fcon) -> erlog_errors:fail(Cps, Db, Fcon); -prove_goal({{if_then}, Label}, Next, Cps, Bs, Vn, Db, Fcon) -> + prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); +prove_goal(Params = #param{goal = fail}) -> erlog_errors:fail(Params); +prove_goal(Param = #param{goal = {{if_then}, Label}, next_goal = Next, choice = Cps}) -> %% We effetively implement ( C -> T ) with ( C, !, T ) but cuts in %% C are local to C. %% There is no ( C, !, T ) here, it has already been prepended to Next. %%io:fwrite("PG(->): ~p\n", [{Next}]), Cut = #cut{label = Label}, - prove_body(Next, [Cut | Cps], Bs, Vn, Db, Fcon); -prove_goal({{if_then_else}, Else, Label}, Next, Cps, Bs, Vn, Db, Fcon) -> + prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); +prove_goal(Param = #param{goal = {{if_then_else}, Else, Label}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> %% Need to push a choicepoint to fail back to inside Cond and a cut %% to cut back to before Then when Cond succeeds. #cp{type=if_then_else} %% functions as both as is always removed whatever the outcome. %% There is no ( C, !, T ) here, it has already been prepended to Next. Cp = #cp{type = if_then_else, label = Label, next = Else, bs = Bs, vn = Vn}, %%io:fwrite("PG(->;): ~p\n", [{Next,Else,[Cp|Cps]}]), - prove_body(Next, [Cp | Cps], Bs, Vn, Db, Fcon); -prove_goal({'\\+', G}, Next0, Cps, Bs, Vn, Db, Fcon) -> + prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); +prove_goal(Param = #param{goal = {'\\+', G}, next_goal = Next0, choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> %% We effectively implementing \+ G with ( G -> fail ; true ). Label = Vn, {Next1, _} = check_goal(G, [{{cut}, Label, true}, fail], Bs, Db, true, Label), Cp = #cp{type = if_then_else, label = Label, next = Next0, bs = Bs, vn = Vn}, %%io:fwrite("PG(\\+): ~p\n", [{G1,[Cp|Cps]]), %% Must increment Vn to avoid clashes!!! - prove_body(Next1, [Cp | Cps], Bs, Vn + 1, Db, Fcon); -prove_goal({{once}, Label}, Next, Cps, Bs, Vn, Db, Fcon) -> + prove_body(Param#param{goal = Next1, choice = [Cp | Cps], var_num = Vn + 1}); +prove_goal(Param = #param{goal = {{once}, Label}, next_goal = Next, choice = Cps}) -> %% We effetively implement once(G) with ( G, ! ) but cuts in %% G are local to G. %% There is no ( G, ! ) here, it has already been prepended to Next. Cut = #cut{label = Label}, - prove_body(Next, [Cut | Cps], Bs, Vn, Db, Fcon); -prove_goal(repeat, Next, Cps, Bs, Vn, Db, Fcon) -> + prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); +prove_goal(Param = #param{goal = repeat, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> Cp = #cp{type = disjunction, next = [repeat | Next], bs = Bs, vn = Vn}, - prove_body(Next, [Cp | Cps], Bs, Vn, Db, Fcon); + prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); %% Clause creation and destruction. -prove_goal({abolish, Pi0}, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal(Param = #param{goal = {abolish, Pi0}, next_goal = Next, bindings = Bs, database = Db}) -> case dderef(Pi0, Bs) of {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> erlog_memory:abolish_clauses(Db, {N, A}), - prove_body(Next, Cps, Bs, Vn, Db, Fcon); + prove_body(Param#param{goal = Next}); Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) end; -prove_goal({assert, C0}, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal(Param = #param{goal = {assert, C0}, next_goal = Next, bindings = Bs, database = Db}) -> C = dderef(C0, Bs), erlog_memory:assertz_clause(Db, C), - prove_body(Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({asserta, C0}, Next, Cps, Bs, Vn, Db, Fcon) -> + prove_body(Param#param{goal = Next}); +prove_goal(Param = #param{goal = {asserta, C0}, next_goal = Next, bindings = Bs, database = Db}) -> C = dderef(C0, Bs), erlog_memory:asserta_clause(Db, C), - prove_body(Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({assertz, C0}, Next, Cps, Bs, Vn, Db, Fcon) -> + prove_body(Param#param{goal = Next}); +prove_goal(Param = #param{goal = {assertz, C0}, next_goal = Next, bindings = Bs, database = Db}) -> C = dderef(C0, Bs), erlog_memory:assertz_clause(Db, C), - prove_body(Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({retract, C0}, Next, Cps, Bs, Vn, Db, Fcon) -> + prove_body(Param#param{goal = Next}); +prove_goal(Param = #param{goal = {retract, C0}, bindings = Bs}) -> C = dderef(C0, Bs), - prove_retract(C, Next, Cps, Bs, Vn, Db, Fcon); + prove_retract(C, Param); %% Clause retrieval and information -prove_goal({clause, H0, B}, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal(Param = #param{goal = {clause, H0, B}, bindings = Bs}) -> H1 = dderef(H0, Bs), - prove_clause(H1, B, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({current_predicate, Pi0}, Next, Cps, Bs, Vn, Db, Fcon) -> + prove_clause(H1, B, Param); +prove_goal(Param = #param{goal = {current_predicate, Pi0}, bindings = Bs}) -> Pi = dderef(Pi0, Bs), - prove_current_predicate(Pi, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({predicate_property, H0, P}, Next, Cps, Bs, Vn, Db, Fcon) -> + prove_current_predicate(Pi, Param); +prove_goal(Param = #param{goal = {predicate_property, H0, P}, bindings = Bs, database = Db}) -> H = dderef(H0, Bs), case catch erlog_memory:get_procedure_type(Db, functor(H)) of - built_in -> unify_prove_body(P, built_in, Next, Cps, Bs, Vn, Db, Fcon); - compiled -> unify_prove_body(P, compiled, Next, Cps, Bs, Vn, Db, Fcon); - interpreted -> unify_prove_body(P, interpreted, Next, Cps, Bs, Vn, Db, Fcon); - undefined -> erlog_errors:fail(Cps, Db, Fcon); + built_in -> unify_prove_body(P, built_in, Param); + compiled -> unify_prove_body(P, compiled, Param); + interpreted -> unify_prove_body(P, interpreted, Param); + undefined -> erlog_errors:fail(Param); {erlog_error, E} -> erlog_errors:erlog_error(E, Db) end; %% External interface -prove_goal({ecall, C0, Val}, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal(Param = #param{goal = {ecall, C0, Val}, bindings = Bs, database = Db}) -> %% Build the initial call. %%io:fwrite("PG(ecall): ~p\n ~p\n ~p\n", [dderef(C0, Bs),Next,Cps]), Efun = case dderef(C0, Bs) of @@ -374,52 +378,52 @@ prove_goal({ecall, C0, Val}, Next, Cps, Bs, Vn, Db, Fcon) -> Fun when is_function(Fun) -> Fun; Other -> erlog_errors:type_error(callable, Other, Db) end, - prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db, Fcon); + prove_ecall(Efun, Val, Param); %% Non-standard but useful. -prove_goal({display, T}, Next, Cps, Bs, Vn, Db, Fcon) -> - %% A very simple display procedure. - io:fwrite("~p\n", [dderef(T, Bs)]), - prove_body(Next, Cps, Bs, Vn, Db, Fcon); +prove_goal(Param = #param{goal = {writeln, T}, next_goal = Next, bindings = Bs, event_man = Evman}) -> + %% Display procedure. + gen_event:notify(Evman, dderef(T, Bs)), + prove_body(Param#param{goal = Next}); %% File utils -prove_goal({consult, Name}, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal(Param = #param{goal = {consult, Name}, next_goal = Next, f_consulter = Fcon, database = Db}) -> case erlog_file:consult(Fcon, Name, Db) of ok -> ok; {Err, Error} when Err == erlog_error; Err == error -> erlog_errors:erlog_error(Error, Db) end, - prove_body(Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({reconsult, Name}, Next, Cps, Bs, Vn, Db, Fcon) -> + prove_body(Param#param{goal = Next}); +prove_goal(Param = #param{goal = {reconsult, Name}, next_goal = Next, f_consulter = Fcon, database = Db}) -> case erlog_file:reconsult(Fcon, Name, Db) of ok -> ok; {Err, Error} when Err == erlog_error; Err == error -> erlog_errors:erlog_error(Error, Db) end, - prove_body(Next, Cps, Bs, Vn, Db, Fcon); + prove_body(Param#param{goal = Next}); %% Now look up the database. -prove_goal(G, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal(Param = #param{goal = G, database = Db}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), case catch erlog_memory:get_procedure(Db, functor(G)) of - built_in -> erlog_bips:prove_goal(G, Next, Cps, Bs, Vn, Db, Fcon); - {code, {Mod, Func}} -> Mod:Func(G, Next, Cps, Bs, Vn, Db, Fcon); - {clauses, Cs} -> prove_goal_clauses(G, Cs, Next, Cps, Bs, Vn, Db, Fcon); - undefined -> erlog_errors:fail(Cps, Db, Fcon); + built_in -> erlog_bips:prove_goal(G, Param); + {code, {Mod, Func}} -> Mod:Func(G, Param); + {clauses, Cs} -> prove_goal_clauses(G, Cs, Param); + undefined -> erlog_errors:fail(Param); %% Getting built_in here is an error! {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data end. -cut(Label, Last, Next, [#cut{label = Label} | Cps] = Cps0, Bs, Vn, Db, Fcon) -> - if Last -> prove_body(Next, Cps, Bs, Vn, Db, Fcon); - true -> prove_body(Next, Cps0, Bs, Vn, Db, Fcon) +cut(Label, Last, Param = #param{next_goal = Next, choice = [#cut{label = Label} | Cps] = Cps0}) -> + if Last -> prove_body(Param#param{goal = Next, choice = Cps}); + true -> prove_body(Param#param{goal = Next, choice = Cps0}) end; -cut(Label, Last, Next, [#cp{type = if_then_else, label = Label} | Cps] = Cps0, Bs, Vn, Db, Fcon) -> - if Last -> prove_body(Next, Cps, Bs, Vn, Db, Fcon); - true -> prove_body(Next, Cps0, Bs, Vn, Db, Fcon) +cut(Label, Last, Param = #param{next_goal = Next, choice = [#cp{type = if_then_else, label = Label} | Cps] = Cps0}) -> + if Last -> prove_body(Param#param{goal = Next, choice = Cps}); + true -> prove_body(Param#param{goal = Next, choice = Cps0}) end; -cut(Label, Last, Next, [#cp{type = goal_clauses, label = Label} = Cp | Cps], Bs, Vn, Db, Fcon) -> - cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db, Fcon); -cut(Label, Last, Next, [_Cp | Cps], Bs, Vn, Db, Fcon) -> - cut(Label, Last, Next, Cps, Bs, Vn, Db, Fcon). +cut(Label, Last, Param = #param{choice = [#cp{type = goal_clauses, label = Label} = Cp | Cps]}) -> + cut_goal_clauses(Last, Cp, Param#param{choice = Cps}); +cut(Label, Last, Param = #param{choice = [_Cp | Cps]}) -> + cut(Label, Last, Param#param{choice = Cps}). %% cut(Label, Last, Next, Cps, Bs, Vn, Db) -> %% cut(Label, Last, Next, Cps, Bs, Vn, Db, 1). @@ -458,49 +462,49 @@ check_goal(G0, Next, Bs, Db, Cut, Label) -> %% Call an external (Erlang) generator and handle return value, either %% succeed or fail. -prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_ecall(Efun, Val, Param = #param{next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> case Efun() of {succeed, Ret, Cont} -> %Succeed and more choices Cp = #cp{type = ecall, data = {Cont, Val}, next = Next, bs = Bs, vn = Vn}, - unify_prove_body(Val, Ret, Next, [Cp | Cps], Bs, Vn, Db, Fcon); + unify_prove_body(Val, Ret, Param#param{choice = [Cp | Cps]}); {succeed_last, Ret} -> %Succeed but last choice - unify_prove_body(Val, Ret, Next, Cps, Bs, Vn, Db, Fcon); - fail -> erlog_errors:fail(Cps, Db, Fcon) %No more + unify_prove_body(Val, Ret, Param); + fail -> erlog_errors:fail(Param) %No more end. %% prove_clause(Head, Body, Next, ChoicePoints, Bindings, VarNum, DataBase) -> %% void. %% Unify clauses matching with functor from Head with both Head and Body. -prove_clause(H, B, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_clause(H, B, Param = #param{database = Db}) -> Functor = functor(H), case erlog_memory:get_procedure(Db, Functor) of - {clauses, Cs} -> unify_clauses(H, B, Cs, Next, Cps, Bs, Vn, Db, Fcon); + {clauses, Cs} -> unify_clauses(H, B, Cs, Param); {code, _} -> erlog_errors:permission_error(access, private_procedure, pred_ind(Functor), Db); built_in -> erlog_errors:permission_error(access, private_procedure, pred_ind(Functor), Db); - undefined -> erlog_errors:fail(Cps, Db, Fcon) + undefined -> erlog_errors:fail(Param) end. %% unify_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to unify Head and Body using Clauses which all have the same functor. -unify_clauses(Ch, Cb, [C], Next, Cps, Bs0, Vn0, Db, Fcon) -> +unify_clauses(Ch, Cb, [C], Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0}) -> %% No choice point on last clause case unify_clause(Ch, Cb, C, Bs0, Vn0) of - {succeed, Bs1, Vn1} -> prove_body(Next, Cps, Bs1, Vn1, Db, Fcon); - fail -> erlog_errors:fail(Cps, Db, Fcon) + {succeed, Bs1, Vn1} -> prove_body(Param#param{goal = Next, bindings = Bs1, var_num = Vn1}); + fail -> erlog_errors:fail(Param) end; -unify_clauses(Ch, Cb, [C | Cs], Next, Cps, Bs0, Vn0, Db, Fcon) -> +unify_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0, choice = Cps}) -> case unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> Cp = #cp{type = clause, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, - prove_body(Next, [Cp | Cps], Bs1, Vn1, Db, Fcon); - fail -> unify_clauses(Ch, Cb, Cs, Next, Cps, Bs0, Vn0, Db, Fcon) + prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); + fail -> unify_clauses(Ch, Cb, Cs, Param) end; -unify_clauses(_Ch, _Cb, [], _Next, Cps, _Bs, _Vn, Db, Fcon) -> erlog_errors:fail(Cps, Db, Fcon). +unify_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param). unify_clause(Ch, Cb, {_Tag, H0, {B0, _}}, Bs0, Vn0) -> {H1, Rs1, Vn1} = term_instance(H0, Vn0), %Unique vars on head first @@ -518,40 +522,40 @@ unify_clause(Ch, Cb, {_Tag, H0, {B0, _}}, Bs0, Vn0) -> %% void. %% Match functors of existing user (interpreted) predicate with PredInd. -prove_current_predicate(Pi, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_current_predicate(Pi, Param = #param{database = Db}) -> case Pi of {'/', _, _} -> ok; {_} -> ok; Other -> erlog_errors:type_error(predicate_indicator, Other) end, Fs = erlog_memory:get_interp_functors(Db), - prove_predicates(Pi, Fs, Next, Cps, Bs, Vn, Db, Fcon). + prove_predicates(Pi, Fs, Param). -prove_predicates(Pi, [F | Fs], Next, Cps, Bs, Vn, Db, Fcon) -> +prove_predicates(Pi, [F | Fs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> Cp = #cp{type = current_predicate, data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, - unify_prove_body(Pi, pred_ind(F), Next, [Cp | Cps], Bs, Vn, Db, Fcon); -prove_predicates(_Pi, [], _Next, Cps, _Bs, _Vn, Db, Fcon) -> erlog_errors:fail(Cps, Db, Fcon). + unify_prove_body(Pi, pred_ind(F), Param#param{choice = [Cp | Cps]}); +prove_predicates(_Pi, [], Param) -> erlog_errors:fail(Param). %% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to prove Goal using Clauses which all have the same functor. -prove_goal_clauses(G, [C], Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal_clauses(G, [C], Params = #param{choice = Cps, var_num = Vn}) -> %% Must be smart here and test whether we need to add a cut point. %% C has the structure {Tag,Head,{Body,BodyHasCut}}. case element(2, element(3, C)) of true -> Cut = #cut{label = Vn}, - prove_goal_clause(G, C, Next, [Cut | Cps], Bs, Vn, Db, Fcon); + prove_goal_clause(G, C, Params#param{choice = [Cut | Cps]}); false -> - prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db, Fcon) + prove_goal_clause(G, C, Params) end; %% prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db); -prove_goal_clauses(G, [C | Cs], Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal_clauses(G, [C | Cs], Params = #param{next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps}) -> Cp = #cp{type = goal_clauses, label = Vn, data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, - prove_goal_clause(G, C, Next, [Cp | Cps], Bs, Vn, Db, Fcon); -prove_goal_clauses(_G, [], _Next, Cps, _Bs, _Vn, Db, Fcon) -> erlog_errors:fail(Cps, Db, Fcon). + prove_goal_clause(G, C, Params#param{choice = [Cp | Cps]}); +prove_goal_clauses(_G, [], Param) -> erlog_errors:fail(Param). -prove_goal_clause(G, {_Tag, H0, {B0, _}}, Next, Cps, Bs0, Vn0, Db, Fcon) -> +prove_goal_clause(G, {_Tag, H0, {B0, _}}, Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0}) -> %% io:fwrite("PGC1: ~p\n", [{G,H0,B0}]), Label = Vn0, case unify_head(G, H0, Bs0, Vn0 + 1) of @@ -559,53 +563,53 @@ prove_goal_clause(G, {_Tag, H0, {B0, _}}, Next, Cps, Bs0, Vn0, Db, Fcon) -> %% io:fwrite("PGC2: ~p\n", [{Rs0}]), {B1, _Rs2, Vn2} = body_instance(B0, Next, Rs0, Vn1, Label), %% io:fwrite("PGC3: ~p\n", [{B1,Next,Cps}]), - prove_body(B1, Cps, Bs1, Vn2, Db, Fcon); - fail -> erlog_errors:fail(Cps, Db, Fcon) + prove_body(Param#param{goal = B1, bindings = Bs1, var_num = Vn2}); + fail -> erlog_errors:fail(Param) end. %% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db). -cut_goal_clauses(true, Next, #cp{label = _}, Cps, Bs, Vn, Db, Fcon) -> +cut_goal_clauses(true, #cp{label = _}, Param = #param{next_goal = Next}) -> %% Just remove the choice point completely and continue. - prove_body(Next, Cps, Bs, Vn, Db, Fcon); -cut_goal_clauses(false, Next, #cp{label = L}, Cps, Bs, Vn, Db, Fcon) -> + prove_body(Param#param{goal = Next}); +cut_goal_clauses(false, #cp{label = L}, Param = #param{next_goal = Next, choice = Cps}) -> %% Replace choice point with cut point then continue. Cut = #cut{label = L}, - prove_body(Next, [Cut | Cps], Bs, Vn, Db, Fcon). + prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). %% prove_retract(Clause, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Retract clauses in database matching Clause. -prove_retract({':-', H, B}, Next, Cps, Bs, Vn, Db, Fcon) -> - prove_retract(H, B, Next, Cps, Bs, Vn, Db, Fcon); -prove_retract(H, Next, Cps, Bs, Vn, Db, Fcon) -> - prove_retract(H, true, Next, Cps, Bs, Vn, Db, Fcon). +prove_retract({':-', H, B}, Params) -> + prove_retract(H, B, Params); +prove_retract(H, Params) -> + prove_retract(H, true, Params). -prove_retract(H, B, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_retract(H, B, Params = #param{database = Db}) -> Functor = functor(H), case erlog_memory:get_procedure(Db, Functor) of - {clauses, Cs} -> retract_clauses(H, B, Cs, Next, Cps, Bs, Vn, Db, Fcon); + {clauses, Cs} -> retract_clauses(H, B, Cs, Params); {code, _} -> erlog_errors:permission_error(modify, static_procedure, pred_ind(Functor), Db); built_in -> erlog_errors:permission_error(modify, static_procedure, pred_ind(Functor), Db); - undefined -> erlog_errors:fail(Cps, Db, Fcon) + undefined -> erlog_errors:fail(Params) end. %% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to retract Head and Body using Clauses which all have the same functor. -retract_clauses(Ch, Cb, [C | Cs], Next, Cps, Bs0, Vn0, Db, Fcon) -> %TODO foreach vs handmaid recursion? +retract_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}) -> %TODO foreach vs handmade recursion? case unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> %% We have found a right clause so now retract it. erlog_memory:retract_clause(Db, functor(Ch), element(1, C)), Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, - prove_body(Next, [Cp | Cps], Bs1, Vn1, Db, Fcon); - fail -> retract_clauses(Ch, Cb, Cs, Next, Cps, Bs0, Vn0, Db, Fcon) + prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); + fail -> retract_clauses(Ch, Cb, Cs, Param) end; -retract_clauses(_Ch, _Cb, [], _Next, Cps, _Bs, _Vn, Db, Fcon) -> erlog_errors:fail(Cps, Db, Fcon). +retract_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param). unify_args(_, _, Bs, I, S) when I > S -> {succeed, Bs}; unify_args(S1, S2, Bs0, I, S) -> diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl new file mode 100644 index 0000000..823c3e8 --- /dev/null +++ b/src/core/erlog_errors.erl @@ -0,0 +1,92 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 18. июн 2014 23:16 +%%%------------------------------------------------------------------- +-module(erlog_errors). +-author("tihon"). + +-include("erlog_int.hrl"). + +%% API +-export([type_error/3, instantiation_error/1, permission_error/4, + type_error/2, instantiation_error/0, erlog_error/2, erlog_error/1, fail/1]). + +%% Errors +%% To keep dialyzer quiet. +-spec type_error(_, _) -> no_return(). +-spec type_error(_, _, _) -> no_return(). +-spec instantiation_error() -> no_return(). +-spec instantiation_error(_) -> no_return(). +-spec permission_error(_, _, _, _) -> no_return(). +-spec erlog_error(_) -> no_return(). +-spec erlog_error(_, _) -> no_return(). + +type_error(Type, Value, Db) -> erlog_error({type_error, Type, Value}, Db). +type_error(Type, Value) -> erlog_error({type_error, Type, Value}). + +instantiation_error(Db) -> erlog_error(instantiation_error, Db). +instantiation_error() -> erlog_error(instantiation_error). + +permission_error(Op, Type, Value, Db) -> + erlog_error({permission_error, Op, Type, Value}, Db). + +erlog_error(E, Db) -> throw({erlog_error, E, Db}). +erlog_error(E) -> throw({erlog_error, E}). + +%% fail(ChoicePoints, Database) -> {fail,Database}. +%% cut(Label, Last, Next, ChoicePoints, Bindings, VarNum, Database) -> void. +%% +%% The functions which manipulate the choice point stack. fail +%% backtracks to next choicepoint skipping cut labels cut steps +%% backwards over choice points until matching cut. +fail(Param = #param{choice = [#cp{type = goal_clauses} = Cp | Cps]}) -> + fail_goal_clauses(Cp, Param#param{choice = Cps}); +fail(Param = #param{choice = [#cp{type = disjunction} = Cp | Cps]}) -> + fail_disjunction(Cp, Param#param{choice = Cps}); +fail(Param = #param{choice = [#cp{type = if_then_else} = Cp | Cps]}) -> + fail_if_then_else(Cp, Param#param{choice = Cps}); +fail(Param = #param{choice = [#cp{type = clause} = Cp | Cps]}) -> + fail_clause(Cp, Param#param{choice = Cps}); +fail(Param = #param{choice = [#cp{type = retract} = Cp | Cps]}) -> + fail_retract(Cp, Param#param{choice = Cps}); +fail(Param = #param{choice = [#cp{type = current_predicate} = Cp | Cps]}) -> + fail_current_predicate(Cp, Param#param{choice = Cps}); +fail(Param = #param{choice = [#cp{type = ecall} = Cp | Cps]}) -> + fail_ecall(Cp, Param#param{choice = Cps}); +fail(#param{choice = [#cp{type = compiled, data = F} = Cp | Cps], database = Db}) -> + F(Cp, Cps, Db); %TODO test this +fail(Param = #param{choice = [#cut{} | Cps]}) -> + fail(Param#param{choice = Cps}); %Fail over cut points. +fail(#param{choice = [], database = Db}) -> {fail, Db}. + +%% @private +fail_disjunction(#cp{next = Next, bs = Bs, vn = Vn}, Param) -> + erlog_core:prove_body(Param#param{goal = Next, bindings = Bs, var_num = Vn}). + +%% @private +fail_if_then_else(#cp{next = Next, bs = Bs, vn = Vn}, Param) -> + erlog_core:prove_body(Param#param{goal = Next, bindings = Bs, var_num = Vn}). + +%% @private +fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Param) -> + erlog_core:prove_ecall(Efun, Val, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + +%% @private +fail_clause(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> + erlog_core:unify_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + +%% @private +fail_retract(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> + erlog_core:retract_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + +%% @private +fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Param) -> + erlog_core:prove_predicates(Pi, Fs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + +%% @private +fail_goal_clauses(#cp{data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> + erlog_core:prove_goal_clauses(G, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). \ No newline at end of file diff --git a/src/core/lang/erlog_parse.erl b/src/core/erlog_parse.erl similarity index 100% rename from src/core/lang/erlog_parse.erl rename to src/core/erlog_parse.erl diff --git a/src/core/lang/erlog_scan.xrl b/src/core/erlog_scan.xrl similarity index 100% rename from src/core/lang/erlog_scan.xrl rename to src/core/erlog_scan.xrl diff --git a/src/core/erlog_simple_printer.erl b/src/core/erlog_simple_printer.erl new file mode 100644 index 0000000..34a5c5c --- /dev/null +++ b/src/core/erlog_simple_printer.erl @@ -0,0 +1,160 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 10. Июль 2014 13:26 +%%%------------------------------------------------------------------- +-module(erlog_simple_printer). +-author("tihon"). + +-behaviour(gen_event). + +%% API +-export([start_link/0, + add_handler/0]). + +%% gen_event callbacks +-export([init/1, + handle_event/2, + handle_call/2, + handle_info/2, + terminate/2, + code_change/3]). + +-define(SERVER, ?MODULE). + +-record(state, {}). + +%%%=================================================================== +%%% gen_event callbacks +%%%=================================================================== + +%%-------------------------------------------------------------------- +%% @doc +%% Creates an event manager +%% +%% @end +%%-------------------------------------------------------------------- +-spec(start_link() -> {ok, pid()} | {error, {already_started, pid()}}). +start_link() -> + gen_event:start_link({local, ?SERVER}). + +%%-------------------------------------------------------------------- +%% @doc +%% Adds an event handler +%% +%% @end +%%-------------------------------------------------------------------- +-spec(add_handler() -> ok | {'EXIT', Reason :: term()} | term()). +add_handler() -> + gen_event:add_handler(?SERVER, ?MODULE, []). + +%%%=================================================================== +%%% gen_event callbacks +%%%=================================================================== + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Whenever a new event handler is added to an event manager, +%% this function is called to initialize the event handler. +%% +%% @end +%%-------------------------------------------------------------------- +-spec(init(InitArgs :: term()) -> + {ok, State :: #state{}} | + {ok, State :: #state{}, hibernate} | + {error, Reason :: term()}). +init([]) -> + {ok, #state{}}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Whenever an event manager receives an event sent using +%% gen_event:notify/2 or gen_event:sync_notify/2, this function is +%% called for each installed event handler to handle the event. +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_event(Event :: term(), State :: #state{}) -> + {ok, NewState :: #state{}} | + {ok, NewState :: #state{}, hibernate} | + {swap_handler, Args1 :: term(), NewState :: #state{}, + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + remove_handler). +handle_event(Event, State) -> + io:format("~p: ~p~n", [?MODULE, Event]), + {ok, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Whenever an event manager receives a request sent using +%% gen_event:call/3,4, this function is called for the specified +%% event handler to handle the request. +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_call(Request :: term(), State :: #state{}) -> + {ok, Reply :: term(), NewState :: #state{}} | + {ok, Reply :: term(), NewState :: #state{}, hibernate} | + {swap_handler, Reply :: term(), Args1 :: term(), NewState :: #state{}, + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + {remove_handler, Reply :: term()}). +handle_call(_Request, State) -> + Reply = ok, + {ok, Reply, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% This function is called for each installed event handler when +%% an event manager receives any other message than an event or a +%% synchronous request (or a system message). +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_info(Info :: term(), State :: #state{}) -> + {ok, NewState :: #state{}} | + {ok, NewState :: #state{}, hibernate} | + {swap_handler, Args1 :: term(), NewState :: #state{}, + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + remove_handler). +handle_info(_Info, State) -> + {ok, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Whenever an event handler is deleted from an event manager, this +%% function is called. It should be the opposite of Module:init/1 and +%% do any necessary cleaning up. +%% +%% @spec terminate(Reason, State) -> void() +%% @end +%%-------------------------------------------------------------------- +-spec(terminate(Args :: (term() | {stop, Reason :: term()} | stop | +remove_handler | {error, {'EXIT', Reason :: term()}} | +{error, term()}), State :: term()) -> term()). +terminate(_Arg, _State) -> + ok. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Convert process state when code is changed +%% +%% @end +%%-------------------------------------------------------------------- +-spec(code_change(OldVsn :: term() | {down, term()}, State :: #state{}, + Extra :: term()) -> + {ok, NewState :: #state{}}). +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%%=================================================================== +%%% Internal functions +%%%=================================================================== diff --git a/src/core/lang/erlog_errors.erl b/src/core/lang/erlog_errors.erl deleted file mode 100644 index d7f94a8..0000000 --- a/src/core/lang/erlog_errors.erl +++ /dev/null @@ -1,92 +0,0 @@ -%%%------------------------------------------------------------------- -%%% @author tihon -%%% @copyright (C) 2014, -%%% @doc -%%% -%%% @end -%%% Created : 18. июн 2014 23:16 -%%%------------------------------------------------------------------- --module(erlog_errors). --author("tihon"). - --include("erlog_int.hrl"). - -%% API --export([type_error/3, instantiation_error/1, permission_error/4, - type_error/2, instantiation_error/0, erlog_error/2, erlog_error/1, fail/3]). - -%% Errors -%% To keep dialyzer quiet. --spec type_error(_, _) -> no_return(). --spec type_error(_, _, _) -> no_return(). --spec instantiation_error() -> no_return(). --spec instantiation_error(_) -> no_return(). --spec permission_error(_, _, _, _) -> no_return(). --spec erlog_error(_) -> no_return(). --spec erlog_error(_, _) -> no_return(). - -type_error(Type, Value, Db) -> erlog_error({type_error, Type, Value}, Db). -type_error(Type, Value) -> erlog_error({type_error, Type, Value}). - -instantiation_error(Db) -> erlog_error(instantiation_error, Db). -instantiation_error() -> erlog_error(instantiation_error). - -permission_error(Op, Type, Value, Db) -> - erlog_error({permission_error, Op, Type, Value}, Db). - -erlog_error(E, Db) -> throw({erlog_error, E, Db}). -erlog_error(E) -> throw({erlog_error, E}). - -%% fail(ChoicePoints, Database) -> {fail,Database}. -%% cut(Label, Last, Next, ChoicePoints, Bindings, VarNum, Database) -> void. -%% -%% The functions which manipulate the choice point stack. fail -%% backtracks to next choicepoint skipping cut labels cut steps -%% backwards over choice points until matching cut. -fail([#cp{type = goal_clauses} = Cp | Cps], Db, Fcon) -> - fail_goal_clauses(Cp, Cps, Db, Fcon); -fail([#cp{type = disjunction} = Cp | Cps], Db, Fcon) -> - fail_disjunction(Cp, Cps, Db, Fcon); -fail([#cp{type = if_then_else} = Cp | Cps], Db, Fcon) -> - fail_if_then_else(Cp, Cps, Db, Fcon); -fail([#cp{type = clause} = Cp | Cps], Db, Fcon) -> - fail_clause(Cp, Cps, Db, Fcon); -fail([#cp{type = retract} = Cp | Cps], Db, Fcon) -> - fail_retract(Cp, Cps, Db, Fcon); -fail([#cp{type = current_predicate} = Cp | Cps], Db, Fcon) -> - fail_current_predicate(Cp, Cps, Db, Fcon); -fail([#cp{type = ecall} = Cp | Cps], Db, Fcon) -> - fail_ecall(Cp, Cps, Db, Fcon); -fail([#cp{type = compiled, data = F} = Cp | Cps], Db, _) -> - F(Cp, Cps, Db); -fail([#cut{} | Cps], Db, Fcon) -> - fail(Cps, Db, Fcon); %Fail over cut points. -fail([], Db, _) -> {fail, Db}. - -%% @private -fail_disjunction(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db, Fcon) -> - erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon). - -%% @private -fail_if_then_else(#cp{next = Next, bs = Bs, vn = Vn}, Cps, Db, Fcon) -> - erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon). - -%% @private -fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Cps, Db, Fcon) -> - erlog_core:prove_ecall(Efun, Val, Next, Cps, Bs, Vn, Db, Fcon). - -%% @private -fail_clause(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db, Fcon) -> - erlog_core:unify_clauses(Ch, Cb, Cs, Next, Cps, Bs, Vn, Db, Fcon). - -%% @private -fail_retract(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db, Fcon) -> - erlog_core:retract_clauses(Ch, Cb, Cs, Next, Cps, Bs, Vn, Db, Fcon). - -%% @private -fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Cps, Db, Fcon) -> - erlog_core:prove_predicates(Pi, Fs, Next, Cps, Bs, Vn, Db, Fcon). - -%% @private -fail_goal_clauses(#cp{data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, Cps, Db, Fcon) -> - erlog_core:prove_goal_clauses(G, Cs, Next, Cps, Bs, Vn, Db, Fcon). \ No newline at end of file diff --git a/src/erlog_demo.erl b/src/erlog_demo.erl deleted file mode 100644 index 5fba472..0000000 --- a/src/erlog_demo.erl +++ /dev/null @@ -1,75 +0,0 @@ -%% Copyright (c) 2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - -%% File : erlog_demo.erl -%% Author : Robert Virding -%% Purpose : Demo functions for Erlang interface of Erlog system. - --module(erlog_demo). - --export([efunc/1, ets_keys/1, get_list/1]). - -%% efunc(Fcall) -> {succeed_last,Val}. -%% ets_keys(Table) -> {succeed,Val,Cont} | {succeed_last,Val} | fail. -%% get_list(ListGenerator) -> {succeed,Val,Cont} | {succeed_last,Val} | fail. -%% Test/demo functions for ecall predicate. Examples of different ways -%% of generating solutions. - -efunc(Fcall) -> - %% Call an erlang function and return the value. - %% This is what the operators will generate. - Val = case Fcall of - {':', M, F} when is_atom(M), is_atom(F) -> M:F(); - {':', M, {F, A}} when is_atom(M), is_atom(F) -> M:F(A); - {':', M, T} when is_atom(M), is_tuple(T), size(T) >= 2, - is_atom(element(1, T)) -> - apply(M, element(1, T), tl(tuple_to_list(T))) - end, - {succeed_last, Val}. %Optimisation - -ets_keys(Tab) -> - %% Ets table keys back-trackable. - %% Solution with no look-ahead, get keys when requested. - %% This fun returns next key and itself for continuation. - F = fun(F1, Tab1, Last1) -> - case ets:next(Tab1, Last1) of - '$end_of_table' -> fail; %No more elements - Key1 -> {succeed, Key1, fun() -> F1(F1, Tab1, Key1) end} - end - end, - case ets:first(Tab) of - '$end_of_table' -> fail; %No elements - Key -> {succeed, Key, fun() -> F(F, Tab, Key) end} - end. - -get_list(ListGen) -> - %% List as back-trackable generator. - %% This is what the operators will generate. - Vals = case ListGen of - {':', M, F} when is_atom(M), is_atom(F) -> M:F(); - {':', M, {F, A}} when is_atom(M), is_atom(F) -> - M:F(A); - {':', M, T} when is_atom(M), is_tuple(T), size(T) >= 2, - is_atom(element(1, T)) -> - apply(M, element(1, T), tl(tuple_to_list(T))) - end, - %% This fun will return head and itself for continuation. - Fun = fun(F1, Es0) -> - case Es0 of - [E] -> {succeed_last, E}; %Optimisation for last one - [E | Es] -> {succeed, E, fun() -> F1(F1, Es) end}; - [] -> fail %No more elements - end - end, - Fun(Fun, Vals). %Call with list of values diff --git a/src/interface/remote/erlog_remote_eh.erl b/src/interface/remote/erlog_remote_eh.erl new file mode 100644 index 0000000..68aaff5 --- /dev/null +++ b/src/interface/remote/erlog_remote_eh.erl @@ -0,0 +1,160 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 10. Июль 2014 13:46 +%%%------------------------------------------------------------------- +-module(erlog_remote_eh). +-author("tihon"). + +-behaviour(gen_event). + +%% API +-export([start_link/0, + add_handler/0]). + +%% gen_event callbacks +-export([init/1, + handle_event/2, + handle_call/2, + handle_info/2, + terminate/2, + code_change/3]). + +-define(SERVER, ?MODULE). + +-record(state, {socket}). + +%%%=================================================================== +%%% gen_event callbacks +%%%=================================================================== + +%%-------------------------------------------------------------------- +%% @doc +%% Creates an event manager +%% +%% @end +%%-------------------------------------------------------------------- +-spec(start_link() -> {ok, pid()} | {error, {already_started, pid()}}). +start_link() -> + gen_event:start_link({local, ?SERVER}). + +%%-------------------------------------------------------------------- +%% @doc +%% Adds an event handler +%% +%% @end +%%-------------------------------------------------------------------- +-spec(add_handler() -> ok | {'EXIT', Reason :: term()} | term()). +add_handler() -> + gen_event:add_handler(?SERVER, ?MODULE, []). + +%%%=================================================================== +%%% gen_event callbacks +%%%=================================================================== + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Whenever a new event handler is added to an event manager, +%% this function is called to initialize the event handler. +%% +%% @end +%%-------------------------------------------------------------------- +-spec(init(InitArgs :: term()) -> + {ok, State :: #state{}} | + {ok, State :: #state{}, hibernate} | + {error, Reason :: term()}). +init(Socket) -> + {ok, #state{socket = Socket}}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Whenever an event manager receives an event sent using +%% gen_event:notify/2 or gen_event:sync_notify/2, this function is +%% called for each installed event handler to handle the event. +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_event(Event :: term(), State :: #state{}) -> + {ok, NewState :: #state{}} | + {ok, NewState :: #state{}, hibernate} | + {swap_handler, Args1 :: term(), NewState :: #state{}, + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + remove_handler). +handle_event(Event, State = #state{socket = Socket}) -> + gen_tcp:send(Socket, Event), + {ok, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Whenever an event manager receives a request sent using +%% gen_event:call/3,4, this function is called for the specified +%% event handler to handle the request. +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_call(Request :: term(), State :: #state{}) -> + {ok, Reply :: term(), NewState :: #state{}} | + {ok, Reply :: term(), NewState :: #state{}, hibernate} | + {swap_handler, Reply :: term(), Args1 :: term(), NewState :: #state{}, + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + {remove_handler, Reply :: term()}). +handle_call(_Request, State) -> + Reply = ok, + {ok, Reply, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% This function is called for each installed event handler when +%% an event manager receives any other message than an event or a +%% synchronous request (or a system message). +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_info(Info :: term(), State :: #state{}) -> + {ok, NewState :: #state{}} | + {ok, NewState :: #state{}, hibernate} | + {swap_handler, Args1 :: term(), NewState :: #state{}, + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + remove_handler). +handle_info(_Info, State) -> + {ok, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Whenever an event handler is deleted from an event manager, this +%% function is called. It should be the opposite of Module:init/1 and +%% do any necessary cleaning up. +%% +%% @spec terminate(Reason, State) -> void() +%% @end +%%-------------------------------------------------------------------- +-spec(terminate(Args :: (term() | {stop, Reason :: term()} | stop | +remove_handler | {error, {'EXIT', Reason :: term()}} | +{error, term()}), State :: term()) -> term()). +terminate(_Arg, _State) -> + ok. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Convert process state when code is changed +%% +%% @end +%%-------------------------------------------------------------------- +-spec(code_change(OldVsn :: term() | {down, term()}, State :: #state{}, + Extra :: term()) -> + {ok, NewState :: #state{}}). +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%%=================================================================== +%%% Internal functions +%%%=================================================================== diff --git a/src/interface/erlog_shell.erl b/src/interface/remote/erlog_remote_shell.erl similarity index 98% rename from src/interface/erlog_shell.erl rename to src/interface/remote/erlog_remote_shell.erl index 4a2e8f6..944fac3 100644 --- a/src/interface/erlog_shell.erl +++ b/src/interface/remote/erlog_remote_shell.erl @@ -7,7 +7,7 @@ %%% @end %%% Created : 26. май 2014 20:05 %%%------------------------------------------------------------------- --module(erlog_shell). +-module(erlog_remote_shell). -author("tihon"). -behaviour(gen_server). @@ -103,7 +103,7 @@ handle_cast(accept, State = #state{socket = ListenSocket}) -> erlog_shell_sup:start_socket(), Version = list_to_binary(erlang:system_info(version)), gen_tcp:send(AcceptSocket, [<<<<"Erlog Shell V">>/binary, Version/binary, <<" (abort with ^G)\n| ?- ">>/binary>>]), - {ok, Pid} = erlog:start_link(), + {ok, Pid} = erlog:start_link([{database, erlog_ets}, {event_h, {erlog_remote_eh, AcceptSocket}}]), {noreply, State#state{socket = AcceptSocket, core = Pid}}; handle_cast(_Request, State) -> {noreply, State}. diff --git a/src/interface/erlog_shell_sup.erl b/src/interface/remote/erlog_shell_sup.erl similarity index 90% rename from src/interface/erlog_shell_sup.erl rename to src/interface/remote/erlog_shell_sup.erl index 11fdd07..95a5aed 100644 --- a/src/interface/erlog_shell_sup.erl +++ b/src/interface/remote/erlog_shell_sup.erl @@ -23,7 +23,7 @@ %%% API functions %%%=================================================================== % for console -start_socket() -> supervisor:start_child(?MODULE, []). +start_socket() -> supervisor:start_child(?MODULE, []). %%-------------------------------------------------------------------- %% @doc @@ -62,10 +62,10 @@ init([]) -> Opts = [{active, true}, {keepalive, true}, {packet, 0}, {reuseaddr, true}], case gen_tcp:listen(Port, Opts) of {ok, ListenSocket} -> - io:fwrite("~w:Listening on port ~p~n", [?MODULE, Port]), %TODO lager + io:fwrite("~w:Listening on port ~p~n", [?MODULE, Port]), RestartStrategy = {simple_one_for_one, 10, 60}, - Listener = {erlog_shell, {erlog_shell, start_link, [{tcp, ListenSocket}]}, - temporary, 2000, worker, [erlog_shell]}, + Listener = {erlog_remote_shell, {erlog_remote_shell, start_link, [{tcp, ListenSocket}]}, + temporary, 2000, worker, [erlog_remote_shell]}, spawn_link(fun start_socket/0), {ok, {RestartStrategy, [Listener]}}; {error, Reason} -> diff --git a/src/core/lang/erlog_bips.erl b/src/libs/erlog_bips.erl similarity index 54% rename from src/core/lang/erlog_bips.erl rename to src/libs/erlog_bips.erl index 5472d99..6269d63 100644 --- a/src/core/lang/erlog_bips.erl +++ b/src/libs/erlog_bips.erl @@ -25,7 +25,7 @@ %% Main interface functions. -export([load/1]). --export([prove_goal/7]). +-export([prove_goal/2]). %%-compile(export_all). @@ -41,136 +41,136 @@ load(Db) -> %% to NextGoal. %% Term unification and comparison -prove_goal({'=', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> - erlog_core:unify_prove_body(L, R, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({'\\=', L, R}, Next, Cps, Bs0, Vn, Db, Fcon) -> +prove_goal({'=', L, R}, Params) -> + erlog_core:unify_prove_body(L, R, Params); +prove_goal({'\\=', L, R}, Params = #param{next_goal = Next, bindings = Bs0}) -> case erlog_core:unify(L, R, Bs0) of - {succeed, _Bs1} -> erlog_errors:fail(Cps, Db, Fcon); - fail -> erlog_core:prove_body(Next, Cps, Bs0, Vn, Db, Fcon) + {succeed, _Bs1} -> erlog_errors:fail(Params); + fail -> erlog_core:prove_body(Params#param{goal = Next}) end; -prove_goal({'@>', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> - term_test_prove_body('>', L, R, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({'@>=', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> - term_test_prove_body('>=', L, R, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({'==', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> - term_test_prove_body('==', L, R, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({'\\==', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> - term_test_prove_body('/=', L, R, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({'@<', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> - term_test_prove_body('<', L, R, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({'@=<', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> - term_test_prove_body('=<', L, R, Next, Cps, Bs, Vn, Db, Fcon); +prove_goal({'@>', L, R}, Params) -> + term_test_prove_body('>', L, R, Params); +prove_goal({'@>=', L, R}, Params) -> + term_test_prove_body('>=', L, R, Params); +prove_goal({'==', L, R}, Params) -> + term_test_prove_body('==', L, R, Params); +prove_goal({'\\==', L, R}, Params) -> + term_test_prove_body('/=', L, R, Params); +prove_goal({'@<', L, R}, Params) -> + term_test_prove_body('<', L, R, Params); +prove_goal({'@=<', L, R}, Params) -> + term_test_prove_body('=<', L, R, Params); %% Term creation and decomposition. -prove_goal({arg, I, Ct, A}, Next, Cps, Bs, Vn, Db, Fcon) -> - prove_arg(erlog_core:deref(I, Bs), erlog_core:deref(Ct, Bs), A, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({copy_term, T0, C}, Next, Cps, Bs, Vn0, Db, Fcon) -> +prove_goal({arg, I, Ct, A}, Params = #param{bindings = Bs}) -> + prove_arg(erlog_core:deref(I, Bs), erlog_core:deref(Ct, Bs), A, Params); +prove_goal({copy_term, T0, C}, Params = #param{bindings = Bs, var_num = Vn0}) -> %% Use term_instance to create the copy, can ignore orddict it creates. {T, _Nbs, Vn1} = erlog_core:term_instance(erlog_core:dderef(T0, Bs), Vn0), - erlog_core:unify_prove_body(T, C, Next, Cps, Bs, Vn1, Db, Fcon); -prove_goal({functor, T, F, A}, Next, Cps, Bs, Vn, Db, Fcon) -> - prove_functor(erlog_core:dderef(T, Bs), F, A, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({'=..', T, L}, Next, Cps, Bs, Vn, Db, Fcon) -> - prove_univ(erlog_core:dderef(T, Bs), L, Next, Cps, Bs, Vn, Db, Fcon); + erlog_core:unify_prove_body(T, C, Params#param{var_num = Vn1}); +prove_goal({functor, T, F, A}, Params = #param{bindings = Bs}) -> + prove_functor(erlog_core:dderef(T, Bs), F, A, Params); +prove_goal({'=..', T, L}, Params = #param{bindings = Bs}) -> + prove_univ(erlog_core:dderef(T, Bs), L, Params); %% Type testing. -prove_goal({atom, T0}, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal({atom, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> case erlog_core:deref(T0, Bs) of - T when is_atom(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon); - _Other -> erlog_errors:fail(Cps, Db, Fcon) + T when is_atom(T) -> erlog_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) end; -prove_goal({atomic, T0}, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal({atomic, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> case erlog_core:deref(T0, Bs) of - T when ?IS_ATOMIC(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon); - _Other -> erlog_errors:fail(Cps, Db, Fcon) + T when ?IS_ATOMIC(T) -> erlog_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) end; -prove_goal({compound, T0}, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal({compound, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> case erlog_core:deref(T0, Bs) of - T when ?IS_ATOMIC(T) -> erlog_errors:fail(Cps, Db, Fcon); - _Other -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon) + T when ?IS_ATOMIC(T) -> erlog_errors:fail(Params); + _Other -> erlog_core:prove_body(Params#param{goal = Next}) end; -prove_goal({integer, T0}, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal({integer, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> case erlog_core:deref(T0, Bs) of - T when is_integer(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon); - _Other -> erlog_errors:fail(Cps, Db, Fcon) + T when is_integer(T) -> erlog_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) end; -prove_goal({float, T0}, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal({float, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> case erlog_core:deref(T0, Bs) of - T when is_float(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon); - _Other -> erlog_errors:fail(Cps, Db, Fcon) + T when is_float(T) -> erlog_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) end; -prove_goal({number, T0}, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal({number, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> case erlog_core:deref(T0, Bs) of - T when is_number(T) -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon); - _Other -> erlog_errors:fail(Cps, Db, Fcon) + T when is_number(T) -> erlog_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) end; -prove_goal({nonvar, T0}, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal({nonvar, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> case erlog_core:deref(T0, Bs) of - {_} -> erlog_errors:fail(Cps, Db, Fcon); - _Other -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon) + {_} -> erlog_errors:fail(Params); + _Other -> erlog_core:prove_body(Params#param{goal = Next}) end; -prove_goal({var, T0}, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal({var, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> case erlog_core:deref(T0, Bs) of - {_} -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon); - _Other -> erlog_errors:fail(Cps, Db, Fcon) + {_} -> erlog_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) end; %% Atom processing. -prove_goal({atom_chars, A, L}, Next, Cps, Bs, Vn, Db, Fcon) -> - prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({atom_length, A0, L0}, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal({atom_chars, A, L}, Params) -> + prove_atom_chars(A, L, Params); +prove_goal({atom_length, A0, L0}, Params = #param{bindings = Bs, database = Db}) -> case erlog_core:dderef(A0, Bs) of A when is_atom(A) -> Alen = length(atom_to_list(A)), %No of chars in atom case erlog_core:dderef(L0, Bs) of L when is_integer(L) -> - erlog_core:unify_prove_body(Alen, L, Next, Cps, Bs, Vn, Db, Fcon); + erlog_core:unify_prove_body(Alen, L, Params); {_} = Var -> - erlog_core:unify_prove_body(Alen, Var, Next, Cps, Bs, Vn, Db, Fcon); + erlog_core:unify_prove_body(Alen, Var, Params); Other -> erlog_errors:type_error(integer, Other, Db) end; {_} -> erlog_errors:instantiation_error(Db); Other -> erlog_errors:type_error(atom, Other, Db) end; %% Arithmetic evalution and comparison. -prove_goal({is, N, E0}, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_goal({is, N, E0}, Params = #param{bindings = Bs, database = Db}) -> E = eval_arith(erlog_core:deref(E0, Bs), Bs, Db), - erlog_core:unify_prove_body(N, E, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({'>', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> - arith_test_prove_body('>', L, R, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({'>=', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> - arith_test_prove_body('>=', L, R, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({'=:=', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> - arith_test_prove_body('==', L, R, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({'=\\=', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> - arith_test_prove_body('/=', L, R, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({'<', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> - arith_test_prove_body('<', L, R, Next, Cps, Bs, Vn, Db, Fcon); -prove_goal({'=<', L, R}, Next, Cps, Bs, Vn, Db, Fcon) -> - arith_test_prove_body('=<', L, R, Next, Cps, Bs, Vn, Db, Fcon). + erlog_core:unify_prove_body(N, E, Params); +prove_goal({'>', L, R}, Params) -> + arith_test_prove_body('>', L, R, Params); +prove_goal({'>=', L, R}, Params) -> + arith_test_prove_body('>=', L, R, Params); +prove_goal({'=:=', L, R}, Params) -> + arith_test_prove_body('==', L, R, Params); +prove_goal({'=\\=', L, R}, Params) -> + arith_test_prove_body('/=', L, R, Params); +prove_goal({'<', L, R}, Params) -> + arith_test_prove_body('<', L, R, Params); +prove_goal({'=<', L, R}, Params) -> + arith_test_prove_body('=<', L, R, Params). %% term_test_prove_body(Test, Left, Right, Next, ChoicePoints, Bindings, Varnum, Database) -> %% void. -term_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db, Fcon) -> +term_test_prove_body(Test, L, R, Params = #param{next_goal = Next, bindings = Bs}) -> case erlang:Test(erlog_core:dderef(L, Bs), erlog_core:dderef(R, Bs)) of - true -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon); - false -> erlog_errors:fail(Cps, Db, Fcon) + true -> erlog_core:prove_body(Params#param{goal = Next}); + false -> erlog_errors:fail(Params) end. %% prove_arg(Index, Term, Arg, Next, ChoicePoints, VarNum, Database) -> void. %% Prove the goal arg(I, Ct, Arg), Index and Term have been dereferenced. -prove_arg(I, [H | T], A, Next, Cps, Bs, Vn, Db, Fcon) when is_integer(I) -> +prove_arg(I, [H | T], A, Param = #param{database = Db}) when is_integer(I) -> %% He, he, he! - if I == 1 -> erlog_core:unify_prove_body(H, A, Next, Cps, Bs, Vn, Db, Fcon); - I == 2 -> erlog_core:unify_prove_body(T, A, Next, Cps, Bs, Vn, Db, Fcon); + if I == 1 -> erlog_core:unify_prove_body(H, A, Param); + I == 2 -> erlog_core:unify_prove_body(T, A, Param); true -> {fail, Db} end; -prove_arg(I, Ct, A, Next, Cps, Bs, Vn, Db, Fcon) +prove_arg(I, Ct, A, Param = #param{database = Db}) when is_integer(I), tuple_size(Ct) >= 2 -> if I > 1, I + 1 =< tuple_size(Ct) -> - erlog_core:unify_prove_body(element(I + 1, Ct), A, Next, Cps, Bs, Vn, Db, Fcon); + erlog_core:unify_prove_body(element(I + 1, Ct), A, Param); true -> {fail, Db} end; -prove_arg(I, Ct, _, _, _, _, _, Db, _) -> +prove_arg(I, Ct, _, #param{database = Db}) -> %%Type failure just generates an error. if not(is_integer(I)) -> erlog_errors:type_error(integer, I, Db); true -> erlog_errors:type_error(compound, Ct, Db) @@ -179,25 +179,25 @@ prove_arg(I, Ct, _, _, _, _, _, Db, _) -> %% prove_functor(Term, Functor, Arity, Next, ChoicePoints, Bindings, VarNum, Database) -> void. %% Prove the call functor(T, F, A), Term has been dereferenced. -prove_functor(T, F, A, Next, Cps, Bs, Vn, Db, Fcon) when tuple_size(T) >= 2 -> - erlog_core:unify_prove_body(F, element(1, T), A, tuple_size(T) - 1, Next, Cps, Bs, Vn, Db, Fcon); -prove_functor(T, F, A, Next, Cps, Bs, Vn, Db, Fcon) when ?IS_ATOMIC(T) -> - erlog_core:unify_prove_body(F, T, A, 0, Next, Cps, Bs, Vn, Db, Fcon); -prove_functor([_ | _], F, A, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_functor(T, F, A, Params) when tuple_size(T) >= 2 -> + erlog_core:unify_prove_body(F, element(1, T), A, tuple_size(T) - 1, Params); +prove_functor(T, F, A, Params) when ?IS_ATOMIC(T) -> + erlog_core:unify_prove_body(F, T, A, 0, Params); +prove_functor([_ | _], F, A, Params) -> %% Just the top level here. - erlog_core:unify_prove_body(F, '.', A, 2, Next, Cps, Bs, Vn, Db, Fcon); -prove_functor({_} = Var, F0, A0, Next, Cps, Bs0, Vn0, Db, Fcon) -> + erlog_core:unify_prove_body(F, '.', A, 2, Params); +prove_functor({_} = Var, F0, A0, Params = #param{next_goal = Next, bindings = Bs0, var_num = Vn0, database = Db}) -> case {erlog_core:dderef(F0, Bs0), erlog_core:dderef(A0, Bs0)} of {'.', 2} -> %He, he, he! Bs1 = erlog_core:add_binding(Var, [{Vn0} | {Vn0 + 1}], Bs0), - erlog_core:prove_body(Next, Cps, Bs1, Vn0 + 2, Db, Fcon); + erlog_core:prove_body(Params#param{goal = Next, bindings = Bs1, var_num = Vn0 + 2}); {F1, 0} when ?IS_ATOMIC(F1) -> Bs1 = erlog_core:add_binding(Var, F1, Bs0), - erlog_core:prove_body(Next, Cps, Bs1, Vn0, Db, Fcon); + erlog_core:prove_body(Params#param{goal = Next, bindings = Bs1}); {F1, A1} when is_atom(F1), is_integer(A1), A1 > 0 -> As = erlog_core:make_vars(A1, Vn0), Bs1 = erlog_core:add_binding(Var, list_to_tuple([F1 | As]), Bs0), - erlog_core:prove_body(Next, Cps, Bs1, Vn0 + A1, Db, Fcon); %!!! + erlog_core:prove_body(Params#param{goal = Next, bindings = Bs1, var_num = Vn0 + A1}); %!!! %% Now the error cases. {{_}, _} -> erlog_errors:instantiation_error(Db); {F1, A1} when is_atom(F1) -> erlog_errors:type_error(integer, A1, Db); @@ -207,41 +207,39 @@ prove_functor({_} = Var, F0, A0, Next, Cps, Bs0, Vn0, Db, Fcon) -> %% prove_univ(Term, List, Next, ChoicePoints, Bindings, VarNum, Database) -> void. %% Prove the goal Term =.. List, Term has already been dereferenced. -prove_univ(T, L, Next, Cps, Bs, Vn, Db, Fcon) when tuple_size(T) >= 2 -> +prove_univ(T, L, Params) when tuple_size(T) >= 2 -> Es = tuple_to_list(T), - erlog_core:unify_prove_body(Es, L, Next, Cps, Bs, Vn, Db, Fcon); -prove_univ(T, L, Next, Cps, Bs, Vn, Db, Fcon) when ?IS_ATOMIC(T) -> - erlog_core:unify_prove_body([T], L, Next, Cps, Bs, Vn, Db, Fcon); -prove_univ([Lh | Lt], L, Next, Cps, Bs, Vn, Db, Fcon) -> - %% He, he, he! - erlog_core:unify_prove_body(['.', Lh, Lt], L, Next, Cps, Bs, Vn, Db, Fcon); -prove_univ({_} = Var, L, Next, Cps, Bs0, Vn, Db, Fcon) -> - case erlog_core:dderef(L, Bs0) of - ['.', Lh, Lt] -> %He, he, he! - Bs1 = erlog_core:add_binding(Var, [Lh | Lt], Bs0), - erlog_core:prove_body(Next, Cps, Bs1, Vn, Db, Fcon); - [A] when ?IS_ATOMIC(A) -> - Bs1 = erlog_core:add_binding(Var, A, Bs0), - erlog_core:prove_body(Next, Cps, Bs1, Vn, Db, Fcon); - [F | As] when is_atom(F), length(As) > 0 -> - Bs1 = erlog_core:add_binding(Var, list_to_tuple([F | As]), Bs0), - erlog_core:prove_body(Next, Cps, Bs1, Vn, Db, Fcon); - %% Now the error cases. - [{_} | _] -> erlog_errors:instantiation_error(Db); - {_} -> erlog_errors:instantiation_error(Db); - Other -> erlog_errors:type_error(list, Other, Db) - end. + erlog_core:unify_prove_body(Es, L, Params); +prove_univ(T, L, Params) when ?IS_ATOMIC(T) -> + erlog_core:unify_prove_body([T], L, Params); +prove_univ([Lh | Lt], L, Params) -> + %% He, he, he! %TODO what does it mean? + erlog_core:unify_prove_body(['.', Lh, Lt], L, Params); +prove_univ({_} = Var, L, Params = #param{next_goal = Next, bindings = Bs0, database = Db}) -> + Bs1 = case erlog_core:dderef(L, Bs0) of + ['.', Lh, Lt] -> %He, he, he! + erlog_core:add_binding(Var, [Lh | Lt], Bs0); + [A] when ?IS_ATOMIC(A) -> + erlog_core:add_binding(Var, A, Bs0); + [F | As] when is_atom(F), length(As) > 0 -> + erlog_core:add_binding(Var, list_to_tuple([F | As]), Bs0); + %% Now the error cases. They end with throw -> no return there + [{_} | _] -> erlog_errors:instantiation_error(Db); + {_} -> erlog_errors:instantiation_error(Db); + Other -> erlog_errors:type_error(list, Other, Db) + end, + erlog_core:prove_body(Params#param{goal = Next, bindings = Bs1}). %% prove_atom_chars(Atom, List, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Prove the atom_chars(Atom, List). -prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db, Fcon) -> +prove_atom_chars(A, L, Params = #param{bindings = Bs, database = Db}) -> %% After a suggestion by Sean Cribbs. case erlog_core:dderef(A, Bs) of Atom when is_atom(Atom) -> AtomList = [list_to_atom([C]) || C <- atom_to_list(Atom)], - erlog_core:unify_prove_body(L, AtomList, Next, Cps, Bs, Vn, Db, Fcon); + erlog_core:unify_prove_body(L, AtomList, Params); {_} = Var -> %% Error #3: List is neither a list nor a partial list. %% Handled in dderef_list/2. @@ -257,7 +255,7 @@ prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db, Fcon) -> end, Chars = lists:map(Fun, List), Atom = list_to_atom(Chars), - erlog_core:unify_prove_body(Var, Atom, Next, Cps, Bs, Vn, Db, Fcon); + erlog_core:unify_prove_body(Var, Atom, Params); Other -> %% Error #2: Atom is neither a variable nor an atom erlog_errors:type_error(atom, Other, Db) @@ -266,11 +264,11 @@ prove_atom_chars(A, L, Next, Cps, Bs, Vn, Db, Fcon) -> %% arith_test_prove_body(Test, Left, Right, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. -arith_test_prove_body(Test, L, R, Next, Cps, Bs, Vn, Db, Fcon) -> +arith_test_prove_body(Test, L, R, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> case erlang:Test(eval_arith(erlog_core:deref(L, Bs), Bs, Db), eval_arith(erlog_core:deref(R, Bs), Bs, Db)) of - true -> erlog_core:prove_body(Next, Cps, Bs, Vn, Db, Fcon); - false -> erlog_errors:fail(Cps, Db, Fcon) + true -> erlog_core:prove_body(Params#param{goal = Next}); + false -> erlog_errors:fail(Params) end. %% eval_arith(ArithExpr, Bindings, Database) -> Number. diff --git a/src/core/lang/erlog_dcg.erl b/src/libs/erlog_dcg.erl similarity index 93% rename from src/core/lang/erlog_dcg.erl rename to src/libs/erlog_dcg.erl index c0813fb..72522c2 100644 --- a/src/core/lang/erlog_dcg.erl +++ b/src/libs/erlog_dcg.erl @@ -21,7 +21,7 @@ -include("erlog_int.hrl"). -export([expand_term/1, expand_term/2]). --export([expand_term_2/7, phrase_3/7]). +-export([expand_term_2/1, phrase_3/1]). -export([load/1]). load(Db) -> @@ -44,22 +44,22 @@ load(Db) -> %% expand_term_2(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> %% void %% Call the expand_term/2 predicate. -expand_term_2(Goal, Next, Cps, Bs, Vn0, Db, Fcon) -> +expand_term_2(Param = #param{goal = Goal, bindings = Bs, var_num = Vn0}) -> {expand_term, DCGRule, A2} = erlog_core:dderef(Goal, Bs), {Exp, Vn1} = expand_term(DCGRule, Vn0), - erlog_core:unify_prove_body(A2, Exp, Next, Cps, Bs, Vn1, Db, Fcon). + erlog_core:unify_prove_body(A2, Exp, Param#param{var_num = Vn1}). %% phrase_3(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> void. %% Call the phrase/3 preidicate. We could easily do this in prolog %% except for that it calls dcg_body/4 which is not exported. %% %% phrase(GRBody, S0, S) -> dcg_body(GRBody, S0, S, Goal), call(Goal). -phrase_3(Goal, Next0, Cps, Bs, Vn0, Db, Fcon) -> +phrase_3(Param = #param{goal = Goal, next_goal = Next0, bindings = Bs, var_num = Vn0}) -> {phrase, GRBody, S0, S} = erlog_core:dderef(Goal, Bs), {Body, Vn1} = dcg_body(GRBody, S0, S, Vn0), %% io:format("~p\n", [Body]), Next1 = [{call, Body} | Next0], %Evaluate body - erlog_core:prove_body(Next1, Cps, Bs, Vn1, Db, Fcon). + erlog_core:prove_body(Param#param{goal = Next1, var_num = Vn1}). %% expand_term(Term) -> {ExpTerm}. %% expand_term(Term, VarNum) -> {ExpTerm,NewVarNum}. diff --git a/src/core/lang/erlog_lists.erl b/src/libs/erlog_lists.erl similarity index 62% rename from src/core/lang/erlog_lists.erl rename to src/libs/erlog_lists.erl index afb23dc..8cb0b4f 100644 --- a/src/core/lang/erlog_lists.erl +++ b/src/libs/erlog_lists.erl @@ -29,7 +29,7 @@ -export([load/1]). %% Library functions. --export([append_3/7, insert_3/7, member_2/7, memberchk_2/7, reverse_2/7, sort_2/7]). +-export([append_3/2, insert_3/2, member_2/2, memberchk_2/2, reverse_2/2, sort_2/2]). %% load(Database) -> Database. %% Assert predicates into the database. @@ -52,92 +52,94 @@ load(Db) -> %% append([], L, L). %% append([H|T], L, [H|L1]) :- append(T, L, L1). %% Here we attempt to compile indexing in the first argument. -append_3({append, A1, L, A3}, Next0, Cps, Bs0, Vn, Db, Fcon) -> +append_3({append, A1, L, A3}, Params = #param{next_goal = Next0, bindings = Bs0, choice = Cps, + var_num = Vn, f_consulter = Fcon}) -> case erlog_core:deref(A1, Bs0) of [] -> %Cannot backtrack - erlog_core:unify_prove_body(L, A3, Next0, Cps, Bs0, Vn, Db, Fcon); + erlog_core:unify_prove_body(L, A3, Params); [H | T] -> %Cannot backtrack L1 = {Vn}, Next1 = [{append, T, L, L1} | Next0], - erlog_core:unify_prove_body(A3, [H | L1], Next1, Cps, Bs0, Vn + 1, Db, Fcon); + erlog_core:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, var_num = Vn + 1}); {_} = Var -> %This can backtrack - FailFun = fun(LCp, LCps, LDb) -> - fail_append_3(LCp, LCps, LDb, Var, L, A3, Fcon) + FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed + fail_append_3(LCp, Params#param{choice = LCps, database = LDb, f_consulter = Fcon}, Var, L, A3) end, Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, Bs1 = erlog_core:add_binding(Var, [], Bs0), - erlog_core:unify_prove_body(L, A3, Next0, [Cp | Cps], Bs1, Vn, Db, Fcon); - _ -> erlog_errors:fail(Cps, Db, Fcon) %Will fail here! + erlog_core:unify_prove_body(L, A3, Params#param{choice = [Cp | Cps], bindings = Bs1}); + _ -> erlog_errors:fail(Params) %Will fail here! end. -fail_append_3(#cp{next = Next0, bs = Bs0, vn = Vn}, Cps, Db, A1, L, A3, Fcon) -> +fail_append_3(#cp{next = Next0, bs = Bs0, vn = Vn}, Params, A1, L, A3) -> H = {Vn}, T = {Vn + 1}, L1 = {Vn + 2}, Bs1 = erlog_core:add_binding(A1, [H | T], Bs0), %A1 always a variable here. Next1 = [{append, T, L, L1} | Next0], - erlog_core:unify_prove_body(A3, [H | L1], Next1, Cps, Bs1, Vn + 3, Db, Fcon). + erlog_core:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs1, + var_num = Vn + 3}). %% insert_3(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% insert(L, X, [X|L]). %% insert([H|L], X, [H|L1]) :- insert(L, X, L1). -insert_3({insert, A1, A2, A3}, Next, Cps, Bs, Vn, Db, Fcon) -> - FailFun = fun(LCp, LCps, LDb) -> - fail_insert_3(LCp, LCps, LDb, A1, A2, A3, Fcon) +insert_3({insert, A1, A2, A3}, Params = #param{next_goal = Next, bindings = Bs, choice = Cps, var_num = Vn, f_consulter = Fcon}) -> + FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed + fail_insert_3(LCp, Params#param{choice = LCps, database = LDb, f_consulter = Fcon}, A1, A2, A3) end, Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, - erlog_core:unify_prove_body(A3, [A2 | A1], Next, [Cp | Cps], Bs, Vn, Db, Fcon). + erlog_core:unify_prove_body(A3, [A2 | A1], Params#param{choice = [Cp | Cps]}). -fail_insert_3(#cp{next = Next0, bs = Bs, vn = Vn}, Cps, Db, A1, X, A3, Fcon) -> +fail_insert_3(#cp{next = Next0, bs = Bs, vn = Vn}, Params, A1, X, A3) -> H = {Vn}, L = {Vn + 1}, L1 = {Vn + 2}, Next1 = [{insert, L, X, L1} | Next0], - erlog_core:unify_prove_body(A1, [H | L], A3, [H | L1], Next1, Cps, Bs, Vn + 3, Db, Fcon). + erlog_core:unify_prove_body(A1, [H | L], A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 3}). %% member_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% member(X, [X|_]). %% member(X, [_|T]) :- member(X, T). -member_2({member, A1, A2}, Next, Cps, Bs, Vn, Db, Fcon) -> +member_2({member, A1, A2}, Param = #param{next_goal = Next, bindings = Bs, choice = Cps, var_num = Vn}) -> FailFun = fun(LCp, LCps, LDb) -> - fail_member_2(LCp, LCps, LDb, A1, A2, Fcon) + fail_member_2(LCp, Param#param{choice = LCps, database = LDb}, A1, A2) end, Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, T = {Vn}, - erlog_core:unify_prove_body(A2, [A1 | T], Next, [Cp | Cps], Bs, Vn + 1, Db, Fcon). + erlog_core:unify_prove_body(A2, [A1 | T], Param#param{choice = [Cp | Cps], var_num = Vn + 1}). -fail_member_2(#cp{next = Next0, bs = Bs, vn = Vn}, Cps, Db, A1, A2, Fcon) -> +fail_member_2(#cp{next = Next0, bs = Bs, vn = Vn}, Params, A1, A2) -> H = {Vn}, T = {Vn + 1}, Next1 = [{member, A1, T} | Next0], - erlog_core:unify_prove_body(A2, [H | T], Next1, Cps, Bs, Vn + 2, Db, Fcon). + erlog_core:unify_prove_body(A2, [H | T], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 2}). %% memberchk_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% memberchk(X, [X|_]) :- !. %% memberchk(X, [_|T]) :- member(X, T). %% We don't build the list and we never backtrack so we can be smart %% and match directly. Should we give a type error? -memberchk_2({memberchk, A1, A2}, Next, Cps, Bs0, Vn, Db, Fcon) -> +memberchk_2({memberchk, A1, A2}, Params = #param{next_goal = Next, bindings = Bs0}) -> case erlog_core:deref(A2, Bs0) of [H | T] -> case erlog_core:unify(A1, H, Bs0) of {succeed, Bs1} -> - erlog_core:prove_body(Next, Cps, Bs1, Vn, Db, Fcon); + erlog_core:prove_body(Params#param{goal = Next, bindings = Bs1}); fail -> - memberchk_2({memberchk, A1, T}, Next, Cps, Bs0, Vn, Db, Fcon) + memberchk_2({memberchk, A1, T}, Params) end; {_} -> erlog_errors:instantiation_error(); - _ -> erlog_errors:fail(Cps, Db, Fcon) + _ -> erlog_errors:fail(Params) end. %% reverse_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% reverse([], []). %% reverse([H|L1], L) :- reverse(L1, L2), append(L2, [H], L). %% Here we attempt to compile indexing in the first argument. -reverse_2({reverse, A1, A2}, Next0, Cps, Bs0, Vn, Db, Fcon) -> +reverse_2({reverse, A1, A2}, Params = #param{next_goal = Next0, bindings = Bs0, choice = Cps, var_num = Vn}) -> case erlog_core:deref(A1, Bs0) of [] -> - erlog_core:unify_prove_body(A2, [], Next0, Cps, Bs0, Vn, Db, Fcon); + erlog_core:unify_prove_body(A2, [], Params); [H | T] -> L = {Vn}, L1 = A2, @@ -146,18 +148,18 @@ reverse_2({reverse, A1, A2}, Next0, Cps, Bs0, Vn, Db, Fcon) -> %%prove_body(Next1, Cps, Bs0, Vn+1, Db); %% Smarter direct calling of local function. Next1 = [{append, L, [H], L1} | Next0], - reverse_2({reverse, T, L}, Next1, Cps, Bs0, Vn + 1, Db, Fcon); + reverse_2({reverse, T, L}, Params#param{next_goal = Next1, var_num = Vn + 1}); {_} = Var -> - FailFun = fun(LCp, LCps, LDb) -> - fail_reverse_2(LCp, LCps, LDb, Var, A2, Fcon) + FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed + fail_reverse_2(LCp, Params#param{choice = LCps, database = LDb}, Var, A2) end, Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, Bs1 = erlog_core:add_binding(Var, [], Bs0), - erlog_core:unify_prove_body(A2, [], Next0, [Cp | Cps], Bs1, Vn, Db, Fcon); - _ -> erlog_errors:fail(Cps, Db, Fcon) %Will fail here! + erlog_core:unify_prove_body(A2, [], Params#param{choice = [Cp | Cps], bindings = Bs1}); + _ -> erlog_errors:fail(Params) %Will fail here! end. -fail_reverse_2(#cp{next = Next, bs = Bs0, vn = Vn}, Cps, Db, A1, A2, Fcon) -> +fail_reverse_2(#cp{next = Next, bs = Bs0, vn = Vn}, Params, A1, A2) -> H = {Vn}, T = {Vn + 1}, L1 = A2, @@ -166,11 +168,11 @@ fail_reverse_2(#cp{next = Next, bs = Bs0, vn = Vn}, Cps, Db, A1, A2, Fcon) -> %%Next1 = [{reverse,T,L},{apperse,L,[H],L1}|Next], %%prove_body(Next1, Cps, Bs1, Vn+3, Db). Next1 = [{append, L, [H], L1} | Next], - reverse_2({reverse, T, L}, Next1, Cps, Bs1, Vn + 3, Db, Fcon). + reverse_2({reverse, T, L}, Params#param{next_goal = Next1, bindings = Bs1, var_num = Vn + 3}). %% sort_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% sort(List, SortedList). -sort_2({sort, L0, S}, Next, Cps, Bs, Vn, Db, Fcon) -> +sort_2({sort, L0, S}, Param = #param{bindings = Bs}) -> %% This may throw an erlog error, we don't catch it here. L1 = lists:usort(erlog_core:dderef_list(L0, Bs)), - erlog_core:unify_prove_body(S, L1, Next, Cps, Bs, Vn, Db, Fcon). \ No newline at end of file + erlog_core:unify_prove_body(S, L1, Param). \ No newline at end of file From e87a64155e4f0e4529394845e9a3769cf1b74068 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 11 Jul 2014 02:01:00 +0000 Subject: [PATCH 040/251] return shell --- src/interface/local/erlog_local_shell.erl | 63 +++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 src/interface/local/erlog_local_shell.erl diff --git a/src/interface/local/erlog_local_shell.erl b/src/interface/local/erlog_local_shell.erl new file mode 100644 index 0000000..3dacc44 --- /dev/null +++ b/src/interface/local/erlog_local_shell.erl @@ -0,0 +1,63 @@ +%% Copyright (c) 2008-2013 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : erlog_shell.erl +%% Author : Robert Virding +%% Purpose : A simple Erlog shell. + +-module(erlog_local_shell). + +-export([start/0]). + +-import(lists, [foldl/3, foreach/2]). + +start() -> + io:fwrite("Erlog Shell V~s (abort with ^G)\n", + [erlang:system_info(version)]), + {ok, Core} = erlog:start_link(), + link(Core), + server_loop(Core, normal, []). + +%% A simple Erlog shell similar to a "normal" Prolog shell. It allows +%% user to enter goals, see resulting bindings and request next +%% solution. +server_loop(Core, State, Line) -> + case io:fread('| ?- ', "~s") of + {ok, [Term]} -> + Res = erlog:execute(Core, lists:append(Line, Term)), + {NewState, NewLine} = process_execute(Res, State, Line, Term), + server_loop(Core, NewState, NewLine); + {error, {_, Em, E}} -> + io:fwrite("Error: ~s\n", [Em:format_error(E)]), + server_loop(Core, State, Line) + end. + +%% Processes return value after execution. +-spec process_execute(tuple(), atom(), list(), string()) -> tuple(). +process_execute({ok, more}, State, Line, Command) -> + {State, lists:append(Line, Command)}; +process_execute({ok, halt}, _, _, _) -> + io:format("OK."), + exit(normal); +process_execute(Reply, _, _, _) -> + process_reply(Reply). + +%% Processes reply from prolog. Form it to normal view. +-spec process_reply(tuple()) -> tuple(). +process_reply({Res, select}) -> + io:format("~p~n: ", [Res]), + {select, []}; +process_reply(Res) -> + io:format("~p~n", [Res]), + {normal, []}. \ No newline at end of file From 60f1609708d3a519434ff1ed85bf63eade15ef61 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 11 Jul 2014 17:09:35 +0000 Subject: [PATCH 041/251] maked erlang return format instead binary --- src/core/erlog.erl | 2 +- src/core/erlog_logic.erl | 13 +++++++------ 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 0534391..f9c6a75 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -152,7 +152,7 @@ run_command(Command, State) -> preprocess_command({ok, Command}, State = #state{f_consulter = Fun, db = Db}) when is_list(Command) -> %TODO may be remove me? case erlog_logic:reconsult_files(Command, Db, Fun) of ok -> - {<<"Yes">>, State}; + {true, State}; {error, {L, Pm, Pe}} -> {erlog_io:format_error([L, Pm:format_error(Pe)]), State}; {Error, Message} when Error == error; Error == erlog_error -> diff --git a/src/core/erlog_logic.erl b/src/core/erlog_logic.erl index a7abaf0..495f3ba 100644 --- a/src/core/erlog_logic.erl +++ b/src/core/erlog_logic.erl @@ -49,23 +49,24 @@ reconsult_files([F | Fs], Db, Fun) -> reconsult_files(Other, _Db, _Fun) -> {error, {type_error, list, Other}}. shell_prove_result({succeed, Vs}) -> show_bindings(Vs); -shell_prove_result(fail) -> <<"No">>; +shell_prove_result(fail) -> false; shell_prove_result({error, Error}) -> erlog_io:format_error([Error]); shell_prove_result({'EXIT', Error}) -> erlog_io:format_error("EXIT", [Error]). %% show_bindings(VarList, Pid) %% Show the bindings and query user for next solution. -show_bindings([]) -> <<"Yes">>; -show_bindings(Vs) -> +show_bindings([]) -> true; +show_bindings(Vs) -> %TODO where atoms are created? Out = lists:foldr( fun({Name, Val}, Acc) -> - [erlog_io:writeq1({'=', {Name}, Val}) | Acc] +%% [erlog_io:writeq1({'=', {Name}, Val}) | Acc] + [{Name, Val} | Acc] %TODO. Test, is this suitable for all variants? If so - writeq can be deleted. end, [], Vs), %format reply - {Out, select}. + {{true, Out}, select}. select_bindings(Selection, Next) -> case string:chr(Selection, $;) of - 0 -> <<"Yes">>; + 0 -> true; _ -> shell_prove_result(Next) end. From 7e33a0e8c0ee8ffe30d83820110b942994e93978 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 11 Jul 2014 17:13:41 +0000 Subject: [PATCH 042/251] updated readme --- README.md | 16 +++++++++++++--- test/erlog_test.erl | 4 ++-- 2 files changed, 15 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index b37c23a..273cb7b 100644 --- a/README.md +++ b/README.md @@ -8,12 +8,22 @@ Make erlog: make rel #### Command line prolog coding: +##### Local shell +To use local shell just run erlang emulator in directory with compiled beam files (`ebin`) and run local shell: + + make + cd ebin + erl + erlog_local_shell:start(). +##### Remote shell +You can use remote shell and connect to it via telnet. Run release: ./rel/erlog/bin/erlog start And connect to it via console: telnet 127.0.0.1 8080 +Port can be set up in `src/erlog.app.src`. #### Processing prolog code from erlang: Spawn new logic core: @@ -30,11 +40,11 @@ Full Example: (erlog@127.0.0.1)1> {ok, Pid} = erlog:start_link(). {ok,<0.961.0>} (erlog@127.0.0.1)2> erlog:execute(Pid, "assert(father('victor', 'andrey'))."). - <<"Yes">> + true (erlog@127.0.0.1)3> erlog:execute(Pid, "father('victor', 'andrey')."). - <<"Yes">> + true (erlog@127.0.0.1)4> erlog:execute(Pid, "father('victor', 'vasya')."). - <<"No">> + false #### Custom database server: Erlog now supports using your own database, instead of using ets and dicts. Just implement `erlog_storage` callback interface diff --git a/test/erlog_test.erl b/test/erlog_test.erl index c34edb9..081a9e2 100644 --- a/test/erlog_test.erl +++ b/test/erlog_test.erl @@ -22,10 +22,10 @@ run_one(File) -> ?debugMsg(File), Res = erlog:execute(ErlogWorker, string:join(["consult(", File, ")."], "\"")), ?debugMsg(Res), - ?assertEqual(<<"Yes">>, Res), + ?assertEqual(true, Res), Res1 = erlog:execute(ErlogWorker, "test_all."), ?debugMsg(Res1), - ?assertEqual(<<"Yes">>, Res1), + ?assertEqual(true, Res1), ok. get_absolute_names(FileNames) -> From 814e9c81de23b2abc37509bec0d6cae6eb46ebb7 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sun, 13 Jul 2014 13:33:07 +0000 Subject: [PATCH 043/251] split execute into select and normal. Move method selection to realisations --- src/core/erlog.erl | 7 ++++--- src/interface/local/erlog_local_shell.erl | 7 +++++-- src/interface/remote/erlog_remote_shell.erl | 11 +++++++---- 3 files changed, 16 insertions(+), 9 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index f9c6a75..8c7da92 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -33,7 +33,7 @@ -include("erlog_int.hrl"). %% Interface to server. --export([start_link/1, start_link/0, execute/2]). +-export([start_link/1, start_link/0, execute/2, select/2]). %% Gen server callbacs. -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). @@ -48,6 +48,7 @@ }). execute(Worker, Command) -> gen_server:call(Worker, {execute, trim_command(Command)}). +select(Worker, Command) -> gen_server:call(Worker, {select, trim_command(Command)}). -spec start_link() -> pid(). start_link() -> @@ -74,14 +75,14 @@ init(Params) -> % use custom database implementation end, {ok, #state{db = Db, f_consulter = FileCon, e_man = E}}. -handle_call({execute, Command}, _From, State = #state{state = normal}) -> %in normal mode +handle_call({execute, Command}, _From, State) -> %running prolog code in normal mode {Res, _} = Repl = case erlog_scan:tokens([], Command, 1) of {done, Result, _Rest} -> run_command(Result, State); % command is finished, run. {more, _} -> {{ok, more}, State} % unfinished command. Report it and do nothing. end, NewState = change_state(Repl), {reply, Res, NewState}; -handle_call({execute, Command}, _From, State) -> %in selection solutions mode +handle_call({select, Command}, _From, State) -> %in selection solutions mode {Res, _} = Repl = preprocess_command({select, Command}, State), NewState = change_state(Repl), % change state, depending on reply {reply, Res, NewState}. diff --git a/src/interface/local/erlog_local_shell.erl b/src/interface/local/erlog_local_shell.erl index 3dacc44..8bc85f4 100644 --- a/src/interface/local/erlog_local_shell.erl +++ b/src/interface/local/erlog_local_shell.erl @@ -35,7 +35,10 @@ start() -> server_loop(Core, State, Line) -> case io:fread('| ?- ', "~s") of {ok, [Term]} -> - Res = erlog:execute(Core, lists:append(Line, Term)), + Res = case State of + select -> erlog:select(Core, lists:append(Line, Term)); + _ -> erlog:execute(Core, lists:append(Line, Term)) + end, {NewState, NewLine} = process_execute(Res, State, Line, Term), server_loop(Core, NewState, NewLine); {error, {_, Em, E}} -> @@ -56,7 +59,7 @@ process_execute(Reply, _, _, _) -> %% Processes reply from prolog. Form it to normal view. -spec process_reply(tuple()) -> tuple(). process_reply({Res, select}) -> - io:format("~p~n: ", [Res]), + io:format("~p~n: ", [{Res, select}]), {select, []}; process_reply(Res) -> io:format("~p~n", [Res]), diff --git a/src/interface/remote/erlog_remote_shell.erl b/src/interface/remote/erlog_remote_shell.erl index 944fac3..a03dc46 100644 --- a/src/interface/remote/erlog_remote_shell.erl +++ b/src/interface/remote/erlog_remote_shell.erl @@ -122,8 +122,8 @@ handle_cast(_Request, State) -> {noreply, NewState :: #state{}} | {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), NewState :: #state{}}). -handle_info({tcp, _, CommandRaw}, State = #state{line = Line, core = Core, socket = Socket}) -> - try erlog:execute(Core, lists:append(Line, CommandRaw)) of +handle_info({tcp, _, CommandRaw}, State = #state{spike = Spike, line = Line, core = Core, socket = Socket}) -> + try call_prolog(Spike, Core, Line, CommandRaw) of {ok, halt} -> gen_tcp:send(Socket, <<"Ok.\n">>), {stop, normal, State}; @@ -180,14 +180,17 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== %%% Internal functions %%%=================================================================== +call_prolog(select, Core, Line, Term) -> erlog:select(Core, lists:append(Line, Term)); +call_prolog(_, Core, Line, Term) -> erlog:execute(Core, lists:append(Line, Term)). + % process reply from prolog process_reply(State = #state{socket = Socket}, {Res, select}) -> io:format("Reply = ~p~n", [Res]), - gen_tcp:send(Socket, Res), + gen_tcp:send(Socket, io_lib:format("~p", [Res])), gen_tcp:send(Socket, <<"\n: ">>), {noreply, State#state{spike = select, line = []}}; process_reply(State = #state{socket = Socket}, Res) -> io:format("Reply = ~p~n", [Res]), - gen_tcp:send(Socket, Res), + gen_tcp:send(Socket, io_lib:format("~p", [Res])), gen_tcp:send(Socket, <<"\n| ?- ">>), {noreply, State#state{spike = normal, line = []}}. \ No newline at end of file From 0580973c6dde7ae337af1c1f3c3b2e24e969fd67 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sun, 13 Jul 2014 14:02:01 +0000 Subject: [PATCH 044/251] fix remote shell & update readme --- README.md | 12 +++++++++++- src/interface/remote/erlog_remote_shell.erl | 6 +++--- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index 273cb7b..c859fcb 100644 --- a/README.md +++ b/README.md @@ -26,15 +26,21 @@ And connect to it via console: Port can be set up in `src/erlog.app.src`. #### Processing prolog code from erlang: +##### Starting Spawn new logic core: {ok, Pid} = erlog:start_link(). +##### Executing Process prolog terms, using your core: erlog:execute(Worker, Command). Where: `Command` is a command, ended with dot, -`Worker` is a pid of your prolog logic core. +`Worker` is a pid of your prolog logic core. +##### Selecting +When erlog:execute returns `select` in result - you can select for some other result calling `erlog:select/2` instead of execute. + + erlog:select(Worker, ";"). Full Example: (erlog@127.0.0.1)1> {ok, Pid} = erlog:start_link(). @@ -45,6 +51,10 @@ Full Example: true (erlog@127.0.0.1)4> erlog:execute(Pid, "father('victor', 'vasya')."). false + (erlog@127.0.0.1)5> erlog:execute(Pid, "run(S)."). + {{true,[{'S',600}]}, select} + (erlog@127.0.0.1)6> erlog:select(Pid, ";"). + false #### Custom database server: Erlog now supports using your own database, instead of using ets and dicts. Just implement `erlog_storage` callback interface diff --git a/src/interface/remote/erlog_remote_shell.erl b/src/interface/remote/erlog_remote_shell.erl index a03dc46..e82361d 100644 --- a/src/interface/remote/erlog_remote_shell.erl +++ b/src/interface/remote/erlog_remote_shell.erl @@ -184,9 +184,9 @@ call_prolog(select, Core, Line, Term) -> erlog:select(Core, lists:append(Line, T call_prolog(_, Core, Line, Term) -> erlog:execute(Core, lists:append(Line, Term)). % process reply from prolog -process_reply(State = #state{socket = Socket}, {Res, select}) -> - io:format("Reply = ~p~n", [Res]), - gen_tcp:send(Socket, io_lib:format("~p", [Res])), +process_reply(State = #state{socket = Socket}, {_, select} = Reply) -> + io:format("Reply = ~p~n", [Reply]), + gen_tcp:send(Socket, io_lib:format("~p", [Reply])), gen_tcp:send(Socket, <<"\n: ">>), {noreply, State#state{spike = select, line = []}}; process_reply(State = #state{socket = Socket}, Res) -> From ba552a521182b72e1343548045f54f12ca87df52 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sun, 13 Jul 2014 22:46:40 +0000 Subject: [PATCH 045/251] findall added --- include/erlog_int.hrl | 6 +++++- src/core/erlog_core.erl | 27 ++++++++++++++++++--------- src/storage/erlog_dict.erl | 8 ++++++-- src/storage/erlog_ets.erl | 13 +++++++++++-- src/storage/erlog_memory.erl | 4 +++- src/storage/erlog_storage.erl | 2 ++ 6 files changed, 45 insertions(+), 15 deletions(-) diff --git a/include/erlog_int.hrl b/include/erlog_int.hrl index 16cc4f7..8e350c4 100644 --- a/include/erlog_int.hrl +++ b/include/erlog_int.hrl @@ -126,6 +126,10 @@ {consult, 1}, {reconsult, 1}, %% Debug functions - {writeln, 1} + {writeln, 1}, + %% Searching functions + {findall, 3}, + {bagof, 3}, + {setof, 3} ] ). \ No newline at end of file diff --git a/src/core/erlog_core.erl b/src/core/erlog_core.erl index 2377d14..3c2cc09 100644 --- a/src/core/erlog_core.erl +++ b/src/core/erlog_core.erl @@ -272,7 +272,7 @@ make_vars(I, Vn) -> %% Logic and control. Conjunctions are handled in prove_body and true %% has been compiled away. prove_goal(Param = #param{goal = {call, G}, next_goal = Next0, choice = Cps, - bindings = Bs, var_num = Vn, database = Db}) -> + bindings = Bs, var_num = Vn, database = Db}) -> %TODO move me to other modules %% Only add cut CP to Cps if goal contains a cut. Label = Vn, case check_goal(G, Next0, Bs, Db, false, Label) of @@ -399,6 +399,16 @@ prove_goal(Param = #param{goal = {reconsult, Name}, next_goal = Next, f_consulte erlog_errors:erlog_error(Error, Db) end, prove_body(Param#param{goal = Next}); +prove_goal(Param = #param{goal = {findall, Goal, Fun, Res}, bindings = Bs0, next_goal = Next, database = Db}) -> + Predicates = erlog_memory:finadll(Db, Fun), + Element = index_of(Goal, tuple_to_list(Fun)) - 1, + Result = lists:foldr( + fun({_, Pred, _}, Acc) -> + [_ | ParamList] = tuple_to_list(Pred), + [lists:nth(Element, ParamList) | Acc] + end, [], Predicates), + Bs1 = erlog_core:add_binding(Res, Result, Bs0), + prove_body(Param#param{goal = Next, bindings = Bs1}); %% Now look up the database. prove_goal(Param = #param{goal = G, database = Db}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), @@ -461,7 +471,6 @@ check_goal(G0, Next, Bs, Db, Cut, Label) -> %% void. %% Call an external (Erlang) generator and handle return value, either %% succeed or fail. - prove_ecall(Efun, Val, Param = #param{next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> case Efun() of {succeed, Ret, Cont} -> %Succeed and more choices @@ -475,7 +484,6 @@ prove_ecall(Efun, Val, Param = #param{next_goal = Next, choice = Cps, bindings = %% prove_clause(Head, Body, Next, ChoicePoints, Bindings, VarNum, DataBase) -> %% void. %% Unify clauses matching with functor from Head with both Head and Body. - prove_clause(H, B, Param = #param{database = Db}) -> Functor = functor(H), case erlog_memory:get_procedure(Db, Functor) of @@ -490,7 +498,6 @@ prove_clause(H, B, Param = #param{database = Db}) -> %% unify_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to unify Head and Body using Clauses which all have the same functor. - unify_clauses(Ch, Cb, [C], Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0}) -> %% No choice point on last clause case unify_clause(Ch, Cb, C, Bs0, Vn0) of @@ -521,7 +528,6 @@ unify_clause(Ch, Cb, {_Tag, H0, {B0, _}}, Bs0, Vn0) -> %% prove_current_predicate(PredInd, Next, ChoicePoints, Bindings, VarNum, DataBase) -> %% void. %% Match functors of existing user (interpreted) predicate with PredInd. - prove_current_predicate(Pi, Param = #param{database = Db}) -> case Pi of {'/', _, _} -> ok; @@ -599,7 +605,6 @@ prove_retract(H, B, Params = #param{database = Db}) -> %% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to retract Head and Body using Clauses which all have the same functor. - retract_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}) -> %TODO foreach vs handmade recursion? case unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> @@ -806,7 +811,6 @@ unify_head_args(G, H, Rs0, Bs0, Vn0, I, S) -> %% check Term as it should already be checked. Use term_instance to %% handle goals. N.B. We have to be VERY careful never to go into the %% original tail as this will cause havoc. - body_instance([{{cut} = Cut, _, Last} | Gs0], Tail, Rs0, Vn0, Label) -> {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), {[{Cut, Label, Last} | Gs1], Rs1, Vn1}; @@ -845,7 +849,6 @@ body_instance([], Tail, Rs, Vn, _Label) -> {Tail, Rs, Vn}. %% overlapping integer ranges. Don't check Term as it should already %% be checked. Use orddict as there will seldom be many variables and %% it it fast to setup. - body_term([{{cut}, _, _} | Gs0], Rs0, Vn0) -> {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), {body_conj('!', Gs1), Rs1, Vn1}; @@ -917,4 +920,10 @@ initial_goal(S, Bs0, Vn0) when ?IS_FUNCTOR(S) -> {As1, Bs1, Vn1} = initial_goal(As0, Bs0, Vn0), {list_to_tuple([element(1, S) | As1]), Bs1, Vn1}; initial_goal(T, Bs, Vn) when ?IS_ATOMIC(T) -> {T, Bs, Vn}; -initial_goal(T, _Bs, _Vn) -> erlog_errors:type_error(callable, T). \ No newline at end of file +initial_goal(T, _Bs, _Vn) -> erlog_errors:type_error(callable, T). + +index_of(Item, List) -> index_of(Item, List, 1). + +index_of(_, [], _) -> not_found; +index_of(Item, [Item | _], Index) -> Index; +index_of(Item, [_ | Tl], Index) -> index_of(Item, Tl, Index + 1). \ No newline at end of file diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 4c60096..5e78a97 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -21,7 +21,8 @@ abolish_clauses/2, get_procedure/2, get_procedure_type/2, - get_interp_functors/1]). + get_interp_functors/1, + findall/2]). %% API -export([]). @@ -105,4 +106,7 @@ clause(Head, Body0, Db, ClauseFun) -> ({code, _}) -> erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); ({clauses, T, Cs}) -> ClauseFun(T, Body, Cs) - end, {clauses, 1, [{0, Head, Body}]}, Db). \ No newline at end of file + end, {clauses, 1, [{0, Head, Body}]}, Db). + +findall(State, Functor) -> %TODO implement me! + erlang:error(not_implemented). diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 9a1021e..41676a8 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -23,7 +23,8 @@ abolish_clauses/2, get_procedure/2, get_procedure_type/2, - get_interp_functors/1]). + get_interp_functors/1, + findall/2]). new() -> {ok, ets:new(eets, [])}. @@ -45,6 +46,7 @@ add_compiled_proc(Db, {Functor, M, F}) -> assertz_clause(Db, {Head, Body0}) -> clause(Head, Body0, Db, fun(Functor, Tag, Cs, Body) -> + io:format("insert functor ~p~n", [Functor]), ets:insert(Db, {Functor, clauses, Tag + 1, Cs ++ [{Tag, Head, Body}]}) end), {ok, Db}. @@ -78,6 +80,13 @@ abolish_clauses(Db, Functor) -> end, {ok, Db}. +findall(Db, Functor) -> + Params = tuple_to_list(Functor), + Fun = hd(Params), + Len = length(Params) - 1, + [{_, _, _, Body}] = ets:lookup(Db, {Fun, Len}), + {Body, Db}. + get_procedure(Db, Functor) -> {case ets:lookup(Db, Functor) of [{_, built_in}] -> built_in; @@ -110,4 +119,4 @@ clause(Head, Body0, Db, ClauseFun) -> [{_, code, _}] -> erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); [{_, clauses, Tag, Cs}] -> ClauseFun(Functor, Tag, Cs, Body); [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) - end. \ No newline at end of file + end. diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 20a7d98..062695b 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -16,7 +16,7 @@ %% API -export([start_link/1, start_link/2, add_compiled_proc/2, assertz_clause/3, asserta_clause/3, retract_clause/3, abolish_clauses/2, get_procedure/2, get_procedure_type/2, - get_interp_functors/1, assertz_clause/2, asserta_clause/2]). + get_interp_functors/1, assertz_clause/2, asserta_clause/2, finadll/2]). -export([add_built_in/2]). @@ -51,6 +51,8 @@ asserta_clause(Database, {':-', H, B}) -> asserta_clause(Database, H, B); asserta_clause(Database, H) -> asserta_clause(Database, H, true). asserta_clause(Database, Head, Body) -> gen_server:call(Database, {asserta_clause, {Head, Body}}). +finadll(Database, Fun) -> gen_server:call(Database, {findall, Fun}). + retract_clause(Database, F, Ct) -> gen_server:call(Database, {retract_clause, {F, Ct}}). abolish_clauses(Database, Func) -> gen_server:call(Database, {abolish_clauses, Func}). diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl index 2efa30b..04889cc 100644 --- a/src/storage/erlog_storage.erl +++ b/src/storage/erlog_storage.erl @@ -21,6 +21,8 @@ -callback asserta_clause(State :: term(), Param :: term()) -> {ok, NewState :: term()}. +-callback findall(State :: term(), Functor :: tuple()) -> {Res :: list(), NewState :: term()}. + -callback retract_clause(State :: term(), Param :: term()) -> {ok, NewState :: term()}. -callback abolish_clauses(State :: term(), Func :: term()) -> {ok, NewState :: term()}. From 6c28d55e99e20eece28cc567f565cebf3a9108c2 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 15 Jul 2014 00:25:24 +0000 Subject: [PATCH 046/251] made bagof --- src/core/erlog.erl | 4 +++- src/core/erlog_core.erl | 40 ++++++++++++++++++++++++++++++++++++++- src/core/erlog_errors.erl | 8 +------- src/storage/erlog_ets.erl | 7 ++++--- 4 files changed, 47 insertions(+), 12 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 8c7da92..1b9bae4 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -144,7 +144,9 @@ load_built_in(Database) -> %% Run scanned command run_command(Command, State) -> case erlog_parse:parse_prolog_term(Command) of - {ok, halt} -> {ok, halt}; + {ok, halt} -> + gen_server:cast(self(), halt), + {true, State}; PrologCmd -> preprocess_command(PrologCmd, State) end. diff --git a/src/core/erlog_core.erl b/src/core/erlog_core.erl index 3c2cc09..7c01cec 100644 --- a/src/core/erlog_core.erl +++ b/src/core/erlog_core.erl @@ -409,6 +409,18 @@ prove_goal(Param = #param{goal = {findall, Goal, Fun, Res}, bindings = Bs0, next end, [], Predicates), Bs1 = erlog_core:add_binding(Res, Result, Bs0), prove_body(Param#param{goal = Next, bindings = Bs1}); +prove_goal(Param = #param{goal = {bagof, Goal, Fun, Res}, choice = Cs0, bindings = Bs0, next_goal = Next, var_num = Vn, database = Db}) -> + Predicates = erlog_memory:finadll(Db, Fun), + FunList = tuple_to_list(Fun), + ResultDict = collect_alternatives(Goal, FunList, Predicates), + Collected = dict:fetch_keys(ResultDict), + [UBs | Choises] = lists:foldr( + fun(Key, Acc) -> + UpdBs0 = update_result(Key, ResultDict, Res, Bs0), + UpdBs1 = update_vars(Goal, FunList, Key, UpdBs0), + [#cp{type = disjunction, label = Fun, next = Next, bs = UpdBs1, vn = Vn} | Acc] + end, Cs0, Collected), + prove_body(Param#param{goal = Next, bindings = UBs#cp.bs, choice = Choises, var_num = Vn + length(Choises)}); %% Now look up the database. prove_goal(Param = #param{goal = G, database = Db}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), @@ -926,4 +938,30 @@ index_of(Item, List) -> index_of(Item, List, 1). index_of(_, [], _) -> not_found; index_of(Item, [Item | _], Index) -> Index; -index_of(Item, [_ | Tl], Index) -> index_of(Item, Tl, Index + 1). \ No newline at end of file +index_of(Item, [_ | Tl], Index) -> index_of(Item, Tl, Index + 1). + +remove_nth(List, N) -> + {A, B} = lists:split(N - 1, List), + A ++ tl(B). + +collect_alternatives(Goal, FunList, Predicates) -> + Element = index_of(Goal, FunList) - 1, + lists:foldr( + fun({_, Pred, _}, Dict) -> + [_ | ParamList] = tuple_to_list(Pred), + Keys = remove_nth(ParamList, Element), + dict:append(Keys, lists:nth(Element, ParamList), Dict) + end, dict:new(), Predicates). + +update_result(Key, ResultDict, Res, Bs0) -> + case dict:find(Key, ResultDict) of + {ok, Value} -> erlog_core:add_binding(Res, Value, Bs0); + error -> Bs0 + end. + +update_vars(Goal, FunList, Key, Bs) -> + Vars = tl(FunList) -- [Goal], + lists:foldl( + fun({N} = Var, UBs1) -> + erlog_core:add_binding(Var, lists:nth(N, Key), UBs1) + end, Bs, Vars). \ No newline at end of file diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 823c3e8..0ea99bc 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -45,10 +45,8 @@ erlog_error(E) -> throw({erlog_error, E}). %% backwards over choice points until matching cut. fail(Param = #param{choice = [#cp{type = goal_clauses} = Cp | Cps]}) -> fail_goal_clauses(Cp, Param#param{choice = Cps}); -fail(Param = #param{choice = [#cp{type = disjunction} = Cp | Cps]}) -> +fail(Param = #param{choice = [#cp{type = Type} = Cp | Cps]}) when Type == disjunction; Type == if_then_else -> fail_disjunction(Cp, Param#param{choice = Cps}); -fail(Param = #param{choice = [#cp{type = if_then_else} = Cp | Cps]}) -> - fail_if_then_else(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = clause} = Cp | Cps]}) -> fail_clause(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = retract} = Cp | Cps]}) -> @@ -67,10 +65,6 @@ fail(#param{choice = [], database = Db}) -> {fail, Db}. fail_disjunction(#cp{next = Next, bs = Bs, vn = Vn}, Param) -> erlog_core:prove_body(Param#param{goal = Next, bindings = Bs, var_num = Vn}). -%% @private -fail_if_then_else(#cp{next = Next, bs = Bs, vn = Vn}, Param) -> - erlog_core:prove_body(Param#param{goal = Next, bindings = Bs, var_num = Vn}). - %% @private fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Param) -> erlog_core:prove_ecall(Efun, Val, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 41676a8..83470cb 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -46,7 +46,6 @@ add_compiled_proc(Db, {Functor, M, F}) -> assertz_clause(Db, {Head, Body0}) -> clause(Head, Body0, Db, fun(Functor, Tag, Cs, Body) -> - io:format("insert functor ~p~n", [Functor]), ets:insert(Db, {Functor, clauses, Tag + 1, Cs ++ [{Tag, Head, Body}]}) end), {ok, Db}. @@ -84,8 +83,10 @@ findall(Db, Functor) -> Params = tuple_to_list(Functor), Fun = hd(Params), Len = length(Params) - 1, - [{_, _, _, Body}] = ets:lookup(Db, {Fun, Len}), - {Body, Db}. + case ets:lookup(Db, {Fun, Len}) of + [{_, _, _, Body}] -> {Body, Db}; + [] -> {[], Db} + end. get_procedure(Db, Functor) -> {case ets:lookup(Db, Functor) of From f43b806d936ae5627a2d2fadb170fca9a862b9be Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 15 Jul 2014 00:51:53 +0000 Subject: [PATCH 047/251] added localtime --- include/erlog_int.hrl | 7 ++++++- src/core/erlog.erl | 3 ++- src/libs/erlog_time.erl | 23 +++++++++++++++++++++++ 3 files changed, 31 insertions(+), 2 deletions(-) create mode 100644 src/libs/erlog_time.erl diff --git a/include/erlog_int.hrl b/include/erlog_int.hrl index 8e350c4..337eee3 100644 --- a/include/erlog_int.hrl +++ b/include/erlog_int.hrl @@ -27,7 +27,7 @@ %% Define the choice point record -record(cp, {type, label, data, next, bs, vn}). -record(cut, {label, next}). - +%TODO move me to different hrl files (one lib - one file) %% record for passing arguments to erlog_core:prove_goal -record(param, { @@ -85,6 +85,11 @@ {{phrase, 3}, erlog_dcg, phrase_3} ]). +-define(ERLOG_TIME, + [ + {{localtime, 1}, ?MODULE, localtime_1} + ]). + -define(ERLOG_LISTS, [ {{append, 3}, ?MODULE, append_3}, diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 1b9bae4..70e55eb 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -137,7 +137,8 @@ load_built_in(Database) -> erlog_core, %Core predicates erlog_bips, %Built in predicates erlog_dcg, %DCG predicates - erlog_lists %Common lists library + erlog_lists, %Common lists library + erlog_time %Bindings for working with data and time ]). %% @private diff --git a/src/libs/erlog_time.erl b/src/libs/erlog_time.erl new file mode 100644 index 0000000..07dc0b9 --- /dev/null +++ b/src/libs/erlog_time.erl @@ -0,0 +1,23 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 15. Июль 2014 0:27 +%%%------------------------------------------------------------------- +-module(erlog_time). +-author("tihon"). + +-include("erlog_int.hrl"). + +%% API +-export([load/1, localtime_1/2]). + +load(Db) -> + lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_TIME). + +localtime_1({localtime, Var}, Params = #param{next_goal = Next, bindings = Bs0}) -> + {M, S, _} = os:timestamp(), + Bs = erlog_core:add_binding(Var, {M, S}, Bs0), + erlog_core:prove_body(Params#param{goal = Next, bindings = Bs}). \ No newline at end of file From 6911d0acd77aada1747654f2ee63f5b7d2c532b6 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 15 Jul 2014 15:50:11 +0000 Subject: [PATCH 048/251] fix datediff --- include/erlog_int.hrl | 3 +- src/libs/erlog_time.erl | 17 +++- test/erlog_test.erl | 3 +- test/erlog_test_handler.erl | 162 ++++++++++++++++++++++++++++++++++++ test/prolog/t2.pl | 105 +++++++++++++++++++++++ test/prolog/t2m.pl | 154 ++++++++++++++++++++++++++++++++++ test/prolog/t3.pl | 54 ++++++++++++ 7 files changed, 494 insertions(+), 4 deletions(-) create mode 100644 test/erlog_test_handler.erl create mode 100644 test/prolog/t2.pl create mode 100644 test/prolog/t2m.pl create mode 100644 test/prolog/t3.pl diff --git a/include/erlog_int.hrl b/include/erlog_int.hrl index 337eee3..f62cd9b 100644 --- a/include/erlog_int.hrl +++ b/include/erlog_int.hrl @@ -87,7 +87,8 @@ -define(ERLOG_TIME, [ - {{localtime, 1}, ?MODULE, localtime_1} + {{localtime, 1}, ?MODULE, localtime_1}, + {{datediff, 4}, ?MODULE, datediff_4} ]). -define(ERLOG_LISTS, diff --git a/src/libs/erlog_time.erl b/src/libs/erlog_time.erl index 07dc0b9..d7e35ea 100644 --- a/src/libs/erlog_time.erl +++ b/src/libs/erlog_time.erl @@ -12,7 +12,7 @@ -include("erlog_int.hrl"). %% API --export([load/1, localtime_1/2]). +-export([load/1, localtime_1/2, datediff_4/2]). load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_TIME). @@ -20,4 +20,17 @@ load(Db) -> localtime_1({localtime, Var}, Params = #param{next_goal = Next, bindings = Bs0}) -> {M, S, _} = os:timestamp(), Bs = erlog_core:add_binding(Var, {M, S}, Bs0), - erlog_core:prove_body(Params#param{goal = Next, bindings = Bs}). \ No newline at end of file + erlog_core:prove_body(Params#param{goal = Next, bindings = Bs}). + +datediff_4({datediff, {M1, S1}, {M2, S2}, Format, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> + Diff = timer:now_diff({M1, S1, 0}, {M2, S2, 0}), + Bs = erlog_core:add_binding(Res, form_output(Diff, Format), Bs0), + erlog_core:prove_body(Params#param{goal = Next, bindings = Bs}). + +%% @private +%% Time in microseconds, atom for output format +-spec form_output(Time :: integer(), atom()) -> integer(). +form_output(Time, day) -> Time / 86400000000; % day = 24 hours +form_output(Time, hour) -> Time / 3600000000; % hour = 60 min +form_output(Time, minute) -> Time / 60000000; % min = 60 sec +form_output(Time, sec) -> Time / 1000000. % micro = 10^-6 \ No newline at end of file diff --git a/test/erlog_test.erl b/test/erlog_test.erl index 081a9e2..88104f0 100644 --- a/test/erlog_test.erl +++ b/test/erlog_test.erl @@ -18,7 +18,8 @@ run_all_test() -> -spec run_one(File :: string()) -> ok. run_one(File) -> - {ok, ErlogWorker} = erlog:start_link(), + ?debugFmt("~nChecking file ~p~n", [File]), + {ok, ErlogWorker} = erlog:start_link([{event_h, {erlog_test_handler, []}}]), ?debugMsg(File), Res = erlog:execute(ErlogWorker, string:join(["consult(", File, ")."], "\"")), ?debugMsg(Res), diff --git a/test/erlog_test_handler.erl b/test/erlog_test_handler.erl new file mode 100644 index 0000000..e5fbdbb --- /dev/null +++ b/test/erlog_test_handler.erl @@ -0,0 +1,162 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 15. Июль 2014 12:55 +%%%------------------------------------------------------------------- +-module(erlog_test_handler). +-author("tihon"). + +-include_lib("eunit/include/eunit.hrl"). + +-behaviour(gen_event). + +%% API +-export([start_link/0, + add_handler/0]). + +%% gen_event callbacks +-export([init/1, + handle_event/2, + handle_call/2, + handle_info/2, + terminate/2, + code_change/3]). + +-define(SERVER, ?MODULE). + +-record(state, {}). + +%%%=================================================================== +%%% gen_event callbacks +%%%=================================================================== + +%%-------------------------------------------------------------------- +%% @doc +%% Creates an event manager +%% +%% @end +%%-------------------------------------------------------------------- +-spec(start_link() -> {ok, pid()} | {error, {already_started, pid()}}). +start_link() -> + gen_event:start_link({local, ?SERVER}). + +%%-------------------------------------------------------------------- +%% @doc +%% Adds an event handler +%% +%% @end +%%-------------------------------------------------------------------- +-spec(add_handler() -> ok | {'EXIT', Reason :: term()} | term()). +add_handler() -> + gen_event:add_handler(?SERVER, ?MODULE, []). + +%%%=================================================================== +%%% gen_event callbacks +%%%=================================================================== + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Whenever a new event handler is added to an event manager, +%% this function is called to initialize the event handler. +%% +%% @end +%%-------------------------------------------------------------------- +-spec(init(InitArgs :: term()) -> + {ok, State :: #state{}} | + {ok, State :: #state{}, hibernate} | + {error, Reason :: term()}). +init([]) -> + {ok, #state{}}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Whenever an event manager receives an event sent using +%% gen_event:notify/2 or gen_event:sync_notify/2, this function is +%% called for each installed event handler to handle the event. +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_event(Event :: term(), State :: #state{}) -> + {ok, NewState :: #state{}} | + {ok, NewState :: #state{}, hibernate} | + {swap_handler, Args1 :: term(), NewState :: #state{}, + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + remove_handler). +handle_event(Event, State) -> + ?debugFmt("~p~n", [Event]), + {ok, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Whenever an event manager receives a request sent using +%% gen_event:call/3,4, this function is called for the specified +%% event handler to handle the request. +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_call(Request :: term(), State :: #state{}) -> + {ok, Reply :: term(), NewState :: #state{}} | + {ok, Reply :: term(), NewState :: #state{}, hibernate} | + {swap_handler, Reply :: term(), Args1 :: term(), NewState :: #state{}, + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + {remove_handler, Reply :: term()}). +handle_call(_Request, State) -> + Reply = ok, + {ok, Reply, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% This function is called for each installed event handler when +%% an event manager receives any other message than an event or a +%% synchronous request (or a system message). +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_info(Info :: term(), State :: #state{}) -> + {ok, NewState :: #state{}} | + {ok, NewState :: #state{}, hibernate} | + {swap_handler, Args1 :: term(), NewState :: #state{}, + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + remove_handler). +handle_info(_Info, State) -> + {ok, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Whenever an event handler is deleted from an event manager, this +%% function is called. It should be the opposite of Module:init/1 and +%% do any necessary cleaning up. +%% +%% @spec terminate(Reason, State) -> void() +%% @end +%%-------------------------------------------------------------------- +-spec(terminate(Args :: (term() | {stop, Reason :: term()} | stop | +remove_handler | {error, {'EXIT', Reason :: term()}} | +{error, term()}), State :: term()) -> term()). +terminate(_Arg, _State) -> + ok. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Convert process state when code is changed +%% +%% @end +%%-------------------------------------------------------------------- +-spec(code_change(OldVsn :: term() | {down, term()}, State :: #state{}, + Extra :: term()) -> + {ok, NewState :: #state{}}). +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%%=================================================================== +%%% Internal functions +%%%=================================================================== diff --git a/test/prolog/t2.pl b/test/prolog/t2.pl new file mode 100644 index 0000000..7d22397 --- /dev/null +++ b/test/prolog/t2.pl @@ -0,0 +1,105 @@ +%%%%%%%%%%%%%% +%% there is +%% types.pl +%% https://drive.google.com/folderview?id=0B3uCF8tBzpM4bzBfaFBzNVFiRUk&usp=sharing +%%%%%%%%%%%%%% + +%�������� ����� + +%����� + +plus(A,B,C):- nonvar(A), nonvar(B), C is A+B. + +plus(A,B,C):- var(A),nonvar(B),A is C-B. + +plus(A,B,C):- var(B),nonvar(A),B is C-A. + +filter(a,X):-atom(X). + +filter(i,X):-integer(X). + +filter(at,X):-atomic(X). + +filter_list([],[],_). + +filter_list([X|T],[X|Tt],F) :- filter(F,X),!, filter_list(T,Tt,F). + +filter_list([_|T],Tt,F) :- filter_list(T,Tt,F). + +%������������ �������� + +fib(1,1). + +fib(2,1). + +fib(X,Y):- X>2, X1 is X-1, X2 is X-2, + + fib(X1,F1), + + fib(X2,F2), Y is F1+F2. + +range(X,Y,X):-X=2, X1 is X-1, X2 is X-2, + + fib(X1,F1), + + fib(X2,F2), Y is F1+F2. + +range(X,Y,X):-X= Date: Tue, 15 Jul 2014 16:58:12 +0000 Subject: [PATCH 049/251] refactoring -> improve code quality --- include/erlog_int.hrl | 3 + src/core/erlog_core.erl | 967 ---------------------------------- src/core/erlog_errors.erl | 4 +- src/core/erlog_logic.erl | 2 +- src/core/logic/ec_body.erl | 164 ++++++ src/core/logic/ec_goals.erl | 260 +++++++++ src/core/logic/ec_support.erl | 145 +++++ src/core/logic/ec_term.erl | 49 ++ src/core/logic/ec_unify.erl | 119 +++++ src/core/logic/erlog_core.erl | 160 ++++++ src/io/erlog_file.erl | 4 +- src/libs/erlog_bips.erl | 158 +++--- src/libs/erlog_dcg.erl | 8 +- src/libs/erlog_lists.erl | 42 +- src/libs/erlog_time.erl | 8 +- src/storage/erlog_dict.erl | 14 +- src/storage/erlog_ets.erl | 14 +- 17 files changed, 1027 insertions(+), 1094 deletions(-) delete mode 100644 src/core/erlog_core.erl create mode 100644 src/core/logic/ec_body.erl create mode 100644 src/core/logic/ec_goals.erl create mode 100644 src/core/logic/ec_support.erl create mode 100644 src/core/logic/ec_term.erl create mode 100644 src/core/logic/ec_unify.erl create mode 100644 src/core/logic/erlog_core.erl diff --git a/include/erlog_int.hrl b/include/erlog_int.hrl index f62cd9b..6159fc0 100644 --- a/include/erlog_int.hrl +++ b/include/erlog_int.hrl @@ -24,6 +24,9 @@ %% The old is_constant/1 ? -define(IS_CONSTANT(T), (not (is_tuple(T) orelse is_list(T)))). +%%-define(BIND, orddict) +-define(BIND, dict). + %% Define the choice point record -record(cp, {type, label, data, next, bs, vn}). -record(cut, {label, next}). diff --git a/src/core/erlog_core.erl b/src/core/erlog_core.erl deleted file mode 100644 index 7c01cec..0000000 --- a/src/core/erlog_core.erl +++ /dev/null @@ -1,967 +0,0 @@ -%% Copyright (c) 2008-2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - -%% File : erlog_int.erl -%% Author : Robert Virding -%% Purpose : Basic interpreter of a Prolog sub-set. -%% -%% This is the basic Prolog interpreter. -%% The internal data structures used are very direct and basic: -%% -%% Structures - {Functor,arg1, Arg2,...} where Functor is an atom -%% Variables - {Name} where Name is an atom or integer -%% Lists - Erlang lists -%% Atomic - Erlang constants -%% -%% There is no problem with the representation of variables as Prolog -%% functors of arity 0 are atoms. This representation is much easier -%% to test for, and create new variables with than using funny atom -%% names like '$1' (yuch!), and we need LOTS of variables. -%% -%% All information about the state of an evaluation is held in the -%% variables: -%% -%% [CurrentGoal,] NextGoal, ChoicePoints, Bindings, VarNum, Database -%% -%% Proving a goal succeeds when we have reached the end of the goal -%% list, i.e. NextGoal is empty (true). Proving goal fails when there -%% are no more choice points left to backtrack into. The evaluation -%% is completely flat as all back track information is held in -%% ChoicePoints. Choice points are added going forwards and removed -%% by backtracking and cuts. -%% -%% Internal goals all have the format {{Name},...} as this is an -%% illegal Erlog structure which can never be generated in (legal) -%% code. -%% -%% Proving a top-level goal will return: -%% -%% {succeed,ChoicePoints,Bindings,VarNum,Database} - the -%% goal succeeded and these are the -%% choicepoints/bindings/varnum/database to continue with. -%% -%% {fail,Database} - the goal failed and this is the current database. -%% -%% When a goal has succeeded back tracking is initiated by calling -%% fail(ChoicePoints, Database) which has the same return values as -%% proving the goal. -%% -%% When the interpreter detects an error it builds an error term -%% -%% {erlog_error,ErrorDescriptor,Database} -%% -%% and throws it. The ErrorDescriptor is a valid Erlog term. -%% -%% Database -%% -%% We use a dictionary for the database. All data for a procedure are -%% kept in the database with the functor as key. Interpreted clauses -%% are kept in a list, each clause has a unique (for that functor) -%% tag. Functions which traverse clauses, clause/retract/goals, get -%% the whole list to use. Any database operations can they be done -%% directly on the database. Retract uses the tag to remove the -%% correct clause. This preserves the logical database view. It is -%% possible to use ETS instead if a dictionary, define macro ETS, but -%% the logical database view makes it difficult to directly use ETS -%% efficiently. -%% -%% Interpreted Code -%% -%% Code, interpreted clause bodies, are not stored directly as Erlog -%% terms. Before being added to the database they are checked that -%% they are well-formed, control structures are recognised, cuts -%% augmented with status and sequences of conjunctions are converted -%% to lists. When code is used a new instance is made with fresh -%% variables, correct cut labels, and bodies directly linked to -%% following code to remove the need of later appending. -%% -%% The following functions convert code: -%% -%% well_form_body/4 - converts an Erlog term to database code body -%% format checking that it is well formed. -%% well_form_goal/4 - converts an Erlog term directly to a code body -%% checking that it is well formed. -%% unify_head/4 - unify a goal directly with head without creating a -%% new instance of the head. Saves creating local variables and -%% MANY bindings. This is a BIG WIN! -%% body_instance/5 - creates a new code body instance from the -%% database format. -%% term_instance/2/3 - creates a new instance of a term with new -%% variables. -%% body_term/3 - creates a copy of a body as a legal Erlog term. -%% -%% Choicepoints/Cuts -%% -%% Choicepoints and cuts are kept on the same stack/list. There are -%% different types of cps depending on their context. Failure pops -%% the first cp off the stack, passing over cuts and resumes -%% execution from that cp. A cut has a label and a flag indicating if -%% this is the last cut with this label. Cut steps over cps/cuts -%% until a cut the same label is reached and execution is resumed -%% with that stack. Unless this is the last cut with a label a new -%% cut is pushed on the stack. For efficiency some cps also act as -%% cuts. -%% -%% It is possible to reuse cut labels for different markers as long -%% the areas the cuts are valid don't overlap, though one may be -%% contained within the other, and the cuts correctly indicate when -%% they are the last cut. This is used for ->; and once/1 where we -%% KNOW the last cut of the internal section. -%% -%% It would be better if the cut marker was the actual cps/cut stack -%% to go back to but this would entail a more interactive -%% body_instance. - --module(erlog_core). - --include("erlog_int.hrl"). - -%%-define(BIND, orddict). %TODO ets and others? --define(BIND, dict). - -%% Main execution functions. --export([ - unify/3, - dderef_list/2, - make_vars/2, - prove_goal/4, - unify_prove_body/5, - prove_body/1, - unify_clauses/4, - retract_clauses/4, - prove_predicates/3, - prove_goal_clauses/3, - pred_ind/1, - well_form_body/3, - deref_list/2, unify_prove_body/3, dderef/2, deref/2, add_binding/3]). -%% Bindings, unification and dereferncing. --export([functor/1]). -%% Creating term and body instances. --export([term_instance/2]). -%% Adding to database. --export([load/1]). - -%% built_in_db(Db) -> Database. -%% Create an initial clause database containing the built-in -%% predicates and predefined library predicates. - -load(Db) -> - lists:foreach(fun(Head) -> erlog_memory:add_built_in(Db, Head) end, ?ERLOG_CORE). %% Add the Erlang built-ins. - -%% prove_goal(Goal, Database) -> Succeed | Fail. -%% This is the main entry point into the interpreter. Check that -%% everything is consistent then prove the goal as a call. --spec prove_goal(Goal0 :: term(), Db :: pid(), Fcon :: fun(), Event :: pid()) -> term(). -prove_goal(Goal0, Db, Fcon, Event) -> - %% put(erlog_cut, orddict:new()), - %% put(erlog_cps, orddict:new()), - %% put(erlog_var, orddict:new()), - %% Check term and build new instance of term with bindings. - {Goal1, Bs, Vn} = initial_goal(Goal0), - Params = #param{goal = [{call, Goal1}], choice = [], bindings = Bs, var_num = Vn, - event_man = Event, database = Db, f_consulter = Fcon}, - prove_body(Params). %TODO use lists:foldr instead! - -%% prove_body(Body, ChoicePoints, Bindings, VarNum, Database) -> -%% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase}. -%% Prove the goals in a body. Remove the first goal and try to prove -%% it. Return when there are no more goals. This is how proving a -%% goal/body succeeds. -prove_body(Params = #param{goal = [G | Gs]}) -> %TODO use lists:foldr instead! - %%io:fwrite("PB: ~p\n", [{G,Gs,Cps}]), - prove_goal(Params#param{goal = G, next_goal = Gs}); -prove_body(#param{goal = [], choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> - %%io:fwrite("Cps: ~p\nCut: ~p\nVar: ~p\nVar: ~p\n", - %% [get(erlog_cps),get(erlog_cut),get(erlog_var),dict:size(Bs)]), - %%io:fwrite("PB: ~p\n", [Cps]), - {succeed, Cps, Bs, Vn, Db}. %No more body %TODO why should we return database? - -%% unify_prove_body(Term1, Term2, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Unify Term1 = Term2, on success prove body Next else fail. -unify_prove_body(T1, T2, Params = #param{next_goal = Next, bindings = Bs0}) -> - case unify(T1, T2, Bs0) of - {succeed, Bs1} -> prove_body(Params#param{goal = Next, bindings = Bs1}); - fail -> erlog_errors:fail(Params) - end. - -%% unify_prove_body(A1, B1, A2, B2, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Unify A1 = B1, A2 = B2, on success prove body Next else fail. -unify_prove_body(A1, B1, A2, B2, Params = #param{bindings = Bs0}) -> - case unify(A1, B1, Bs0) of - {succeed, Bs1} -> unify_prove_body(A2, B2, Params#param{bindings = Bs1}); - fail -> erlog_errors:fail(Params) - end. - -%% deref(Term, Bindings) -> Term. -%% Dereference a variable, else just return the term. -deref({V} = T0, Bs) -> - case ?BIND:find(V, Bs) of - {ok, T1} -> deref(T1, Bs); - error -> T0 - end; -deref(T, _) -> T. %Not a variable, return it. - -%% deref_list(List, Bindings) -> List. -%% Dereference the top-level checking that it is a list. -deref_list([], _) -> []; %It already is a list %TODO where it is used? -deref_list([_ | _] = L, _) -> L; -deref_list({V}, Bs) -> - case dict:find(V, Bs) of - {ok, L} -> deref_list(L, Bs); - error -> erlog_errors:instantiation_error() - end; -deref_list(Other, _) -> erlog_errors:type_error(list, Other). - -%% dderef(Term, Bindings) -> Term. -%% Do a deep dereference. Completely dereference all the variables -%% occuring in a term, even those occuring in a variables value. -dderef(A, _) when ?IS_CONSTANT(A) -> A; -dderef([], _) -> []; -dderef([H0 | T0], Bs) -> - [dderef(H0, Bs) | dderef(T0, Bs)]; -dderef({V} = Var, Bs) -> - case ?BIND:find(V, Bs) of %TODO check, why dict instead erlog_storage - {ok, T} -> dderef(T, Bs); - error -> Var - end; -dderef(T, Bs) when is_tuple(T) -> - Es0 = tuple_to_list(T), - Es1 = dderef(Es0, Bs), - list_to_tuple(Es1). - -%% dderef_list(List, Bindings) -> List. -%% Dereference all variables to any depth but check that the -%% top-level is a list. -dderef_list([], _Bs) -> []; -dderef_list([H | T], Bs) -> - [dderef(H, Bs) | dderef_list(T, Bs)]; -dderef_list({V}, Bs) -> - case ?BIND:find(V, Bs) of - {ok, L} -> dderef_list(L, Bs); - error -> erlog_errors:instantiation_error() - end; -dderef_list(Other, _Bs) -> erlog_errors:type_error(list, Other). - -%% make_vars(Count, VarNum) -> [Var]. -%% Make a list of new variables starting at VarNum. -make_vars(0, _) -> []; -make_vars(I, Vn) -> - [{Vn} | make_vars(I - 1, Vn + 1)]. - -%% prove_goal(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> -%% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase} | -%% {fail,NewDatabase}. -%% Prove one goal. We seldom return succeed here but usually go directly to -%% to NextGoal. -%% Handle built-in predicates here. RTFM for a description of the -%% built-ins. Hopefully we do the same. - -%% Logic and control. Conjunctions are handled in prove_body and true -%% has been compiled away. -prove_goal(Param = #param{goal = {call, G}, next_goal = Next0, choice = Cps, - bindings = Bs, var_num = Vn, database = Db}) -> %TODO move me to other modules - %% Only add cut CP to Cps if goal contains a cut. - Label = Vn, - case check_goal(G, Next0, Bs, Db, false, Label) of - {Next1, true} -> - %% Must increment Vn to avoid clashes!!! - Cut = #cut{label = Label}, - prove_body(Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); - {Next1, false} -> prove_body(Param#param{goal = Next1, var_num = Vn + 1}) - end; -prove_goal(Param = #param{goal = {{cut}, Label, Last}}) -> - %% Cut succeeds and trims back to cut ancestor. - cut(Label, Last, Param); -prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> - %% There is no L here, it has already been prepended to Next. - Cp = #cp{type = disjunction, next = R, bs = Bs, vn = Vn}, - prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); -prove_goal(Params = #param{goal = fail}) -> erlog_errors:fail(Params); -prove_goal(Param = #param{goal = {{if_then}, Label}, next_goal = Next, choice = Cps}) -> - %% We effetively implement ( C -> T ) with ( C, !, T ) but cuts in - %% C are local to C. - %% There is no ( C, !, T ) here, it has already been prepended to Next. - %%io:fwrite("PG(->): ~p\n", [{Next}]), - Cut = #cut{label = Label}, - prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); -prove_goal(Param = #param{goal = {{if_then_else}, Else, Label}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> - %% Need to push a choicepoint to fail back to inside Cond and a cut - %% to cut back to before Then when Cond succeeds. #cp{type=if_then_else} - %% functions as both as is always removed whatever the outcome. - %% There is no ( C, !, T ) here, it has already been prepended to Next. - Cp = #cp{type = if_then_else, label = Label, next = Else, bs = Bs, vn = Vn}, - %%io:fwrite("PG(->;): ~p\n", [{Next,Else,[Cp|Cps]}]), - prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); -prove_goal(Param = #param{goal = {'\\+', G}, next_goal = Next0, choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> - %% We effectively implementing \+ G with ( G -> fail ; true ). - Label = Vn, - {Next1, _} = check_goal(G, [{{cut}, Label, true}, fail], Bs, Db, true, Label), - Cp = #cp{type = if_then_else, label = Label, next = Next0, bs = Bs, vn = Vn}, - %%io:fwrite("PG(\\+): ~p\n", [{G1,[Cp|Cps]]), - %% Must increment Vn to avoid clashes!!! - prove_body(Param#param{goal = Next1, choice = [Cp | Cps], var_num = Vn + 1}); -prove_goal(Param = #param{goal = {{once}, Label}, next_goal = Next, choice = Cps}) -> - %% We effetively implement once(G) with ( G, ! ) but cuts in - %% G are local to G. - %% There is no ( G, ! ) here, it has already been prepended to Next. - Cut = #cut{label = Label}, - prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); -prove_goal(Param = #param{goal = repeat, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> - Cp = #cp{type = disjunction, next = [repeat | Next], bs = Bs, vn = Vn}, - prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); -%% Clause creation and destruction. -prove_goal(Param = #param{goal = {abolish, Pi0}, next_goal = Next, bindings = Bs, database = Db}) -> - case dderef(Pi0, Bs) of - {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> - erlog_memory:abolish_clauses(Db, {N, A}), - prove_body(Param#param{goal = Next}); - Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) - end; -prove_goal(Param = #param{goal = {assert, C0}, next_goal = Next, bindings = Bs, database = Db}) -> - C = dderef(C0, Bs), - erlog_memory:assertz_clause(Db, C), - prove_body(Param#param{goal = Next}); -prove_goal(Param = #param{goal = {asserta, C0}, next_goal = Next, bindings = Bs, database = Db}) -> - C = dderef(C0, Bs), - erlog_memory:asserta_clause(Db, C), - prove_body(Param#param{goal = Next}); -prove_goal(Param = #param{goal = {assertz, C0}, next_goal = Next, bindings = Bs, database = Db}) -> - C = dderef(C0, Bs), - erlog_memory:assertz_clause(Db, C), - prove_body(Param#param{goal = Next}); -prove_goal(Param = #param{goal = {retract, C0}, bindings = Bs}) -> - C = dderef(C0, Bs), - prove_retract(C, Param); -%% Clause retrieval and information -prove_goal(Param = #param{goal = {clause, H0, B}, bindings = Bs}) -> - H1 = dderef(H0, Bs), - prove_clause(H1, B, Param); -prove_goal(Param = #param{goal = {current_predicate, Pi0}, bindings = Bs}) -> - Pi = dderef(Pi0, Bs), - prove_current_predicate(Pi, Param); -prove_goal(Param = #param{goal = {predicate_property, H0, P}, bindings = Bs, database = Db}) -> - H = dderef(H0, Bs), - case catch erlog_memory:get_procedure_type(Db, functor(H)) of - built_in -> unify_prove_body(P, built_in, Param); - compiled -> unify_prove_body(P, compiled, Param); - interpreted -> unify_prove_body(P, interpreted, Param); - undefined -> erlog_errors:fail(Param); - {erlog_error, E} -> erlog_errors:erlog_error(E, Db) - end; -%% External interface -prove_goal(Param = #param{goal = {ecall, C0, Val}, bindings = Bs, database = Db}) -> - %% Build the initial call. - %%io:fwrite("PG(ecall): ~p\n ~p\n ~p\n", [dderef(C0, Bs),Next,Cps]), - Efun = case dderef(C0, Bs) of - {':', M, F} when is_atom(M), is_atom(F) -> - fun() -> M:F() end; - {':', M, {F, A}} when is_atom(M), is_atom(F) -> - fun() -> M:F(A) end; - {':', M, {F, A1, A2}} when is_atom(M), is_atom(F) -> - fun() -> M:F(A1, A2) end; - {':', M, T} when is_atom(M), ?IS_FUNCTOR(T) -> - L = tuple_to_list(T), - fun() -> apply(M, hd(L), tl(L)) end; - Fun when is_function(Fun) -> Fun; - Other -> erlog_errors:type_error(callable, Other, Db) - end, - prove_ecall(Efun, Val, Param); -%% Non-standard but useful. -prove_goal(Param = #param{goal = {writeln, T}, next_goal = Next, bindings = Bs, event_man = Evman}) -> - %% Display procedure. - gen_event:notify(Evman, dderef(T, Bs)), - prove_body(Param#param{goal = Next}); -%% File utils -prove_goal(Param = #param{goal = {consult, Name}, next_goal = Next, f_consulter = Fcon, database = Db}) -> - case erlog_file:consult(Fcon, Name, Db) of - ok -> ok; - {Err, Error} when Err == erlog_error; Err == error -> - erlog_errors:erlog_error(Error, Db) - end, - prove_body(Param#param{goal = Next}); -prove_goal(Param = #param{goal = {reconsult, Name}, next_goal = Next, f_consulter = Fcon, database = Db}) -> - case erlog_file:reconsult(Fcon, Name, Db) of - ok -> ok; - {Err, Error} when Err == erlog_error; Err == error -> - erlog_errors:erlog_error(Error, Db) - end, - prove_body(Param#param{goal = Next}); -prove_goal(Param = #param{goal = {findall, Goal, Fun, Res}, bindings = Bs0, next_goal = Next, database = Db}) -> - Predicates = erlog_memory:finadll(Db, Fun), - Element = index_of(Goal, tuple_to_list(Fun)) - 1, - Result = lists:foldr( - fun({_, Pred, _}, Acc) -> - [_ | ParamList] = tuple_to_list(Pred), - [lists:nth(Element, ParamList) | Acc] - end, [], Predicates), - Bs1 = erlog_core:add_binding(Res, Result, Bs0), - prove_body(Param#param{goal = Next, bindings = Bs1}); -prove_goal(Param = #param{goal = {bagof, Goal, Fun, Res}, choice = Cs0, bindings = Bs0, next_goal = Next, var_num = Vn, database = Db}) -> - Predicates = erlog_memory:finadll(Db, Fun), - FunList = tuple_to_list(Fun), - ResultDict = collect_alternatives(Goal, FunList, Predicates), - Collected = dict:fetch_keys(ResultDict), - [UBs | Choises] = lists:foldr( - fun(Key, Acc) -> - UpdBs0 = update_result(Key, ResultDict, Res, Bs0), - UpdBs1 = update_vars(Goal, FunList, Key, UpdBs0), - [#cp{type = disjunction, label = Fun, next = Next, bs = UpdBs1, vn = Vn} | Acc] - end, Cs0, Collected), - prove_body(Param#param{goal = Next, bindings = UBs#cp.bs, choice = Choises, var_num = Vn + length(Choises)}); -%% Now look up the database. -prove_goal(Param = #param{goal = G, database = Db}) -> -%% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), - case catch erlog_memory:get_procedure(Db, functor(G)) of - built_in -> erlog_bips:prove_goal(G, Param); - {code, {Mod, Func}} -> Mod:Func(G, Param); - {clauses, Cs} -> prove_goal_clauses(G, Cs, Param); - undefined -> erlog_errors:fail(Param); - %% Getting built_in here is an error! - {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data - end. - - -cut(Label, Last, Param = #param{next_goal = Next, choice = [#cut{label = Label} | Cps] = Cps0}) -> - if Last -> prove_body(Param#param{goal = Next, choice = Cps}); - true -> prove_body(Param#param{goal = Next, choice = Cps0}) - end; -cut(Label, Last, Param = #param{next_goal = Next, choice = [#cp{type = if_then_else, label = Label} | Cps] = Cps0}) -> - if Last -> prove_body(Param#param{goal = Next, choice = Cps}); - true -> prove_body(Param#param{goal = Next, choice = Cps0}) - end; -cut(Label, Last, Param = #param{choice = [#cp{type = goal_clauses, label = Label} = Cp | Cps]}) -> - cut_goal_clauses(Last, Cp, Param#param{choice = Cps}); -cut(Label, Last, Param = #param{choice = [_Cp | Cps]}) -> - cut(Label, Last, Param#param{choice = Cps}). - -%% cut(Label, Last, Next, Cps, Bs, Vn, Db) -> -%% cut(Label, Last, Next, Cps, Bs, Vn, Db, 1). - -%% cut(Label, Last, Next, [#cut{label=Label}|Cps]=Cps0, Bs, Vn, Db, Cn) -> -%% put(erlog_cut, orddict:update_counter(Cn, 1, get(erlog_cut))), -%% if Last -> prove_body(Next, Cps, Bs, Vn, Db); -%% true -> prove_body(Next, Cps0, Bs, Vn, Db) -%% end; -%% cut(Label, Last, Next, [#cp{type=if_then_else,label=Label}|Cps]=Cps0, Bs, Vn, Db, Cn) -> -%% put(erlog_cut, orddict:update_counter(Cn, 1, get(erlog_cut))), -%% if Last -> prove_body(Next, Cps, Bs, Vn, Db); -%% true -> prove_body(Next, Cps0, Bs, Vn, Db) -%% end; -%% cut(Label, Last, Next, [#cp{type=goal_clauses,label=Label}=Cp|Cps], Bs, Vn, Db, Cn) -> -%% put(erlog_cut, orddict:update_counter(Cn, 1, get(erlog_cut))), -%% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db); -%% cut(Label, Last, Next, [_Cp|Cps], Bs, Vn, Db, Cn) -> -%% cut(Label, Last, Next, Cps, Bs, Vn, Db, Cn+1). - -%% check_goal(Goal, Next, Bindings, Database, CutAfter, CutLabel) -> -%% {WellFormedBody,HasCut}. -%% Check to see that Goal is bound and ensure that it is well-formed. -check_goal(G0, Next, Bs, Db, Cut, Label) -> - case dderef(G0, Bs) of - {_} -> erlog_errors:instantiation_error(Db); %Must have something to call - G1 -> - case catch {ok, well_form_goal(G1, Next, Cut, Label)} of - {erlog_error, E} -> erlog_errors:erlog_error(E, Db); - {ok, GC} -> GC %Body and cut - end - end. - -%% prove_ecall(Generator, Value, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Call an external (Erlang) generator and handle return value, either -%% succeed or fail. -prove_ecall(Efun, Val, Param = #param{next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> - case Efun() of - {succeed, Ret, Cont} -> %Succeed and more choices - Cp = #cp{type = ecall, data = {Cont, Val}, next = Next, bs = Bs, vn = Vn}, - unify_prove_body(Val, Ret, Param#param{choice = [Cp | Cps]}); - {succeed_last, Ret} -> %Succeed but last choice - unify_prove_body(Val, Ret, Param); - fail -> erlog_errors:fail(Param) %No more - end. - -%% prove_clause(Head, Body, Next, ChoicePoints, Bindings, VarNum, DataBase) -> -%% void. -%% Unify clauses matching with functor from Head with both Head and Body. -prove_clause(H, B, Param = #param{database = Db}) -> - Functor = functor(H), - case erlog_memory:get_procedure(Db, Functor) of - {clauses, Cs} -> unify_clauses(H, B, Cs, Param); - {code, _} -> - erlog_errors:permission_error(access, private_procedure, pred_ind(Functor), Db); - built_in -> - erlog_errors:permission_error(access, private_procedure, pred_ind(Functor), Db); - undefined -> erlog_errors:fail(Param) - end. - -%% unify_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Try to unify Head and Body using Clauses which all have the same functor. -unify_clauses(Ch, Cb, [C], Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0}) -> - %% No choice point on last clause - case unify_clause(Ch, Cb, C, Bs0, Vn0) of - {succeed, Bs1, Vn1} -> prove_body(Param#param{goal = Next, bindings = Bs1, var_num = Vn1}); - fail -> erlog_errors:fail(Param) - end; -unify_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0, choice = Cps}) -> - case unify_clause(Ch, Cb, C, Bs0, Vn0) of - {succeed, Bs1, Vn1} -> - Cp = #cp{type = clause, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, - prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); - fail -> unify_clauses(Ch, Cb, Cs, Param) - end; -unify_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param). - -unify_clause(Ch, Cb, {_Tag, H0, {B0, _}}, Bs0, Vn0) -> - {H1, Rs1, Vn1} = term_instance(H0, Vn0), %Unique vars on head first - case unify(Ch, H1, Bs0) of - {succeed, Bs1} -> - {B1, _Rs2, Vn2} = body_term(B0, Rs1, Vn1), %Now we need the rest - case unify(Cb, B1, Bs1) of - {succeed, Bs2} -> {succeed, Bs2, Vn2}; - fail -> fail - end; - fail -> fail - end. - -%% prove_current_predicate(PredInd, Next, ChoicePoints, Bindings, VarNum, DataBase) -> -%% void. -%% Match functors of existing user (interpreted) predicate with PredInd. -prove_current_predicate(Pi, Param = #param{database = Db}) -> - case Pi of - {'/', _, _} -> ok; - {_} -> ok; - Other -> erlog_errors:type_error(predicate_indicator, Other) - end, - Fs = erlog_memory:get_interp_functors(Db), - prove_predicates(Pi, Fs, Param). - -prove_predicates(Pi, [F | Fs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> - Cp = #cp{type = current_predicate, data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, - unify_prove_body(Pi, pred_ind(F), Param#param{choice = [Cp | Cps]}); -prove_predicates(_Pi, [], Param) -> erlog_errors:fail(Param). - -%% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Try to prove Goal using Clauses which all have the same functor. -prove_goal_clauses(G, [C], Params = #param{choice = Cps, var_num = Vn}) -> - %% Must be smart here and test whether we need to add a cut point. - %% C has the structure {Tag,Head,{Body,BodyHasCut}}. - case element(2, element(3, C)) of - true -> - Cut = #cut{label = Vn}, - prove_goal_clause(G, C, Params#param{choice = [Cut | Cps]}); - false -> - prove_goal_clause(G, C, Params) - end; -%% prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db); -prove_goal_clauses(G, [C | Cs], Params = #param{next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps}) -> - Cp = #cp{type = goal_clauses, label = Vn, data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, - prove_goal_clause(G, C, Params#param{choice = [Cp | Cps]}); -prove_goal_clauses(_G, [], Param) -> erlog_errors:fail(Param). - -prove_goal_clause(G, {_Tag, H0, {B0, _}}, Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0}) -> - %% io:fwrite("PGC1: ~p\n", [{G,H0,B0}]), - Label = Vn0, - case unify_head(G, H0, Bs0, Vn0 + 1) of - {succeed, Rs0, Bs1, Vn1} -> - %% io:fwrite("PGC2: ~p\n", [{Rs0}]), - {B1, _Rs2, Vn2} = body_instance(B0, Next, Rs0, Vn1, Label), - %% io:fwrite("PGC3: ~p\n", [{B1,Next,Cps}]), - prove_body(Param#param{goal = B1, bindings = Bs1, var_num = Vn2}); - fail -> erlog_errors:fail(Param) - end. - -%% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db). -cut_goal_clauses(true, #cp{label = _}, Param = #param{next_goal = Next}) -> - %% Just remove the choice point completely and continue. - prove_body(Param#param{goal = Next}); -cut_goal_clauses(false, #cp{label = L}, Param = #param{next_goal = Next, choice = Cps}) -> - %% Replace choice point with cut point then continue. - Cut = #cut{label = L}, - prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). - -%% prove_retract(Clause, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Retract clauses in database matching Clause. - -prove_retract({':-', H, B}, Params) -> - prove_retract(H, B, Params); -prove_retract(H, Params) -> - prove_retract(H, true, Params). - -prove_retract(H, B, Params = #param{database = Db}) -> - Functor = functor(H), - case erlog_memory:get_procedure(Db, Functor) of - {clauses, Cs} -> retract_clauses(H, B, Cs, Params); - {code, _} -> - erlog_errors:permission_error(modify, static_procedure, pred_ind(Functor), Db); - built_in -> - erlog_errors:permission_error(modify, static_procedure, pred_ind(Functor), Db); - undefined -> erlog_errors:fail(Params) - end. - -%% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Try to retract Head and Body using Clauses which all have the same functor. -retract_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}) -> %TODO foreach vs handmade recursion? - case unify_clause(Ch, Cb, C, Bs0, Vn0) of - {succeed, Bs1, Vn1} -> - %% We have found a right clause so now retract it. - erlog_memory:retract_clause(Db, functor(Ch), element(1, C)), - Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, - prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); - fail -> retract_clauses(Ch, Cb, Cs, Param) - end; -retract_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param). - -unify_args(_, _, Bs, I, S) when I > S -> {succeed, Bs}; -unify_args(S1, S2, Bs0, I, S) -> - case unify(element(I, S1), element(I, S2), Bs0) of - {succeed, Bs1} -> unify_args(S1, S2, Bs1, I + 1, S); - fail -> fail - end. - -%% unify(Term, Term, Bindings) -> {succeed,NewBindings} | fail. -%% Unify two terms with a set of bindings. -unify(T10, T20, Bs0) -> - case {deref(T10, Bs0), deref(T20, Bs0)} of - {T1, T2} when ?IS_CONSTANT(T1), T1 == T2 -> - {succeed, Bs0}; - {{V}, {V}} -> {succeed, Bs0}; - {{_} = Var, T2} -> {succeed, add_binding(Var, T2, Bs0)}; - {T1, {_} = Var} -> {succeed, add_binding(Var, T1, Bs0)}; - {[H1 | T1], [H2 | T2]} -> - case unify(H1, H2, Bs0) of - {succeed, Bs1} -> unify(T1, T2, Bs1); - fail -> fail - end; - {[], []} -> {succeed, Bs0}; - {T1, T2} when tuple_size(T1) == tuple_size(T2), - element(1, T1) == element(1, T2) -> - unify_args(T1, T2, Bs0, 2, tuple_size(T1)); - _Other -> fail - end. - -%% functor(Goal) -> {Name,Arity}. -functor(T) when ?IS_FUNCTOR(T) -> - {element(1, T), tuple_size(T) - 1}; -functor(T) when is_atom(T) -> {T, 0}; -functor(T) -> erlog_errors:type_error(callable, T). - -%% well_form_body(Body, HasCutAfter, CutLabel) -> {Body,HasCut}. -%% well_form_body(Body, Tail, HasCutAfter, CutLabel) -> {Body,HasCut}. -%% Check that Body is well-formed, flatten conjunctions, fix cuts and -%% add explicit call to top-level variables. -well_form_body(Body, Cut, Label) -> well_form_body(Body, [], Cut, Label). - -well_form_body({',', L, R}, Tail0, Cut0, Label) -> - {Tail1, Cut1} = well_form_body(R, Tail0, Cut0, Label), - well_form_body(L, Tail1, Cut1, Label); -well_form_body({';', {'->', C0, T0}, E0}, Tail, Cut0, Label) -> - {T1, Tc} = well_form_body(T0, Cut0, Label), - {E1, Ec} = well_form_body(E0, Cut0, Label), - %% N.B. an extra cut will be added at run-time! - {C1, _} = well_form_body(C0, true, Label), - {[{{if_then_else}, C1, T1, E1, Label} | Tail], Tc or Ec}; -well_form_body({';', L0, R0}, Tail, Cut0, Label) -> - {L1, Lc} = well_form_body(L0, Cut0, Label), - {R1, Rc} = well_form_body(R0, Cut0, Label), - {[{{disj}, L1, R1} | Tail], Lc or Rc}; -well_form_body({'->', C0, T0}, Tail, Cut0, Label) -> - {T1, Cut1} = well_form_body(T0, Cut0, Label), - %% N.B. an extra cut will be added at run-time! - {C1, _} = well_form_body(C0, true, Label), - {[{{if_then}, C1, T1, Label} | Tail], Cut1}; -well_form_body({once, G}, Tail, Cut, Label) -> - %% N.B. an extra cut is added at run-time! - {G1, _} = well_form_body(G, true, Label), - {[{{once}, G1, Label} | Tail], Cut}; -well_form_body({V}, Tail, Cut, _Label) -> - {[{call, {V}} | Tail], Cut}; -well_form_body(true, Tail, Cut, _Label) -> {Tail, Cut}; %No-op -well_form_body(fail, _Tail, _Cut, _Label) -> {[fail], false}; %No further -well_form_body('!', Tail, Cut, Label) -> - {[{{cut}, Label, not Cut} | Tail], true}; -well_form_body(Goal, Tail, Cut, _Label) -> - functor(Goal), %Check goal - {[Goal | Tail], Cut}. - -%% well_form_goal(Goal, Tail, HasCutAfter, CutLabel) -> {Body,HasCut}. -%% Check that Goal is well-formed, flatten conjunctions, fix cuts and -%% add explicit call to top-level variables. -well_form_goal({',', L, R}, Tail0, Cut0, Label) -> - {Tail1, Cut1} = well_form_goal(R, Tail0, Cut0, Label), - well_form_goal(L, Tail1, Cut1, Label); -well_form_goal({';', {'->', C0, T0}, E0}, Tail, Cut0, Label) -> - {T1, Tc} = well_form_goal(T0, Tail, Cut0, Label), - {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), - {E1, Ec} = well_form_goal(E0, Tail, Cut0, Label), - {[{{if_then_else}, E1, Label} | C1], Tc or Ec}; -well_form_goal({';', L0, R0}, Tail, Cut0, Label) -> - {L1, Lc} = well_form_goal(L0, Tail, Cut0, Label), - {R1, Rc} = well_form_goal(R0, Tail, Cut0, Label), - {[{{disj}, R1} | L1], Lc or Rc}; -well_form_goal({'->', C0, T0}, Tail, Cut0, Label) -> - {T1, Cut1} = well_form_goal(T0, Tail, Cut0, Label), - %% N.B. an extra cut will be added at run-time! - {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), - {[{{if_then}, Label} | C1], Cut1}; -well_form_goal({once, G}, Tail, Cut, Label) -> - {G1, _} = well_form_goal(G, [{{cut}, Label, true} | Tail], true, Label), - {[{{once}, Label} | G1], Cut}; -well_form_goal({V}, Tail, Cut, _Label) -> - {[{call, {V}} | Tail], Cut}; -well_form_goal(true, Tail, Cut, _Label) -> {Tail, Cut}; %No-op -well_form_goal(fail, _Tail, _Cut, _Label) -> {[fail], false}; %No further -well_form_goal('!', Tail, Cut, Label) -> - {[{{cut}, Label, not Cut} | Tail], true}; -well_form_goal(Goal, Tail, Cut, _Label) -> - functor(Goal), %Check goal - {[Goal | Tail], Cut}. - -%% term_instance(Term, VarNum) -> {Term,NewRepls,NewVarNum}. -%% term_instance(Term, Repls, VarNum) -> {Term,NewRepls,NewVarNum}. -%% Generate a copy of a term with new, fresh unused variables. No -%% bindings from original variables to new variables. It can handle -%% replacing integer variables with overlapping integer ranges. Don't -%% check Term as it should already be checked. Use orddict as there -%% will seldom be many variables and it it fast to setup. -term_instance(A, Vn) -> term_instance(A, orddict:new(), Vn). - -term_instance([], Rs, Vn) -> {[], Rs, Vn}; -term_instance([H0 | T0], Rs0, Vn0) -> - {H, Rs1, Vn1} = term_instance(H0, Rs0, Vn0), - {T, Rs2, Vn2} = term_instance(T0, Rs1, Vn1), - {[H | T], Rs2, Vn2}; -term_instance({'_'}, Rs, Vn) -> {{Vn}, Rs, Vn + 1}; %Unique variable -term_instance({V0}, Rs0, Vn0) -> %Other variables - case orddict:find(V0, Rs0) of - {ok, V1} -> {V1, Rs0, Vn0}; - error -> - V1 = {Vn0}, - {V1, orddict:store(V0, V1, Rs0), Vn0 + 1} - end; -%% Special case some smaller structures. -term_instance({Atom, Arg}, Rs0, Vn0) -> - {CopyArg, Rs1, Vn1} = term_instance(Arg, Rs0, Vn0), - {{Atom, CopyArg}, Rs1, Vn1}; -term_instance({Atom, A1, A2}, Rs0, Vn0) -> - {CopyA1, Rs1, Vn1} = term_instance(A1, Rs0, Vn0), - {CopyA2, Rs2, Vn2} = term_instance(A2, Rs1, Vn1), - {{Atom, CopyA1, CopyA2}, Rs2, Vn2}; -term_instance(T, Rs0, Vn0) when is_tuple(T) -> - As0 = tl(tuple_to_list(T)), - {As1, Rs1, Vn1} = term_instance(As0, Rs0, Vn0), - {list_to_tuple([element(1, T) | As1]), Rs1, Vn1}; -term_instance(A, Rs, Vn) -> {A, Rs, Vn}. %Constant - -%% unify_head(Goal, Head, Bindings, VarNum) -> -%% {succeed,Repls,NewBindings,NewVarNum} | fail -%% Unify a goal with a head without creating an instance of the -%% head. This saves us creating many variables which are local to the -%% clause and saves many variable bindings. - -unify_head(Goal, Head, Bs, Vn) -> - unify_head(deref(Goal, Bs), Head, orddict:new(), Bs, Vn). - -unify_head(G, H, Rs, Bs, Vn) when ?IS_CONSTANT(G), G == H -> - {succeed, Rs, Bs, Vn}; -unify_head(_T, {'_'}, Rs, Bs, Vn) -> {succeed, Rs, Bs, Vn}; -unify_head(T, {V0}, Rs, Bs0, Vn) -> - %% Now for the tricky bit! - case orddict:find(V0, Rs) of - {ok, V1} -> %Already have a replacement - case unify(T, V1, Bs0) of - {succeed, Bs1} -> {succeed, Rs, Bs1, Vn}; - fail -> fail - end; - error -> %Add a replacement - {succeed, orddict:store(V0, T, Rs), Bs0, Vn} - end; -unify_head({_} = Var, H0, Rs0, Bs, Vn0) -> - %% Must have an instance here. - {H1, Rs1, Vn1} = term_instance(H0, Rs0, Vn0), - {succeed, Rs1, add_binding(Var, H1, Bs), Vn1}; -unify_head([GH | GT], [HH | HT], Rs0, Bs0, Vn0) -> - case unify_head(deref(GH, Bs0), HH, Rs0, Bs0, Vn0) of - {succeed, Rs1, Bs1, Vn1} -> unify_head(deref(GT, Bs1), HT, Rs1, Bs1, Vn1); - fail -> fail - end; -unify_head([], [], Rs, Bs, Vn) -> {succeed, Rs, Bs, Vn}; -unify_head(G, H, Rs, Bs, Vn) when tuple_size(G) == tuple_size(H), - element(1, G) == element(1, H) -> - unify_head_args(G, H, Rs, Bs, Vn, 2, tuple_size(G)); -unify_head(_G, _H, _Rs, _Bs, _Vn) -> fail. - -unify_head_args(_G, _H, Rs, Bs, Vn, I, S) when I > S -> - {succeed, Rs, Bs, Vn}; -unify_head_args(G, H, Rs0, Bs0, Vn0, I, S) -> - case unify_head(deref(element(I, G), Bs0), element(I, H), Rs0, Bs0, Vn0) of - {succeed, Rs1, Bs1, Vn1} -> unify_head_args(G, H, Rs1, Bs1, Vn1, I + 1, S); - fail -> fail - end. - -%% body_instance(Body, Tail, Repls, VarNum, Label) -> -%% {Body,NewRepls,NewVarNum}. -%% Generate a copy of a body in a form ready to be interpreted. No -%% bindings from original variables to new variables. It can handle -%% replacing integer variables with overlapping integer ranges. Don't -%% check Term as it should already be checked. Use term_instance to -%% handle goals. N.B. We have to be VERY careful never to go into the -%% original tail as this will cause havoc. -body_instance([{{cut} = Cut, _, Last} | Gs0], Tail, Rs0, Vn0, Label) -> - {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), - {[{Cut, Label, Last} | Gs1], Rs1, Vn1}; -body_instance([{{disj} = Disj, L0, R0} | Gs0], Tail, Rs0, Vn0, Label) -> - {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), - %% Append Gs1 directly to L and R. - {L1, Rs2, Vn2} = body_instance(L0, Gs1, Rs1, Vn1, Label), - {R1, Rs3, Vn3} = body_instance(R0, Gs1, Rs2, Vn2, Label), - {[{Disj, R1} | L1], Rs3, Vn3}; -body_instance([{{if_then} = IT, C0, T0, _} | Gs0], Tail, Rs0, Vn0, Label) -> - {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), - {T1, Rs2, Vn2} = body_instance(T0, Gs1, Rs1, Vn1, Label), - {C1, Rs3, Vn3} = body_instance(C0, [{{cut}, Label, true} | T1], Rs2, Vn2, Label), - %% Append Gs1 directly to T1 to C1. - {[{IT, Label} | C1], Rs3, Vn3}; -body_instance([{{if_then_else} = ITE, C0, T0, E0, _} | Gs0], Tail, Rs0, Vn0, Label) -> - {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), - {T1, Rs2, Vn2} = body_instance(T0, Gs1, Rs1, Vn1, Label), - {C1, Rs3, Vn3} = body_instance(C0, [{{cut}, Label, true} | T1], Rs2, Vn2, Label), - {E1, Rs4, Vn4} = body_instance(E0, Gs1, Rs3, Vn3, Label), - {[{ITE, E1, Label} | C1], Rs4, Vn4}; -body_instance([{{once} = Once, G0, _} | Gs0], Tail, Rs0, Vn0, Label) -> - {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), - {G1, Rs2, Vn2} = body_instance(G0, [{{cut}, Label, true} | Gs1], Rs1, Vn1, Label), - {[{Once, Label} | G1], Rs2, Vn2}; -body_instance([G0 | Gs0], Tail, Rs0, Vn0, Label) -> - {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), - {G1, Rs2, Vn2} = term_instance(G0, Rs1, Vn1), - {[G1 | Gs1], Rs2, Vn2}; -body_instance([], Tail, Rs, Vn, _Label) -> {Tail, Rs, Vn}. - -%% body_term(Body, Repls, VarNum) -> {Term,NewRepls,NewVarNum}. -%% Generate a copy of a body as a term with new, fresh unused -%% variables. No bindings from original variables to new -%% variables. It can handle replacing integer variables with -%% overlapping integer ranges. Don't check Term as it should already -%% be checked. Use orddict as there will seldom be many variables and -%% it it fast to setup. -body_term([{{cut}, _, _} | Gs0], Rs0, Vn0) -> - {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), - {body_conj('!', Gs1), Rs1, Vn1}; -body_term([{{disj}, L0, R0} | Gs0], Rs0, Vn0) -> - {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), - {L1, Rs2, Vn2} = body_term(L0, Rs1, Vn1), - {R1, Rs3, Vn3} = body_term(R0, Rs2, Vn2), - {body_conj({';', L1, R1}, Gs1), Rs3, Vn3}; -body_term([{{if_then}, C0, T0, _} | Gs0], Rs0, Vn0) -> - {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), - {C1, Rs2, Vn2} = body_term(C0, Rs1, Vn1), - {T1, Rs3, Vn3} = body_term(T0, Rs2, Vn2), - {body_conj({'->', C1, T1}, Gs1), Rs3, Vn3}; -body_term([{{if_then_else}, C0, T0, E0, _} | Gs0], Rs0, Vn0) -> - {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), - {C1, Rs2, Vn2} = body_term(C0, Rs1, Vn1), - {T1, Rs3, Vn3} = body_term(T0, Rs2, Vn2), - {E1, Rs4, Vn4} = body_term(E0, Rs3, Vn3), - {body_conj({';', {'->', C1, T1}, E1}, Gs1), Rs4, Vn4}; -body_term([{{once}, G0, _} | Gs0], Rs0, Vn0) -> - {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), - {G1, Rs2, Vn2} = body_term(G0, Rs1, Vn1), - {body_conj({once, G1}, Gs1), Rs2, Vn2}; -body_term([G0 | Gs0], Rs0, Vn0) -> - {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), - {G1, Rs2, Vn2} = term_instance(G0, Rs1, Vn1), - {body_conj(G1, Gs1), Rs2, Vn2}; -body_term([], Rs, Vn) -> {true, Rs, Vn}. - -body_conj(L, true) -> L; -body_conj(L, R) -> {',', L, R}. - -pred_ind({N, A}) -> {'/', N, A}. - -%% pred_ind(N, A) -> {'/',N,A}. - -%% Bindings -%% Bindings are kept in a dict where the key is the variable name. -new_bindings() -> ?BIND:new(). - -add_binding({V}, Val, Bs0) -> - ?BIND:store(V, Val, Bs0). - -get_binding({V}, Bs) -> - ?BIND:find(V, Bs). - -%% initial_goal(Goal) -> {Goal,Bindings,NewVarNum}. -%% initial_goal(Goal, Bindings, VarNum) -> {Goal,NewBindings,NewVarNum}. -%% Check term for well-formedness as an Erlog term and replace '_' -%% variables with unique numbered variables. Error on non-well-formed -%% goals. -initial_goal(Goal) -> initial_goal(Goal, new_bindings(), 0). - -initial_goal({'_'}, Bs, Vn) -> {{Vn}, Bs, Vn + 1}; %Anonymous variable -initial_goal({Name} = Var0, Bs, Vn) when is_atom(Name) -> - case get_binding(Var0, Bs) of - {ok, Var1} -> {Var1, Bs, Vn}; - error -> - Var1 = {Vn}, - {Var1, add_binding(Var0, Var1, Bs), Vn + 1} - end; -initial_goal([H0 | T0], Bs0, Vn0) -> - {H1, Bs1, Vn1} = initial_goal(H0, Bs0, Vn0), - {T1, Bs2, Vn2} = initial_goal(T0, Bs1, Vn1), - {[H1 | T1], Bs2, Vn2}; -initial_goal([], Bs, Vn) -> {[], Bs, Vn}; -initial_goal(S, Bs0, Vn0) when ?IS_FUNCTOR(S) -> - As0 = tl(tuple_to_list(S)), - {As1, Bs1, Vn1} = initial_goal(As0, Bs0, Vn0), - {list_to_tuple([element(1, S) | As1]), Bs1, Vn1}; -initial_goal(T, Bs, Vn) when ?IS_ATOMIC(T) -> {T, Bs, Vn}; -initial_goal(T, _Bs, _Vn) -> erlog_errors:type_error(callable, T). - -index_of(Item, List) -> index_of(Item, List, 1). - -index_of(_, [], _) -> not_found; -index_of(Item, [Item | _], Index) -> Index; -index_of(Item, [_ | Tl], Index) -> index_of(Item, Tl, Index + 1). - -remove_nth(List, N) -> - {A, B} = lists:split(N - 1, List), - A ++ tl(B). - -collect_alternatives(Goal, FunList, Predicates) -> - Element = index_of(Goal, FunList) - 1, - lists:foldr( - fun({_, Pred, _}, Dict) -> - [_ | ParamList] = tuple_to_list(Pred), - Keys = remove_nth(ParamList, Element), - dict:append(Keys, lists:nth(Element, ParamList), Dict) - end, dict:new(), Predicates). - -update_result(Key, ResultDict, Res, Bs0) -> - case dict:find(Key, ResultDict) of - {ok, Value} -> erlog_core:add_binding(Res, Value, Bs0); - error -> Bs0 - end. - -update_vars(Goal, FunList, Key, Bs) -> - Vars = tl(FunList) -- [Goal], - lists:foldl( - fun({N} = Var, UBs1) -> - erlog_core:add_binding(Var, lists:nth(N, Key), UBs1) - end, Bs, Vars). \ No newline at end of file diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 0ea99bc..c32bec0 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -63,7 +63,7 @@ fail(#param{choice = [], database = Db}) -> {fail, Db}. %% @private fail_disjunction(#cp{next = Next, bs = Bs, vn = Vn}, Param) -> - erlog_core:prove_body(Param#param{goal = Next, bindings = Bs, var_num = Vn}). + ec_body:prove_body(Param#param{goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Param) -> @@ -71,7 +71,7 @@ fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Param) -> %% @private fail_clause(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> - erlog_core:unify_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + ec_unify:unify_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_retract(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> diff --git a/src/core/erlog_logic.erl b/src/core/erlog_logic.erl index 495f3ba..fef7268 100644 --- a/src/core/erlog_logic.erl +++ b/src/core/erlog_logic.erl @@ -28,7 +28,7 @@ unlistify([]) -> true; unlistify(G) -> G. %In case it wasn't a list. prove_result({succeed, Cps, Bs, _Vn, _Db1}, Vs) -> - {succeed, erlog_core:dderef(Vs, Bs), [Vs, Cps]}; + {succeed, ec_support:dderef(Vs, Bs), [Vs, Cps]}; prove_result({fail, _Db1}, _Vs) -> fail; prove_result({erlog_error, Error, _Db1}, _Vs) -> diff --git a/src/core/logic/ec_body.erl b/src/core/logic/ec_body.erl new file mode 100644 index 0000000..7397693 --- /dev/null +++ b/src/core/logic/ec_body.erl @@ -0,0 +1,164 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 15. Июль 2014 16:06 +%%%------------------------------------------------------------------- +-module(ec_body). +-author("tihon"). + +-include("erlog_int.hrl"). + +%% API +-export([body_instance/5, prove_body/1, unify_prove_body/3, unify_prove_body/5, body_term/3]). + +%% prove_body(Body, ChoicePoints, Bindings, VarNum, Database) -> +%% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase}. +%% Prove the goals in a body. Remove the first goal and try to prove +%% it. Return when there are no more goals. This is how proving a +%% goal/body succeeds. +prove_body(Params = #param{goal = [G | Gs]}) -> %TODO use lists:foldr instead! + %%io:fwrite("PB: ~p\n", [{G,Gs,Cps}]), + ec_goals:prove_goal(Params#param{goal = G, next_goal = Gs}); +prove_body(#param{goal = [], choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> + %%io:fwrite("Cps: ~p\nCut: ~p\nVar: ~p\nVar: ~p\n", + %% [get(erlog_cps),get(erlog_cut),get(erlog_var),dict:size(Bs)]), + %%io:fwrite("PB: ~p\n", [Cps]), + {succeed, Cps, Bs, Vn, Db}. %No more body %TODO why should we return database? + +%% unify_prove_body(Term1, Term2, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Unify Term1 = Term2, on success prove body Next else fail. +unify_prove_body(T1, T2, Params = #param{next_goal = Next, bindings = Bs0}) -> + case ec_unify:unify(T1, T2, Bs0) of + {succeed, Bs1} -> prove_body(Params#param{goal = Next, bindings = Bs1}); + fail -> erlog_errors:fail(Params) + end. + +%% unify_prove_body(A1, B1, A2, B2, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Unify A1 = B1, A2 = B2, on success prove body Next else fail. +unify_prove_body(A1, B1, A2, B2, Params = #param{bindings = Bs0}) -> + case ec_unify:unify(A1, B1, Bs0) of + {succeed, Bs1} -> unify_prove_body(A2, B2, Params#param{bindings = Bs1}); + fail -> erlog_errors:fail(Params) + end. + +%% body_instance(Body, Tail, Repls, VarNum, Label) -> +%% {Body,NewRepls,NewVarNum}. +%% Generate a copy of a body in a form ready to be interpreted. No +%% bindings from original variables to new variables. It can handle +%% replacing integer variables with overlapping integer ranges. Don't +%% check Term as it should already be checked. Use term_instance to +%% handle goals. N.B. We have to be VERY careful never to go into the +%% original tail as this will cause havoc. +body_instance([{{cut} = Cut, _, Last} | Gs0], Tail, Rs0, Vn0, Label) -> + {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), + {[{Cut, Label, Last} | Gs1], Rs1, Vn1}; +body_instance([{{disj} = Disj, L0, R0} | Gs0], Tail, Rs0, Vn0, Label) -> + {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), + %% Append Gs1 directly to L and R. + {L1, Rs2, Vn2} = body_instance(L0, Gs1, Rs1, Vn1, Label), + {R1, Rs3, Vn3} = body_instance(R0, Gs1, Rs2, Vn2, Label), + {[{Disj, R1} | L1], Rs3, Vn3}; +body_instance([{{if_then} = IT, C0, T0, _} | Gs0], Tail, Rs0, Vn0, Label) -> + {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), + {T1, Rs2, Vn2} = body_instance(T0, Gs1, Rs1, Vn1, Label), + {C1, Rs3, Vn3} = body_instance(C0, [{{cut}, Label, true} | T1], Rs2, Vn2, Label), + %% Append Gs1 directly to T1 to C1. + {[{IT, Label} | C1], Rs3, Vn3}; +body_instance([{{if_then_else} = ITE, C0, T0, E0, _} | Gs0], Tail, Rs0, Vn0, Label) -> + {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), + {T1, Rs2, Vn2} = body_instance(T0, Gs1, Rs1, Vn1, Label), + {C1, Rs3, Vn3} = body_instance(C0, [{{cut}, Label, true} | T1], Rs2, Vn2, Label), + {E1, Rs4, Vn4} = body_instance(E0, Gs1, Rs3, Vn3, Label), + {[{ITE, E1, Label} | C1], Rs4, Vn4}; +body_instance([{{once} = Once, G0, _} | Gs0], Tail, Rs0, Vn0, Label) -> + {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), + {G1, Rs2, Vn2} = body_instance(G0, [{{cut}, Label, true} | Gs1], Rs1, Vn1, Label), + {[{Once, Label} | G1], Rs2, Vn2}; +body_instance([G0 | Gs0], Tail, Rs0, Vn0, Label) -> + {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), + {G1, Rs2, Vn2} = ec_term:term_instance(G0, Rs1, Vn1), + {[G1 | Gs1], Rs2, Vn2}; +body_instance([], Tail, Rs, Vn, _Label) -> {Tail, Rs, Vn}. + +%% well_form_body(Body, HasCutAfter, CutLabel) -> {Body,HasCut}. +%% well_form_body(Body, Tail, HasCutAfter, CutLabel) -> {Body,HasCut}. +%% Check that Body is well-formed, flatten conjunctions, fix cuts and +%% add explicit call to top-level variables. +well_form_body(Body, Cut, Label) -> well_form_body(Body, [], Cut, Label). + +well_form_body({',', L, R}, Tail0, Cut0, Label) -> + {Tail1, Cut1} = well_form_body(R, Tail0, Cut0, Label), + well_form_body(L, Tail1, Cut1, Label); +well_form_body({';', {'->', C0, T0}, E0}, Tail, Cut0, Label) -> + {T1, Tc} = well_form_body(T0, Cut0, Label), + {E1, Ec} = well_form_body(E0, Cut0, Label), + %% N.B. an extra cut will be added at run-time! + {C1, _} = well_form_body(C0, true, Label), + {[{{if_then_else}, C1, T1, E1, Label} | Tail], Tc or Ec}; +well_form_body({';', L0, R0}, Tail, Cut0, Label) -> + {L1, Lc} = well_form_body(L0, Cut0, Label), + {R1, Rc} = well_form_body(R0, Cut0, Label), + {[{{disj}, L1, R1} | Tail], Lc or Rc}; +well_form_body({'->', C0, T0}, Tail, Cut0, Label) -> + {T1, Cut1} = well_form_body(T0, Cut0, Label), + %% N.B. an extra cut will be added at run-time! + {C1, _} = well_form_body(C0, true, Label), + {[{{if_then}, C1, T1, Label} | Tail], Cut1}; +well_form_body({once, G}, Tail, Cut, Label) -> + %% N.B. an extra cut is added at run-time! + {G1, _} = well_form_body(G, true, Label), + {[{{once}, G1, Label} | Tail], Cut}; +well_form_body({V}, Tail, Cut, _Label) -> + {[{call, {V}} | Tail], Cut}; +well_form_body(true, Tail, Cut, _Label) -> {Tail, Cut}; %No-op +well_form_body(fail, _Tail, _Cut, _Label) -> {[fail], false}; %No further +well_form_body('!', Tail, Cut, Label) -> + {[{{cut}, Label, not Cut} | Tail], true}; +well_form_body(Goal, Tail, Cut, _Label) -> + ec_support:functor(Goal), %Check goal + {[Goal | Tail], Cut}. + +%% body_term(Body, Repls, VarNum) -> {Term,NewRepls,NewVarNum}. +%% Generate a copy of a body as a term with new, fresh unused +%% variables. No bindings from original variables to new +%% variables. It can handle replacing integer variables with +%% overlapping integer ranges. Don't check Term as it should already +%% be checked. Use orddict as there will seldom be many variables and +%% it it fast to setup. +body_term([{{cut}, _, _} | Gs0], Rs0, Vn0) -> + {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), + {body_conj('!', Gs1), Rs1, Vn1}; +body_term([{{disj}, L0, R0} | Gs0], Rs0, Vn0) -> + {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), + {L1, Rs2, Vn2} = body_term(L0, Rs1, Vn1), + {R1, Rs3, Vn3} = body_term(R0, Rs2, Vn2), + {body_conj({';', L1, R1}, Gs1), Rs3, Vn3}; +body_term([{{if_then}, C0, T0, _} | Gs0], Rs0, Vn0) -> + {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), + {C1, Rs2, Vn2} = body_term(C0, Rs1, Vn1), + {T1, Rs3, Vn3} = body_term(T0, Rs2, Vn2), + {body_conj({'->', C1, T1}, Gs1), Rs3, Vn3}; +body_term([{{if_then_else}, C0, T0, E0, _} | Gs0], Rs0, Vn0) -> + {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), + {C1, Rs2, Vn2} = body_term(C0, Rs1, Vn1), + {T1, Rs3, Vn3} = body_term(T0, Rs2, Vn2), + {E1, Rs4, Vn4} = body_term(E0, Rs3, Vn3), + {body_conj({';', {'->', C1, T1}, E1}, Gs1), Rs4, Vn4}; +body_term([{{once}, G0, _} | Gs0], Rs0, Vn0) -> + {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), + {G1, Rs2, Vn2} = body_term(G0, Rs1, Vn1), + {body_conj({once, G1}, Gs1), Rs2, Vn2}; +body_term([G0 | Gs0], Rs0, Vn0) -> + {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), + {G1, Rs2, Vn2} = ec_term:term_instance(G0, Rs1, Vn1), + {body_conj(G1, Gs1), Rs2, Vn2}; +body_term([], Rs, Vn) -> {true, Rs, Vn}. + + +body_conj(L, true) -> L; +body_conj(L, R) -> {',', L, R}. \ No newline at end of file diff --git a/src/core/logic/ec_goals.erl b/src/core/logic/ec_goals.erl new file mode 100644 index 0000000..fc6b474 --- /dev/null +++ b/src/core/logic/ec_goals.erl @@ -0,0 +1,260 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 15. Июль 2014 16:02 +%%%------------------------------------------------------------------- +-module(ec_goals). +-author("tihon"). + +-include("erlog_int.hrl"). + +%% API +-export([prove_goal/1, initial_goal/1]). + +%% prove_goal(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> +%% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase} | +%% {fail,NewDatabase}. +%% Prove one goal. We seldom return succeed here but usually go directly to +%% to NextGoal. +%% Handle built-in predicates here. RTFM for a description of the +%% built-ins. Hopefully we do the same. + +%% Logic and control. Conjunctions are handled in prove_body and true +%% has been compiled away. +prove_goal(Param = #param{goal = {call, G}, next_goal = Next0, choice = Cps, + bindings = Bs, var_num = Vn, database = Db}) -> %TODO move me to other modules + %% Only add cut CP to Cps if goal contains a cut. + Label = Vn, + case check_goal(G, Next0, Bs, Db, false, Label) of + {Next1, true} -> + %% Must increment Vn to avoid clashes!!! + Cut = #cut{label = Label}, + ec_body:prove_body(Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); %TODO recursive call! Use foldr instead + {Next1, false} -> ec_body:prove_body(Param#param{goal = Next1, var_num = Vn + 1}) + end; +prove_goal(Param = #param{goal = {{cut}, Label, Last}}) -> + %% Cut succeeds and trims back to cut ancestor. + ec_support:cut(Label, Last, Param); +prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> + %% There is no L here, it has already been prepended to Next. + Cp = #cp{type = disjunction, next = R, bs = Bs, vn = Vn}, + ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); +prove_goal(Params = #param{goal = fail}) -> erlog_errors:fail(Params); +prove_goal(Param = #param{goal = {{if_then}, Label}, next_goal = Next, choice = Cps}) -> + %% We effetively implement ( C -> T ) with ( C, !, T ) but cuts in + %% C are local to C. + %% There is no ( C, !, T ) here, it has already been prepended to Next. + %%io:fwrite("PG(->): ~p\n", [{Next}]), + Cut = #cut{label = Label}, + ec_body:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); +prove_goal(Param = #param{goal = {{if_then_else}, Else, Label}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> + %% Need to push a choicepoint to fail back to inside Cond and a cut + %% to cut back to before Then when Cond succeeds. #cp{type=if_then_else} + %% functions as both as is always removed whatever the outcome. + %% There is no ( C, !, T ) here, it has already been prepended to Next. + Cp = #cp{type = if_then_else, label = Label, next = Else, bs = Bs, vn = Vn}, + %%io:fwrite("PG(->;): ~p\n", [{Next,Else,[Cp|Cps]}]), + ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); +prove_goal(Param = #param{goal = {'\\+', G}, next_goal = Next0, choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> + %% We effectively implementing \+ G with ( G -> fail ; true ). + Label = Vn, + {Next1, _} = check_goal(G, [{{cut}, Label, true}, fail], Bs, Db, true, Label), + Cp = #cp{type = if_then_else, label = Label, next = Next0, bs = Bs, vn = Vn}, + %%io:fwrite("PG(\\+): ~p\n", [{G1,[Cp|Cps]]), + %% Must increment Vn to avoid clashes!!! + ec_body:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], var_num = Vn + 1}); +prove_goal(Param = #param{goal = {{once}, Label}, next_goal = Next, choice = Cps}) -> + %% We effetively implement once(G) with ( G, ! ) but cuts in + %% G are local to G. + %% There is no ( G, ! ) here, it has already been prepended to Next. + Cut = #cut{label = Label}, + ec_body:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); +prove_goal(Param = #param{goal = repeat, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> + Cp = #cp{type = disjunction, next = [repeat | Next], bs = Bs, vn = Vn}, + ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); +%% Clause creation and destruction. +prove_goal(Param = #param{goal = {abolish, Pi0}, next_goal = Next, bindings = Bs, database = Db}) -> + case ec_support:dderef(Pi0, Bs) of + {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> + erlog_memory:abolish_clauses(Db, {N, A}), + ec_body:prove_body(Param#param{goal = Next}); + Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) + end; +prove_goal(Param = #param{goal = {assert, C0}, next_goal = Next, bindings = Bs, database = Db}) -> + C = ec_support:dderef(C0, Bs), + erlog_memory:assertz_clause(Db, C), + ec_body:prove_body(Param#param{goal = Next}); +prove_goal(Param = #param{goal = {asserta, C0}, next_goal = Next, bindings = Bs, database = Db}) -> + C = ec_support:dderef(C0, Bs), + erlog_memory:asserta_clause(Db, C), + ec_body:prove_body(Param#param{goal = Next}); +prove_goal(Param = #param{goal = {assertz, C0}, next_goal = Next, bindings = Bs, database = Db}) -> + C = ec_support:dderef(C0, Bs), + erlog_memory:assertz_clause(Db, C), + ec_body:prove_body(Param#param{goal = Next}); +prove_goal(Param = #param{goal = {retract, C0}, bindings = Bs}) -> + C = ec_support:dderef(C0, Bs), + erlog_core:prove_retract(C, Param); +%% Clause retrieval and information +prove_goal(Param = #param{goal = {clause, H0, B}, bindings = Bs}) -> + H1 = ec_support:dderef(H0, Bs), + erlog_core:prove_clause(H1, B, Param); +prove_goal(Param = #param{goal = {current_predicate, Pi0}, bindings = Bs}) -> + Pi = ec_support:dderef(Pi0, Bs), + erlog_core:prove_current_predicate(Pi, Param); +prove_goal(Param = #param{goal = {predicate_property, H0, P}, bindings = Bs, database = Db}) -> + H = ec_support:dderef(H0, Bs), + case catch erlog_memory:get_procedure_type(Db, ec_support:functor(H)) of + built_in -> ec_body:unify_prove_body(P, built_in, Param); + compiled -> ec_body:unify_prove_body(P, compiled, Param); + interpreted -> ec_body:unify_prove_body(P, interpreted, Param); + undefined -> erlog_errors:fail(Param); + {erlog_error, E} -> erlog_errors:erlog_error(E, Db) + end; +%% External interface +prove_goal(Param = #param{goal = {ecall, C0, Val}, bindings = Bs, database = Db}) -> + %% Build the initial call. + %%io:fwrite("PG(ecall): ~p\n ~p\n ~p\n", [dderef(C0, Bs),Next,Cps]), + Efun = case ec_support:dderef(C0, Bs) of + {':', M, F} when is_atom(M), is_atom(F) -> + fun() -> M:F() end; + {':', M, {F, A}} when is_atom(M), is_atom(F) -> + fun() -> M:F(A) end; + {':', M, {F, A1, A2}} when is_atom(M), is_atom(F) -> + fun() -> M:F(A1, A2) end; + {':', M, T} when is_atom(M), ?IS_FUNCTOR(T) -> + L = tuple_to_list(T), + fun() -> apply(M, hd(L), tl(L)) end; + Fun when is_function(Fun) -> Fun; + Other -> erlog_errors:type_error(callable, Other, Db) + end, + erlog_core:prove_ecall(Efun, Val, Param); +%% Non-standard but useful. +prove_goal(Param = #param{goal = {writeln, T}, next_goal = Next, bindings = Bs, event_man = Evman}) -> + %% Display procedure. + gen_event:notify(Evman, ec_support:dderef(T, Bs)), + ec_body:prove_body(Param#param{goal = Next}); +%% File utils +prove_goal(Param = #param{goal = {consult, Name}, next_goal = Next, f_consulter = Fcon, database = Db}) -> + case erlog_file:consult(Fcon, Name, Db) of + ok -> ok; + {Err, Error} when Err == erlog_error; Err == error -> + erlog_errors:erlog_error(Error, Db) + end, + ec_body:prove_body(Param#param{goal = Next}); +prove_goal(Param = #param{goal = {reconsult, Name}, next_goal = Next, f_consulter = Fcon, database = Db}) -> + case erlog_file:reconsult(Fcon, Name, Db) of + ok -> ok; + {Err, Error} when Err == erlog_error; Err == error -> + erlog_errors:erlog_error(Error, Db) + end, + ec_body:prove_body(Param#param{goal = Next}); +prove_goal(Param = #param{goal = {findall, Goal, Fun, Res}, bindings = Bs0, next_goal = Next, database = Db}) -> + Predicates = erlog_memory:finadll(Db, Fun), + Element = ec_support:index_of(Goal, tuple_to_list(Fun)) - 1, + Result = lists:foldr( + fun({_, Pred, _}, Acc) -> + [_ | ParamList] = tuple_to_list(Pred), + [lists:nth(Element, ParamList) | Acc] + end, [], Predicates), + Bs1 = ec_support:add_binding(Res, Result, Bs0), + ec_body:prove_body(Param#param{goal = Next, bindings = Bs1}); +prove_goal(Param = #param{goal = {bagof, Goal, Fun, Res}, choice = Cs0, bindings = Bs0, next_goal = Next, var_num = Vn, database = Db}) -> + Predicates = erlog_memory:finadll(Db, Fun), + FunList = tuple_to_list(Fun), + ResultDict = ec_support:collect_alternatives(Goal, FunList, Predicates), + Collected = dict:fetch_keys(ResultDict), + [UBs | Choises] = lists:foldr( + fun(Key, Acc) -> + UpdBs0 = ec_support:update_result(Key, ResultDict, Res, Bs0), + UpdBs1 = ec_support:update_vars(Goal, FunList, Key, UpdBs0), + [#cp{type = disjunction, label = Fun, next = Next, bs = UpdBs1, vn = Vn} | Acc] + end, Cs0, Collected), + ec_body:prove_body(Param#param{goal = Next, bindings = UBs#cp.bs, choice = Choises, var_num = Vn + length(Choises)}); +%% Now look up the database. +prove_goal(Param = #param{goal = G, database = Db}) -> +%% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), + case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of + built_in -> erlog_bips:prove_goal(G, Param); + {code, {Mod, Func}} -> Mod:Func(G, Param); + {clauses, Cs} -> erlog_core:prove_goal_clauses(G, Cs, Param); + undefined -> erlog_errors:fail(Param); + %% Getting built_in here is an error! + {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data + end. + +%% check_goal(Goal, Next, Bindings, Database, CutAfter, CutLabel) -> +%% {WellFormedBody,HasCut}. +%% Check to see that Goal is bound and ensure that it is well-formed. +check_goal(G0, Next, Bs, Db, Cut, Label) -> + case ec_support:dderef(G0, Bs) of + {_} -> erlog_errors:instantiation_error(Db); %Must have something to call + G1 -> + case catch {ok, well_form_goal(G1, Next, Cut, Label)} of + {erlog_error, E} -> erlog_errors:erlog_error(E, Db); + {ok, GC} -> GC %Body and cut + end + end. + +%% well_form_goal(Goal, Tail, HasCutAfter, CutLabel) -> {Body,HasCut}. +%% Check that Goal is well-formed, flatten conjunctions, fix cuts and +%% add explicit call to top-level variables. +well_form_goal({',', L, R}, Tail0, Cut0, Label) -> + {Tail1, Cut1} = well_form_goal(R, Tail0, Cut0, Label), + well_form_goal(L, Tail1, Cut1, Label); +well_form_goal({';', {'->', C0, T0}, E0}, Tail, Cut0, Label) -> + {T1, Tc} = well_form_goal(T0, Tail, Cut0, Label), + {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), + {E1, Ec} = well_form_goal(E0, Tail, Cut0, Label), + {[{{if_then_else}, E1, Label} | C1], Tc or Ec}; +well_form_goal({';', L0, R0}, Tail, Cut0, Label) -> + {L1, Lc} = well_form_goal(L0, Tail, Cut0, Label), + {R1, Rc} = well_form_goal(R0, Tail, Cut0, Label), + {[{{disj}, R1} | L1], Lc or Rc}; +well_form_goal({'->', C0, T0}, Tail, Cut0, Label) -> + {T1, Cut1} = well_form_goal(T0, Tail, Cut0, Label), + %% N.B. an extra cut will be added at run-time! + {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), + {[{{if_then}, Label} | C1], Cut1}; +well_form_goal({once, G}, Tail, Cut, Label) -> + {G1, _} = well_form_goal(G, [{{cut}, Label, true} | Tail], true, Label), + {[{{once}, Label} | G1], Cut}; +well_form_goal({V}, Tail, Cut, _Label) -> + {[{call, {V}} | Tail], Cut}; +well_form_goal(true, Tail, Cut, _Label) -> {Tail, Cut}; %No-op +well_form_goal(fail, _Tail, _Cut, _Label) -> {[fail], false}; %No further +well_form_goal('!', Tail, Cut, Label) -> + {[{{cut}, Label, not Cut} | Tail], true}; +well_form_goal(Goal, Tail, Cut, _Label) -> + ec_support:functor(Goal), %Check goal + {[Goal | Tail], Cut}. + +%% initial_goal(Goal) -> {Goal,Bindings,NewVarNum}. +%% initial_goal(Goal, Bindings, VarNum) -> {Goal,NewBindings,NewVarNum}. +%% Check term for well-formedness as an Erlog term and replace '_' +%% variables with unique numbered variables. Error on non-well-formed +%% goals. +initial_goal(Goal) -> initial_goal(Goal, ec_support:new_bindings(), 0). + +initial_goal({'_'}, Bs, Vn) -> {{Vn}, Bs, Vn + 1}; %Anonymous variable +initial_goal({Name} = Var0, Bs, Vn) when is_atom(Name) -> + case ec_support:get_binding(Var0, Bs) of + {ok, Var1} -> {Var1, Bs, Vn}; + error -> + Var1 = {Vn}, + {Var1, ec_support:add_binding(Var0, Var1, Bs), Vn + 1} + end; +initial_goal([H0 | T0], Bs0, Vn0) -> + {H1, Bs1, Vn1} = initial_goal(H0, Bs0, Vn0), + {T1, Bs2, Vn2} = initial_goal(T0, Bs1, Vn1), + {[H1 | T1], Bs2, Vn2}; +initial_goal([], Bs, Vn) -> {[], Bs, Vn}; +initial_goal(S, Bs0, Vn0) when ?IS_FUNCTOR(S) -> + As0 = tl(tuple_to_list(S)), + {As1, Bs1, Vn1} = initial_goal(As0, Bs0, Vn0), + {list_to_tuple([element(1, S) | As1]), Bs1, Vn1}; +initial_goal(T, Bs, Vn) when ?IS_ATOMIC(T) -> {T, Bs, Vn}; +initial_goal(T, _Bs, _Vn) -> erlog_errors:type_error(callable, T). \ No newline at end of file diff --git a/src/core/logic/ec_support.erl b/src/core/logic/ec_support.erl new file mode 100644 index 0000000..47d86a2 --- /dev/null +++ b/src/core/logic/ec_support.erl @@ -0,0 +1,145 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 15. Июль 2014 16:09 +%%%------------------------------------------------------------------- +-module(ec_support). +-author("tihon"). + +-include("erlog_int.hrl"). + +%% API +-export([new_bindings/0, get_binding/2, add_binding/3, functor/1, cut/3, collect_alternatives/3, update_result/4, update_vars/4, deref/2, dderef_list/2, make_vars/2, pred_ind/1, deref_list/2]). + +%% deref(Term, Bindings) -> Term. +%% Dereference a variable, else just return the term. +deref({V} = T0, Bs) -> + case ?BIND:find(V, Bs) of + {ok, T1} -> deref(T1, Bs); + error -> T0 + end; +deref(T, _) -> T. %Not a variable, return it. + +%% deref_list(List, Bindings) -> List. +%% Dereference the top-level checking that it is a list. +deref_list([], _) -> []; %It already is a list %TODO where it is used? +deref_list([_ | _] = L, _) -> L; +deref_list({V}, Bs) -> + case dict:find(V, Bs) of + {ok, L} -> deref_list(L, Bs); + error -> erlog_errors:instantiation_error() + end; +deref_list(Other, _) -> erlog_errors:type_error(list, Other). + +%% dderef(Term, Bindings) -> Term. +%% Do a deep dereference. Completely dereference all the variables +%% occuring in a term, even those occuring in a variables value. +dderef(A, _) when ?IS_CONSTANT(A) -> A; +dderef([], _) -> []; +dderef([H0 | T0], Bs) -> + [dderef(H0, Bs) | dderef(T0, Bs)]; +dderef({V} = Var, Bs) -> + case ?BIND:find(V, Bs) of %TODO check, why dict instead erlog_storage + {ok, T} -> dderef(T, Bs); + error -> Var + end; +dderef(T, Bs) when is_tuple(T) -> + Es0 = tuple_to_list(T), + Es1 = dderef(Es0, Bs), + list_to_tuple(Es1). + +%% dderef_list(List, Bindings) -> List. +%% Dereference all variables to any depth but check that the +%% top-level is a list. +dderef_list([], _Bs) -> []; +dderef_list([H | T], Bs) -> + [dderef(H, Bs) | dderef_list(T, Bs)]; +dderef_list({V}, Bs) -> + case ?BIND:find(V, Bs) of + {ok, L} -> dderef_list(L, Bs); + error -> erlog_errors:instantiation_error() + end; +dderef_list(Other, _Bs) -> erlog_errors:type_error(list, Other). + +%% make_vars(Count, VarNum) -> [Var]. +%% Make a list of new variables starting at VarNum. +make_vars(0, _) -> []; +make_vars(I, Vn) -> + [{Vn} | make_vars(I - 1, Vn + 1)]. + +%% functor(Goal) -> {Name,Arity}. +functor(T) when ?IS_FUNCTOR(T) -> + {element(1, T), tuple_size(T) - 1}; +functor(T) when is_atom(T) -> {T, 0}; +functor(T) -> erlog_errors:type_error(callable, T). + +pred_ind({N, A}) -> {'/', N, A}. + +%% pred_ind(N, A) -> {'/',N,A}. + +%% Bindings +%% Bindings are kept in a dict where the key is the variable name. +new_bindings() -> ?BIND:new(). + +add_binding({V}, Val, Bs0) -> + ?BIND:store(V, Val, Bs0). + +get_binding({V}, Bs) -> + ?BIND:find(V, Bs). + +collect_alternatives(Goal, FunList, Predicates) -> + Element = index_of(Goal, FunList) - 1, + lists:foldr( + fun({_, Pred, _}, Dict) -> + [_ | ParamList] = tuple_to_list(Pred), + Keys = remove_nth(ParamList, Element), + dict:append(Keys, lists:nth(Element, ParamList), Dict) + end, dict:new(), Predicates). + +update_result(Key, ResultDict, Res, Bs0) -> + case dict:find(Key, ResultDict) of + {ok, Value} -> add_binding(Res, Value, Bs0); + error -> Bs0 + end. + +update_vars(Goal, FunList, Key, Bs) -> + Vars = tl(FunList) -- [Goal], + lists:foldl( + fun({N} = Var, UBs1) -> + add_binding(Var, lists:nth(N, Key), UBs1) + end, Bs, Vars). + +index_of(Item, List) -> index_of(Item, List, 1). + +index_of(_, [], _) -> not_found; +index_of(Item, [Item | _], Index) -> Index; +index_of(Item, [_ | Tl], Index) -> index_of(Item, Tl, Index + 1). + +remove_nth(List, N) -> + {A, B} = lists:split(N - 1, List), + A ++ tl(B). + +cut(Label, Last, Param = #param{next_goal = Next, choice = [#cut{label = Label} | Cps] = Cps0}) -> + if Last -> ec_body:prove_body(Param#param{goal = Next, choice = Cps}); + true -> ec_body:prove_body(Param#param{goal = Next, choice = Cps0}) + end; +cut(Label, Last, Param = #param{next_goal = Next, choice = [#cp{type = if_then_else, label = Label} | Cps] = Cps0}) -> + if Last -> ec_body:prove_body(Param#param{goal = Next, choice = Cps}); + true -> ec_body:prove_body(Param#param{goal = Next, choice = Cps0}) + end; +cut(Label, Last, Param = #param{choice = [#cp{type = goal_clauses, label = Label} = Cp | Cps]}) -> + cut_goal_clauses(Last, Cp, Param#param{choice = Cps}); +cut(Label, Last, Param = #param{choice = [_Cp | Cps]}) -> + cut(Label, Last, Param#param{choice = Cps}). + +%% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db). +cut_goal_clauses(true, #cp{label = _}, Param = #param{next_goal = Next}) -> + %% Just remove the choice point completely and continue. + ec_body:prove_body(Param#param{goal = Next}); +cut_goal_clauses(false, #cp{label = L}, Param = #param{next_goal = Next, choice = Cps}) -> + %% Replace choice point with cut point then continue. + Cut = #cut{label = L}, + ec_body:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). \ No newline at end of file diff --git a/src/core/logic/ec_term.erl b/src/core/logic/ec_term.erl new file mode 100644 index 0000000..26dbff1 --- /dev/null +++ b/src/core/logic/ec_term.erl @@ -0,0 +1,49 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 15. Июль 2014 16:29 +%%%------------------------------------------------------------------- +-module(ec_term). +-author("tihon"). + +%% API +-export([term_instance/2]). + +%% term_instance(Term, VarNum) -> {Term,NewRepls,NewVarNum}. +%% term_instance(Term, Repls, VarNum) -> {Term,NewRepls,NewVarNum}. +%% Generate a copy of a term with new, fresh unused variables. No +%% bindings from original variables to new variables. It can handle +%% replacing integer variables with overlapping integer ranges. Don't +%% check Term as it should already be checked. Use orddict as there +%% will seldom be many variables and it it fast to setup. +term_instance(A, Vn) -> term_instance(A, orddict:new(), Vn). + +term_instance([], Rs, Vn) -> {[], Rs, Vn}; +term_instance([H0 | T0], Rs0, Vn0) -> + {H, Rs1, Vn1} = term_instance(H0, Rs0, Vn0), + {T, Rs2, Vn2} = term_instance(T0, Rs1, Vn1), + {[H | T], Rs2, Vn2}; +term_instance({'_'}, Rs, Vn) -> {{Vn}, Rs, Vn + 1}; %Unique variable +term_instance({V0}, Rs0, Vn0) -> %Other variables + case orddict:find(V0, Rs0) of + {ok, V1} -> {V1, Rs0, Vn0}; + error -> + V1 = {Vn0}, + {V1, orddict:store(V0, V1, Rs0), Vn0 + 1} + end; +%% Special case some smaller structures. +term_instance({Atom, Arg}, Rs0, Vn0) -> + {CopyArg, Rs1, Vn1} = term_instance(Arg, Rs0, Vn0), + {{Atom, CopyArg}, Rs1, Vn1}; +term_instance({Atom, A1, A2}, Rs0, Vn0) -> + {CopyA1, Rs1, Vn1} = term_instance(A1, Rs0, Vn0), + {CopyA2, Rs2, Vn2} = term_instance(A2, Rs1, Vn1), + {{Atom, CopyA1, CopyA2}, Rs2, Vn2}; +term_instance(T, Rs0, Vn0) when is_tuple(T) -> + As0 = tl(tuple_to_list(T)), + {As1, Rs1, Vn1} = term_instance(As0, Rs0, Vn0), + {list_to_tuple([element(1, T) | As1]), Rs1, Vn1}; +term_instance(A, Rs, Vn) -> {A, Rs, Vn}. %Constant \ No newline at end of file diff --git a/src/core/logic/ec_unify.erl b/src/core/logic/ec_unify.erl new file mode 100644 index 0000000..7c9ae2c --- /dev/null +++ b/src/core/logic/ec_unify.erl @@ -0,0 +1,119 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 15. Июль 2014 16:26 +%%%------------------------------------------------------------------- +-module(ec_unify). +-author("tihon"). + +-include("erlog_int.hrl"). + +%% API +-export([unify/3, unify_clauses/4, unify_head/4]). + +%% unify(Term, Term, Bindings) -> {succeed,NewBindings} | fail. +%% Unify two terms with a set of bindings. +unify(T10, T20, Bs0) -> + case {ec_support:deref(T10, Bs0), ec_support:deref(T20, Bs0)} of + {T1, T2} when ?IS_CONSTANT(T1), T1 == T2 -> + {succeed, Bs0}; + {{V}, {V}} -> {succeed, Bs0}; + {{_} = Var, T2} -> {succeed, ec_support:add_binding(Var, T2, Bs0)}; + {T1, {_} = Var} -> {succeed, ec_support:add_binding(Var, T1, Bs0)}; + {[H1 | T1], [H2 | T2]} -> + case unify(H1, H2, Bs0) of + {succeed, Bs1} -> unify(T1, T2, Bs1); + fail -> fail + end; + {[], []} -> {succeed, Bs0}; + {T1, T2} when tuple_size(T1) == tuple_size(T2), + element(1, T1) == element(1, T2) -> + unify_args(T1, T2, Bs0, 2, tuple_size(T1)); + _Other -> fail + end. + +%% unify_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Try to unify Head and Body using Clauses which all have the same functor. +unify_clauses(Ch, Cb, [C], Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0}) -> + %% No choice point on last clause + case unify_clause(Ch, Cb, C, Bs0, Vn0) of + {succeed, Bs1, Vn1} -> ec_body:prove_body(Param#param{goal = Next, bindings = Bs1, var_num = Vn1}); + fail -> erlog_errors:fail(Param) + end; +unify_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0, choice = Cps}) -> + case unify_clause(Ch, Cb, C, Bs0, Vn0) of + {succeed, Bs1, Vn1} -> + Cp = #cp{type = clause, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, + ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); + fail -> unify_clauses(Ch, Cb, Cs, Param) + end; +unify_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param). + +unify_clause(Ch, Cb, {_Tag, H0, {B0, _}}, Bs0, Vn0) -> + {H1, Rs1, Vn1} = ec_term:term_instance(H0, Vn0), %Unique vars on head first + case unify(Ch, H1, Bs0) of + {succeed, Bs1} -> + {B1, _Rs2, Vn2} = ec_body:body_term(B0, Rs1, Vn1), %Now we need the rest + case unify(Cb, B1, Bs1) of + {succeed, Bs2} -> {succeed, Bs2, Vn2}; + fail -> fail + end; + fail -> fail + end. + +%% unify_head(Goal, Head, Bindings, VarNum) -> +%% {succeed,Repls,NewBindings,NewVarNum} | fail +%% Unify a goal with a head without creating an instance of the +%% head. This saves us creating many variables which are local to the +%% clause and saves many variable bindings. + +unify_head(Goal, Head, Bs, Vn) -> + unify_head(ec_support:deref(Goal, Bs), Head, orddict:new(), Bs, Vn). + +unify_head(G, H, Rs, Bs, Vn) when ?IS_CONSTANT(G), G == H -> + {succeed, Rs, Bs, Vn}; +unify_head(_T, {'_'}, Rs, Bs, Vn) -> {succeed, Rs, Bs, Vn}; +unify_head(T, {V0}, Rs, Bs0, Vn) -> + %% Now for the tricky bit! + case orddict:find(V0, Rs) of + {ok, V1} -> %Already have a replacement + case unify(T, V1, Bs0) of + {succeed, Bs1} -> {succeed, Rs, Bs1, Vn}; + fail -> fail + end; + error -> %Add a replacement + {succeed, orddict:store(V0, T, Rs), Bs0, Vn} + end; +unify_head({_} = Var, H0, Rs0, Bs, Vn0) -> + %% Must have an instance here. + {H1, Rs1, Vn1} = ec_term:term_instance(H0, Rs0, Vn0), + {succeed, Rs1, ec_support:add_binding(Var, H1, Bs), Vn1}; +unify_head([GH | GT], [HH | HT], Rs0, Bs0, Vn0) -> + case unify_head(ec_support:deref(GH, Bs0), HH, Rs0, Bs0, Vn0) of + {succeed, Rs1, Bs1, Vn1} -> unify_head(ec_support:deref(GT, Bs1), HT, Rs1, Bs1, Vn1); + fail -> fail + end; +unify_head([], [], Rs, Bs, Vn) -> {succeed, Rs, Bs, Vn}; +unify_head(G, H, Rs, Bs, Vn) when tuple_size(G) == tuple_size(H), + element(1, G) == element(1, H) -> + unify_head_args(G, H, Rs, Bs, Vn, 2, tuple_size(G)); +unify_head(_G, _H, _Rs, _Bs, _Vn) -> fail. + +unify_head_args(_G, _H, Rs, Bs, Vn, I, S) when I > S -> + {succeed, Rs, Bs, Vn}; +unify_head_args(G, H, Rs0, Bs0, Vn0, I, S) -> + case unify_head(ec_support:deref(element(I, G), Bs0), element(I, H), Rs0, Bs0, Vn0) of + {succeed, Rs1, Bs1, Vn1} -> unify_head_args(G, H, Rs1, Bs1, Vn1, I + 1, S); + fail -> fail + end. + +unify_args(_, _, Bs, I, S) when I > S -> {succeed, Bs}; +unify_args(S1, S2, Bs0, I, S) -> + case unify(element(I, S1), element(I, S2), Bs0) of + {succeed, Bs1} -> unify_args(S1, S2, Bs1, I + 1, S); + fail -> fail + end. \ No newline at end of file diff --git a/src/core/logic/erlog_core.erl b/src/core/logic/erlog_core.erl new file mode 100644 index 0000000..35d38d7 --- /dev/null +++ b/src/core/logic/erlog_core.erl @@ -0,0 +1,160 @@ +%% Copyright (c) 2008-2013 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +-module(erlog_core). + +-include("erlog_int.hrl"). + +%% Main execution functions. +-export([ + retract_clauses/4, + prove_predicates/3, + prove_goal_clauses/3, + prove_retract/2, + prove_clause/3, + prove_current_predicate/2, + prove_ecall/3, + prove_goal/4]). +%% Adding to database. +-export([load/1]). + +%% built_in_db(Db) -> Database. +%% Create an initial clause database containing the built-in +%% predicates and predefined library predicates. + +load(Db) -> + lists:foreach(fun(Head) -> erlog_memory:add_built_in(Db, Head) end, ?ERLOG_CORE). %% Add the Erlang built-ins. + +%% prove_goal(Goal, Database) -> Succeed | Fail. +%% This is the main entry point into the interpreter. Check that +%% everything is consistent then prove the goal as a call. +-spec prove_goal(Goal0 :: term(), Db :: pid(), Fcon :: fun(), Event :: pid()) -> term(). +prove_goal(Goal0, Db, Fcon, Event) -> + %% put(erlog_cut, orddict:new()), + %% put(erlog_cps, orddict:new()), + %% put(erlog_var, orddict:new()), + %% Check term and build new instance of term with bindings. + {Goal1, Bs, Vn} = ec_goals:initial_goal(Goal0), + Params = #param{goal = [{call, Goal1}], choice = [], bindings = Bs, var_num = Vn, + event_man = Event, database = Db, f_consulter = Fcon}, + ec_body:prove_body(Params). %TODO use lists:foldr instead! + +%% prove_ecall(Generator, Value, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Call an external (Erlang) generator and handle return value, either +%% succeed or fail. +prove_ecall(Efun, Val, Param = #param{next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> + case Efun() of + {succeed, Ret, Cont} -> %Succeed and more choices + Cp = #cp{type = ecall, data = {Cont, Val}, next = Next, bs = Bs, vn = Vn}, + ec_body:unify_prove_body(Val, Ret, Param#param{choice = [Cp | Cps]}); + {succeed_last, Ret} -> %Succeed but last choice + ec_body:unify_prove_body(Val, Ret, Param); + fail -> erlog_errors:fail(Param) %No more + end. + +%% prove_clause(Head, Body, Next, ChoicePoints, Bindings, VarNum, DataBase) -> +%% void. +%% Unify clauses matching with functor from Head with both Head and Body. +prove_clause(H, B, Param = #param{database = Db}) -> + Functor = ec_support:functor(H), + case erlog_memory:get_procedure(Db, Functor) of + {clauses, Cs} -> ec_unify:unify_clauses(H, B, Cs, Param); + {code, _} -> + erlog_errors:permission_error(access, private_procedure, ec_support:pred_ind(Functor), Db); + built_in -> + erlog_errors:permission_error(access, private_procedure, ec_support:pred_ind(Functor), Db); + undefined -> erlog_errors:fail(Param) + end. + +%% prove_current_predicate(PredInd, Next, ChoicePoints, Bindings, VarNum, DataBase) -> +%% void. +%% Match functors of existing user (interpreted) predicate with PredInd. +prove_current_predicate(Pi, Param = #param{database = Db}) -> + case Pi of + {'/', _, _} -> ok; + {_} -> ok; + Other -> erlog_errors:type_error(predicate_indicator, Other) + end, + Fs = erlog_memory:get_interp_functors(Db), + prove_predicates(Pi, Fs, Param). + +prove_predicates(Pi, [F | Fs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> + Cp = #cp{type = current_predicate, data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, + ec_body:unify_prove_body(Pi, ec_support:pred_ind(F), Param#param{choice = [Cp | Cps]}); +prove_predicates(_Pi, [], Param) -> erlog_errors:fail(Param). + +%% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Try to prove Goal using Clauses which all have the same functor. +prove_goal_clauses(G, [C], Params = #param{choice = Cps, var_num = Vn}) -> + %% Must be smart here and test whether we need to add a cut point. + %% C has the structure {Tag,Head,{Body,BodyHasCut}}. + case element(2, element(3, C)) of + true -> + Cut = #cut{label = Vn}, + prove_goal_clause(G, C, Params#param{choice = [Cut | Cps]}); + false -> + prove_goal_clause(G, C, Params) + end; +%% prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db); +prove_goal_clauses(G, [C | Cs], Params = #param{next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps}) -> + Cp = #cp{type = goal_clauses, label = Vn, data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, + prove_goal_clause(G, C, Params#param{choice = [Cp | Cps]}); +prove_goal_clauses(_G, [], Param) -> erlog_errors:fail(Param). + +prove_goal_clause(G, {_Tag, H0, {B0, _}}, Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0}) -> + %% io:fwrite("PGC1: ~p\n", [{G,H0,B0}]), + Label = Vn0, + case ec_unify:unify_head(G, H0, Bs0, Vn0 + 1) of + {succeed, Rs0, Bs1, Vn1} -> + %% io:fwrite("PGC2: ~p\n", [{Rs0}]), + {B1, _Rs2, Vn2} = ec_body:body_instance(B0, Next, Rs0, Vn1, Label), + %% io:fwrite("PGC3: ~p\n", [{B1,Next,Cps}]), + ec_body:prove_body(Param#param{goal = B1, bindings = Bs1, var_num = Vn2}); + fail -> erlog_errors:fail(Param) + end. + +%% prove_retract(Clause, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Retract clauses in database matching Clause. +prove_retract({':-', H, B}, Params) -> + prove_retract(H, B, Params); +prove_retract(H, Params) -> + prove_retract(H, true, Params). + +prove_retract(H, B, Params = #param{database = Db}) -> + Functor = ec_support:functor(H), + case erlog_memory:get_procedure(Db, Functor) of + {clauses, Cs} -> retract_clauses(H, B, Cs, Params); + {code, _} -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + built_in -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + undefined -> erlog_errors:fail(Params) + end. + +%% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Try to retract Head and Body using Clauses which all have the same functor. +retract_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}) -> %TODO foreach vs handmade recursion? + case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of + {succeed, Bs1, Vn1} -> + %% We have found a right clause so now retract it. + erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), + Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, + ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); + fail -> retract_clauses(Ch, Cb, Cs, Param) + end; +retract_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param). \ No newline at end of file diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index f8852e7..d6dc611 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -86,5 +86,5 @@ consult_terms(Ifun, Params, [Term | Ts]) -> consult_terms(_, _, []) -> ok. %% @private -functor({':-', H, _B}) -> erlog_core:functor(H); -functor(T) -> erlog_core:functor(T). \ No newline at end of file +functor({':-', H, _B}) -> ec_support:functor(H); +functor(T) -> ec_support:functor(T). \ No newline at end of file diff --git a/src/libs/erlog_bips.erl b/src/libs/erlog_bips.erl index 6269d63..e1677ef 100644 --- a/src/libs/erlog_bips.erl +++ b/src/libs/erlog_bips.erl @@ -42,11 +42,11 @@ load(Db) -> %% Term unification and comparison prove_goal({'=', L, R}, Params) -> - erlog_core:unify_prove_body(L, R, Params); + ec_body:unify_prove_body(L, R, Params); prove_goal({'\\=', L, R}, Params = #param{next_goal = Next, bindings = Bs0}) -> - case erlog_core:unify(L, R, Bs0) of + case ec_unify:unify(L, R, Bs0) of {succeed, _Bs1} -> erlog_errors:fail(Params); - fail -> erlog_core:prove_body(Params#param{goal = Next}) + fail -> ec_body:prove_body(Params#param{goal = Next}) end; prove_goal({'@>', L, R}, Params) -> term_test_prove_body('>', L, R, Params); @@ -62,68 +62,68 @@ prove_goal({'@=<', L, R}, Params) -> term_test_prove_body('=<', L, R, Params); %% Term creation and decomposition. prove_goal({arg, I, Ct, A}, Params = #param{bindings = Bs}) -> - prove_arg(erlog_core:deref(I, Bs), erlog_core:deref(Ct, Bs), A, Params); + prove_arg(ec_support:deref(I, Bs), ec_support:deref(Ct, Bs), A, Params); prove_goal({copy_term, T0, C}, Params = #param{bindings = Bs, var_num = Vn0}) -> %% Use term_instance to create the copy, can ignore orddict it creates. - {T, _Nbs, Vn1} = erlog_core:term_instance(erlog_core:dderef(T0, Bs), Vn0), - erlog_core:unify_prove_body(T, C, Params#param{var_num = Vn1}); + {T, _Nbs, Vn1} = ec_term:term_instance(ec_support:dderef(T0, Bs), Vn0), + ec_body:unify_prove_body(T, C, Params#param{var_num = Vn1}); prove_goal({functor, T, F, A}, Params = #param{bindings = Bs}) -> - prove_functor(erlog_core:dderef(T, Bs), F, A, Params); + prove_functor(ec_support:dderef(T, Bs), F, A, Params); prove_goal({'=..', T, L}, Params = #param{bindings = Bs}) -> - prove_univ(erlog_core:dderef(T, Bs), L, Params); + prove_univ(ec_support:dderef(T, Bs), L, Params); %% Type testing. prove_goal({atom, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> - case erlog_core:deref(T0, Bs) of - T when is_atom(T) -> erlog_core:prove_body(Params#param{goal = Next}); + case ec_support:deref(T0, Bs) of + T when is_atom(T) -> ec_body:prove_body(Params#param{goal = Next}); _Other -> erlog_errors:fail(Params) end; prove_goal({atomic, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> - case erlog_core:deref(T0, Bs) of - T when ?IS_ATOMIC(T) -> erlog_core:prove_body(Params#param{goal = Next}); + case ec_support:deref(T0, Bs) of + T when ?IS_ATOMIC(T) -> ec_body:prove_body(Params#param{goal = Next}); _Other -> erlog_errors:fail(Params) end; prove_goal({compound, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> - case erlog_core:deref(T0, Bs) of + case ec_support:deref(T0, Bs) of T when ?IS_ATOMIC(T) -> erlog_errors:fail(Params); - _Other -> erlog_core:prove_body(Params#param{goal = Next}) + _Other -> ec_body:prove_body(Params#param{goal = Next}) end; prove_goal({integer, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> - case erlog_core:deref(T0, Bs) of - T when is_integer(T) -> erlog_core:prove_body(Params#param{goal = Next}); + case ec_support:deref(T0, Bs) of + T when is_integer(T) -> ec_body:prove_body(Params#param{goal = Next}); _Other -> erlog_errors:fail(Params) end; prove_goal({float, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> - case erlog_core:deref(T0, Bs) of - T when is_float(T) -> erlog_core:prove_body(Params#param{goal = Next}); + case ec_support:deref(T0, Bs) of + T when is_float(T) -> ec_body:prove_body(Params#param{goal = Next}); _Other -> erlog_errors:fail(Params) end; prove_goal({number, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> - case erlog_core:deref(T0, Bs) of - T when is_number(T) -> erlog_core:prove_body(Params#param{goal = Next}); + case ec_support:deref(T0, Bs) of + T when is_number(T) -> ec_body:prove_body(Params#param{goal = Next}); _Other -> erlog_errors:fail(Params) end; prove_goal({nonvar, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> - case erlog_core:deref(T0, Bs) of + case ec_support:deref(T0, Bs) of {_} -> erlog_errors:fail(Params); - _Other -> erlog_core:prove_body(Params#param{goal = Next}) + _Other -> ec_body:prove_body(Params#param{goal = Next}) end; prove_goal({var, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> - case erlog_core:deref(T0, Bs) of - {_} -> erlog_core:prove_body(Params#param{goal = Next}); + case ec_support:deref(T0, Bs) of + {_} -> ec_body:prove_body(Params#param{goal = Next}); _Other -> erlog_errors:fail(Params) end; %% Atom processing. prove_goal({atom_chars, A, L}, Params) -> prove_atom_chars(A, L, Params); prove_goal({atom_length, A0, L0}, Params = #param{bindings = Bs, database = Db}) -> - case erlog_core:dderef(A0, Bs) of + case ec_support:dderef(A0, Bs) of A when is_atom(A) -> Alen = length(atom_to_list(A)), %No of chars in atom - case erlog_core:dderef(L0, Bs) of + case ec_support:dderef(L0, Bs) of L when is_integer(L) -> - erlog_core:unify_prove_body(Alen, L, Params); + ec_body:unify_prove_body(Alen, L, Params); {_} = Var -> - erlog_core:unify_prove_body(Alen, Var, Params); + ec_body:unify_prove_body(Alen, Var, Params); Other -> erlog_errors:type_error(integer, Other, Db) end; {_} -> erlog_errors:instantiation_error(Db); @@ -131,8 +131,8 @@ prove_goal({atom_length, A0, L0}, Params = #param{bindings = Bs, database = Db}) end; %% Arithmetic evalution and comparison. prove_goal({is, N, E0}, Params = #param{bindings = Bs, database = Db}) -> - E = eval_arith(erlog_core:deref(E0, Bs), Bs, Db), - erlog_core:unify_prove_body(N, E, Params); + E = eval_arith(ec_support:deref(E0, Bs), Bs, Db), + ec_body:unify_prove_body(N, E, Params); prove_goal({'>', L, R}, Params) -> arith_test_prove_body('>', L, R, Params); prove_goal({'>=', L, R}, Params) -> @@ -150,8 +150,8 @@ prove_goal({'=<', L, R}, Params) -> %% void. term_test_prove_body(Test, L, R, Params = #param{next_goal = Next, bindings = Bs}) -> - case erlang:Test(erlog_core:dderef(L, Bs), erlog_core:dderef(R, Bs)) of - true -> erlog_core:prove_body(Params#param{goal = Next}); + case erlang:Test(ec_support:dderef(L, Bs), ec_support:dderef(R, Bs)) of + true -> ec_body:prove_body(Params#param{goal = Next}); false -> erlog_errors:fail(Params) end. @@ -160,14 +160,14 @@ term_test_prove_body(Test, L, R, Params = #param{next_goal = Next, bindings = Bs prove_arg(I, [H | T], A, Param = #param{database = Db}) when is_integer(I) -> %% He, he, he! - if I == 1 -> erlog_core:unify_prove_body(H, A, Param); - I == 2 -> erlog_core:unify_prove_body(T, A, Param); + if I == 1 -> ec_body:unify_prove_body(H, A, Param); + I == 2 -> ec_body:unify_prove_body(T, A, Param); true -> {fail, Db} end; prove_arg(I, Ct, A, Param = #param{database = Db}) when is_integer(I), tuple_size(Ct) >= 2 -> if I > 1, I + 1 =< tuple_size(Ct) -> - erlog_core:unify_prove_body(element(I + 1, Ct), A, Param); + ec_body:unify_prove_body(element(I + 1, Ct), A, Param); true -> {fail, Db} end; prove_arg(I, Ct, _, #param{database = Db}) -> @@ -180,24 +180,24 @@ prove_arg(I, Ct, _, #param{database = Db}) -> %% Prove the call functor(T, F, A), Term has been dereferenced. prove_functor(T, F, A, Params) when tuple_size(T) >= 2 -> - erlog_core:unify_prove_body(F, element(1, T), A, tuple_size(T) - 1, Params); + ec_body:unify_prove_body(F, element(1, T), A, tuple_size(T) - 1, Params); prove_functor(T, F, A, Params) when ?IS_ATOMIC(T) -> - erlog_core:unify_prove_body(F, T, A, 0, Params); + ec_body:unify_prove_body(F, T, A, 0, Params); prove_functor([_ | _], F, A, Params) -> %% Just the top level here. - erlog_core:unify_prove_body(F, '.', A, 2, Params); + ec_body:unify_prove_body(F, '.', A, 2, Params); prove_functor({_} = Var, F0, A0, Params = #param{next_goal = Next, bindings = Bs0, var_num = Vn0, database = Db}) -> - case {erlog_core:dderef(F0, Bs0), erlog_core:dderef(A0, Bs0)} of + case {ec_support:dderef(F0, Bs0), ec_support:dderef(A0, Bs0)} of {'.', 2} -> %He, he, he! - Bs1 = erlog_core:add_binding(Var, [{Vn0} | {Vn0 + 1}], Bs0), - erlog_core:prove_body(Params#param{goal = Next, bindings = Bs1, var_num = Vn0 + 2}); + Bs1 = ec_support:add_binding(Var, [{Vn0} | {Vn0 + 1}], Bs0), + ec_body:prove_body(Params#param{goal = Next, bindings = Bs1, var_num = Vn0 + 2}); {F1, 0} when ?IS_ATOMIC(F1) -> - Bs1 = erlog_core:add_binding(Var, F1, Bs0), - erlog_core:prove_body(Params#param{goal = Next, bindings = Bs1}); + Bs1 = ec_support:add_binding(Var, F1, Bs0), + ec_body:prove_body(Params#param{goal = Next, bindings = Bs1}); {F1, A1} when is_atom(F1), is_integer(A1), A1 > 0 -> - As = erlog_core:make_vars(A1, Vn0), - Bs1 = erlog_core:add_binding(Var, list_to_tuple([F1 | As]), Bs0), - erlog_core:prove_body(Params#param{goal = Next, bindings = Bs1, var_num = Vn0 + A1}); %!!! + As = ec_support:make_vars(A1, Vn0), + Bs1 = ec_support:add_binding(Var, list_to_tuple([F1 | As]), Bs0), + ec_body:prove_body(Params#param{goal = Next, bindings = Bs1, var_num = Vn0 + A1}); %!!! %% Now the error cases. {{_}, _} -> erlog_errors:instantiation_error(Db); {F1, A1} when is_atom(F1) -> erlog_errors:type_error(integer, A1, Db); @@ -209,26 +209,26 @@ prove_functor({_} = Var, F0, A0, Params = #param{next_goal = Next, bindings = Bs prove_univ(T, L, Params) when tuple_size(T) >= 2 -> Es = tuple_to_list(T), - erlog_core:unify_prove_body(Es, L, Params); + ec_body:unify_prove_body(Es, L, Params); prove_univ(T, L, Params) when ?IS_ATOMIC(T) -> - erlog_core:unify_prove_body([T], L, Params); + ec_body:unify_prove_body([T], L, Params); prove_univ([Lh | Lt], L, Params) -> %% He, he, he! %TODO what does it mean? - erlog_core:unify_prove_body(['.', Lh, Lt], L, Params); + ec_body:unify_prove_body(['.', Lh, Lt], L, Params); prove_univ({_} = Var, L, Params = #param{next_goal = Next, bindings = Bs0, database = Db}) -> - Bs1 = case erlog_core:dderef(L, Bs0) of + Bs1 = case ec_support:dderef(L, Bs0) of ['.', Lh, Lt] -> %He, he, he! - erlog_core:add_binding(Var, [Lh | Lt], Bs0); + ec_support:add_binding(Var, [Lh | Lt], Bs0); [A] when ?IS_ATOMIC(A) -> - erlog_core:add_binding(Var, A, Bs0); + ec_support:add_binding(Var, A, Bs0); [F | As] when is_atom(F), length(As) > 0 -> - erlog_core:add_binding(Var, list_to_tuple([F | As]), Bs0); + ec_support:add_binding(Var, list_to_tuple([F | As]), Bs0); %% Now the error cases. They end with throw -> no return there [{_} | _] -> erlog_errors:instantiation_error(Db); {_} -> erlog_errors:instantiation_error(Db); Other -> erlog_errors:type_error(list, Other, Db) end, - erlog_core:prove_body(Params#param{goal = Next, bindings = Bs1}). + ec_body:prove_body(Params#param{goal = Next, bindings = Bs1}). %% prove_atom_chars(Atom, List, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. @@ -236,14 +236,14 @@ prove_univ({_} = Var, L, Params = #param{next_goal = Next, bindings = Bs0, datab prove_atom_chars(A, L, Params = #param{bindings = Bs, database = Db}) -> %% After a suggestion by Sean Cribbs. - case erlog_core:dderef(A, Bs) of + case ec_support:dderef(A, Bs) of Atom when is_atom(Atom) -> AtomList = [list_to_atom([C]) || C <- atom_to_list(Atom)], - erlog_core:unify_prove_body(L, AtomList, Params); + ec_body:unify_prove_body(L, AtomList, Params); {_} = Var -> %% Error #3: List is neither a list nor a partial list. %% Handled in dderef_list/2. - List = erlog_core:dderef_list(L, Bs), + List = ec_support:dderef_list(L, Bs), %% Error #1, #4: List is a list or partial list with an %% element which is a variable or not one char atom. Fun = fun({_}) -> erlog_errors:instantiation_error(Db); @@ -255,7 +255,7 @@ prove_atom_chars(A, L, Params = #param{bindings = Bs, database = Db}) -> end, Chars = lists:map(Fun, List), Atom = list_to_atom(Chars), - erlog_core:unify_prove_body(Var, Atom, Params); + ec_body:unify_prove_body(Var, Atom, Params); Other -> %% Error #2: Atom is neither a variable nor an atom erlog_errors:type_error(atom, Other, Db) @@ -265,9 +265,9 @@ prove_atom_chars(A, L, Params = #param{bindings = Bs, database = Db}) -> %% void. arith_test_prove_body(Test, L, R, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> - case erlang:Test(eval_arith(erlog_core:deref(L, Bs), Bs, Db), - eval_arith(erlog_core:deref(R, Bs), Bs, Db)) of - true -> erlog_core:prove_body(Params#param{goal = Next}); + case erlang:Test(eval_arith(ec_support:deref(L, Bs), Bs, Db), + eval_arith(ec_support:deref(R, Bs), Bs, Db)) of + true -> ec_body:prove_body(Params#param{goal = Next}); false -> erlog_errors:fail(Params) end. @@ -277,40 +277,40 @@ arith_test_prove_body(Test, L, R, Params = #param{next_goal = Next, bindings = B %% work. Must be called deferenced. eval_arith({'+', A, B}, Bs, Db) -> - eval_arith(erlog_core:deref(A, Bs), Bs, Db) + eval_arith(erlog_core:deref(B, Bs), Bs, Db); + eval_arith(ec_support:deref(A, Bs), Bs, Db) + eval_arith(ec_support:deref(B, Bs), Bs, Db); eval_arith({'-', A, B}, Bs, Db) -> - eval_arith(erlog_core:deref(A, Bs), Bs, Db) - eval_arith(erlog_core:deref(B, Bs), Bs, Db); + eval_arith(ec_support:deref(A, Bs), Bs, Db) - eval_arith(ec_support:deref(B, Bs), Bs, Db); eval_arith({'*', A, B}, Bs, Db) -> - eval_arith(erlog_core:deref(A, Bs), Bs, Db) * eval_arith(erlog_core:deref(B, Bs), Bs, Db); + eval_arith(ec_support:deref(A, Bs), Bs, Db) * eval_arith(ec_support:deref(B, Bs), Bs, Db); eval_arith({'/', A, B}, Bs, Db) -> - eval_arith(erlog_core:deref(A, Bs), Bs, Db) / eval_arith(erlog_core:deref(B, Bs), Bs, Db); + eval_arith(ec_support:deref(A, Bs), Bs, Db) / eval_arith(ec_support:deref(B, Bs), Bs, Db); eval_arith({'**', A, B}, Bs, Db) -> - math:pow(eval_arith(erlog_core:deref(A, Bs), Bs, Db), - eval_arith(erlog_core:deref(B, Bs), Bs, Db)); + math:pow(eval_arith(ec_support:deref(A, Bs), Bs, Db), + eval_arith(ec_support:deref(B, Bs), Bs, Db)); eval_arith({'//', A, B}, Bs, Db) -> - eval_int(erlog_core:deref(A, Bs), Bs, Db) div eval_int(erlog_core:deref(B, Bs), Bs, Db); + eval_int(ec_support:deref(A, Bs), Bs, Db) div eval_int(ec_support:deref(B, Bs), Bs, Db); eval_arith({'mod', A, B}, Bs, Db) -> - eval_int(erlog_core:deref(A, Bs), Bs, Db) rem eval_int(erlog_core:deref(B, Bs), Bs, Db); + eval_int(ec_support:deref(A, Bs), Bs, Db) rem eval_int(ec_support:deref(B, Bs), Bs, Db); eval_arith({'/\\', A, B}, Bs, Db) -> - eval_int(erlog_core:deref(A, Bs), Bs, Db) band eval_int(erlog_core:deref(B, Bs), Bs, Db); + eval_int(ec_support:deref(A, Bs), Bs, Db) band eval_int(ec_support:deref(B, Bs), Bs, Db); eval_arith({'\\/', A, B}, Bs, Db) -> - eval_int(erlog_core:deref(A, Bs), Bs, Db) bor eval_int(erlog_core:deref(B, Bs), Bs, Db); + eval_int(ec_support:deref(A, Bs), Bs, Db) bor eval_int(ec_support:deref(B, Bs), Bs, Db); eval_arith({'<<', A, B}, Bs, Db) -> - eval_int(erlog_core:deref(A, Bs), Bs, Db) bsl eval_int(erlog_core:deref(B, Bs), Bs, Db); + eval_int(ec_support:deref(A, Bs), Bs, Db) bsl eval_int(ec_support:deref(B, Bs), Bs, Db); eval_arith({'>>', A, B}, Bs, Db) -> - eval_int(erlog_core:deref(A, Bs), Bs, Db) bsr eval_int(erlog_core:deref(B, Bs), Bs, Db); + eval_int(ec_support:deref(A, Bs), Bs, Db) bsr eval_int(ec_support:deref(B, Bs), Bs, Db); eval_arith({'\\', A}, Bs, Db) -> - bnot eval_int(erlog_core:deref(A, Bs), Bs, Db); + bnot eval_int(ec_support:deref(A, Bs), Bs, Db); eval_arith({'+', A}, Bs, Db) -> - + eval_arith(erlog_core:deref(A, Bs), Bs, Db); + + eval_arith(ec_support:deref(A, Bs), Bs, Db); eval_arith({'-', A}, Bs, Db) -> - - eval_arith(erlog_core:deref(A, Bs), Bs, Db); + - eval_arith(ec_support:deref(A, Bs), Bs, Db); eval_arith({'abs', A}, Bs, Db) -> - abs(eval_arith(erlog_core:deref(A, Bs), Bs, Db)); + abs(eval_arith(ec_support:deref(A, Bs), Bs, Db)); eval_arith({'float', A}, Bs, Db) -> - float(eval_arith(erlog_core:deref(A, Bs), Bs, Db)); + float(eval_arith(ec_support:deref(A, Bs), Bs, Db)); eval_arith({'truncate', A}, Bs, Db) -> - trunc(eval_arith(erlog_core:deref(A, Bs), Bs, Db)); + trunc(eval_arith(ec_support:deref(A, Bs), Bs, Db)); eval_arith(N, _Bs, _Db) when is_number(N) -> N; %Just a number %% Error cases. eval_arith({_}, _Bs, Db) -> erlog_errors:instantiation_error(Db); diff --git a/src/libs/erlog_dcg.erl b/src/libs/erlog_dcg.erl index 72522c2..f2b311a 100644 --- a/src/libs/erlog_dcg.erl +++ b/src/libs/erlog_dcg.erl @@ -45,9 +45,9 @@ load(Db) -> %% void %% Call the expand_term/2 predicate. expand_term_2(Param = #param{goal = Goal, bindings = Bs, var_num = Vn0}) -> - {expand_term, DCGRule, A2} = erlog_core:dderef(Goal, Bs), + {expand_term, DCGRule, A2} = ec_support:dderef(Goal, Bs), {Exp, Vn1} = expand_term(DCGRule, Vn0), - erlog_core:unify_prove_body(A2, Exp, Param#param{var_num = Vn1}). + ec_body:unify_prove_body(A2, Exp, Param#param{var_num = Vn1}). %% phrase_3(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> void. %% Call the phrase/3 preidicate. We could easily do this in prolog @@ -55,11 +55,11 @@ expand_term_2(Param = #param{goal = Goal, bindings = Bs, var_num = Vn0}) -> %% %% phrase(GRBody, S0, S) -> dcg_body(GRBody, S0, S, Goal), call(Goal). phrase_3(Param = #param{goal = Goal, next_goal = Next0, bindings = Bs, var_num = Vn0}) -> - {phrase, GRBody, S0, S} = erlog_core:dderef(Goal, Bs), + {phrase, GRBody, S0, S} = ec_support:dderef(Goal, Bs), {Body, Vn1} = dcg_body(GRBody, S0, S, Vn0), %% io:format("~p\n", [Body]), Next1 = [{call, Body} | Next0], %Evaluate body - erlog_core:prove_body(Param#param{goal = Next1, var_num = Vn1}). + ec_body:prove_body(Param#param{goal = Next1, var_num = Vn1}). %% expand_term(Term) -> {ExpTerm}. %% expand_term(Term, VarNum) -> {ExpTerm,NewVarNum}. diff --git a/src/libs/erlog_lists.erl b/src/libs/erlog_lists.erl index 8cb0b4f..1205f3d 100644 --- a/src/libs/erlog_lists.erl +++ b/src/libs/erlog_lists.erl @@ -54,20 +54,20 @@ load(Db) -> %% Here we attempt to compile indexing in the first argument. append_3({append, A1, L, A3}, Params = #param{next_goal = Next0, bindings = Bs0, choice = Cps, var_num = Vn, f_consulter = Fcon}) -> - case erlog_core:deref(A1, Bs0) of + case ec_support:deref(A1, Bs0) of [] -> %Cannot backtrack - erlog_core:unify_prove_body(L, A3, Params); + ec_body:unify_prove_body(L, A3, Params); [H | T] -> %Cannot backtrack L1 = {Vn}, Next1 = [{append, T, L, L1} | Next0], - erlog_core:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, var_num = Vn + 1}); + ec_body:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, var_num = Vn + 1}); {_} = Var -> %This can backtrack FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed fail_append_3(LCp, Params#param{choice = LCps, database = LDb, f_consulter = Fcon}, Var, L, A3) end, Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, - Bs1 = erlog_core:add_binding(Var, [], Bs0), - erlog_core:unify_prove_body(L, A3, Params#param{choice = [Cp | Cps], bindings = Bs1}); + Bs1 = ec_support:add_binding(Var, [], Bs0), + ec_body:unify_prove_body(L, A3, Params#param{choice = [Cp | Cps], bindings = Bs1}); _ -> erlog_errors:fail(Params) %Will fail here! end. @@ -75,9 +75,9 @@ fail_append_3(#cp{next = Next0, bs = Bs0, vn = Vn}, Params, A1, L, A3) -> H = {Vn}, T = {Vn + 1}, L1 = {Vn + 2}, - Bs1 = erlog_core:add_binding(A1, [H | T], Bs0), %A1 always a variable here. + Bs1 = ec_support:add_binding(A1, [H | T], Bs0), %A1 always a variable here. Next1 = [{append, T, L, L1} | Next0], - erlog_core:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs1, + ec_body:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs1, var_num = Vn + 3}). %% insert_3(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. @@ -88,14 +88,14 @@ insert_3({insert, A1, A2, A3}, Params = #param{next_goal = Next, bindings = Bs, fail_insert_3(LCp, Params#param{choice = LCps, database = LDb, f_consulter = Fcon}, A1, A2, A3) end, Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, - erlog_core:unify_prove_body(A3, [A2 | A1], Params#param{choice = [Cp | Cps]}). + ec_body:unify_prove_body(A3, [A2 | A1], Params#param{choice = [Cp | Cps]}). fail_insert_3(#cp{next = Next0, bs = Bs, vn = Vn}, Params, A1, X, A3) -> H = {Vn}, L = {Vn + 1}, L1 = {Vn + 2}, Next1 = [{insert, L, X, L1} | Next0], - erlog_core:unify_prove_body(A1, [H | L], A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 3}). + ec_body:unify_prove_body(A1, [H | L], A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 3}). %% member_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% member(X, [X|_]). @@ -106,13 +106,13 @@ member_2({member, A1, A2}, Param = #param{next_goal = Next, bindings = Bs, choic end, Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, T = {Vn}, - erlog_core:unify_prove_body(A2, [A1 | T], Param#param{choice = [Cp | Cps], var_num = Vn + 1}). + ec_body:unify_prove_body(A2, [A1 | T], Param#param{choice = [Cp | Cps], var_num = Vn + 1}). fail_member_2(#cp{next = Next0, bs = Bs, vn = Vn}, Params, A1, A2) -> H = {Vn}, T = {Vn + 1}, Next1 = [{member, A1, T} | Next0], - erlog_core:unify_prove_body(A2, [H | T], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 2}). + ec_body:unify_prove_body(A2, [H | T], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 2}). %% memberchk_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% memberchk(X, [X|_]) :- !. @@ -120,11 +120,11 @@ fail_member_2(#cp{next = Next0, bs = Bs, vn = Vn}, Params, A1, A2) -> %% We don't build the list and we never backtrack so we can be smart %% and match directly. Should we give a type error? memberchk_2({memberchk, A1, A2}, Params = #param{next_goal = Next, bindings = Bs0}) -> - case erlog_core:deref(A2, Bs0) of + case ec_support:deref(A2, Bs0) of [H | T] -> - case erlog_core:unify(A1, H, Bs0) of + case ec_unify:unify(A1, H, Bs0) of {succeed, Bs1} -> - erlog_core:prove_body(Params#param{goal = Next, bindings = Bs1}); + ec_body:prove_body(Params#param{goal = Next, bindings = Bs1}); fail -> memberchk_2({memberchk, A1, T}, Params) end; @@ -137,9 +137,9 @@ memberchk_2({memberchk, A1, A2}, Params = #param{next_goal = Next, bindings = Bs %% reverse([H|L1], L) :- reverse(L1, L2), append(L2, [H], L). %% Here we attempt to compile indexing in the first argument. reverse_2({reverse, A1, A2}, Params = #param{next_goal = Next0, bindings = Bs0, choice = Cps, var_num = Vn}) -> - case erlog_core:deref(A1, Bs0) of + case ec_support:deref(A1, Bs0) of [] -> - erlog_core:unify_prove_body(A2, [], Params); + ec_body:unify_prove_body(A2, [], Params); [H | T] -> L = {Vn}, L1 = A2, @@ -154,8 +154,8 @@ reverse_2({reverse, A1, A2}, Params = #param{next_goal = Next0, bindings = Bs0, fail_reverse_2(LCp, Params#param{choice = LCps, database = LDb}, Var, A2) end, Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, - Bs1 = erlog_core:add_binding(Var, [], Bs0), - erlog_core:unify_prove_body(A2, [], Params#param{choice = [Cp | Cps], bindings = Bs1}); + Bs1 = ec_support:add_binding(Var, [], Bs0), + ec_body:unify_prove_body(A2, [], Params#param{choice = [Cp | Cps], bindings = Bs1}); _ -> erlog_errors:fail(Params) %Will fail here! end. @@ -164,7 +164,7 @@ fail_reverse_2(#cp{next = Next, bs = Bs0, vn = Vn}, Params, A1, A2) -> T = {Vn + 1}, L1 = A2, L = {Vn + 2}, - Bs1 = erlog_core:add_binding(A1, [H | T], Bs0), + Bs1 = ec_support:add_binding(A1, [H | T], Bs0), %%Next1 = [{reverse,T,L},{apperse,L,[H],L1}|Next], %%prove_body(Next1, Cps, Bs1, Vn+3, Db). Next1 = [{append, L, [H], L1} | Next], @@ -174,5 +174,5 @@ fail_reverse_2(#cp{next = Next, bs = Bs0, vn = Vn}, Params, A1, A2) -> %% sort(List, SortedList). sort_2({sort, L0, S}, Param = #param{bindings = Bs}) -> %% This may throw an erlog error, we don't catch it here. - L1 = lists:usort(erlog_core:dderef_list(L0, Bs)), - erlog_core:unify_prove_body(S, L1, Param). \ No newline at end of file + L1 = lists:usort(ec_support:dderef_list(L0, Bs)), + ec_body:unify_prove_body(S, L1, Param). \ No newline at end of file diff --git a/src/libs/erlog_time.erl b/src/libs/erlog_time.erl index d7e35ea..f309c5e 100644 --- a/src/libs/erlog_time.erl +++ b/src/libs/erlog_time.erl @@ -19,13 +19,13 @@ load(Db) -> localtime_1({localtime, Var}, Params = #param{next_goal = Next, bindings = Bs0}) -> {M, S, _} = os:timestamp(), - Bs = erlog_core:add_binding(Var, {M, S}, Bs0), - erlog_core:prove_body(Params#param{goal = Next, bindings = Bs}). + Bs = ec_support:add_binding(Var, {M, S}, Bs0), + ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). datediff_4({datediff, {M1, S1}, {M2, S2}, Format, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> Diff = timer:now_diff({M1, S1, 0}, {M2, S2, 0}), - Bs = erlog_core:add_binding(Res, form_output(Diff, Format), Bs0), - erlog_core:prove_body(Params#param{goal = Next, bindings = Bs}). + Bs = ec_support:add_binding(Res, form_output(Diff, Format), Bs0), + ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% @private %% Time in microseconds, atom for output format diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 5e78a97..d038697 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -37,7 +37,7 @@ add_built_in(Db, Functor) -> add_compiled_proc(Db, {Functor, M, F}) -> {ok, dict:update(Functor, fun(built_in) -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); (_) -> {code, {M, F}} end, {code, {M, F}}, Db)}. @@ -56,9 +56,9 @@ asserta_clause(Db, {Head, Body0}) -> retract_clause(Db, {Functor, Ct}) -> {ok, case dict:find(Functor, Db) of {ok, built_in} -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); {ok, {code, _}} -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); {ok, {clauses, Nt, Cs}} -> dict:store(Functor, {clauses, Nt, lists:keydelete(Ct, 1, Cs)}, Db); error -> Db %Do nothing @@ -67,7 +67,7 @@ retract_clause(Db, {Functor, Ct}) -> abolish_clauses(Db, Functor) -> {ok, case dict:find(Functor, Db) of {ok, built_in} -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); {ok, {code, _}} -> dict:erase(Functor, Db); {ok, {clauses, _, _}} -> dict:erase(Functor, Db); error -> Db %Do nothing @@ -96,15 +96,15 @@ get_interp_functors(Db) -> end, [], Db), Db}. clause(Head, Body0, Db, ClauseFun) -> - {Functor, Body} = case catch {ok, erlog_core:functor(Head), erlog_core:well_form_body(Body0, false, sture)} of + {Functor, Body} = case catch {ok, ec_support:functor(Head), ec_body:well_form_body(Body0, false, sture)} of {erlog_error, E} -> erlog_errors:erlog_error(E, Db); {ok, F, B} -> {F, B} end, dict:update(Functor, fun(built_in) -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); ({code, _}) -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); ({clauses, T, Cs}) -> ClauseFun(T, Body, Cs) end, {clauses, 1, [{0, Head, Body}]}, Db). diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 83470cb..ada6450 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -37,7 +37,7 @@ add_built_in(Db, Functor) -> add_compiled_proc(Db, {Functor, M, F}) -> case ets:lookup(Db, Functor) of [{_, built_in}] -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); [_] -> ets:insert(Db, {Functor, code, {M, F}}); [] -> ets:insert(Db, {Functor, code, {M, F}}) end, @@ -60,9 +60,9 @@ asserta_clause(Db, {Head, Body0}) -> retract_clause(Db, {Functor, Ct}) -> case ets:lookup(Db, Functor) of [{_, built_in}] -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); [{_, code, _}] -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); [{_, clauses, Nt, Cs}] -> ets:insert(Db, {Functor, clauses, Nt, lists:keydelete(Ct, 1, Cs)}); [] -> ok %Do nothing @@ -72,7 +72,7 @@ retract_clause(Db, {Functor, Ct}) -> abolish_clauses(Db, Functor) -> case ets:lookup(Db, Functor) of [{_, built_in}] -> - erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); [{_, code, _}] -> ets:delete(Db, Functor); [{_, clauses, _, _}] -> ets:delete(Db, Functor); [] -> ok %Do nothing @@ -111,13 +111,13 @@ get_interp_functors(Db) -> end, [], Db), Db}. clause(Head, Body0, Db, ClauseFun) -> - {Functor, Body} = case catch {ok, erlog_core:functor(Head), erlog_core:well_form_body(Body0, false, sture)} of + {Functor, Body} = case catch {ok, ec_support:functor(Head), ec_body:well_form_body(Body0, false, sture)} of {erlog_error, E} -> erlog_errors:erlog_error(E, Db); {ok, F, B} -> {F, B} end, case ets:lookup(Db, Functor) of - [{_, built_in}] -> erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); - [{_, code, _}] -> erlog_errors:permission_error(modify, static_procedure, erlog_core:pred_ind(Functor), Db); + [{_, built_in}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + [{_, code, _}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); [{_, clauses, Tag, Cs}] -> ClauseFun(Functor, Tag, Cs, Body); [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) end. From 128f0d6512e28722ff874464e39670122461d183 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 15 Jul 2014 17:12:23 +0000 Subject: [PATCH 050/251] partly fix test file --- test/prolog/t2m.pl | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/test/prolog/t2m.pl b/test/prolog/t2m.pl index 2ab4a52..3f3c7f8 100644 --- a/test/prolog/t2m.pl +++ b/test/prolog/t2m.pl @@ -4,9 +4,9 @@ %% https://drive.google.com/folderview?id=0B3uCF8tBzpM4bzBfaFBzNVFiRUk&usp=sharing %%%%%%%%%%%%%% -% +%�������� ����� -% +%����� plus(A,B,C):- nonvar(A), nonvar(B), C is A+B. @@ -26,7 +26,7 @@ filter_list([_|T],Tt,F) :- filter_list(T,Tt,F). -% +%������������ �������� fib(1,1). @@ -42,7 +42,7 @@ range(X,Y,Z):-X Date: Wed, 16 Jul 2014 17:42:50 +0000 Subject: [PATCH 051/251] add date_add predicate --- include/erlog_int.hrl | 3 ++- src/libs/erlog_time.erl | 35 ++++++++++++++++++++++++++++------- 2 files changed, 30 insertions(+), 8 deletions(-) diff --git a/include/erlog_int.hrl b/include/erlog_int.hrl index 6159fc0..15593a2 100644 --- a/include/erlog_int.hrl +++ b/include/erlog_int.hrl @@ -91,7 +91,8 @@ -define(ERLOG_TIME, [ {{localtime, 1}, ?MODULE, localtime_1}, - {{datediff, 4}, ?MODULE, datediff_4} + {{date_diff, 4}, ?MODULE, datediff_4}, + {{date_add, 4}, ?MODULE, dateadd_4} ]). -define(ERLOG_LISTS, diff --git a/src/libs/erlog_time.erl b/src/libs/erlog_time.erl index f309c5e..46ea1d9 100644 --- a/src/libs/erlog_time.erl +++ b/src/libs/erlog_time.erl @@ -12,7 +12,7 @@ -include("erlog_int.hrl"). %% API --export([load/1, localtime_1/2, datediff_4/2]). +-export([load/1, localtime_1/2, datediff_4/2, dateadd_4/2]). load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_TIME). @@ -24,13 +24,34 @@ localtime_1({localtime, Var}, Params = #param{next_goal = Next, bindings = Bs0}) datediff_4({datediff, {M1, S1}, {M2, S2}, Format, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> Diff = timer:now_diff({M1, S1, 0}, {M2, S2, 0}), - Bs = ec_support:add_binding(Res, form_output(Diff, Format), Bs0), + Bs = ec_support:add_binding(Res, microseconds_to_date(Diff, Format), Bs0), + ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). + +dateadd_4({dateadd, Time1, Type, T2, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> + Ts1 = date_to_ts(Time1), + Diff = Ts1 + date_to_seconds(T2, Type), + Bs = ec_support:add_binding(Res, Diff, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% @private %% Time in microseconds, atom for output format --spec form_output(Time :: integer(), atom()) -> integer(). -form_output(Time, day) -> Time / 86400000000; % day = 24 hours -form_output(Time, hour) -> Time / 3600000000; % hour = 60 min -form_output(Time, minute) -> Time / 60000000; % min = 60 sec -form_output(Time, sec) -> Time / 1000000. % micro = 10^-6 \ No newline at end of file +-spec microseconds_to_date(Time :: integer(), atom()) -> integer(). +microseconds_to_date(Time, day) -> Time / 86400000000; % day = 24 hours +microseconds_to_date(Time, hour) -> Time / 3600000000; % hour = 60 min +microseconds_to_date(Time, minute) -> Time / 60000000; % min = 60 sec +microseconds_to_date(Time, sec) -> Time / 1000000. % micro = 10^-6 + +%% @private +%% Converts day|hour|minute to seconds +-spec date_to_seconds(integer(), atom()) -> integer(). +date_to_seconds(Time, day) -> Time * 86400; +date_to_seconds(Time, hour) -> Time * 3600; +date_to_seconds(Time, minute) -> Time * 60; +date_to_seconds(Time, sec) -> Time. + +%% @private +%% Converts part of timestamp (MegaSecs, Secs) to integer seconds +-spec date_to_ts(tuple()) -> integer(). +date_to_ts({M1, S1}) -> + TimeStr = lists:concat([M1, S1]), + list_to_integer(TimeStr). From 47ae0abf47e101b7f65e440c922762dbb4fe51ae Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 16 Jul 2014 22:11:54 +0000 Subject: [PATCH 052/251] added parse, add and print in data library --- include/erlog_int.hrl | 4 +++- src/libs/erlog_time.erl | 24 ++++++++++++++++++++++-- test/prolog/t3.pl | 20 ++++++++++---------- 3 files changed, 35 insertions(+), 13 deletions(-) diff --git a/include/erlog_int.hrl b/include/erlog_int.hrl index 15593a2..3c380a9 100644 --- a/include/erlog_int.hrl +++ b/include/erlog_int.hrl @@ -92,7 +92,9 @@ [ {{localtime, 1}, ?MODULE, localtime_1}, {{date_diff, 4}, ?MODULE, datediff_4}, - {{date_add, 4}, ?MODULE, dateadd_4} + {{date_add, 4}, ?MODULE, dateadd_4}, + {{dateprint, 4}, ?MODULE, dateprint_2}, + {{dateparse, 4}, ?MODULE, dateparse_2} ]). -define(ERLOG_LISTS, diff --git a/src/libs/erlog_time.erl b/src/libs/erlog_time.erl index 46ea1d9..03ab7cb 100644 --- a/src/libs/erlog_time.erl +++ b/src/libs/erlog_time.erl @@ -12,25 +12,45 @@ -include("erlog_int.hrl"). %% API --export([load/1, localtime_1/2, datediff_4/2, dateadd_4/2]). +-export([load/1, localtime_1/2, datediff_4/2, dateadd_4/2, dateprint_2/2, dateparse_2/2]). load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_TIME). +%% Returns current time in date tuple. localtime_1({localtime, Var}, Params = #param{next_goal = Next, bindings = Bs0}) -> {M, S, _} = os:timestamp(), Bs = ec_support:add_binding(Var, {M, S}, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). +%% Calculates differense between two date tuples. Returns the result in specifyed format datediff_4({datediff, {M1, S1}, {M2, S2}, Format, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> Diff = timer:now_diff({M1, S1, 0}, {M2, S2, 0}), Bs = ec_support:add_binding(Res, microseconds_to_date(Diff, Format), Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). +%% Adds number of seconds T2 in Type format to Time1. Returns the result in Type format dateadd_4({dateadd, Time1, Type, T2, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> Ts1 = date_to_ts(Time1), Diff = Ts1 + date_to_seconds(T2, Type), - Bs = ec_support:add_binding(Res, Diff, Bs0), + Bs = ec_support:add_binding(Res, microseconds_to_date(Diff * 1000000, Type), Bs0), + ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). + +%% Converts date tuple to human readable format +dateprint_2({dateprint, {M, N}, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> + {{Year, Month, Day}, {Hour, Minute, Second}} = calendar:now_to_universal_time({M, N, 0}), + DateStr = lists:flatten(io_lib:format("~2w ~2..0w ~4w ~2w:~2..0w:~2..0w", [Day, Month, Year, Hour, Minute, Second])), + Bs = ec_support:add_binding(Res, DateStr, Bs0), + ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). + +%% Parses date string and returnsdata tuple. +dateparse_2({dateparse, DataStr, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> + [DStr, MStr, YStr, HStr, MnStr, SStr] = string:tokens(DataStr, " :"), + Data = {{list_to_integer(YStr), list_to_integer(MStr), list_to_integer(DStr)}, + {list_to_integer(HStr), list_to_integer(MnStr), list_to_integer(SStr)}}, + Seconds = calendar:datetime_to_gregorian_seconds(Data) - 62167219200, + Ts = {Seconds div 1000000, Seconds rem 1000000}, + Bs = ec_support:add_binding(Res, Ts, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% @private diff --git a/test/prolog/t3.pl b/test/prolog/t3.pl index 3a5be1f..47a4fc6 100644 --- a/test/prolog/t3.pl +++ b/test/prolog/t3.pl @@ -1,24 +1,24 @@ add_some_facts(Now):- add_some_facts(Now, 32, 10, [5, 15, 25, 30, 35, 40, 45, 50]). - + add_some_facts(LastTime, HoursFrom, MinutesDiap, SomeValues):- - date_diff(FirstDate, LastTime, hour, HoursFrom), + date_add(LastTime, hour, -HoursFrom, LastTime), generate_facts(FirstDate, LastTime, MinutesDiap, SomeValues, SomeValues). - + generate_facts(FirstDate, LastTime, MinutesDiap, [Val|L], SomeValues):- - date_diff( FirstDate, NextTime, minute, MinutesDiap), + date_add(FirstDate, minute, MinutesDiap, NextTime), NextTime =< LastTime, assert(some_fact("some name", Val, NextTime)), generate_facts(NextTime, LastTime, MinutesDiap, L, SomeValues). generate_facts(FirstDate, LastTime, MinutesDiap, [], SomeValues):- generate_facts(NextTime, LastTime, MinutesDiap, SomeValues, SomeValues). generate_facts(_, _, _, _, _). - + get_sum(Sum, Now):- Name = "some name", - findall(Val, (some_fact( Name, Val, Time), date_diff(Time, Now, hour, Acum), Acum =< 24), Vals), + findall(Val, (some_fact( Name, Val, Time), date_diff( Time, Now, hour, Acum), Acum =< 24), Vals), sum(Vals, Sum). - + sum( Vals, Sum):- sum( Vals, 0, Sum). sum( [Val|Vals], Ac, Sum):- @@ -26,7 +26,7 @@ !, sum(Vals, AcNext, Sum). sum([], Sum, Sum). - + get_sum1(Sum, Now):- Name = "some name", get_sum1(Sum, Now, Name), @@ -38,7 +38,7 @@ acum_val(Name, Acum), fail. get_sum1(_Sum, _Now, _Name). - + acum_val(Name, Acum):- retract(acum_fact(Name, PrevVal)), NextVal is PrevVal + Acum, @@ -46,7 +46,7 @@ !. acum_val(Name, Val):- assert(acum_fact(Name, Val)). - + test_all:- localtime(Now), add_some_facts(Now), From 061e028b9675c8351464a97867a5b9acc3ddc92a Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 17 Jul 2014 01:01:37 +0000 Subject: [PATCH 053/251] add some more data predicates --- include/erlog_int.hrl | 4 ++- src/libs/erlog_time.erl | 63 ++++++++++++++++++++++++++++++----------- 2 files changed, 50 insertions(+), 17 deletions(-) diff --git a/include/erlog_int.hrl b/include/erlog_int.hrl index 3c380a9..dc59acd 100644 --- a/include/erlog_int.hrl +++ b/include/erlog_int.hrl @@ -94,7 +94,9 @@ {{date_diff, 4}, ?MODULE, datediff_4}, {{date_add, 4}, ?MODULE, dateadd_4}, {{dateprint, 4}, ?MODULE, dateprint_2}, - {{dateparse, 4}, ?MODULE, dateparse_2} + {{dateparse, 4}, ?MODULE, dateparse_2}, + {{date, 2}, ?MODULE, date_2}, + {{date, 4}, ?MODULE, date_4} ]). -define(ERLOG_LISTS, diff --git a/src/libs/erlog_time.erl b/src/libs/erlog_time.erl index 03ab7cb..67ad8e8 100644 --- a/src/libs/erlog_time.erl +++ b/src/libs/erlog_time.erl @@ -12,20 +12,33 @@ -include("erlog_int.hrl"). %% API --export([load/1, localtime_1/2, datediff_4/2, dateadd_4/2, dateprint_2/2, dateparse_2/2]). +-export([load/1, localtime_1/2, datediff_4/2, dateadd_4/2, dateprint_2/2, dateparse_2/2, date_2/2, date_4/2]). load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_TIME). -%% Returns current time in date tuple. +%% Returns current timestamp. localtime_1({localtime, Var}, Params = #param{next_goal = Next, bindings = Bs0}) -> {M, S, _} = os:timestamp(), - Bs = ec_support:add_binding(Var, {M, S}, Bs0), + Bs = ec_support:add_binding(Var, date_to_ts({M, S}), Bs0), + ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). + +%% Returns timestamp for data, ignoring time +date_2({date, DateString, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> + {{Y, M, D}, _} = date_string_to_data(DateString), + DataTS = data_to_ts({{Y, M, D}, {0, 0, 0}}), + Bs = ec_support:add_binding(Res, DataTS, Bs0), + ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). + +%% Returns timestamp for data, ignoring time +date_4({date, D, M, Y, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> + DataTS = data_to_ts({{Y, M, D}, {0, 0, 0}}), + Bs = ec_support:add_binding(Res, DataTS, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% Calculates differense between two date tuples. Returns the result in specifyed format -datediff_4({datediff, {M1, S1}, {M2, S2}, Format, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - Diff = timer:now_diff({M1, S1, 0}, {M2, S2, 0}), +datediff_4({datediff, TS1, TS2, Format, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> + Diff = timer:now_diff(ts_to_date(TS1), ts_to_date(TS2)), Bs = ec_support:add_binding(Res, microseconds_to_date(Diff, Format), Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). @@ -36,21 +49,17 @@ dateadd_4({dateadd, Time1, Type, T2, Res}, Params = #param{next_goal = Next, bin Bs = ec_support:add_binding(Res, microseconds_to_date(Diff * 1000000, Type), Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). -%% Converts date tuple to human readable format -dateprint_2({dateprint, {M, N}, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - {{Year, Month, Day}, {Hour, Minute, Second}} = calendar:now_to_universal_time({M, N, 0}), +%% Converts timestamp to human readable format +dateprint_2({dateprint, TS1, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> + {{Year, Month, Day}, {Hour, Minute, Second}} = calendar:now_to_universal_time(ts_to_date(TS1)), DateStr = lists:flatten(io_lib:format("~2w ~2..0w ~4w ~2w:~2..0w:~2..0w", [Day, Month, Year, Hour, Minute, Second])), Bs = ec_support:add_binding(Res, DateStr, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). -%% Parses date string and returnsdata tuple. +%% Parses date string and returns timestamp. dateparse_2({dateparse, DataStr, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - [DStr, MStr, YStr, HStr, MnStr, SStr] = string:tokens(DataStr, " :"), - Data = {{list_to_integer(YStr), list_to_integer(MStr), list_to_integer(DStr)}, - {list_to_integer(HStr), list_to_integer(MnStr), list_to_integer(SStr)}}, - Seconds = calendar:datetime_to_gregorian_seconds(Data) - 62167219200, - Ts = {Seconds div 1000000, Seconds rem 1000000}, - Bs = ec_support:add_binding(Res, Ts, Bs0), + Data = date_string_to_data(DataStr), + Bs = ec_support:add_binding(Res, data_to_ts(Data), Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% @private @@ -70,8 +79,30 @@ date_to_seconds(Time, minute) -> Time * 60; date_to_seconds(Time, sec) -> Time. %% @private -%% Converts part of timestamp (MegaSecs, Secs) to integer seconds +%% Converts string date representation to timestamp. Format DD MM YYYY HH:MM:SS +-spec date_string_to_data(string()) -> tuple(). +date_string_to_data(DataStr) -> + [DStr, MStr, YStr, HStr, MnStr, SStr] = string:tokens(DataStr, " :"), + {{list_to_integer(YStr), list_to_integer(MStr), list_to_integer(DStr)}, + {list_to_integer(HStr), list_to_integer(MnStr), list_to_integer(SStr)}}. + +%% @private +%% Converts data tuple to timestamp +-spec data_to_ts(tuple()) -> integer(). +data_to_ts(Data) -> + calendar:datetime_to_gregorian_seconds(Data) - 62167219200. + +%% @private +%% Converts data tuple (part of timestamp: MegaSecs, Secs) to integer seconds -spec date_to_ts(tuple()) -> integer(). date_to_ts({M1, S1}) -> TimeStr = lists:concat([M1, S1]), list_to_integer(TimeStr). + +%% @private +%% Converts timestamp to data tuple +-spec ts_to_date(integer()) -> tuple(). +ts_to_date(Timestamp) -> + TSStr = integer_to_list(Timestamp), + {M1, S1} = lists:split(4, TSStr), + {list_to_integer(M1), list_to_integer(S1), 0}. \ No newline at end of file From 96ad003bf5d2aa0ea19d269970d8d017185b7767 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 17 Jul 2014 20:31:13 +0000 Subject: [PATCH 054/251] partly added db module --- include/erlog_bips.hrl | 47 +++++++++++++++ include/{erlog_int.hrl => erlog_core.hrl} | 65 --------------------- include/erlog_db.hrl | 20 +++++++ include/erlog_dcg.hrl | 15 +++++ include/erlog_lists.hrl | 19 ++++++ include/erlog_time.hrl | 22 +++++++ src/core/erlog.erl | 5 +- src/core/erlog_errors.erl | 2 +- src/core/erlog_logic.erl | 2 +- src/core/logic/ec_body.erl | 2 +- src/core/logic/ec_goals.erl | 9 +-- src/core/logic/ec_support.erl | 7 ++- src/core/logic/ec_unify.erl | 2 +- src/core/logic/erlog_core.erl | 7 ++- src/libs/erlog_bips.erl | 3 +- src/libs/erlog_db.erl | 71 +++++++++++++++++++++++ src/libs/erlog_dcg.erl | 3 +- src/libs/erlog_lists.erl | 3 +- src/libs/erlog_time.erl | 33 +++++++++-- src/storage/erlog_ets.erl | 2 - src/storage/erlog_memory.erl | 17 +++++- 21 files changed, 263 insertions(+), 93 deletions(-) create mode 100644 include/erlog_bips.hrl rename include/{erlog_int.hrl => erlog_core.hrl} (61%) create mode 100644 include/erlog_db.hrl create mode 100644 include/erlog_dcg.hrl create mode 100644 include/erlog_lists.hrl create mode 100644 include/erlog_time.hrl create mode 100644 src/libs/erlog_db.erl diff --git a/include/erlog_bips.hrl b/include/erlog_bips.hrl new file mode 100644 index 0000000..bdda41e --- /dev/null +++ b/include/erlog_bips.hrl @@ -0,0 +1,47 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 17. Июль 2014 11:20 +%%%------------------------------------------------------------------- +-author("tihon"). + +-define(ERLOG_BIPS, + [ + %% Term unification and comparison + {'=', 2}, + {'\\=', 2}, + {'@>', 2}, + {'@>=', 2}, + {'==', 2}, + {'\\==', 2}, + {'@<', 2}, + {'@=<', 2}, + %% Term creation and decomposition. + {arg, 3}, + {copy_term, 2}, + {functor, 3}, + {'=..', 2}, + %% Type testing. + {atom, 1}, + {atomic, 1}, + {compound, 1}, + {integer, 1}, + {float, 1}, + {number, 1}, + {nonvar, 1}, + {var, 1}, + %% Atom processing. + {atom_chars, 2}, + {atom_length, 2}, + %% Arithmetic evaluation and comparison + {'is', 2}, + {'>', 2}, + {'>=', 2}, + {'=:=', 2}, + {'=\\=', 2}, + {'<', 2}, + {'=<', 2} + ]). \ No newline at end of file diff --git a/include/erlog_int.hrl b/include/erlog_core.hrl similarity index 61% rename from include/erlog_int.hrl rename to include/erlog_core.hrl index dc59acd..c803d13 100644 --- a/include/erlog_int.hrl +++ b/include/erlog_core.hrl @@ -44,71 +44,6 @@ f_consulter }). --define(ERLOG_BIPS, - [ - %% Term unification and comparison - {'=', 2}, - {'\\=', 2}, - {'@>', 2}, - {'@>=', 2}, - {'==', 2}, - {'\\==', 2}, - {'@<', 2}, - {'@=<', 2}, - %% Term creation and decomposition. - {arg, 3}, - {copy_term, 2}, - {functor, 3}, - {'=..', 2}, - %% Type testing. - {atom, 1}, - {atomic, 1}, - {compound, 1}, - {integer, 1}, - {float, 1}, - {number, 1}, - {nonvar, 1}, - {var, 1}, - %% Atom processing. - {atom_chars, 2}, - {atom_length, 2}, - %% Arithmetic evaluation and comparison - {'is', 2}, - {'>', 2}, - {'>=', 2}, - {'=:=', 2}, - {'=\\=', 2}, - {'<', 2}, - {'=<', 2} - ]). - --define(ERLOG_DCG, - [ - {{expand_term, 2}, erlog_dcg, expand_term_2}, - {{phrase, 3}, erlog_dcg, phrase_3} - ]). - --define(ERLOG_TIME, - [ - {{localtime, 1}, ?MODULE, localtime_1}, - {{date_diff, 4}, ?MODULE, datediff_4}, - {{date_add, 4}, ?MODULE, dateadd_4}, - {{dateprint, 4}, ?MODULE, dateprint_2}, - {{dateparse, 4}, ?MODULE, dateparse_2}, - {{date, 2}, ?MODULE, date_2}, - {{date, 4}, ?MODULE, date_4} - ]). - --define(ERLOG_LISTS, - [ - {{append, 3}, ?MODULE, append_3}, - {{insert, 3}, ?MODULE, insert_3}, - {{member, 2}, ?MODULE, member_2}, - {{memberchk, 2}, ?MODULE, memberchk_2}, - {{reverse, 2}, ?MODULE, reverse_2}, - {{sort, 2}, ?MODULE, sort_2} - ]). - -define(ERLOG_CORE, [ %% Logic and control. diff --git a/include/erlog_db.hrl b/include/erlog_db.hrl new file mode 100644 index 0000000..fbbac28 --- /dev/null +++ b/include/erlog_db.hrl @@ -0,0 +1,20 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 17. Июль 2014 11:19 +%%%------------------------------------------------------------------- +-author("tihon"). + +-define(ERLOG_DB, + [ + {abolish, 1}, + {assert, 1}, + {asserta, 1}, + {assertz, 1}, + {retract, 1}, + {retractall, 1} + ] +). \ No newline at end of file diff --git a/include/erlog_dcg.hrl b/include/erlog_dcg.hrl new file mode 100644 index 0000000..5234481 --- /dev/null +++ b/include/erlog_dcg.hrl @@ -0,0 +1,15 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 17. Июль 2014 11:20 +%%%------------------------------------------------------------------- +-author("tihon"). + +-define(ERLOG_DCG, + [ + {{expand_term, 2}, erlog_dcg, expand_term_2}, + {{phrase, 3}, erlog_dcg, phrase_3} + ]). \ No newline at end of file diff --git a/include/erlog_lists.hrl b/include/erlog_lists.hrl new file mode 100644 index 0000000..0e6e9ab --- /dev/null +++ b/include/erlog_lists.hrl @@ -0,0 +1,19 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 17. Июль 2014 11:19 +%%%------------------------------------------------------------------- +-author("tihon"). + +-define(ERLOG_LISTS, + [ + {{append, 3}, ?MODULE, append_3}, + {{insert, 3}, ?MODULE, insert_3}, + {{member, 2}, ?MODULE, member_2}, + {{memberchk, 2}, ?MODULE, memberchk_2}, + {{reverse, 2}, ?MODULE, reverse_2}, + {{sort, 2}, ?MODULE, sort_2} + ]). \ No newline at end of file diff --git a/include/erlog_time.hrl b/include/erlog_time.hrl new file mode 100644 index 0000000..8b468a1 --- /dev/null +++ b/include/erlog_time.hrl @@ -0,0 +1,22 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 17. Июль 2014 11:19 +%%%------------------------------------------------------------------- +-author("tihon"). + +-define(ERLOG_TIME, + [ + {{localtime, 1}, ?MODULE, localtime_1}, + {{date_diff, 4}, ?MODULE, datediff_4}, + {{date_add, 4}, ?MODULE, dateadd_4}, + {{dateprint, 4}, ?MODULE, dateprint_2}, + {{dateparse, 4}, ?MODULE, dateparse_2}, + {{date, 2}, ?MODULE, date_2}, + {{date, 4}, ?MODULE, date_4}, + {{time, 2}, ?MODULE, time_2}, + {{time, 4}, ?MODULE, time_4} + ]). \ No newline at end of file diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 70e55eb..c9e84d8 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -30,7 +30,7 @@ -behaviour(gen_server). -vsn('0.7'). --include("erlog_int.hrl"). +-include("erlog_core.hrl"). %% Interface to server. -export([start_link/1, start_link/0, execute/2, select/2]). @@ -138,7 +138,8 @@ load_built_in(Database) -> erlog_bips, %Built in predicates erlog_dcg, %DCG predicates erlog_lists, %Common lists library - erlog_time %Bindings for working with data and time + erlog_time %Bindings for working with data and time +%% erlog_db %Database support %TODO in some cases it is unneeded. Think about loading it dynamically ]). %% @private diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index c32bec0..9af0fa9 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -9,7 +9,7 @@ -module(erlog_errors). -author("tihon"). --include("erlog_int.hrl"). +-include("erlog_core.hrl"). %% API -export([type_error/3, instantiation_error/1, permission_error/4, diff --git a/src/core/erlog_logic.erl b/src/core/erlog_logic.erl index fef7268..3a8c2aa 100644 --- a/src/core/erlog_logic.erl +++ b/src/core/erlog_logic.erl @@ -18,7 +18,7 @@ -module(erlog_logic). --include("erlog_int.hrl"). +-include("erlog_core.hrl"). -export([vars_in/1, is_legal_term/1, reconsult_files/3, select_bindings/2, shell_prove_result/1, prove_result/2, unlistify/1]). diff --git a/src/core/logic/ec_body.erl b/src/core/logic/ec_body.erl index 7397693..d47c561 100644 --- a/src/core/logic/ec_body.erl +++ b/src/core/logic/ec_body.erl @@ -9,7 +9,7 @@ -module(ec_body). -author("tihon"). --include("erlog_int.hrl"). +-include("erlog_core.hrl"). %% API -export([body_instance/5, prove_body/1, unify_prove_body/3, unify_prove_body/5, body_term/3]). diff --git a/src/core/logic/ec_goals.erl b/src/core/logic/ec_goals.erl index fc6b474..e011f61 100644 --- a/src/core/logic/ec_goals.erl +++ b/src/core/logic/ec_goals.erl @@ -9,7 +9,7 @@ -module(ec_goals). -author("tihon"). --include("erlog_int.hrl"). +-include("erlog_core.hrl"). %% API -export([prove_goal/1, initial_goal/1]). @@ -83,7 +83,8 @@ prove_goal(Param = #param{goal = {abolish, Pi0}, next_goal = Next, bindings = Bs ec_body:prove_body(Param#param{goal = Next}); Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) end; -prove_goal(Param = #param{goal = {assert, C0}, next_goal = Next, bindings = Bs, database = Db}) -> +prove_goal(Param = #param{goal = {Assert, C0}, next_goal = Next, bindings = Bs, database = Db}) + when Assert == assert; Assert == assertz -> C = ec_support:dderef(C0, Bs), erlog_memory:assertz_clause(Db, C), ec_body:prove_body(Param#param{goal = Next}); @@ -91,10 +92,6 @@ prove_goal(Param = #param{goal = {asserta, C0}, next_goal = Next, bindings = Bs, C = ec_support:dderef(C0, Bs), erlog_memory:asserta_clause(Db, C), ec_body:prove_body(Param#param{goal = Next}); -prove_goal(Param = #param{goal = {assertz, C0}, next_goal = Next, bindings = Bs, database = Db}) -> - C = ec_support:dderef(C0, Bs), - erlog_memory:assertz_clause(Db, C), - ec_body:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {retract, C0}, bindings = Bs}) -> C = ec_support:dderef(C0, Bs), erlog_core:prove_retract(C, Param); diff --git a/src/core/logic/ec_support.erl b/src/core/logic/ec_support.erl index 47d86a2..14fea62 100644 --- a/src/core/logic/ec_support.erl +++ b/src/core/logic/ec_support.erl @@ -9,10 +9,13 @@ -module(ec_support). -author("tihon"). --include("erlog_int.hrl"). +-include("erlog_core.hrl"). %% API --export([new_bindings/0, get_binding/2, add_binding/3, functor/1, cut/3, collect_alternatives/3, update_result/4, update_vars/4, deref/2, dderef_list/2, make_vars/2, pred_ind/1, deref_list/2]). +-export([new_bindings/0, get_binding/2, add_binding/3, + functor/1, cut/3, collect_alternatives/3, + update_result/4, update_vars/4, deref/2, dderef_list/2, + make_vars/2, pred_ind/1, deref_list/2]). %% deref(Term, Bindings) -> Term. %% Dereference a variable, else just return the term. diff --git a/src/core/logic/ec_unify.erl b/src/core/logic/ec_unify.erl index 7c9ae2c..c61721c 100644 --- a/src/core/logic/ec_unify.erl +++ b/src/core/logic/ec_unify.erl @@ -9,7 +9,7 @@ -module(ec_unify). -author("tihon"). --include("erlog_int.hrl"). +-include("erlog_core.hrl"). %% API -export([unify/3, unify_clauses/4, unify_head/4]). diff --git a/src/core/logic/erlog_core.erl b/src/core/logic/erlog_core.erl index 35d38d7..558ee2c 100644 --- a/src/core/logic/erlog_core.erl +++ b/src/core/logic/erlog_core.erl @@ -14,7 +14,12 @@ -module(erlog_core). --include("erlog_int.hrl"). +-include("erlog_core.hrl"). +-include("erlog_bips.hrl"). +-include("erlog_db.hrl"). +-include("erlog_dcg.hrl"). +-include("erlog_lists.hrl"). +-include("erlog_time.hrl"). %% Main execution functions. -export([ diff --git a/src/libs/erlog_bips.erl b/src/libs/erlog_bips.erl index e1677ef..b4bf933 100644 --- a/src/libs/erlog_bips.erl +++ b/src/libs/erlog_bips.erl @@ -21,7 +21,8 @@ -module(erlog_bips). --include("erlog_int.hrl"). +-include("erlog_core.hrl"). +-include("erlog_bips.hrl"). %% Main interface functions. -export([load/1]). diff --git a/src/libs/erlog_db.erl b/src/libs/erlog_db.erl new file mode 100644 index 0000000..1f2b091 --- /dev/null +++ b/src/libs/erlog_db.erl @@ -0,0 +1,71 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 17. Июль 2014 11:18 +%%%------------------------------------------------------------------- +-module(erlog_db). +-author("tihon"). + +-include("erlog_core.hrl"). +-include("erlog_db.hrl"). + +%% API +-export([load/1, db_assert_2/2, db_asserta_2/2, db_abolish_2/2, db_retract_2/2]). + +load(Db) -> + lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_DB). + +db_assert_2({db_assert, Table, Fact}, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> + C = ec_support:dderef(Fact, Bs), + erlog_memory:db_assertz_clause(Db, Table, C), + ec_body:prove_body(Params#param{goal = Next}). + +db_asserta_2({db_asserta, Table, Fact}, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> + C = ec_support:dderef(Fact, Bs), + erlog_memory:db_asserta_clause(Db, Table, C), + ec_body:prove_body(Params#param{goal = Next}). + +db_abolish_2({db_abolish, Table, Fact}, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> + case ec_support:dderef(Fact, Bs) of + {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> + erlog_memory:db_abolish_clauses(Db, Table, {N, A}), + ec_body:prove_body(Params#param{goal = Next}); + Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) + end. + +db_retract_2({db_retract, Table, Fact}, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> + C = ec_support:dderef(Fact, Bs), + prove_retract(C, Table, Params). + +prove_retract({':-', H, B}, Table, Params) -> + prove_retract(H, B, Table, Params); +prove_retract(H, Table, Params) -> + prove_retract(H, true, Table, Params). + +prove_retract(H, B, Table, Params = #param{database = Db}) -> + Functor = ec_support:functor(H), + case erlog_memory:get_procedure(Db, Functor) of + {clauses, Cs} -> retract_clauses(H, B, Cs, Params); + {code, _} -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + built_in -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + undefined -> erlog_errors:fail(Params) + end. + +%% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Try to retract Head and Body using Clauses which all have the same functor. +retract_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}) -> %TODO foreach vs handmade recursion? + case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of + {succeed, Bs1, Vn1} -> + %% We have found a right clause so now retract it. + erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), + Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, + ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); + fail -> retract_clauses(Ch, Cb, Cs, Param) + end; +retract_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param). \ No newline at end of file diff --git a/src/libs/erlog_dcg.erl b/src/libs/erlog_dcg.erl index f2b311a..e6083c1 100644 --- a/src/libs/erlog_dcg.erl +++ b/src/libs/erlog_dcg.erl @@ -18,7 +18,8 @@ -module(erlog_dcg). --include("erlog_int.hrl"). +-include("erlog_core.hrl"). +-include("erlog_dcg.hrl"). -export([expand_term/1, expand_term/2]). -export([expand_term_2/1, phrase_3/1]). diff --git a/src/libs/erlog_lists.erl b/src/libs/erlog_lists.erl index 1205f3d..e1e04ce 100644 --- a/src/libs/erlog_lists.erl +++ b/src/libs/erlog_lists.erl @@ -23,7 +23,8 @@ -module(erlog_lists). --include("erlog_int.hrl"). +-include("erlog_core.hrl"). +-include("erlog_lists.hrl"). %% Main interface functions. -export([load/1]). diff --git a/src/libs/erlog_time.erl b/src/libs/erlog_time.erl index 67ad8e8..9ccbecc 100644 --- a/src/libs/erlog_time.erl +++ b/src/libs/erlog_time.erl @@ -9,10 +9,13 @@ -module(erlog_time). -author("tihon"). --include("erlog_int.hrl"). +-include("erlog_core.hrl"). +-include("erlog_time.hrl"). %% API --export([load/1, localtime_1/2, datediff_4/2, dateadd_4/2, dateprint_2/2, dateparse_2/2, date_2/2, date_4/2]). +-export([load/1, localtime_1/2]). +-export([date_2/2, date_4/2, time_2/2, time_4/2]). +-export([datediff_4/2, dateadd_4/2, dateprint_2/2, dateparse_2/2]). load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_TIME). @@ -36,6 +39,19 @@ date_4({date, D, M, Y, Res}, Params = #param{next_goal = Next, bindings = Bs0}) Bs = ec_support:add_binding(Res, DataTS, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). +%% Returns timestamp for data, ignoring data. +time_2({time, TimeString, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> + {_, {H, M, S}} = date_string_to_data(TimeString), %cut YMD + TS = S * date_to_seconds(M, minute) * date_to_seconds(H, hour), + Bs = ec_support:add_binding(Res, TS, Bs0), + ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). + +%% Returns timestamp for data, ignoring data. +time_4({time, H, M, S, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> + TS = S * date_to_seconds(M, minute) * date_to_seconds(H, hour), + Bs = ec_support:add_binding(Res, TS, Bs0), + ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). + %% Calculates differense between two date tuples. Returns the result in specifyed format datediff_4({datediff, TS1, TS2, Format, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> Diff = timer:now_diff(ts_to_date(TS1), ts_to_date(TS2)), @@ -44,14 +60,13 @@ datediff_4({datediff, TS1, TS2, Format, Res}, Params = #param{next_goal = Next, %% Adds number of seconds T2 in Type format to Time1. Returns the result in Type format dateadd_4({dateadd, Time1, Type, T2, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - Ts1 = date_to_ts(Time1), - Diff = Ts1 + date_to_seconds(T2, Type), + Diff = Time1 + date_to_seconds(T2, Type), Bs = ec_support:add_binding(Res, microseconds_to_date(Diff * 1000000, Type), Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% Converts timestamp to human readable format dateprint_2({dateprint, TS1, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - {{Year, Month, Day}, {Hour, Minute, Second}} = calendar:now_to_universal_time(ts_to_date(TS1)), + {{Year, Month, Day}, {Hour, Minute, Second}} = date_to_data(ts_to_date(TS1)), DateStr = lists:flatten(io_lib:format("~2w ~2..0w ~4w ~2w:~2..0w:~2..0w", [Day, Month, Year, Hour, Minute, Second])), Bs = ec_support:add_binding(Res, DateStr, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). @@ -79,7 +94,7 @@ date_to_seconds(Time, minute) -> Time * 60; date_to_seconds(Time, sec) -> Time. %% @private -%% Converts string date representation to timestamp. Format DD MM YYYY HH:MM:SS +%% Converts string date representation to timestamp. Format DD MM YYYY hh:mm:ss -spec date_string_to_data(string()) -> tuple(). date_string_to_data(DataStr) -> [DStr, MStr, YStr, HStr, MnStr, SStr] = string:tokens(DataStr, " :"), @@ -92,6 +107,12 @@ date_string_to_data(DataStr) -> data_to_ts(Data) -> calendar:datetime_to_gregorian_seconds(Data) - 62167219200. +%% @private +%% Converts data tuple to date tuple {{YYYY,MM,DD},{hh,mm,ss}} +-spec date_to_data(tuple()) -> tuple(). +date_to_data(Ts) -> + calendar:now_to_universal_time(Ts). + %% @private %% Converts data tuple (part of timestamp: MegaSecs, Secs) to integer seconds -spec date_to_ts(tuple()) -> integer(). diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index ada6450..ce9dcfe 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -11,8 +11,6 @@ -behaviour(erlog_storage). --include("erlog_int.hrl"). - %% erlog callbacks -export([new/0, new/1, add_built_in/2, diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 062695b..a139b40 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -11,13 +11,14 @@ -behaviour(gen_server). --include("erlog_int.hrl"). - %% API -export([start_link/1, start_link/2, add_compiled_proc/2, assertz_clause/3, asserta_clause/3, retract_clause/3, abolish_clauses/2, get_procedure/2, get_procedure_type/2, get_interp_functors/1, assertz_clause/2, asserta_clause/2, finadll/2]). +-export([db_assertz_clause/3, db_assertz_clause/4, db_asserta_clause/4, db_asserta_clause/3, + db_retract_clause/4, db_abolish_clauses/3]). + -export([add_built_in/2]). %% gen_server callbacks @@ -47,15 +48,27 @@ assertz_clause(Database, {':-', Head, Body}) -> assertz_clause(Database, Head, B assertz_clause(Database, Head) -> assertz_clause(Database, Head, true). assertz_clause(Database, Head, Body) -> gen_server:call(Database, {assertz_clause, {Head, Body}}). +db_assertz_clause(Database, Collection, {':-', Head, Body}) -> db_assertz_clause(Database, Collection, Head, Body); +db_assertz_clause(Database, Collection, Head) -> db_assertz_clause(Database, Collection, Head, true). +db_assertz_clause(Database, Collection, Head, Body) -> + gen_server:call(Database, {assertz_clause, {Collection, Head, Body}}). + asserta_clause(Database, {':-', H, B}) -> asserta_clause(Database, H, B); asserta_clause(Database, H) -> asserta_clause(Database, H, true). asserta_clause(Database, Head, Body) -> gen_server:call(Database, {asserta_clause, {Head, Body}}). +db_asserta_clause(Database, Collection, {':-', H, B}) -> db_asserta_clause(Database, Collection, H, B); +db_asserta_clause(Database, Collection, H) -> db_asserta_clause(Database, Collection, H, true). +db_asserta_clause(Database, Collection, Head, Body) -> + gen_server:call(Database, {asserta_clause, {Collection, Head, Body}}). + finadll(Database, Fun) -> gen_server:call(Database, {findall, Fun}). retract_clause(Database, F, Ct) -> gen_server:call(Database, {retract_clause, {F, Ct}}). +db_retract_clause(Database, Collection, F, Ct) -> gen_server:call(Database, {retract_clause, {Collection, F, Ct}}). abolish_clauses(Database, Func) -> gen_server:call(Database, {abolish_clauses, Func}). +db_abolish_clauses(Database, Collection, Func) -> gen_server:call(Database, {abolish_clauses, Collection, Func}). get_procedure(Database, Func) -> gen_server:call(Database, {get_procedure, Func}). From 9b273620cb9e4caee7fa2e59d2180b777df7116b Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 17 Jul 2014 20:41:44 +0000 Subject: [PATCH 055/251] fix loading --- src/core/logic/ec_body.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/logic/ec_body.erl b/src/core/logic/ec_body.erl index d47c561..4e71db0 100644 --- a/src/core/logic/ec_body.erl +++ b/src/core/logic/ec_body.erl @@ -12,7 +12,7 @@ -include("erlog_core.hrl"). %% API --export([body_instance/5, prove_body/1, unify_prove_body/3, unify_prove_body/5, body_term/3]). +-export([body_instance/5, prove_body/1, unify_prove_body/3, unify_prove_body/5, body_term/3, well_form_body/4, well_form_body/3]). %% prove_body(Body, ChoicePoints, Bindings, VarNum, Database) -> %% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase}. From 3235c3fe1372c723a27294d744affb0d2545591f Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 17 Jul 2014 21:30:45 +0000 Subject: [PATCH 056/251] fix mistake in export --- src/core/logic/ec_support.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/logic/ec_support.erl b/src/core/logic/ec_support.erl index 14fea62..786313f 100644 --- a/src/core/logic/ec_support.erl +++ b/src/core/logic/ec_support.erl @@ -15,7 +15,7 @@ -export([new_bindings/0, get_binding/2, add_binding/3, functor/1, cut/3, collect_alternatives/3, update_result/4, update_vars/4, deref/2, dderef_list/2, - make_vars/2, pred_ind/1, deref_list/2]). + make_vars/2, pred_ind/1, deref_list/2, dderef/2]). %% deref(Term, Bindings) -> Term. %% Dereference a variable, else just return the term. From 6ef8c66587039fc1bb9a706475eba07cb218b443 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 17 Jul 2014 22:06:26 +0000 Subject: [PATCH 057/251] add load predicate, fix halt erlog_local_shell --- include/erlog_core.hrl | 4 +++- src/core/erlog.erl | 3 +-- src/core/logic/ec_goals.erl | 7 +++++++ src/interface/local/erlog_local_shell.erl | 5 ++++- 4 files changed, 15 insertions(+), 4 deletions(-) diff --git a/include/erlog_core.hrl b/include/erlog_core.hrl index c803d13..e2a5c82 100644 --- a/include/erlog_core.hrl +++ b/include/erlog_core.hrl @@ -79,6 +79,8 @@ %% Searching functions {findall, 3}, {bagof, 3}, - {setof, 3} + {setof, 3}, + %% Non standart functions + {use, 1} %load erlang library module ] ). \ No newline at end of file diff --git a/src/core/erlog.erl b/src/core/erlog.erl index c9e84d8..8181dc3 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -138,8 +138,7 @@ load_built_in(Database) -> erlog_bips, %Built in predicates erlog_dcg, %DCG predicates erlog_lists, %Common lists library - erlog_time %Bindings for working with data and time -%% erlog_db %Database support %TODO in some cases it is unneeded. Think about loading it dynamically + erlog_time %Bindings for working with data and time ]). %% @private diff --git a/src/core/logic/ec_goals.erl b/src/core/logic/ec_goals.erl index e011f61..b2dfbf7 100644 --- a/src/core/logic/ec_goals.erl +++ b/src/core/logic/ec_goals.erl @@ -149,6 +149,13 @@ prove_goal(Param = #param{goal = {reconsult, Name}, next_goal = Next, f_consulte erlog_errors:erlog_error(Error, Db) end, ec_body:prove_body(Param#param{goal = Next}); +prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db}) -> + try Library:load(Db) + catch + _:Error -> + erlog_errors:erlog_error(Error, Db) + end, + ec_body:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {findall, Goal, Fun, Res}, bindings = Bs0, next_goal = Next, database = Db}) -> Predicates = erlog_memory:finadll(Db, Fun), Element = ec_support:index_of(Goal, tuple_to_list(Fun)) - 1, diff --git a/src/interface/local/erlog_local_shell.erl b/src/interface/local/erlog_local_shell.erl index 8bc85f4..3d3a390 100644 --- a/src/interface/local/erlog_local_shell.erl +++ b/src/interface/local/erlog_local_shell.erl @@ -40,7 +40,10 @@ server_loop(Core, State, Line) -> _ -> erlog:execute(Core, lists:append(Line, Term)) end, {NewState, NewLine} = process_execute(Res, State, Line, Term), - server_loop(Core, NewState, NewLine); + case Term of + "halt." -> ok; + _ -> server_loop(Core, NewState, NewLine) + end; {error, {_, Em, E}} -> io:fwrite("Error: ~s\n", [Em:format_error(E)]), server_loop(Core, State, Line) From b6abf30fb9218dd15c783c9bb994f1bd1f8d531d Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 17 Jul 2014 22:08:23 +0000 Subject: [PATCH 058/251] fix time names --- include/erlog_time.hrl | 4 ++-- src/libs/erlog_time.erl | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/include/erlog_time.hrl b/include/erlog_time.hrl index 8b468a1..9dbf47a 100644 --- a/include/erlog_time.hrl +++ b/include/erlog_time.hrl @@ -13,8 +13,8 @@ {{localtime, 1}, ?MODULE, localtime_1}, {{date_diff, 4}, ?MODULE, datediff_4}, {{date_add, 4}, ?MODULE, dateadd_4}, - {{dateprint, 4}, ?MODULE, dateprint_2}, - {{dateparse, 4}, ?MODULE, dateparse_2}, + {{date_print, 4}, ?MODULE, dateprint_2}, + {{date_parse, 4}, ?MODULE, dateparse_2}, {{date, 2}, ?MODULE, date_2}, {{date, 4}, ?MODULE, date_4}, {{time, 2}, ?MODULE, time_2}, diff --git a/src/libs/erlog_time.erl b/src/libs/erlog_time.erl index 9ccbecc..ee09908 100644 --- a/src/libs/erlog_time.erl +++ b/src/libs/erlog_time.erl @@ -53,26 +53,26 @@ time_4({time, H, M, S, Res}, Params = #param{next_goal = Next, bindings = Bs0}) ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% Calculates differense between two date tuples. Returns the result in specifyed format -datediff_4({datediff, TS1, TS2, Format, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> +datediff_4({date_diff, TS1, TS2, Format, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> Diff = timer:now_diff(ts_to_date(TS1), ts_to_date(TS2)), Bs = ec_support:add_binding(Res, microseconds_to_date(Diff, Format), Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% Adds number of seconds T2 in Type format to Time1. Returns the result in Type format -dateadd_4({dateadd, Time1, Type, T2, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> +dateadd_4({date_add, Time1, Type, T2, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> Diff = Time1 + date_to_seconds(T2, Type), Bs = ec_support:add_binding(Res, microseconds_to_date(Diff * 1000000, Type), Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% Converts timestamp to human readable format -dateprint_2({dateprint, TS1, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> +dateprint_2({date_print, TS1, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> {{Year, Month, Day}, {Hour, Minute, Second}} = date_to_data(ts_to_date(TS1)), DateStr = lists:flatten(io_lib:format("~2w ~2..0w ~4w ~2w:~2..0w:~2..0w", [Day, Month, Year, Hour, Minute, Second])), Bs = ec_support:add_binding(Res, DateStr, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% Parses date string and returns timestamp. -dateparse_2({dateparse, DataStr, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> +dateparse_2({date_parse, DataStr, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> Data = date_string_to_data(DataStr), Bs = ec_support:add_binding(Res, data_to_ts(Data), Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). From a13e08b1d2489ab7f88d687762fe3598a63fca5a Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 17 Jul 2014 23:23:30 +0000 Subject: [PATCH 059/251] fix vars binding --- src/core/erlog.erl | 2 +- src/libs/erlog_time.erl | 24 +++++++++++++++--------- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 8181dc3..7c8281c 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -195,7 +195,7 @@ prove_goal(Goal0, State = #state{db = Db, f_consulter = Fcon, e_man = Event}) -> %% optimisation. case erlog_logic:prove_result(catch erlog_core:prove_goal(Goal1, Db, Fcon, Event), Vs) of {succeed, Res, Args} -> {{succeed, Res}, State#state{state = Args}}; - OtherRes -> {OtherRes, State} + OtherRes -> io:format("other res ~p~n", [OtherRes]),{OtherRes, State} end. %% @private diff --git a/src/libs/erlog_time.erl b/src/libs/erlog_time.erl index ee09908..cde3185 100644 --- a/src/libs/erlog_time.erl +++ b/src/libs/erlog_time.erl @@ -28,52 +28,52 @@ localtime_1({localtime, Var}, Params = #param{next_goal = Next, bindings = Bs0}) %% Returns timestamp for data, ignoring time date_2({date, DateString, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - {{Y, M, D}, _} = date_string_to_data(DateString), + {{Y, M, D}, _} = date_string_to_data(check_var(DateString, Bs0)), DataTS = data_to_ts({{Y, M, D}, {0, 0, 0}}), Bs = ec_support:add_binding(Res, DataTS, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% Returns timestamp for data, ignoring time date_4({date, D, M, Y, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - DataTS = data_to_ts({{Y, M, D}, {0, 0, 0}}), + DataTS = data_to_ts({{check_var(Y, Bs0), check_var(M, Bs0), check_var(D, Bs0)}, {0, 0, 0}}), Bs = ec_support:add_binding(Res, DataTS, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% Returns timestamp for data, ignoring data. time_2({time, TimeString, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - {_, {H, M, S}} = date_string_to_data(TimeString), %cut YMD + {_, {H, M, S}} = date_string_to_data(check_var(TimeString, Bs0)), %cut YMD TS = S * date_to_seconds(M, minute) * date_to_seconds(H, hour), Bs = ec_support:add_binding(Res, TS, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% Returns timestamp for data, ignoring data. time_4({time, H, M, S, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - TS = S * date_to_seconds(M, minute) * date_to_seconds(H, hour), + TS = check_var(S, Bs0) * date_to_seconds(check_var(M, Bs0), minute) * date_to_seconds(check_var(H, Bs0), hour), Bs = ec_support:add_binding(Res, TS, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% Calculates differense between two date tuples. Returns the result in specifyed format datediff_4({date_diff, TS1, TS2, Format, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - Diff = timer:now_diff(ts_to_date(TS1), ts_to_date(TS2)), + Diff = timer:now_diff(ts_to_date(check_var(TS1, Bs0)), ts_to_date(check_var(TS2, Bs0))), Bs = ec_support:add_binding(Res, microseconds_to_date(Diff, Format), Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% Adds number of seconds T2 in Type format to Time1. Returns the result in Type format dateadd_4({date_add, Time1, Type, T2, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - Diff = Time1 + date_to_seconds(T2, Type), + Diff = check_var(Time1, Bs0) + date_to_seconds(check_var(T2, Bs0), Type), Bs = ec_support:add_binding(Res, microseconds_to_date(Diff * 1000000, Type), Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% Converts timestamp to human readable format dateprint_2({date_print, TS1, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - {{Year, Month, Day}, {Hour, Minute, Second}} = date_to_data(ts_to_date(TS1)), + {{Year, Month, Day}, {Hour, Minute, Second}} = date_to_data(ts_to_date(check_var(TS1, Bs0))), DateStr = lists:flatten(io_lib:format("~2w ~2..0w ~4w ~2w:~2..0w:~2..0w", [Day, Month, Year, Hour, Minute, Second])), Bs = ec_support:add_binding(Res, DateStr, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% Parses date string and returns timestamp. dateparse_2({date_parse, DataStr, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - Data = date_string_to_data(DataStr), + Data = date_string_to_data(check_var(DataStr, Bs0)), Bs = ec_support:add_binding(Res, data_to_ts(Data), Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). @@ -126,4 +126,10 @@ date_to_ts({M1, S1}) -> ts_to_date(Timestamp) -> TSStr = integer_to_list(Timestamp), {M1, S1} = lists:split(4, TSStr), - {list_to_integer(M1), list_to_integer(S1), 0}. \ No newline at end of file + {list_to_integer(M1), list_to_integer(S1), 0}. + + +%% @private +%% Checks - if var is normal, or binded. Returns var's value. +check_var({Var}, Bs) -> ec_support:deref({Var}, Bs); +check_var(Var, _) -> Var. \ No newline at end of file From 2f69841fe37bd5a2c6d4020b237ebda4a76df07e Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 17 Jul 2014 23:32:26 +0000 Subject: [PATCH 060/251] remove debug --- src/core/erlog.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 7c8281c..8181dc3 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -195,7 +195,7 @@ prove_goal(Goal0, State = #state{db = Db, f_consulter = Fcon, e_man = Event}) -> %% optimisation. case erlog_logic:prove_result(catch erlog_core:prove_goal(Goal1, Db, Fcon, Event), Vs) of {succeed, Res, Args} -> {{succeed, Res}, State#state{state = Args}}; - OtherRes -> io:format("other res ~p~n", [OtherRes]),{OtherRes, State} + OtherRes -> {OtherRes, State} end. %% @private From 0e14286f5249cc077e25f79b0790835468a05639 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 17 Jul 2014 23:53:22 +0000 Subject: [PATCH 061/251] change io:fread to getline, fix seconds to date --- src/interface/local/erlog_local_shell.erl | 23 +++++++++-------------- src/libs/erlog_time.erl | 20 ++++++++++---------- 2 files changed, 19 insertions(+), 24 deletions(-) diff --git a/src/interface/local/erlog_local_shell.erl b/src/interface/local/erlog_local_shell.erl index 3d3a390..d5e504e 100644 --- a/src/interface/local/erlog_local_shell.erl +++ b/src/interface/local/erlog_local_shell.erl @@ -33,20 +33,15 @@ start() -> %% user to enter goals, see resulting bindings and request next %% solution. server_loop(Core, State, Line) -> - case io:fread('| ?- ', "~s") of - {ok, [Term]} -> - Res = case State of - select -> erlog:select(Core, lists:append(Line, Term)); - _ -> erlog:execute(Core, lists:append(Line, Term)) - end, - {NewState, NewLine} = process_execute(Res, State, Line, Term), - case Term of - "halt." -> ok; - _ -> server_loop(Core, NewState, NewLine) - end; - {error, {_, Em, E}} -> - io:fwrite("Error: ~s\n", [Em:format_error(E)]), - server_loop(Core, State, Line) + Term = io:get_line('| ?- '), + Res = case State of + select -> erlog:select(Core, lists:append(Line, Term)); + _ -> erlog:execute(Core, lists:append(Line, Term)) + end, + {NewState, NewLine} = process_execute(Res, State, Line, Term), + case Term of + "halt." -> ok; + _ -> server_loop(Core, NewState, NewLine) end. %% Processes return value after execution. diff --git a/src/libs/erlog_time.erl b/src/libs/erlog_time.erl index cde3185..0108968 100644 --- a/src/libs/erlog_time.erl +++ b/src/libs/erlog_time.erl @@ -52,16 +52,16 @@ time_4({time, H, M, S, Res}, Params = #param{next_goal = Next, bindings = Bs0}) Bs = ec_support:add_binding(Res, TS, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). -%% Calculates differense between two date tuples. Returns the result in specifyed format +%% Calculates differense between two timestamps. Returns the result in specifyed format datediff_4({date_diff, TS1, TS2, Format, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - Diff = timer:now_diff(ts_to_date(check_var(TS1, Bs0)), ts_to_date(check_var(TS2, Bs0))), - Bs = ec_support:add_binding(Res, microseconds_to_date(Diff, Format), Bs0), + Diff = timer:now_diff(ts_to_date(check_var(TS1, Bs0)), ts_to_date(check_var(TS2, Bs0))) / 1000000, + Bs = ec_support:add_binding(Res, seconds_to_date(Diff, Format), Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). -%% Adds number of seconds T2 in Type format to Time1. Returns the result in Type format +%% Adds number of seconds T2 in Type format to Time1. Returns timestamp dateadd_4({date_add, Time1, Type, T2, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> Diff = check_var(Time1, Bs0) + date_to_seconds(check_var(T2, Bs0), Type), - Bs = ec_support:add_binding(Res, microseconds_to_date(Diff * 1000000, Type), Bs0), + Bs = ec_support:add_binding(Res, Diff, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% Converts timestamp to human readable format @@ -79,11 +79,11 @@ dateparse_2({date_parse, DataStr, Res}, Params = #param{next_goal = Next, bindin %% @private %% Time in microseconds, atom for output format --spec microseconds_to_date(Time :: integer(), atom()) -> integer(). -microseconds_to_date(Time, day) -> Time / 86400000000; % day = 24 hours -microseconds_to_date(Time, hour) -> Time / 3600000000; % hour = 60 min -microseconds_to_date(Time, minute) -> Time / 60000000; % min = 60 sec -microseconds_to_date(Time, sec) -> Time / 1000000. % micro = 10^-6 +-spec seconds_to_date(Time :: integer(), atom()) -> integer(). +seconds_to_date(Time, day) -> round(Time / 86400); % day = 24 hours +seconds_to_date(Time, hour) -> round(Time / 3600); % hour = 60 min +seconds_to_date(Time, minute) -> round(Time / 60); % min = 60 sec +seconds_to_date(Time, sec) -> Time. %% @private %% Converts day|hour|minute to seconds From ad9d74a40db0e913dcb8fdb62d2474bd37ebfefe Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 17 Jul 2014 23:54:40 +0000 Subject: [PATCH 062/251] renamed add time and remove round --- include/erlog_time.hrl | 2 +- src/libs/erlog_time.erl | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/include/erlog_time.hrl b/include/erlog_time.hrl index 9dbf47a..b7b800b 100644 --- a/include/erlog_time.hrl +++ b/include/erlog_time.hrl @@ -12,7 +12,7 @@ [ {{localtime, 1}, ?MODULE, localtime_1}, {{date_diff, 4}, ?MODULE, datediff_4}, - {{date_add, 4}, ?MODULE, dateadd_4}, + {{add_time, 4}, ?MODULE, add_time_4}, {{date_print, 4}, ?MODULE, dateprint_2}, {{date_parse, 4}, ?MODULE, dateparse_2}, {{date, 2}, ?MODULE, date_2}, diff --git a/src/libs/erlog_time.erl b/src/libs/erlog_time.erl index 0108968..f0830d0 100644 --- a/src/libs/erlog_time.erl +++ b/src/libs/erlog_time.erl @@ -15,7 +15,7 @@ %% API -export([load/1, localtime_1/2]). -export([date_2/2, date_4/2, time_2/2, time_4/2]). --export([datediff_4/2, dateadd_4/2, dateprint_2/2, dateparse_2/2]). +-export([datediff_4/2, add_time_4/2, dateprint_2/2, dateparse_2/2]). load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_TIME). @@ -59,7 +59,7 @@ datediff_4({date_diff, TS1, TS2, Format, Res}, Params = #param{next_goal = Next, ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% Adds number of seconds T2 in Type format to Time1. Returns timestamp -dateadd_4({date_add, Time1, Type, T2, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> +add_time_4({add_time, Time1, Type, T2, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> Diff = check_var(Time1, Bs0) + date_to_seconds(check_var(T2, Bs0), Type), Bs = ec_support:add_binding(Res, Diff, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). @@ -80,9 +80,9 @@ dateparse_2({date_parse, DataStr, Res}, Params = #param{next_goal = Next, bindin %% @private %% Time in microseconds, atom for output format -spec seconds_to_date(Time :: integer(), atom()) -> integer(). -seconds_to_date(Time, day) -> round(Time / 86400); % day = 24 hours -seconds_to_date(Time, hour) -> round(Time / 3600); % hour = 60 min -seconds_to_date(Time, minute) -> round(Time / 60); % min = 60 sec +seconds_to_date(Time, day) -> Time / 86400; % day = 24 hours +seconds_to_date(Time, hour) -> Time / 3600; % hour = 60 min +seconds_to_date(Time, minute) -> Time / 60; % min = 60 sec seconds_to_date(Time, sec) -> Time. %% @private From 5a6f73e66154c74423d57a32cefe283928846d94 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 18 Jul 2014 00:07:17 +0000 Subject: [PATCH 063/251] made proper output in erlog_local_shell --- src/interface/local/erlog_local_shell.erl | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/interface/local/erlog_local_shell.erl b/src/interface/local/erlog_local_shell.erl index d5e504e..8922c85 100644 --- a/src/interface/local/erlog_local_shell.erl +++ b/src/interface/local/erlog_local_shell.erl @@ -57,8 +57,14 @@ process_execute(Reply, _, _, _) -> %% Processes reply from prolog. Form it to normal view. -spec process_reply(tuple()) -> tuple(). process_reply({Res, select}) -> - io:format("~p~n: ", [{Res, select}]), + print_res(Res), {select, []}; process_reply(Res) -> - io:format("~p~n", [Res]), - {normal, []}. \ No newline at end of file + print_res(Res), + {normal, []}. + +print_res({Bool, Bindings}) -> + io:format("~p~n", [Bool]), + lists:foreach(fun({Var, Value}) -> io:format("~p = ~p~n", [Var, Value]) end, Bindings); +print_res(Res) -> + io:format("~p~n", [Res]). \ No newline at end of file From 7a14ddbd05a6c00eb5466df203262206c27b1bc6 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 18 Jul 2014 18:21:12 +0000 Subject: [PATCH 064/251] fix ec_term export --- src/core/logic/ec_term.erl | 2 +- test/prolog/t3.pl | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/logic/ec_term.erl b/src/core/logic/ec_term.erl index 26dbff1..e57516d 100644 --- a/src/core/logic/ec_term.erl +++ b/src/core/logic/ec_term.erl @@ -10,7 +10,7 @@ -author("tihon"). %% API --export([term_instance/2]). +-export([term_instance/2, term_instance/3]). %% term_instance(Term, VarNum) -> {Term,NewRepls,NewVarNum}. %% term_instance(Term, Repls, VarNum) -> {Term,NewRepls,NewVarNum}. diff --git a/test/prolog/t3.pl b/test/prolog/t3.pl index 47a4fc6..555b393 100644 --- a/test/prolog/t3.pl +++ b/test/prolog/t3.pl @@ -2,11 +2,11 @@ add_some_facts(Now, 32, 10, [5, 15, 25, 30, 35, 40, 45, 50]). add_some_facts(LastTime, HoursFrom, MinutesDiap, SomeValues):- - date_add(LastTime, hour, -HoursFrom, LastTime), + add_time(LastTime, hour, -HoursFrom, LastTime), generate_facts(FirstDate, LastTime, MinutesDiap, SomeValues, SomeValues). generate_facts(FirstDate, LastTime, MinutesDiap, [Val|L], SomeValues):- - date_add(FirstDate, minute, MinutesDiap, NextTime), + add_time(FirstDate, minute, MinutesDiap, NextTime), NextTime =< LastTime, assert(some_fact("some name", Val, NextTime)), generate_facts(NextTime, LastTime, MinutesDiap, L, SomeValues). From 3eb718dfd464ea21bc1f9db4098ab58a6e460d13 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 18 Jul 2014 18:28:41 +0000 Subject: [PATCH 065/251] update time test --- test/prolog/t3.pl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/prolog/t3.pl b/test/prolog/t3.pl index 555b393..360063e 100644 --- a/test/prolog/t3.pl +++ b/test/prolog/t3.pl @@ -2,7 +2,7 @@ add_some_facts(Now, 32, 10, [5, 15, 25, 30, 35, 40, 45, 50]). add_some_facts(LastTime, HoursFrom, MinutesDiap, SomeValues):- - add_time(LastTime, hour, -HoursFrom, LastTime), + add_time(LastTime, hour, -HoursFrom, FirstDate), generate_facts(FirstDate, LastTime, MinutesDiap, SomeValues, SomeValues). generate_facts(FirstDate, LastTime, MinutesDiap, [Val|L], SomeValues):- @@ -16,7 +16,7 @@ get_sum(Sum, Now):- Name = "some name", - findall(Val, (some_fact( Name, Val, Time), date_diff( Time, Now, hour, Acum), Acum =< 24), Vals), + findall(Val, (some_fact( Name, Val, Time), date_diff( Now, Time, hour, Acum), Acum =< 24), Vals), sum(Vals, Sum). sum( Vals, Sum):- @@ -33,7 +33,7 @@ acum_fact(Name, Sum). get_sum1(Sum, Now, Name):- some_fact( Name, Val, Time), - date_diff( Time, Now, hour, Acum), + date_diff( Now, Time, hour, Acum), Acum =< 24, acum_val(Name, Acum), fail. From 9b63e3ab095fe2cfc2915eddd8e34cc942b76871 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 18 Jul 2014 20:49:39 +0000 Subject: [PATCH 066/251] fix time for integers < 0 --- src/libs/erlog_db.erl | 18 +++++++----------- src/libs/erlog_time.erl | 5 +++-- src/storage/erlog_memory.erl | 3 ++- 3 files changed, 12 insertions(+), 14 deletions(-) diff --git a/src/libs/erlog_db.erl b/src/libs/erlog_db.erl index 1f2b091..a8a94d6 100644 --- a/src/libs/erlog_db.erl +++ b/src/libs/erlog_db.erl @@ -36,7 +36,7 @@ db_abolish_2({db_abolish, Table, Fact}, Params = #param{next_goal = Next, bindin Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) end. -db_retract_2({db_retract, Table, Fact}, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> +db_retract_2({db_retract, Table, Fact}, Params = #param{bindings = Bs}) -> C = ec_support:dderef(Fact, Bs), prove_retract(C, Table, Params). @@ -47,25 +47,21 @@ prove_retract(H, Table, Params) -> prove_retract(H, B, Table, Params = #param{database = Db}) -> Functor = ec_support:functor(H), - case erlog_memory:get_procedure(Db, Functor) of - {clauses, Cs} -> retract_clauses(H, B, Cs, Params); - {code, _} -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - built_in -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + case erlog_memory:get_db_procedure(Db, Table, Functor) of + {clauses, Cs} -> retract_clauses(H, B, Cs, Params, Table); undefined -> erlog_errors:fail(Params) end. %% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to retract Head and Body using Clauses which all have the same functor. -retract_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}) -> %TODO foreach vs handmade recursion? +retract_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Collection) -> %TODO foreach vs handmade recursion? case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> %% We have found a right clause so now retract it. - erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), + erlog_memory:db_retract_clause(Db, Collection, ec_support:functor(Ch), element(1, C)), Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); - fail -> retract_clauses(Ch, Cb, Cs, Param) + fail -> retract_clauses(Ch, Cb, Cs, Param, Collection) end; -retract_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param). \ No newline at end of file +retract_clauses(_Ch, _Cb, [], Param, _) -> erlog_errors:fail(Param). \ No newline at end of file diff --git a/src/libs/erlog_time.erl b/src/libs/erlog_time.erl index f0830d0..2549b4f 100644 --- a/src/libs/erlog_time.erl +++ b/src/libs/erlog_time.erl @@ -130,6 +130,7 @@ ts_to_date(Timestamp) -> %% @private -%% Checks - if var is normal, or binded. Returns var's value. -check_var({Var}, Bs) -> ec_support:deref({Var}, Bs); +%% Checks - if var is normal, or binded, or < 0 (if int). Returns var's value. +check_var({Var}, Bs) -> check_var(ec_support:deref({Var}, Bs), Bs); +check_var({'-', Var}, _) when is_integer(Var) -> Var * -1; check_var(Var, _) -> Var. \ No newline at end of file diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index a139b40..0c1ea34 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -17,7 +17,7 @@ get_interp_functors/1, assertz_clause/2, asserta_clause/2, finadll/2]). -export([db_assertz_clause/3, db_assertz_clause/4, db_asserta_clause/4, db_asserta_clause/3, - db_retract_clause/4, db_abolish_clauses/3]). + db_retract_clause/4, db_abolish_clauses/3, get_db_procedure/3]). -export([add_built_in/2]). @@ -71,6 +71,7 @@ abolish_clauses(Database, Func) -> gen_server:call(Database, {abolish_clauses, F db_abolish_clauses(Database, Collection, Func) -> gen_server:call(Database, {abolish_clauses, Collection, Func}). get_procedure(Database, Func) -> gen_server:call(Database, {get_procedure, Func}). +get_db_procedure(Database, Collection, Func) -> gen_server:call(Database, {get_procedure, Collection, Func}). get_procedure_type(Database, Func) -> gen_server:call(Database, {get_procedure_type, Func}). From bb2f20edd759bdb7fdf886a48547fa31c494c065 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 18 Jul 2014 21:04:32 +0000 Subject: [PATCH 067/251] fix erlog_db names --- include/erlog_db.hrl | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/include/erlog_db.hrl b/include/erlog_db.hrl index fbbac28..6c8c1ae 100644 --- a/include/erlog_db.hrl +++ b/include/erlog_db.hrl @@ -10,11 +10,11 @@ -define(ERLOG_DB, [ - {abolish, 1}, - {assert, 1}, - {asserta, 1}, - {assertz, 1}, - {retract, 1}, - {retractall, 1} + {{db_abolish, 2}, ?MODULE, db_abolish_2}, + {{db_assert, 2}, ?MODULE, db_assert_2}, + {{db_asserta, 2}, ?MODULE, db_asserta_2}, + {{db_assertz, 2}, ?MODULE, db_assert_2}, + {{db_retract, 2}, ?MODULE, db_retract_2}, + {{db_retractall, 2}, ?MODULE, db_retractall_2} ] ). \ No newline at end of file From 2e47efd6c3d949a86d6462d9b5f4fc56a50abe1e Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 18 Jul 2014 22:07:35 +0000 Subject: [PATCH 068/251] fix negative tied values --- src/libs/erlog_time.erl | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/libs/erlog_time.erl b/src/libs/erlog_time.erl index 2549b4f..34c490c 100644 --- a/src/libs/erlog_time.erl +++ b/src/libs/erlog_time.erl @@ -60,6 +60,7 @@ datediff_4({date_diff, TS1, TS2, Format, Res}, Params = #param{next_goal = Next, %% Adds number of seconds T2 in Type format to Time1. Returns timestamp add_time_4({add_time, Time1, Type, T2, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> + io:format("add time ~p ~p ~p~n", [Time1, Type, T2]), Diff = check_var(Time1, Bs0) + date_to_seconds(check_var(T2, Bs0), Type), Bs = ec_support:add_binding(Res, Diff, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). @@ -131,6 +132,10 @@ ts_to_date(Timestamp) -> %% @private %% Checks - if var is normal, or binded, or < 0 (if int). Returns var's value. +check_var({'-', Var}, Bs) -> + case check_var(Var, Bs) of + Res when is_integer(Res) -> -1 * Res; + Res -> Res + end; check_var({Var}, Bs) -> check_var(ec_support:deref({Var}, Bs), Bs); -check_var({'-', Var}, _) when is_integer(Var) -> Var * -1; check_var(Var, _) -> Var. \ No newline at end of file From a8257ae1216731c482f526f3a0217a4ee8b286ff Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 18 Jul 2014 22:33:13 +0000 Subject: [PATCH 069/251] removed debug --- src/libs/erlog_time.erl | 1 - 1 file changed, 1 deletion(-) diff --git a/src/libs/erlog_time.erl b/src/libs/erlog_time.erl index 34c490c..55747a9 100644 --- a/src/libs/erlog_time.erl +++ b/src/libs/erlog_time.erl @@ -60,7 +60,6 @@ datediff_4({date_diff, TS1, TS2, Format, Res}, Params = #param{next_goal = Next, %% Adds number of seconds T2 in Type format to Time1. Returns timestamp add_time_4({add_time, Time1, Type, T2, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - io:format("add time ~p ~p ~p~n", [Time1, Type, T2]), Diff = check_var(Time1, Bs0) + date_to_seconds(check_var(T2, Bs0), Type), Bs = ec_support:add_binding(Res, Diff, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). From f9339fac118eae9a01c33d3af326770f8119c128 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 18 Jul 2014 22:38:27 +0000 Subject: [PATCH 070/251] fix functions aritty --- include/erlog_time.hrl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/include/erlog_time.hrl b/include/erlog_time.hrl index b7b800b..4f7f802 100644 --- a/include/erlog_time.hrl +++ b/include/erlog_time.hrl @@ -13,8 +13,8 @@ {{localtime, 1}, ?MODULE, localtime_1}, {{date_diff, 4}, ?MODULE, datediff_4}, {{add_time, 4}, ?MODULE, add_time_4}, - {{date_print, 4}, ?MODULE, dateprint_2}, - {{date_parse, 4}, ?MODULE, dateparse_2}, + {{date_print, 2}, ?MODULE, dateprint_2}, + {{date_parse, 2}, ?MODULE, dateparse_2}, {{date, 2}, ?MODULE, date_2}, {{date, 4}, ?MODULE, date_4}, {{time, 2}, ?MODULE, time_2}, From e3b9651ee00c3fcd26e4ec09d96f96ddc8efb94a Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 21 Jul 2014 19:54:33 +0000 Subject: [PATCH 071/251] made proper error return --- src/io/erlog_io.erl | 3 ++- test/prolog/t3.pl | 16 ++++++++-------- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/src/io/erlog_io.erl b/src/io/erlog_io.erl index 8364716..73e8d04 100644 --- a/src/io/erlog_io.erl +++ b/src/io/erlog_io.erl @@ -233,4 +233,5 @@ format_error(Type, Params) -> (Param, Acc) -> [io_lib:format("~p", [Param]) | Acc] end, ["\n"], [Type | Params]), - string:join(B, ": "). \ No newline at end of file + S = string:join(B, ": "), + lists:flatten(S). diff --git a/test/prolog/t3.pl b/test/prolog/t3.pl index 360063e..8176335 100644 --- a/test/prolog/t3.pl +++ b/test/prolog/t3.pl @@ -1,24 +1,24 @@ add_some_facts(Now):- add_some_facts(Now, 32, 10, [5, 15, 25, 30, 35, 40, 45, 50]). - + add_some_facts(LastTime, HoursFrom, MinutesDiap, SomeValues):- add_time(LastTime, hour, -HoursFrom, FirstDate), generate_facts(FirstDate, LastTime, MinutesDiap, SomeValues, SomeValues). - + generate_facts(FirstDate, LastTime, MinutesDiap, [Val|L], SomeValues):- add_time(FirstDate, minute, MinutesDiap, NextTime), NextTime =< LastTime, assert(some_fact("some name", Val, NextTime)), generate_facts(NextTime, LastTime, MinutesDiap, L, SomeValues). -generate_facts(FirstDate, LastTime, MinutesDiap, [], SomeValues):- +generate_facts(NextTime, LastTime, MinutesDiap, [], SomeValues):- generate_facts(NextTime, LastTime, MinutesDiap, SomeValues, SomeValues). generate_facts(_, _, _, _, _). - + get_sum(Sum, Now):- Name = "some name", findall(Val, (some_fact( Name, Val, Time), date_diff( Now, Time, hour, Acum), Acum =< 24), Vals), sum(Vals, Sum). - + sum( Vals, Sum):- sum( Vals, 0, Sum). sum( [Val|Vals], Ac, Sum):- @@ -26,7 +26,7 @@ !, sum(Vals, AcNext, Sum). sum([], Sum, Sum). - + get_sum1(Sum, Now):- Name = "some name", get_sum1(Sum, Now, Name), @@ -38,7 +38,7 @@ acum_val(Name, Acum), fail. get_sum1(_Sum, _Now, _Name). - + acum_val(Name, Acum):- retract(acum_fact(Name, PrevVal)), NextVal is PrevVal + Acum, @@ -46,7 +46,7 @@ !. acum_val(Name, Val):- assert(acum_fact(Name, Val)). - + test_all:- localtime(Now), add_some_facts(Now), From 739369e52c9e684519395cafda5be64e6049c76c Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 22 Jul 2014 01:42:47 +0000 Subject: [PATCH 072/251] fix database module --- src/core/logic/ec_goals.erl | 2 +- src/core/logic/ec_support.erl | 2 +- src/interface/local/erlog_local_shell.erl | 2 + src/storage/erlog_dict.erl | 12 +- src/storage/erlog_ets.erl | 36 ++++- src/storage/erlog_memory.erl | 16 +-- src/storage/ets_db_storage.erl | 159 ++++++++++++++++++++++ 7 files changed, 206 insertions(+), 23 deletions(-) create mode 100644 src/storage/ets_db_storage.erl diff --git a/src/core/logic/ec_goals.erl b/src/core/logic/ec_goals.erl index b2dfbf7..1032b11 100644 --- a/src/core/logic/ec_goals.erl +++ b/src/core/logic/ec_goals.erl @@ -157,7 +157,7 @@ prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db end, ec_body:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {findall, Goal, Fun, Res}, bindings = Bs0, next_goal = Next, database = Db}) -> - Predicates = erlog_memory:finadll(Db, Fun), + Predicates = erlog_memory:finadll(Db, Fun), %TODO findall(A, (append(L, [B|L2], [1,2,3,4,5]), A is B * 10), R) Element = ec_support:index_of(Goal, tuple_to_list(Fun)) - 1, Result = lists:foldr( fun({_, Pred, _}, Acc) -> diff --git a/src/core/logic/ec_support.erl b/src/core/logic/ec_support.erl index 786313f..0047acd 100644 --- a/src/core/logic/ec_support.erl +++ b/src/core/logic/ec_support.erl @@ -15,7 +15,7 @@ -export([new_bindings/0, get_binding/2, add_binding/3, functor/1, cut/3, collect_alternatives/3, update_result/4, update_vars/4, deref/2, dderef_list/2, - make_vars/2, pred_ind/1, deref_list/2, dderef/2]). + make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3]). %% deref(Term, Bindings) -> Term. %% Dereference a variable, else just return the term. diff --git a/src/interface/local/erlog_local_shell.erl b/src/interface/local/erlog_local_shell.erl index 8922c85..d9d3a5a 100644 --- a/src/interface/local/erlog_local_shell.erl +++ b/src/interface/local/erlog_local_shell.erl @@ -27,6 +27,8 @@ start() -> [erlang:system_info(version)]), {ok, Core} = erlog:start_link(), link(Core), + {ok, Proc} = ets_db_storage:start_link(), %start default ets-implementation of stand-alone database-module + link(Proc), server_loop(Core, normal, []). %% A simple Erlog shell similar to a "normal" Prolog shell. It allows diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index d038697..465283a 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -31,10 +31,10 @@ new() -> {ok, dict:new()}. new(_) -> {ok, dict:new()}. -add_built_in(Db, Functor) -> +add_built_in(Db, {Functor}) -> {ok, dict:store(Functor, built_in, Db)}. -add_compiled_proc(Db, {Functor, M, F}) -> +add_compiled_proc(Db, {{Functor, M, F}}) -> {ok, dict:update(Functor, fun(built_in) -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); @@ -64,7 +64,7 @@ retract_clause(Db, {Functor, Ct}) -> error -> Db %Do nothing end}. -abolish_clauses(Db, Functor) -> +abolish_clauses(Db, {Functor}) -> {ok, case dict:find(Functor, Db) of {ok, built_in} -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); @@ -73,7 +73,7 @@ abolish_clauses(Db, Functor) -> error -> Db %Do nothing end}. -get_procedure(Db, Functor) -> +get_procedure(Db, {Functor}) -> {case dict:find(Functor, Db) of {ok, built_in} -> built_in; %A built-in {ok, {code, {_M, _F}} = P} -> P; %Compiled (perhaps someday) @@ -81,7 +81,7 @@ get_procedure(Db, Functor) -> error -> undefined %Undefined end, Db}. -get_procedure_type(Db, Functor) -> +get_procedure_type(Db, {Functor}) -> {case dict:find(Functor, Db) of {ok, built_in} -> built_in; %A built-in {ok, {code, _}} -> compiled; %Compiled (perhaps someday) @@ -108,5 +108,5 @@ clause(Head, Body0, Db, ClauseFun) -> ({clauses, T, Cs}) -> ClauseFun(T, Body, Cs) end, {clauses, 1, [{0, Head, Body}]}, Db). -findall(State, Functor) -> %TODO implement me! +findall(State, {Functor}) -> %TODO implement me! erlang:error(not_implemented). diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index ce9dcfe..5328203 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -28,11 +28,11 @@ new() -> {ok, ets:new(eets, [])}. new(_) -> {ok, ets:new(eets, [])}. -add_built_in(Db, Functor) -> +add_built_in(Db, {Functor}) -> true = ets:insert(Db, {Functor, built_in}), {ok, Db}. -add_compiled_proc(Db, {Functor, M, F}) -> +add_compiled_proc(Db, {{Functor, M, F}}) -> case ets:lookup(Db, Functor) of [{_, built_in}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); @@ -41,6 +41,10 @@ add_compiled_proc(Db, {Functor, M, F}) -> end, {ok, Db}. +assertz_clause(Db, {Collection, Head, Body0}) -> + Ets = ets_db_storage:get_db(Collection), + {ok, _} = assertz_clause(Ets, {Head, Body0}), + {ok, Db}; assertz_clause(Db, {Head, Body0}) -> clause(Head, Body0, Db, fun(Functor, Tag, Cs, Body) -> @@ -48,6 +52,10 @@ assertz_clause(Db, {Head, Body0}) -> end), {ok, Db}. +asserta_clause(Db, {Collection, Head, Body0}) -> + Ets = ets_db_storage:get_db(Collection), + {ok, _} = asserta_clause(Ets, {Head, Body0}), + {ok, Db}; asserta_clause(Db, {Head, Body0}) -> clause(Head, Body0, Db, fun(Functor, Tag, Cs, Body) -> @@ -55,6 +63,10 @@ asserta_clause(Db, {Head, Body0}) -> end), {ok, Db}. +retract_clause(Db, {Collection, Functor, Ct}) -> + Ets = ets_db_storage:get_db(Collection), + {ok, _} = retract_clause(Ets, {Functor, Ct}), + {ok, Db}; retract_clause(Db, {Functor, Ct}) -> case ets:lookup(Db, Functor) of [{_, built_in}] -> @@ -67,7 +79,11 @@ retract_clause(Db, {Functor, Ct}) -> end, {ok, Db}. -abolish_clauses(Db, Functor) -> +abolish_clauses(Db, {Collection, Functor}) -> + Ets = ets_db_storage:get_db(Collection), + {ok, _} = abolish_clauses(Ets, Functor), + {ok, Db}; +abolish_clauses(Db, {Functor}) -> case ets:lookup(Db, Functor) of [{_, built_in}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); @@ -77,16 +93,22 @@ abolish_clauses(Db, Functor) -> end, {ok, Db}. -findall(Db, Functor) -> +findall(Db, {Functor}) -> Params = tuple_to_list(Functor), Fun = hd(Params), Len = length(Params) - 1, case ets:lookup(Db, {Fun, Len}) of - [{_, _, _, Body}] -> {Body, Db}; + [{_, clauses, _, Body}] -> {Body, Db}; + [{_, code, Body}] -> {Body, Db}; + [{Body, built_in}] -> {Body, Db}; [] -> {[], Db} end. -get_procedure(Db, Functor) -> +get_procedure(Db, {Collection, Functor}) -> + Ets = ets_db_storage:get_db(Collection), + {ok, _} = get_procedure(Ets, Functor), + {ok, Db}; +get_procedure(Db, {Functor}) -> {case ets:lookup(Db, Functor) of [{_, built_in}] -> built_in; [{_, code, C}] -> {code, C}; @@ -94,7 +116,7 @@ get_procedure(Db, Functor) -> [] -> undefined end, Db}. -get_procedure_type(Db, Functor) -> +get_procedure_type(Db, {Functor}) -> {case ets:lookup(Db, Functor) of [{_, built_in}] -> built_in; %A built-in [{_, code, _C}] -> compiled; %Compiled (perhaps someday) diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 0c1ea34..f2ded84 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -40,9 +40,9 @@ %%%=================================================================== %%% API %%%=================================================================== -add_built_in(Database, Element) -> gen_server:call(Database, {add_built_in, Element}). +add_built_in(Database, Element) -> gen_server:call(Database, {add_built_in, {Element}}). -add_compiled_proc(Database, Proc) -> gen_server:call(Database, {add_compiled_proc, Proc}). +add_compiled_proc(Database, Proc) -> gen_server:call(Database, {add_compiled_proc, {Proc}}). assertz_clause(Database, {':-', Head, Body}) -> assertz_clause(Database, Head, Body); assertz_clause(Database, Head) -> assertz_clause(Database, Head, true). @@ -62,18 +62,18 @@ db_asserta_clause(Database, Collection, H) -> db_asserta_clause(Database, Collec db_asserta_clause(Database, Collection, Head, Body) -> gen_server:call(Database, {asserta_clause, {Collection, Head, Body}}). -finadll(Database, Fun) -> gen_server:call(Database, {findall, Fun}). +finadll(Database, Fun) -> gen_server:call(Database, {findall, {Fun}}). retract_clause(Database, F, Ct) -> gen_server:call(Database, {retract_clause, {F, Ct}}). db_retract_clause(Database, Collection, F, Ct) -> gen_server:call(Database, {retract_clause, {Collection, F, Ct}}). -abolish_clauses(Database, Func) -> gen_server:call(Database, {abolish_clauses, Func}). -db_abolish_clauses(Database, Collection, Func) -> gen_server:call(Database, {abolish_clauses, Collection, Func}). +abolish_clauses(Database, Func) -> gen_server:call(Database, {abolish_clauses, {Func}}). +db_abolish_clauses(Database, Collection, Func) -> gen_server:call(Database, {abolish_clauses, {Collection, Func}}). -get_procedure(Database, Func) -> gen_server:call(Database, {get_procedure, Func}). -get_db_procedure(Database, Collection, Func) -> gen_server:call(Database, {get_procedure, Collection, Func}). +get_procedure(Database, Func) -> gen_server:call(Database, {get_procedure, {Func}}). +get_db_procedure(Database, Collection, Func) -> gen_server:call(Database, {get_procedure, {Collection, Func}}). -get_procedure_type(Database, Func) -> gen_server:call(Database, {get_procedure_type, Func}). +get_procedure_type(Database, Func) -> gen_server:call(Database, {get_procedure_type, {Func}}). get_interp_functors(Database) -> gen_server:call(Database, get_interp_functors). diff --git a/src/storage/ets_db_storage.erl b/src/storage/ets_db_storage.erl new file mode 100644 index 0000000..f9002fd --- /dev/null +++ b/src/storage/ets_db_storage.erl @@ -0,0 +1,159 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% Default implementation of standalone database. For test purposes of +%%% operating facts with another db. It goes as an extencion of erlog_ets. +%%% @end +%%% Created : 22. Июль 2014 0:49 +%%%------------------------------------------------------------------- +-module(ets_db_storage). +-author("tihon"). + +-behaviour(gen_server). + +%% API +-export([start_link/0, get_db/1]). + +%% gen_server callbacks +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). + +-define(SERVER, ?MODULE). + +-record(state, +{ + ets = [] :: proplists:proplist() +}). + +%%%=================================================================== +%%% API +%%%=================================================================== +-spec get_db(atom()) -> ets. +get_db(Collection) -> gen_server:call(?MODULE, {get_db, Collection}). + +%%-------------------------------------------------------------------- +%% @doc +%% Starts the server +%% +%% @end +%%-------------------------------------------------------------------- +-spec(start_link() -> + {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). +start_link() -> + gen_server:start_link({local, ?SERVER}, ?MODULE, [], []). + +%%%=================================================================== +%%% gen_server callbacks +%%%=================================================================== + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Initializes the server +%% +%% @spec init(Args) -> {ok, State} | +%% {ok, State, Timeout} | +%% ignore | +%% {stop, Reason} +%% @end +%%-------------------------------------------------------------------- +-spec(init(Args :: term()) -> + {ok, State :: #state{}} | {ok, State :: #state{}, timeout() | hibernate} | + {stop, Reason :: term()} | ignore). +init([]) -> + {ok, #state{}}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Handling call messages +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_call(Request :: term(), From :: {pid(), Tag :: term()}, + State :: #state{}) -> + {reply, Reply :: term(), NewState :: #state{}} | + {reply, Reply :: term(), NewState :: #state{}, timeout() | hibernate} | + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | + {stop, Reason :: term(), NewState :: #state{}}). +handle_call({get_db, Collection}, _From, State = #state{ets = Dbs}) -> + case proplists:get_value(Collection, Dbs) of + undefined -> + Ets = ets:new(Collection, [public]), + {reply, Ets, State#state{ets = [{Collection, Ets} | Dbs]}}; + Ets -> {reply, Ets, State} + end; +handle_call(_Request, _From, State) -> + {reply, ok, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Handling cast messages +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_cast(Request :: term(), State :: #state{}) -> + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), NewState :: #state{}}). +handle_cast(_Request, State) -> + {noreply, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Handling all non call/cast messages +%% +%% @spec handle_info(Info, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} +%% @end +%%-------------------------------------------------------------------- +-spec(handle_info(Info :: timeout() | term(), State :: #state{}) -> + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), NewState :: #state{}}). +handle_info(_Info, State) -> + {noreply, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% This function is called by a gen_server when it is about to +%% terminate. It should be the opposite of Module:init/1 and do any +%% necessary cleaning up. When it returns, the gen_server terminates +%% with Reason. The return value is ignored. +%% +%% @spec terminate(Reason, State) -> void() +%% @end +%%-------------------------------------------------------------------- +-spec(terminate(Reason :: (normal | shutdown | {shutdown, term()} | term()), + State :: #state{}) -> term()). +terminate(_Reason, _State) -> + ok. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Convert process state when code is changed +%% +%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState} +%% @end +%%-------------------------------------------------------------------- +-spec(code_change(OldVsn :: term() | {down, term()}, State :: #state{}, + Extra :: term()) -> + {ok, NewState :: #state{}} | {error, Reason :: term()}). +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%%=================================================================== +%%% Internal functions +%%%=================================================================== From c11727ebe4fb0d5b22d309c3190456e16ba48d7b Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 22 Jul 2014 14:03:11 +0000 Subject: [PATCH 073/251] made retractall --- src/core/erlog_errors.erl | 2 +- src/core/logic/ec_goals.erl | 3 +++ src/core/logic/ec_unify.erl | 2 +- src/core/logic/erlog_core.erl | 47 +++++++++++++++++++++++++---------- 4 files changed, 39 insertions(+), 15 deletions(-) diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 9af0fa9..281840e 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -75,7 +75,7 @@ fail_clause(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> %% @private fail_retract(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> - erlog_core:retract_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + erlog_core:retract_clauses(Ch, Cb, Cs, fun erlog_core:retract/7, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Param) -> diff --git a/src/core/logic/ec_goals.erl b/src/core/logic/ec_goals.erl index 1032b11..ac04b37 100644 --- a/src/core/logic/ec_goals.erl +++ b/src/core/logic/ec_goals.erl @@ -95,6 +95,9 @@ prove_goal(Param = #param{goal = {asserta, C0}, next_goal = Next, bindings = Bs, prove_goal(Param = #param{goal = {retract, C0}, bindings = Bs}) -> C = ec_support:dderef(C0, Bs), erlog_core:prove_retract(C, Param); +prove_goal(Param = #param{goal = {retractall, C0}, bindings = Bs}) -> + C = ec_support:dderef(C0, Bs), + erlog_core:prove_retractall(C, Param); %% Clause retrieval and information prove_goal(Param = #param{goal = {clause, H0, B}, bindings = Bs}) -> H1 = ec_support:dderef(H0, Bs), diff --git a/src/core/logic/ec_unify.erl b/src/core/logic/ec_unify.erl index c61721c..d4b449c 100644 --- a/src/core/logic/ec_unify.erl +++ b/src/core/logic/ec_unify.erl @@ -12,7 +12,7 @@ -include("erlog_core.hrl"). %% API --export([unify/3, unify_clauses/4, unify_head/4]). +-export([unify/3, unify_clauses/4, unify_head/4, unify_clause/5]). %% unify(Term, Term, Bindings) -> {succeed,NewBindings} | fail. %% Unify two terms with a set of bindings. diff --git a/src/core/logic/erlog_core.erl b/src/core/logic/erlog_core.erl index 558ee2c..be91cb2 100644 --- a/src/core/logic/erlog_core.erl +++ b/src/core/logic/erlog_core.erl @@ -23,14 +23,14 @@ %% Main execution functions. -export([ - retract_clauses/4, prove_predicates/3, prove_goal_clauses/3, prove_retract/2, + prove_retractall/2, prove_clause/3, prove_current_predicate/2, prove_ecall/3, - prove_goal/4]). + prove_goal/4, retractall/7, retract/7, retract_clauses/5]). %% Adding to database. -export([load/1]). @@ -135,14 +135,20 @@ prove_goal_clause(G, {_Tag, H0, {B0, _}}, Param = #param{next_goal = Next, bindi %% void. %% Retract clauses in database matching Clause. prove_retract({':-', H, B}, Params) -> - prove_retract(H, B, Params); + prove_retract(H, B, fun retract/7, Params); prove_retract(H, Params) -> - prove_retract(H, true, Params). + prove_retract(H, true, fun retract/7, Params). -prove_retract(H, B, Params = #param{database = Db}) -> +prove_retractall({':-', H, B}, Params) -> + prove_retract(H, B, fun retractall/7, Params); +prove_retractall(H, Params) -> + prove_retract(H, true, fun retractall/7, Params). + +%% @private +prove_retract(H, B, Fun, Params = #param{database = Db}) -> Functor = ec_support:functor(H), case erlog_memory:get_procedure(Db, Functor) of - {clauses, Cs} -> retract_clauses(H, B, Cs, Params); + {clauses, Cs} -> retract_clauses(H, B, Cs, Fun, Params); {code, _} -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); built_in -> @@ -150,16 +156,31 @@ prove_retract(H, B, Params = #param{database = Db}) -> undefined -> erlog_errors:fail(Params) end. +%% @private +retract(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1) -> + erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), + Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, + ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). + +%% @private +retractall(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1) -> + erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), + Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, + case Cs of + [] -> + ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); + _ -> + retract_clauses(Ch, Cb, Cs, fun retractall/7, Param#param{choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}) + end. + %% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to retract Head and Body using Clauses which all have the same functor. -retract_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}) -> %TODO foreach vs handmade recursion? +retract_clauses(_Ch, _Cb, [], _, Param) -> erlog_errors:fail(Param); +retract_clauses(Ch, Cb, [C | Cs], Fun, Param = #param{bindings = Bs0, var_num = Vn0}) -> %TODO foreach vs handmade recursion? case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> %% We have found a right clause so now retract it. - erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), - Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, - ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); - fail -> retract_clauses(Ch, Cb, Cs, Param) - end; -retract_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param). \ No newline at end of file + Fun(Ch, Cb, C, Cs, Param, Bs1, Vn1); + fail -> retract_clauses(Ch, Cb, Cs, Fun, Param) + end. \ No newline at end of file From bd8bc456631190002381fd3a6b2e8381e57c2cca Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 22 Jul 2014 17:54:45 +0000 Subject: [PATCH 074/251] made db_retractall --- src/core/erlog_errors.erl | 6 ++-- src/core/logic/erlog_core.erl | 4 +-- src/libs/erlog_db.erl | 52 +++++++++++++++++++++++++++-------- src/storage/erlog_ets.erl | 20 +++++++------- 4 files changed, 56 insertions(+), 26 deletions(-) diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 281840e..efbecbd 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -51,6 +51,8 @@ fail(Param = #param{choice = [#cp{type = clause} = Cp | Cps]}) -> fail_clause(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = retract} = Cp | Cps]}) -> fail_retract(Cp, Param#param{choice = Cps}); +fail(Param = #param{choice = [#cp{type = db_retract} = Cp | Cps]}) -> + erlog_db:fail_retract(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = current_predicate} = Cp | Cps]}) -> fail_current_predicate(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = ecall} = Cp | Cps]}) -> @@ -74,8 +76,8 @@ fail_clause(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> ec_unify:unify_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private -fail_retract(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> - erlog_core:retract_clauses(Ch, Cb, Cs, fun erlog_core:retract/7, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). +fail_retract(#cp{data = {Ch, Cb, Cs, Fun}, next = Next, bs = Bs, vn = Vn}, Param) -> + erlog_core:retract_clauses(Ch, Cb, Cs, Fun, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Param) -> diff --git a/src/core/logic/erlog_core.erl b/src/core/logic/erlog_core.erl index be91cb2..a36bf9f 100644 --- a/src/core/logic/erlog_core.erl +++ b/src/core/logic/erlog_core.erl @@ -159,13 +159,13 @@ prove_retract(H, B, Fun, Params = #param{database = Db}) -> %% @private retract(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1) -> erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), - Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, + Cp = #cp{type = retract, data = {Ch, Cb, Cs, fun retract/7}, next = Next, bs = Bs0, vn = Vn0}, ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). %% @private retractall(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1) -> erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), - Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, + Cp = #cp{type = retract, data = {Ch, Cb, Cs, fun retractall/7}, next = Next, bs = Bs0, vn = Vn0}, case Cs of [] -> ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); diff --git a/src/libs/erlog_db.erl b/src/libs/erlog_db.erl index a8a94d6..b622671 100644 --- a/src/libs/erlog_db.erl +++ b/src/libs/erlog_db.erl @@ -13,7 +13,7 @@ -include("erlog_db.hrl"). %% API --export([load/1, db_assert_2/2, db_asserta_2/2, db_abolish_2/2, db_retract_2/2]). +-export([load/1, db_assert_2/2, db_asserta_2/2, db_abolish_2/2, db_retract_2/2, db_retractall_2/2, fail_retract/2]). load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_DB). @@ -40,28 +40,56 @@ db_retract_2({db_retract, Table, Fact}, Params = #param{bindings = Bs}) -> C = ec_support:dderef(Fact, Bs), prove_retract(C, Table, Params). +db_retractall_2({db_retractall, Table, Fact}, Params = #param{bindings = Bs}) -> + C = ec_support:dderef(Fact, Bs), + prove_retractall(C, Table, Params). + + prove_retract({':-', H, B}, Table, Params) -> - prove_retract(H, B, Table, Params); + prove_retract(H, B, Table, fun retract/8, Params); prove_retract(H, Table, Params) -> - prove_retract(H, true, Table, Params). + prove_retract(H, true, Table, fun retract/8, Params). -prove_retract(H, B, Table, Params = #param{database = Db}) -> +prove_retractall({':-', H, B}, Table, Params) -> + prove_retract(H, B, Table, fun retractall/8, Params); +prove_retractall(H, Table, Params) -> + prove_retract(H, true, Table, fun retractall/8, Params). + +prove_retract(H, B, Table, Fun, Params = #param{database = Db}) -> Functor = ec_support:functor(H), case erlog_memory:get_db_procedure(Db, Table, Functor) of - {clauses, Cs} -> retract_clauses(H, B, Cs, Params, Table); + {clauses, Cs} -> retract_clauses(H, B, Cs, Fun, Params, Table); undefined -> erlog_errors:fail(Params) end. +%% @private +retract(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1, Table) -> + erlog_memory:db_retract_clause(Db, Table, ec_support:functor(Ch), element(1, C)), + Cp = #cp{type = db_retract, data = {Ch, Cb, Cs, fun retract/8, Table}, next = Next, bs = Bs0, vn = Vn0}, + ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). + +%% @private +retractall(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1, Table) -> + erlog_memory:db_retract_clause(Db, Table, ec_support:functor(Ch), element(1, C)), + Cp = #cp{type = db_retract, data = {Ch, Cb, Cs, fun retractall/8, Table}, next = Next, bs = Bs0, vn = Vn0}, + case Cs of + [] -> + ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); + _ -> + retract_clauses(Ch, Cb, Cs, fun retractall/8, Param#param{choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}, Table) + end. + %% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to retract Head and Body using Clauses which all have the same functor. -retract_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Collection) -> %TODO foreach vs handmade recursion? +retract_clauses(_Ch, _Cb, [], _, Param, _) -> erlog_errors:fail(Param); +retract_clauses(Ch, Cb, [C | Cs], Fun, Param = #param{bindings = Bs0, var_num = Vn0}, Table) -> %TODO foreach vs handmade recursion? case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> %% We have found a right clause so now retract it. - erlog_memory:db_retract_clause(Db, Collection, ec_support:functor(Ch), element(1, C)), - Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, - ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); - fail -> retract_clauses(Ch, Cb, Cs, Param, Collection) - end; -retract_clauses(_Ch, _Cb, [], Param, _) -> erlog_errors:fail(Param). \ No newline at end of file + Fun(Ch, Cb, C, Cs, Param, Bs1, Vn1, Table); + fail -> retract_clauses(Ch, Cb, Cs, Fun, Param, Table) + end. + +fail_retract(#cp{data = {Ch, Cb, Cs, Fun, Table}, next = Next, bs = Bs, vn = Vn}, Param) -> + retract_clauses(Ch, Cb, Cs, Fun, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}, Table). \ No newline at end of file diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 5328203..fae047d 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -43,8 +43,8 @@ add_compiled_proc(Db, {{Functor, M, F}}) -> assertz_clause(Db, {Collection, Head, Body0}) -> Ets = ets_db_storage:get_db(Collection), - {ok, _} = assertz_clause(Ets, {Head, Body0}), - {ok, Db}; + {Res, _} = assertz_clause(Ets, {Head, Body0}), + {Res, Db}; assertz_clause(Db, {Head, Body0}) -> clause(Head, Body0, Db, fun(Functor, Tag, Cs, Body) -> @@ -54,8 +54,8 @@ assertz_clause(Db, {Head, Body0}) -> asserta_clause(Db, {Collection, Head, Body0}) -> Ets = ets_db_storage:get_db(Collection), - {ok, _} = asserta_clause(Ets, {Head, Body0}), - {ok, Db}; + {Res, _} = asserta_clause(Ets, {Head, Body0}), + {Res, Db}; asserta_clause(Db, {Head, Body0}) -> clause(Head, Body0, Db, fun(Functor, Tag, Cs, Body) -> @@ -65,8 +65,8 @@ asserta_clause(Db, {Head, Body0}) -> retract_clause(Db, {Collection, Functor, Ct}) -> Ets = ets_db_storage:get_db(Collection), - {ok, _} = retract_clause(Ets, {Functor, Ct}), - {ok, Db}; + {Res, _} = retract_clause(Ets, {Functor, Ct}), + {Res, Db}; retract_clause(Db, {Functor, Ct}) -> case ets:lookup(Db, Functor) of [{_, built_in}] -> @@ -81,8 +81,8 @@ retract_clause(Db, {Functor, Ct}) -> abolish_clauses(Db, {Collection, Functor}) -> Ets = ets_db_storage:get_db(Collection), - {ok, _} = abolish_clauses(Ets, Functor), - {ok, Db}; + {Res, _} = abolish_clauses(Ets, {Functor}), + {Res, Db}; abolish_clauses(Db, {Functor}) -> case ets:lookup(Db, Functor) of [{_, built_in}] -> @@ -106,8 +106,8 @@ findall(Db, {Functor}) -> get_procedure(Db, {Collection, Functor}) -> Ets = ets_db_storage:get_db(Collection), - {ok, _} = get_procedure(Ets, Functor), - {ok, Db}; + {Res, _} = get_procedure(Ets, {Functor}), + {Res, Db}; get_procedure(Db, {Functor}) -> {case ets:lookup(Db, Functor) of [{_, built_in}] -> built_in; From 7f45708c44ab66f5259ba16545737eb32e1416e0 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 22 Jul 2014 18:07:16 +0000 Subject: [PATCH 075/251] change data format --- include/erlog_time.hrl | 4 ++++ src/libs/erlog_time.erl | 9 +++++---- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/include/erlog_time.hrl b/include/erlog_time.hrl index 4f7f802..7c34cbb 100644 --- a/include/erlog_time.hrl +++ b/include/erlog_time.hrl @@ -8,6 +8,10 @@ %%%------------------------------------------------------------------- -author("tihon"). +-define(MONTHS, {"Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", + "Aug", "Sep", "Oct", "Nov", "Dec"}). +-define(MONTH(X), element(X, ?MONTHS)). + -define(ERLOG_TIME, [ {{localtime, 1}, ?MODULE, localtime_1}, diff --git a/src/libs/erlog_time.erl b/src/libs/erlog_time.erl index 55747a9..0fe38af 100644 --- a/src/libs/erlog_time.erl +++ b/src/libs/erlog_time.erl @@ -67,7 +67,7 @@ add_time_4({add_time, Time1, Type, T2, Res}, Params = #param{next_goal = Next, b %% Converts timestamp to human readable format dateprint_2({date_print, TS1, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> {{Year, Month, Day}, {Hour, Minute, Second}} = date_to_data(ts_to_date(check_var(TS1, Bs0))), - DateStr = lists:flatten(io_lib:format("~2w ~2..0w ~4w ~2w:~2..0w:~2..0w", [Day, Month, Year, Hour, Minute, Second])), + DateStr = lists:flatten(io_lib:format("~s ~2w ~4w ~2w:~2..0w:~2..0w", [?MONTH(Month), Day, Year, Hour, Minute, Second])), Bs = ec_support:add_binding(Res, DateStr, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). @@ -94,11 +94,12 @@ date_to_seconds(Time, minute) -> Time * 60; date_to_seconds(Time, sec) -> Time. %% @private -%% Converts string date representation to timestamp. Format DD MM YYYY hh:mm:ss +%% Converts string date representation to timestamp. Format MM DD YYYY hh:mm:ss -spec date_string_to_data(string()) -> tuple(). date_string_to_data(DataStr) -> - [DStr, MStr, YStr, HStr, MnStr, SStr] = string:tokens(DataStr, " :"), - {{list_to_integer(YStr), list_to_integer(MStr), list_to_integer(DStr)}, + [MStr, DStr, YStr, HStr, MnStr, SStr] = string:tokens(DataStr, " :"), + Month = ec_support:index_of(MStr, tuple_to_list(?MONTHS)), + {{list_to_integer(YStr), Month, list_to_integer(DStr)}, {list_to_integer(HStr), list_to_integer(MnStr), list_to_integer(SStr)}}. %% @private From 33d637de8bdd0879ff9b84d8054b238e9fe26654 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 22 Jul 2014 18:14:39 +0000 Subject: [PATCH 076/251] updated readme --- README.md | 18 +++++++++++++++++- src/libs/{ => external}/erlog_db.erl | 0 src/libs/{ => standard}/erlog_bips.erl | 0 src/libs/{ => standard}/erlog_dcg.erl | 0 src/libs/{ => standard}/erlog_lists.erl | 0 src/libs/{ => standard}/erlog_time.erl | 0 6 files changed, 17 insertions(+), 1 deletion(-) rename src/libs/{ => external}/erlog_db.erl (100%) rename src/libs/{ => standard}/erlog_bips.erl (100%) rename src/libs/{ => standard}/erlog_dcg.erl (100%) rename src/libs/{ => standard}/erlog_lists.erl (100%) rename src/libs/{ => standard}/erlog_time.erl (100%) diff --git a/README.md b/README.md index c859fcb..533f1fd 100644 --- a/README.md +++ b/README.md @@ -93,4 +93,20 @@ See `erlog_simple_printer` as a default implementation of console printer as an To configure your gen_event module - just pass module and arguments as __event_h__ in configuration: ConfList = [{event_h, {my_event_handler, Args}], - erlog:start_link(ConfList). \ No newline at end of file + erlog:start_link(ConfList). + +#### Working with libraries: +Erlog is implemented in erlang modules, called libraries. They can be standard and external. +All predicates from standard functions are loaded to memory when you start erlog core. +But to use predicates from external functions - you should manually load them to memory with the help of `use/1` command: + + | ?- db_assert(test,foo(a,b)). + false + | ?- use(erlog_db). + true + | ?- db_assert(test,foo(a,b)). + true +This example demonstrates the loading of external database library. +First call is false, because there is no such function loaded to memory. +Second - library is loaded. +Third - function run successfully. \ No newline at end of file diff --git a/src/libs/erlog_db.erl b/src/libs/external/erlog_db.erl similarity index 100% rename from src/libs/erlog_db.erl rename to src/libs/external/erlog_db.erl diff --git a/src/libs/erlog_bips.erl b/src/libs/standard/erlog_bips.erl similarity index 100% rename from src/libs/erlog_bips.erl rename to src/libs/standard/erlog_bips.erl diff --git a/src/libs/erlog_dcg.erl b/src/libs/standard/erlog_dcg.erl similarity index 100% rename from src/libs/erlog_dcg.erl rename to src/libs/standard/erlog_dcg.erl diff --git a/src/libs/erlog_lists.erl b/src/libs/standard/erlog_lists.erl similarity index 100% rename from src/libs/erlog_lists.erl rename to src/libs/standard/erlog_lists.erl diff --git a/src/libs/erlog_time.erl b/src/libs/standard/erlog_time.erl similarity index 100% rename from src/libs/erlog_time.erl rename to src/libs/standard/erlog_time.erl From 81e1355b63cb17cea2f49a79bcec26cc9a8566f3 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 23 Jul 2014 21:40:20 +0000 Subject: [PATCH 077/251] take findall from @rviding develop branch --- include/erlog_core.hrl | 1 - src/core/erlog_errors.erl | 13 +++++++++++- src/core/logic/ec_goals.erl | 18 ++++++---------- src/core/logic/erlog_core.erl | 40 +++++++++++++++++++++++++++++++++-- src/storage/erlog_dict.erl | 18 +++++++++++++++- src/storage/erlog_ets.erl | 26 ++++++++++++++++++++++- src/storage/erlog_memory.erl | 10 ++++++++- src/storage/erlog_storage.erl | 10 ++++++++- 8 files changed, 117 insertions(+), 19 deletions(-) diff --git a/include/erlog_core.hrl b/include/erlog_core.hrl index e2a5c82..8de2532 100644 --- a/include/erlog_core.hrl +++ b/include/erlog_core.hrl @@ -17,7 +17,6 @@ %% Purpose : Basic interpreter of a Prolog definitions. %% Some standard type macros. - -define(IS_ATOMIC(T), (not (is_tuple(T) orelse (is_list(T) andalso T /= [])))). -define(IS_FUNCTOR(T), (is_tuple(T) andalso (tuple_size(T) >= 2) andalso is_atom(element(1, T)))). diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index efbecbd..ffec997 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -49,6 +49,8 @@ fail(Param = #param{choice = [#cp{type = Type} = Cp | Cps]}) when Type == disjun fail_disjunction(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = clause} = Cp | Cps]}) -> fail_clause(Cp, Param#param{choice = Cps}); +fail(Param = #param{choice = [#cp{type = findall} = Cp | Cps]}) -> + fail_findall(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = retract} = Cp | Cps]}) -> fail_retract(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = db_retract} = Cp | Cps]}) -> @@ -85,4 +87,13 @@ fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Para %% @private fail_goal_clauses(#cp{data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> - erlog_core:prove_goal_clauses(G, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). \ No newline at end of file + erlog_core:prove_goal_clauses(G, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + +fail_findall(#cp{next = Next, data = {Tag, Bag}, bs = Bs, vn = Vn0}, Param = #param{database = Db}) -> + Data = erlog_memory:raw_fetch(Db, Tag), + erlog_memory:raw_erase(Db, Tag), %Clear special entry + {Bs1, Vn1} = lists:mapfoldl(fun(B0, V0) -> %Create proper instances + {B1, _, V1} = ec_term:term_instance(ec_support:dderef(B0, Bs), V0), + {B1, V1} + end, Vn0, lists:reverse(Data)), + ec_body:unify_prove_body(Bag, Bs1, Param#param{next_goal = Next, var_num = Vn1}). \ No newline at end of file diff --git a/src/core/logic/ec_goals.erl b/src/core/logic/ec_goals.erl index ac04b37..53d8aea 100644 --- a/src/core/logic/ec_goals.erl +++ b/src/core/logic/ec_goals.erl @@ -12,7 +12,7 @@ -include("erlog_core.hrl"). %% API --export([prove_goal/1, initial_goal/1]). +-export([prove_goal/1, initial_goal/1, check_goal/6]). %% prove_goal(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> %% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase} | @@ -159,16 +159,12 @@ prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db erlog_errors:erlog_error(Error, Db) end, ec_body:prove_body(Param#param{goal = Next}); -prove_goal(Param = #param{goal = {findall, Goal, Fun, Res}, bindings = Bs0, next_goal = Next, database = Db}) -> - Predicates = erlog_memory:finadll(Db, Fun), %TODO findall(A, (append(L, [B|L2], [1,2,3,4,5]), A is B * 10), R) - Element = ec_support:index_of(Goal, tuple_to_list(Fun)) - 1, - Result = lists:foldr( - fun({_, Pred, _}, Acc) -> - [_ | ParamList] = tuple_to_list(Pred), - [lists:nth(Element, ParamList) | Acc] - end, [], Predicates), - Bs1 = ec_support:add_binding(Res, Result, Bs0), - ec_body:prove_body(Param#param{goal = Next, bindings = Bs1}); +prove_goal(Param = #param{goal = {findall, T, G, B}}) -> + erlog_core:prove_findall(T, G, B, Param); +prove_goal(Param = #param{goal = {{findall}, Tag, T0}, bindings = Bs, database = Db}) -> + T1 = ec_support:dderef(T0, Bs), + erlog_memory:raw_append(Db, Tag, T1), %Append to saved list + erlog_errors:fail(Param); prove_goal(Param = #param{goal = {bagof, Goal, Fun, Res}, choice = Cs0, bindings = Bs0, next_goal = Next, var_num = Vn, database = Db}) -> Predicates = erlog_memory:finadll(Db, Fun), FunList = tuple_to_list(Fun), diff --git a/src/core/logic/erlog_core.erl b/src/core/logic/erlog_core.erl index a36bf9f..3fb5713 100644 --- a/src/core/logic/erlog_core.erl +++ b/src/core/logic/erlog_core.erl @@ -30,7 +30,7 @@ prove_clause/3, prove_current_predicate/2, prove_ecall/3, - prove_goal/4, retractall/7, retract/7, retract_clauses/5]). + prove_goal/4, retractall/7, retract/7, retract_clauses/5, prove_findall/4]). %% Adding to database. -export([load/1]). @@ -55,6 +55,29 @@ prove_goal(Goal0, Db, Fcon, Event) -> event_man = Event, database = Db, f_consulter = Fcon}, ec_body:prove_body(Params). %TODO use lists:foldr instead! +%% prove_findall(Term, Goal, Bag, Param) +%% Do findall on Goal and return list of each Term in Bag. We are +%% sneaky here and use the database to keep the list using the +%% current VarNum as tag. This is done in the internal goal +%% {findall}. Then when findall finally fails which catch it in +%% fail_findall which cleans up by removing special database entry +%% and unifying Bag. +prove_findall(T, G, B0, Param = #param{bindings = Bs, choice = Cps, next_goal = Next, var_num = Vn, database = Db}) -> + Label = Vn, + Tag = Vn + 1, %Increment to avoid clashes + {Next1, _} = ec_goals:check_goal(G, [{{findall}, Tag, T}], Bs, Db, false, Label), + B1 = partial_list(B0, Bs), + Cp = #cp{type = findall, data = {Tag, B1}, next = Next, bs = Bs, vn = Vn}, + erlog_memory:raw_store(Db, Tag, []), %Initialise collection + %% Catch case where an erlog error occurs when cleanup database. + try + ec_body:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], bindings = Bs, var_num = Vn + 1}) + catch + throw:{erlog_error, E, Dba} -> + Dbb = erlog_memory:raw_erase(Dba, Tag), %Clear special entry + erlog_errors:erlog_error(E, Dbb) + end. + %% prove_ecall(Generator, Value, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Call an external (Erlang) generator and handle return value, either @@ -183,4 +206,17 @@ retract_clauses(Ch, Cb, [C | Cs], Fun, Param = #param{bindings = Bs0, var_num = %% We have found a right clause so now retract it. Fun(Ch, Cb, C, Cs, Param, Bs1, Vn1); fail -> retract_clauses(Ch, Cb, Cs, Fun, Param) - end. \ No newline at end of file + end. + +%% partial_list(Term, Bindings) -> Term. +%% Dereference all variables and check if partial list. +partial_list([], _) -> []; +partial_list([H | T0], Bs) -> + T1 = partial_list(T0, Bs), + [H | T1]; +partial_list({V} = Var, Bs) -> + case ?BIND:find(V, Bs) of + {ok, T} -> partial_list(T, Bs); + error -> Var + end; +partial_list(Other, _) -> erlog_errors:type_error(list, Other). \ No newline at end of file diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 465283a..2568271 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -22,7 +22,11 @@ get_procedure/2, get_procedure_type/2, get_interp_functors/1, - findall/2]). + findall/2, %TODO remove me + raw_store/2, + raw_fetch/2, + raw_append/2, + raw_erase/2]). %% API -export([]). @@ -110,3 +114,15 @@ clause(Head, Body0, Db, ClauseFun) -> findall(State, {Functor}) -> %TODO implement me! erlang:error(not_implemented). + +raw_store(State, {Key, Value}) -> + erlang:error(not_implemented). + +raw_fetch(State, {Key}) -> + erlang:error(not_implemented). + +raw_append(State, {Key, Value}) -> + erlang:error(not_implemented). + +raw_erase(State, {Key}) -> + erlang:error(not_implemented). diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index fae047d..024cce4 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -22,7 +22,11 @@ get_procedure/2, get_procedure_type/2, get_interp_functors/1, - findall/2]). + findall/2, %TODO remove me + raw_store/2, + raw_fetch/2, + raw_append/2, + raw_erase/2]). new() -> {ok, ets:new(eets, [])}. @@ -141,3 +145,23 @@ clause(Head, Body0, Db, ClauseFun) -> [{_, clauses, Tag, Cs}] -> ClauseFun(Functor, Tag, Cs, Body); [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) end. + +raw_store(Db, {Key, Value}) -> + ets:insert(Db, {Key, Value}), + {ok, Db}. + +raw_fetch(Db, {Key}) -> + Res = case ets:lookup(Db, Key) of + [] -> []; + [{_, Value}] -> Value + end, + {Res, Db}. + +raw_append(Db, {Key, AppendValue}) -> + {Value, _} = raw_fetch(Db, {Key}), + raw_store(Db, {Key, [AppendValue | Value]}), + {ok, Db}. + +raw_erase(Db, {Key}) -> + ets:delete(Db, Key), + {ok, Db}. \ No newline at end of file diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index f2ded84..2c2c74c 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -14,7 +14,7 @@ %% API -export([start_link/1, start_link/2, add_compiled_proc/2, assertz_clause/3, asserta_clause/3, retract_clause/3, abolish_clauses/2, get_procedure/2, get_procedure_type/2, - get_interp_functors/1, assertz_clause/2, asserta_clause/2, finadll/2]). + get_interp_functors/1, assertz_clause/2, asserta_clause/2, finadll/2, raw_store/3, raw_fetch/2, raw_append/3, raw_erase/2]). -export([db_assertz_clause/3, db_assertz_clause/4, db_asserta_clause/4, db_asserta_clause/3, db_retract_clause/4, db_abolish_clauses/3, get_db_procedure/3]). @@ -77,6 +77,14 @@ get_procedure_type(Database, Func) -> gen_server:call(Database, {get_procedure_t get_interp_functors(Database) -> gen_server:call(Database, get_interp_functors). +raw_store(Database, Key, Value) -> gen_server:call(Database, {raw_store, {Key, Value}}). + +raw_fetch(Database, Key) -> gen_server:call(Database, {raw_fetch, {Key}}). + +raw_append(Database, Key, Value) -> gen_server:call(Database, {raw_append, {Key, Value}}). + +raw_erase(Database, Key) -> gen_server:call(Database, {raw_erase, {Key}}). + %%-------------------------------------------------------------------- %% @doc %% Starts the server diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl index 04889cc..71c6855 100644 --- a/src/storage/erlog_storage.erl +++ b/src/storage/erlog_storage.erl @@ -31,4 +31,12 @@ -callback get_procedure_type(State :: term(), Func :: term()) -> {atom(), NewState :: term()}. --callback get_interp_functors(State :: term()) -> {list(), NewState :: term()}. \ No newline at end of file +-callback get_interp_functors(State :: term()) -> {list(), NewState :: term()}. + +-callback raw_store(State :: term(), Param :: tuple()) -> {ok, NewState :: term()}. + +-callback raw_fetch(State :: term(), Param :: tuple()) -> {Value :: any(), NewState :: term()}. + +-callback raw_append(State :: term(), Param :: tuple()) -> {ok, NewState :: term()}. + +-callback raw_erase(State :: term(), Param :: tuple()) -> {ok, NewState :: term()}. \ No newline at end of file From 54299349056ee0cf3e5b3bdca2ff5898e07b0617 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 24 Jul 2014 02:34:15 +0000 Subject: [PATCH 078/251] made db_call --- include/erlog_db.hrl | 3 ++- src/core/logic/ec_goals.erl | 4 ++-- src/libs/external/erlog_db.erl | 19 ++++++++++++++++++- src/storage/erlog_ets.erl | 7 +++++++ src/storage/erlog_memory.erl | 3 ++- 5 files changed, 31 insertions(+), 5 deletions(-) diff --git a/include/erlog_db.hrl b/include/erlog_db.hrl index 6c8c1ae..d938849 100644 --- a/include/erlog_db.hrl +++ b/include/erlog_db.hrl @@ -15,6 +15,7 @@ {{db_asserta, 2}, ?MODULE, db_asserta_2}, {{db_assertz, 2}, ?MODULE, db_assert_2}, {{db_retract, 2}, ?MODULE, db_retract_2}, - {{db_retractall, 2}, ?MODULE, db_retractall_2} + {{db_retractall, 2}, ?MODULE, db_retractall_2}, + {{db_call, 2}, ?MODULE, db_call_2} ] ). \ No newline at end of file diff --git a/src/core/logic/ec_goals.erl b/src/core/logic/ec_goals.erl index 53d8aea..2357d4b 100644 --- a/src/core/logic/ec_goals.erl +++ b/src/core/logic/ec_goals.erl @@ -25,14 +25,14 @@ %% Logic and control. Conjunctions are handled in prove_body and true %% has been compiled away. prove_goal(Param = #param{goal = {call, G}, next_goal = Next0, choice = Cps, - bindings = Bs, var_num = Vn, database = Db}) -> %TODO move me to other modules + bindings = Bs, var_num = Vn, database = Db}) -> %% Only add cut CP to Cps if goal contains a cut. Label = Vn, case check_goal(G, Next0, Bs, Db, false, Label) of {Next1, true} -> %% Must increment Vn to avoid clashes!!! Cut = #cut{label = Label}, - ec_body:prove_body(Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); %TODO recursive call! Use foldr instead + ec_body:prove_body(Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); {Next1, false} -> ec_body:prove_body(Param#param{goal = Next1, var_num = Vn + 1}) end; prove_goal(Param = #param{goal = {{cut}, Label, Last}}) -> diff --git a/src/libs/external/erlog_db.erl b/src/libs/external/erlog_db.erl index b622671..bd49edf 100644 --- a/src/libs/external/erlog_db.erl +++ b/src/libs/external/erlog_db.erl @@ -13,11 +13,28 @@ -include("erlog_db.hrl"). %% API --export([load/1, db_assert_2/2, db_asserta_2/2, db_abolish_2/2, db_retract_2/2, db_retractall_2/2, fail_retract/2]). +-export([load/1, db_assert_2/2, db_asserta_2/2, db_abolish_2/2, db_retract_2/2, db_retractall_2/2, fail_retract/2, db_call_2/2]). load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_DB). +db_call_2({db_call, Table, Goal}, Param = #param{next_goal = Next0, bindings = Bs, choice = Cps, database = Db, var_num = Vn}) -> +%% Only add cut CP to Cps if goal contains a cut. + Label = Vn, + case erlog_memory:db_findall(Db, Table, Goal) of + [] -> ec_body:prove_body(Param#param{goal = Next0, var_num = Vn + 1}); + Goal1 -> + ec_goals:prove_goal(Param#param{goal = {assert, Goal1}}), %load fact to memory + Res = case ec_goals:check_goal(Goal, Next0, Bs, Db, false, Label) of + {Next1, true} -> + Cut = #cut{label = Label}, + ec_body:prove_body(Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); + {Next1, false} ->ec_body:prove_body(Param#param{goal = Next1, var_num = Vn + 1}) + end, + ec_goals:prove_goal(Param#param{goal = {retract, Goal1}}), %unload fact from memory + Res + end. + db_assert_2({db_assert, Table, Fact}, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> C = ec_support:dderef(Fact, Bs), erlog_memory:db_assertz_clause(Db, Table, C), diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 024cce4..23cc608 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -97,6 +97,13 @@ abolish_clauses(Db, {Functor}) -> end, {ok, Db}. +findall(Db, {Collection, Functor}) -> + Ets = ets_db_storage:get_db(Collection), + Res = case findall(Ets, {Functor}) of + {[], _} -> []; + {[{_, Result, _}], _} -> Result + end, + {Res, Db}; findall(Db, {Functor}) -> Params = tuple_to_list(Functor), Fun = hd(Params), diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 2c2c74c..e9e285d 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -14,7 +14,7 @@ %% API -export([start_link/1, start_link/2, add_compiled_proc/2, assertz_clause/3, asserta_clause/3, retract_clause/3, abolish_clauses/2, get_procedure/2, get_procedure_type/2, - get_interp_functors/1, assertz_clause/2, asserta_clause/2, finadll/2, raw_store/3, raw_fetch/2, raw_append/3, raw_erase/2]). + get_interp_functors/1, assertz_clause/2, asserta_clause/2, finadll/2, raw_store/3, raw_fetch/2, raw_append/3, raw_erase/2, db_findall/3]). -export([db_assertz_clause/3, db_assertz_clause/4, db_asserta_clause/4, db_asserta_clause/3, db_retract_clause/4, db_abolish_clauses/3, get_db_procedure/3]). @@ -62,6 +62,7 @@ db_asserta_clause(Database, Collection, H) -> db_asserta_clause(Database, Collec db_asserta_clause(Database, Collection, Head, Body) -> gen_server:call(Database, {asserta_clause, {Collection, Head, Body}}). +db_findall(Database, Collection, Fun) -> gen_server:call(Database, {findall, {Collection, Fun}}). finadll(Database, Fun) -> gen_server:call(Database, {findall, {Fun}}). retract_clause(Database, F, Ct) -> gen_server:call(Database, {retract_clause, {F, Ct}}). From 75a9bbf8d83491cde6fa5ed71fb4cfa05789833d Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 24 Jul 2014 15:31:45 +0000 Subject: [PATCH 079/251] changed db_call --- src/core/logic/ec_unify.erl | 1 - src/libs/external/erlog_db.erl | 12 +----------- src/storage/erlog_ets.erl | 5 +---- 3 files changed, 2 insertions(+), 16 deletions(-) diff --git a/src/core/logic/ec_unify.erl b/src/core/logic/ec_unify.erl index d4b449c..7bf49bd 100644 --- a/src/core/logic/ec_unify.erl +++ b/src/core/logic/ec_unify.erl @@ -70,7 +70,6 @@ unify_clause(Ch, Cb, {_Tag, H0, {B0, _}}, Bs0, Vn0) -> %% Unify a goal with a head without creating an instance of the %% head. This saves us creating many variables which are local to the %% clause and saves many variable bindings. - unify_head(Goal, Head, Bs, Vn) -> unify_head(ec_support:deref(Goal, Bs), Head, orddict:new(), Bs, Vn). diff --git a/src/libs/external/erlog_db.erl b/src/libs/external/erlog_db.erl index bd49edf..92393f1 100644 --- a/src/libs/external/erlog_db.erl +++ b/src/libs/external/erlog_db.erl @@ -20,19 +20,9 @@ load(Db) -> db_call_2({db_call, Table, Goal}, Param = #param{next_goal = Next0, bindings = Bs, choice = Cps, database = Db, var_num = Vn}) -> %% Only add cut CP to Cps if goal contains a cut. - Label = Vn, case erlog_memory:db_findall(Db, Table, Goal) of [] -> ec_body:prove_body(Param#param{goal = Next0, var_num = Vn + 1}); - Goal1 -> - ec_goals:prove_goal(Param#param{goal = {assert, Goal1}}), %load fact to memory - Res = case ec_goals:check_goal(Goal, Next0, Bs, Db, false, Label) of - {Next1, true} -> - Cut = #cut{label = Label}, - ec_body:prove_body(Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); - {Next1, false} ->ec_body:prove_body(Param#param{goal = Next1, var_num = Vn + 1}) - end, - ec_goals:prove_goal(Param#param{goal = {retract, Goal1}}), %unload fact from memory - Res + Cs -> erlog_core:prove_goal_clauses(Goal, Cs, Param) end. db_assert_2({db_assert, Table, Fact}, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 23cc608..f07288c 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -99,10 +99,7 @@ abolish_clauses(Db, {Functor}) -> findall(Db, {Collection, Functor}) -> Ets = ets_db_storage:get_db(Collection), - Res = case findall(Ets, {Functor}) of - {[], _} -> []; - {[{_, Result, _}], _} -> Result - end, + {Res, _} = findall(Ets, {Functor}), {Res, Db}; findall(Db, {Functor}) -> Params = tuple_to_list(Functor), From 19aa72c2ab19d018363199030fb10a38623522e4 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 24 Jul 2014 17:40:40 +0000 Subject: [PATCH 080/251] got rid of reverse in raw fetch -> move it to custom implementation --- src/core/erlog_errors.erl | 2 +- src/storage/erlog_ets.erl | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index ffec997..2b29077 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -95,5 +95,5 @@ fail_findall(#cp{next = Next, data = {Tag, Bag}, bs = Bs, vn = Vn0}, Param = #pa {Bs1, Vn1} = lists:mapfoldl(fun(B0, V0) -> %Create proper instances {B1, _, V1} = ec_term:term_instance(ec_support:dderef(B0, Bs), V0), {B1, V1} - end, Vn0, lists:reverse(Data)), + end, Vn0, Data), ec_body:unify_prove_body(Bag, Bs1, Param#param{next_goal = Next, var_num = Vn1}). \ No newline at end of file diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index f07288c..6df1232 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -163,7 +163,7 @@ raw_fetch(Db, {Key}) -> raw_append(Db, {Key, AppendValue}) -> {Value, _} = raw_fetch(Db, {Key}), - raw_store(Db, {Key, [AppendValue | Value]}), + raw_store(Db, {Key, lists:concat([Value, AppendValue])}), {ok, Db}. raw_erase(Db, {Key}) -> From b43734529ebd705aa640c7c05f059f4d8bc4a666 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 24 Jul 2014 21:02:52 +0000 Subject: [PATCH 081/251] fix concatination in case of string results --- include/erlog_currency.hrl | 15 ++ src/libs/external/currency/erlog_curr_sup.erl | 76 +++++++++ .../external/currency/erlog_curr_sync.erl | 146 ++++++++++++++++++ src/libs/external/currency/erlog_currency.erl | 13 ++ src/libs/external/{ => db}/erlog_db.erl | 0 .../external/db}/ets_db_storage.erl | 0 src/storage/erlog_ets.erl | 2 +- 7 files changed, 251 insertions(+), 1 deletion(-) create mode 100644 include/erlog_currency.hrl create mode 100644 src/libs/external/currency/erlog_curr_sup.erl create mode 100644 src/libs/external/currency/erlog_curr_sync.erl create mode 100644 src/libs/external/currency/erlog_currency.erl rename src/libs/external/{ => db}/erlog_db.erl (100%) rename src/{storage => libs/external/db}/ets_db_storage.erl (100%) diff --git a/include/erlog_currency.hrl b/include/erlog_currency.hrl new file mode 100644 index 0000000..adebcfb --- /dev/null +++ b/include/erlog_currency.hrl @@ -0,0 +1,15 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 24. Июль 2014 20:06 +%%%------------------------------------------------------------------- +-author("tihon"). + +-define(ERLOG_CURRENCY, + [ + {{db_abolish, 2}, ?MODULE, db_abolish_2} + ] +). \ No newline at end of file diff --git a/src/libs/external/currency/erlog_curr_sup.erl b/src/libs/external/currency/erlog_curr_sup.erl new file mode 100644 index 0000000..3524019 --- /dev/null +++ b/src/libs/external/currency/erlog_curr_sup.erl @@ -0,0 +1,76 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 24. Июль 2014 20:10 +%%%------------------------------------------------------------------- +-module(erlog_curr_sup). +-author("tihon"). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). + +%% Supervisor callbacks +-export([init/1]). + +-define(SERVER, ?MODULE). + +%%%=================================================================== +%%% API functions +%%%=================================================================== + +%%-------------------------------------------------------------------- +%% @doc +%% Starts the supervisor +%% +%% @end +%%-------------------------------------------------------------------- +-spec(start_link() -> + {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). +start_link() -> + supervisor:start_link({local, ?SERVER}, ?MODULE, []). + +%%%=================================================================== +%%% Supervisor callbacks +%%%=================================================================== + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Whenever a supervisor is started using supervisor:start_link/[2,3], +%% this function is called by the new process to find out about +%% restart strategy, maximum restart frequency and child +%% specifications. +%% +%% @end +%%-------------------------------------------------------------------- +-spec(init(Args :: term()) -> + {ok, {SupFlags :: {RestartStrategy :: supervisor:strategy(), + MaxR :: non_neg_integer(), MaxT :: non_neg_integer()}, + [ChildSpec :: supervisor:child_spec()] + }} | + ignore | + {error, Reason :: term()}). +init([]) -> + RestartStrategy = one_for_one, + MaxRestarts = 1000, + MaxSecondsBetweenRestarts = 3600, + + SupFlags = {RestartStrategy, MaxRestarts, MaxSecondsBetweenRestarts}, + + Restart = permanent, + Shutdown = 2000, + Type = worker, + + AChild = {'AName', {'AModule', start_link, []}, + Restart, Shutdown, Type, ['AModule']}, + + {ok, {SupFlags, [AChild]}}. + +%%%=================================================================== +%%% Internal functions +%%%=================================================================== diff --git a/src/libs/external/currency/erlog_curr_sync.erl b/src/libs/external/currency/erlog_curr_sync.erl new file mode 100644 index 0000000..03e24d1 --- /dev/null +++ b/src/libs/external/currency/erlog_curr_sync.erl @@ -0,0 +1,146 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 24. Июль 2014 20:07 +%%%------------------------------------------------------------------- +-module(erlog_curr_sync). +-author("tihon"). + +-behaviour(gen_server). + +%% API +-export([start_link/0]). + +%% gen_server callbacks +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). + +-define(SERVER, ?MODULE). + +-record(state, {}). + +%%%=================================================================== +%%% API +%%%=================================================================== + +%%-------------------------------------------------------------------- +%% @doc +%% Starts the server +%% +%% @end +%%-------------------------------------------------------------------- +-spec(start_link() -> + {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). +start_link() -> + gen_server:start_link({local, ?SERVER}, ?MODULE, [], []). + +%%%=================================================================== +%%% gen_server callbacks +%%%=================================================================== + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Initializes the server +%% +%% @spec init(Args) -> {ok, State} | +%% {ok, State, Timeout} | +%% ignore | +%% {stop, Reason} +%% @end +%%-------------------------------------------------------------------- +-spec(init(Args :: term()) -> + {ok, State :: #state{}} | {ok, State :: #state{}, timeout() | hibernate} | + {stop, Reason :: term()} | ignore). +init([]) -> + {ok, #state{}}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Handling call messages +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_call(Request :: term(), From :: {pid(), Tag :: term()}, + State :: #state{}) -> + {reply, Reply :: term(), NewState :: #state{}} | + {reply, Reply :: term(), NewState :: #state{}, timeout() | hibernate} | + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | + {stop, Reason :: term(), NewState :: #state{}}). +handle_call(_Request, _From, State) -> + {reply, ok, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Handling cast messages +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_cast(Request :: term(), State :: #state{}) -> + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), NewState :: #state{}}). +handle_cast(_Request, State) -> + {noreply, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Handling all non call/cast messages +%% +%% @spec handle_info(Info, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} +%% @end +%%-------------------------------------------------------------------- +-spec(handle_info(Info :: timeout() | term(), State :: #state{}) -> + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), NewState :: #state{}}). +handle_info(_Info, State) -> + {noreply, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% This function is called by a gen_server when it is about to +%% terminate. It should be the opposite of Module:init/1 and do any +%% necessary cleaning up. When it returns, the gen_server terminates +%% with Reason. The return value is ignored. +%% +%% @spec terminate(Reason, State) -> void() +%% @end +%%-------------------------------------------------------------------- +-spec(terminate(Reason :: (normal | shutdown | {shutdown, term()} | term()), + State :: #state{}) -> term()). +terminate(_Reason, _State) -> + ok. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Convert process state when code is changed +%% +%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState} +%% @end +%%-------------------------------------------------------------------- +-spec(code_change(OldVsn :: term() | {down, term()}, State :: #state{}, + Extra :: term()) -> + {ok, NewState :: #state{}} | {error, Reason :: term()}). +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%%=================================================================== +%%% Internal functions +%%%=================================================================== diff --git a/src/libs/external/currency/erlog_currency.erl b/src/libs/external/currency/erlog_currency.erl new file mode 100644 index 0000000..a8eb047 --- /dev/null +++ b/src/libs/external/currency/erlog_currency.erl @@ -0,0 +1,13 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 24. Июль 2014 20:06 +%%%------------------------------------------------------------------- +-module(erlog_currency). +-author("tihon"). + +%% API +-export([]). diff --git a/src/libs/external/erlog_db.erl b/src/libs/external/db/erlog_db.erl similarity index 100% rename from src/libs/external/erlog_db.erl rename to src/libs/external/db/erlog_db.erl diff --git a/src/storage/ets_db_storage.erl b/src/libs/external/db/ets_db_storage.erl similarity index 100% rename from src/storage/ets_db_storage.erl rename to src/libs/external/db/ets_db_storage.erl diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 6df1232..25e6acc 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -163,7 +163,7 @@ raw_fetch(Db, {Key}) -> raw_append(Db, {Key, AppendValue}) -> {Value, _} = raw_fetch(Db, {Key}), - raw_store(Db, {Key, lists:concat([Value, AppendValue])}), + raw_store(Db, {Key, lists:concat([Value, [AppendValue]])}), {ok, Db}. raw_erase(Db, {Key}) -> From 5d5808749d6b02652a32e6cbe5121a32af518629 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 25 Jul 2014 01:15:45 +0000 Subject: [PATCH 082/251] added erlog currency server --- .gitignore | 1 + Makefile | 1 + include/erlog_currency.hrl | 16 +++++- rebar.config | 2 +- src/erlog.app.src | 4 +- src/libs/external/currency/erlog_curr_sup.erl | 21 +++----- .../external/currency/erlog_curr_sync.erl | 51 ++++++++++++++++++- src/libs/external/currency/erlog_currency.erl | 36 ++++++++++++- 8 files changed, 109 insertions(+), 23 deletions(-) diff --git a/.gitignore b/.gitignore index c6c071b..2e76dfe 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,4 @@ erlog_scan.erl rel/erlog .rebar .eunit +deps diff --git a/Makefile b/Makefile index e3a67fb..03e70e4 100644 --- a/Makefile +++ b/Makefile @@ -33,6 +33,7 @@ compile: then rebar compile; \ else $(MAKE) $(MFLAGS) erlc_compile; \ fi + cp deps/jsx/ebin/*.* ebin ## Compile using erlc erlc_compile: $(addprefix $(EBINDIR)/, $(EBINS)) diff --git a/include/erlog_currency.hrl b/include/erlog_currency.hrl index adebcfb..619cf2d 100644 --- a/include/erlog_currency.hrl +++ b/include/erlog_currency.hrl @@ -8,8 +8,20 @@ %%%------------------------------------------------------------------- -author("tihon"). +-define(COURSE_URL, "https://api.privatbank.ua/p24api/pubinfo?jsonp&exchange&coursid=5"). +-define(CHECK_PERIOD, 60000). + + -define(ERLOG_CURRENCY, [ - {{db_abolish, 2}, ?MODULE, db_abolish_2} + {{exchange, 4}, ?MODULE, exchange_4} ] -). \ No newline at end of file +). + +-record(currency, +{ + name, + base_name, + buy_course, + sell_course +}). \ No newline at end of file diff --git a/rebar.config b/rebar.config index b318795..1e2b238 100644 --- a/rebar.config +++ b/rebar.config @@ -12,5 +12,5 @@ %% deps { - deps, [] + deps, [{jsx, ".*", {git, "https://github.com/talentdeficit/jsx.git", {branch, "master"}}}] }. \ No newline at end of file diff --git a/src/erlog.app.src b/src/erlog.app.src index cea2be0..b6f0fab 100644 --- a/src/erlog.app.src +++ b/src/erlog.app.src @@ -5,12 +5,12 @@ {registered, []}, {applications, [ kernel, - stdlib + stdlib, + inets ]}, {mod, {erlog_app, []}}, {env, [ - {database, ets}, % ets | dict {console_port, 8080} ]} ]}. diff --git a/src/libs/external/currency/erlog_curr_sup.erl b/src/libs/external/currency/erlog_curr_sup.erl index 3524019..945ee99 100644 --- a/src/libs/external/currency/erlog_curr_sup.erl +++ b/src/libs/external/currency/erlog_curr_sup.erl @@ -12,7 +12,7 @@ -behaviour(supervisor). %% API --export([start_link/0]). +-export([start_link/0, start_sync_worker/0]). %% Supervisor callbacks -export([init/1]). @@ -22,6 +22,7 @@ %%%=================================================================== %%% API functions %%%=================================================================== +start_sync_worker() -> supervisor:start_child(?MODULE, []). %%-------------------------------------------------------------------- %% @doc @@ -56,20 +57,10 @@ start_link() -> ignore | {error, Reason :: term()}). init([]) -> - RestartStrategy = one_for_one, - MaxRestarts = 1000, - MaxSecondsBetweenRestarts = 3600, - - SupFlags = {RestartStrategy, MaxRestarts, MaxSecondsBetweenRestarts}, - - Restart = permanent, - Shutdown = 2000, - Type = worker, - - AChild = {'AName', {'AModule', start_link, []}, - Restart, Shutdown, Type, ['AModule']}, - - {ok, {SupFlags, [AChild]}}. + RestartStrategy = {simple_one_for_one, 10, 60}, + Worker = {erlog_curr_sync, {erlog_curr_sync, start_link, []}, + permanent, 2000, worker, [erlog_curr_sync]}, + {ok, {RestartStrategy, [Worker]}}. %%%=================================================================== %%% Internal functions diff --git a/src/libs/external/currency/erlog_curr_sync.erl b/src/libs/external/currency/erlog_curr_sync.erl index 03e24d1..ef6d9d5 100644 --- a/src/libs/external/currency/erlog_curr_sync.erl +++ b/src/libs/external/currency/erlog_curr_sync.erl @@ -9,6 +9,8 @@ -module(erlog_curr_sync). -author("tihon"). +-include("erlog_currency.hrl"). + -behaviour(gen_server). %% API @@ -24,7 +26,10 @@ -define(SERVER, ?MODULE). --record(state, {}). +-record(state, +{ + course :: dict:dict() +}). %%%=================================================================== %%% API @@ -60,7 +65,9 @@ start_link() -> {ok, State :: #state{}} | {ok, State :: #state{}, timeout() | hibernate} | {stop, Reason :: term()} | ignore). init([]) -> - {ok, #state{}}. + gen_server:cast(self(), check), + timer:send_interval(?CHECK_PERIOD, self(), check), + {ok, #state{course = dict:new()}}. %%-------------------------------------------------------------------- %% @private @@ -91,6 +98,9 @@ handle_call(_Request, _From, State) -> {noreply, NewState :: #state{}} | {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), NewState :: #state{}}). +handle_cast(check, State = #state{course = CourseList}) -> + UpdCourse = check_course(CourseList), + {noreply, State#state{course = UpdCourse}}; handle_cast(_Request, State) -> {noreply, State}. @@ -108,6 +118,9 @@ handle_cast(_Request, State) -> {noreply, NewState :: #state{}} | {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), NewState :: #state{}}). +handle_info(check, State = #state{course = CourseList}) -> + UpdCourse = check_course(CourseList), + {noreply, State#state{course = UpdCourse}}; handle_info(_Info, State) -> {noreply, State}. @@ -144,3 +157,37 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== %%% Internal functions %%%=================================================================== +check_course(Current) -> + CourseJson = get_course(), + Parsed = jsx:decode(CourseJson), + parse_course(Parsed, Current). + +get_course() -> + {ok, {{_, 200, _}}, _, Body} = httpc:request(get, {?COURSE_URL, []}, [], []), + Body. + +-spec update_currency(#currency{}, dict:dict()) -> dict:dict(). +update_currency(Currency = #currency{base_name = Name}, Dict) -> + dict:store(Name, Currency, Dict). + +-spec parse_course(list(), dict:dict()) -> dict:dict(). +parse_course(New, Current) -> + lists:foldl( + fun(Proplist, Acc) -> + try update_currency(parse_currency(Proplist), Acc) + catch + _:_ -> Acc + end + end, Current, New). + +-spec parse_currency(proplists:proplist()) -> #currency{}. +parse_currency(Currency) -> + Name = parse_value(<<"ccy">>, Currency), + BaseName = parse_value(<<"base_ccy">>, Currency), + Buy = parse_value(<<"buy">>, Currency), + Sell = parse_value(<<"sale">>, Currency), + #currency{name = Name, base_name = BaseName, buy_course = Buy, sell_course = Sell}. + +-spec parse_value(binary(), proplists:proplist()) -> list(). +parse_value(Key, List) -> + binary_to_list(proplists:get_value(Key, List)). \ No newline at end of file diff --git a/src/libs/external/currency/erlog_currency.erl b/src/libs/external/currency/erlog_currency.erl index a8eb047..4b7fd40 100644 --- a/src/libs/external/currency/erlog_currency.erl +++ b/src/libs/external/currency/erlog_currency.erl @@ -9,5 +9,39 @@ -module(erlog_currency). -author("tihon"). +-include("erlog_currency.hrl"). +-include("erlog_core.hrl"). + %% API --export([]). +-export([load/1, exchange/2]). + +load(Db) -> + start_sync_if_needed(), + lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_CURRENCY). + +exchange({exchange, ValueFrom, CurrencyTypeFrom, ValueTo, CurrencyTypeTo}, Param = #param{next_goal = Next0, + bindings = Bs, choice = Cps, database = Db, var_num = Vn}) -> + %TODO todo... + ok. + + + +%% @private +%% Starts erlog_curr_sync server if it is not started. +%% Makes monitor to it. +start_sync_if_needed() -> + case check_server(whereis(erlog_curr_sync)) of + undefined -> start_server(); + _ -> ok + end. + +%% @private +%% Checks if server is registered and running +check_server(undefined) -> undefined; +check_server(Pid) -> process_info(Pid). + +%% @private +%% Starts supervisor and currency sync server +start_server() -> + catch erlog_curr_sup:start_link(), + erlog_curr_sup:start_sync_worker(). \ No newline at end of file From 23419ea0471fc3f374b000a391ea6f512b006de2 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 25 Jul 2014 22:32:23 +0000 Subject: [PATCH 083/251] make db_call return false if no facts --- src/libs/external/db/erlog_db.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 92393f1..5d53680 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -18,10 +18,10 @@ load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_DB). -db_call_2({db_call, Table, Goal}, Param = #param{next_goal = Next0, bindings = Bs, choice = Cps, database = Db, var_num = Vn}) -> +db_call_2({db_call, Table, Goal}, Param = #param{database = Db}) -> %% Only add cut CP to Cps if goal contains a cut. case erlog_memory:db_findall(Db, Table, Goal) of - [] -> ec_body:prove_body(Param#param{goal = Next0, var_num = Vn + 1}); + [] -> erlog_errors:fail(Param); Cs -> erlog_core:prove_goal_clauses(Goal, Cs, Param) end. From 43e237ab89b34612f40c2297e4262730e8939fa9 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 25 Jul 2014 22:58:52 +0000 Subject: [PATCH 084/251] change dict:dict() to atom dict to support r17- --- src/libs/external/currency/erlog_curr_sync.erl | 6 +++--- src/libs/external/currency/erlog_currency.erl | 10 ++++++++-- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/src/libs/external/currency/erlog_curr_sync.erl b/src/libs/external/currency/erlog_curr_sync.erl index ef6d9d5..f7bddc6 100644 --- a/src/libs/external/currency/erlog_curr_sync.erl +++ b/src/libs/external/currency/erlog_curr_sync.erl @@ -28,7 +28,7 @@ -record(state, { - course :: dict:dict() + course :: dict }). %%%=================================================================== @@ -166,11 +166,11 @@ get_course() -> {ok, {{_, 200, _}}, _, Body} = httpc:request(get, {?COURSE_URL, []}, [], []), Body. --spec update_currency(#currency{}, dict:dict()) -> dict:dict(). +-spec update_currency(#currency{}, dict) -> dict. update_currency(Currency = #currency{base_name = Name}, Dict) -> dict:store(Name, Currency, Dict). --spec parse_course(list(), dict:dict()) -> dict:dict(). +-spec parse_course(list(), dict) -> dict. parse_course(New, Current) -> lists:foldl( fun(Proplist, Acc) -> diff --git a/src/libs/external/currency/erlog_currency.erl b/src/libs/external/currency/erlog_currency.erl index 4b7fd40..c2a1777 100644 --- a/src/libs/external/currency/erlog_currency.erl +++ b/src/libs/external/currency/erlog_currency.erl @@ -21,9 +21,11 @@ load(Db) -> exchange({exchange, ValueFrom, CurrencyTypeFrom, ValueTo, CurrencyTypeTo}, Param = #param{next_goal = Next0, bindings = Bs, choice = Cps, database = Db, var_num = Vn}) -> - %TODO todo... - ok. + From = ec_support:dderef(ValueFrom, Bs), + To = ec_support:dderef(ValueTo, Bs), + io:format("From ~p, To ~p~n", [From, To]), + ok. %% @private @@ -43,5 +45,9 @@ check_server(Pid) -> process_info(Pid). %% @private %% Starts supervisor and currency sync server start_server() -> + ok = inets:start(), %start inets if needed + ok = application:start(crypto), + ok = application:start(public_key), + ok = application:start(ssl), catch erlog_curr_sup:start_link(), erlog_curr_sup:start_sync_worker(). \ No newline at end of file From 7f16f0ee975481aad7dee211f2b82995db2ca4dd Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 28 Jul 2014 21:46:42 +0000 Subject: [PATCH 085/251] add exchange command --- .../external/currency/erlog_curr_sync.erl | 22 ++++++++---- src/libs/external/currency/erlog_currency.erl | 34 ++++++++++++------- 2 files changed, 37 insertions(+), 19 deletions(-) diff --git a/src/libs/external/currency/erlog_curr_sync.erl b/src/libs/external/currency/erlog_curr_sync.erl index f7bddc6..d2e35b1 100644 --- a/src/libs/external/currency/erlog_curr_sync.erl +++ b/src/libs/external/currency/erlog_curr_sync.erl @@ -14,7 +14,7 @@ -behaviour(gen_server). %% API --export([start_link/0]). +-export([start_link/0, get_course_by_curr/1]). %% gen_server callbacks -export([init/1, @@ -34,6 +34,7 @@ %%%=================================================================== %%% API %%%=================================================================== +get_course_by_curr(Currency) -> gen_server:call(?MODULE, {get, Currency}). %%-------------------------------------------------------------------- %% @doc @@ -84,6 +85,9 @@ init([]) -> {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | {stop, Reason :: term(), NewState :: #state{}}). +handle_call({get, Currency}, _From, State = #state{course = Dict}) -> + Course = dict:find(Currency, Dict), + {reply, Course, State}; handle_call(_Request, _From, State) -> {reply, ok, State}. @@ -98,8 +102,8 @@ handle_call(_Request, _From, State) -> {noreply, NewState :: #state{}} | {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), NewState :: #state{}}). -handle_cast(check, State = #state{course = CourseList}) -> - UpdCourse = check_course(CourseList), +handle_cast(check, State = #state{course = Dict}) -> + UpdCourse = check_course(Dict), {noreply, State#state{course = UpdCourse}}; handle_cast(_Request, State) -> {noreply, State}. @@ -163,12 +167,16 @@ check_course(Current) -> parse_course(Parsed, Current). get_course() -> - {ok, {{_, 200, _}}, _, Body} = httpc:request(get, {?COURSE_URL, []}, [], []), +%% {ok, {{_, 200, _}, _, Body}} = httpc:request(get, {?COURSE_URL, []}, [], []), %TODO! + Body = <<"[{\"ccy\":\"RUR\",\"base_ccy\":\"UAH\",\"buy\":\"0.32500\",\"sale\":\"0.36000\"}, + {\"ccy\":\"EUR\",\"base_ccy\":\"UAH\",\"buy\":\"15.60000\",\"sale\":\"16.60000\"}, + {\"ccy\":\"USD\",\"base_ccy\":\"UAH\",\"buy\":\"11.65000\",\"sale\":\"11.95000\"}]">>, Body. -spec update_currency(#currency{}, dict) -> dict. -update_currency(Currency = #currency{base_name = Name}, Dict) -> - dict:store(Name, Currency, Dict). +update_currency(Currency = #currency{base_name = BName, name = Name}, Dict) -> + Key = lists:concat(lists:sort([Name, BName])), + dict:store(Key, Currency, Dict). -spec parse_course(list(), dict) -> dict. parse_course(New, Current) -> @@ -186,7 +194,7 @@ parse_currency(Currency) -> BaseName = parse_value(<<"base_ccy">>, Currency), Buy = parse_value(<<"buy">>, Currency), Sell = parse_value(<<"sale">>, Currency), - #currency{name = Name, base_name = BaseName, buy_course = Buy, sell_course = Sell}. + #currency{name = Name, base_name = BaseName, buy_course = list_to_float(Buy), sell_course = list_to_float(Sell)}. -spec parse_value(binary(), proplists:proplist()) -> list(). parse_value(Key, List) -> diff --git a/src/libs/external/currency/erlog_currency.erl b/src/libs/external/currency/erlog_currency.erl index c2a1777..15431e3 100644 --- a/src/libs/external/currency/erlog_currency.erl +++ b/src/libs/external/currency/erlog_currency.erl @@ -13,19 +13,26 @@ -include("erlog_core.hrl"). %% API --export([load/1, exchange/2]). +-export([load/1, exchange_4/2]). load(Db) -> start_sync_if_needed(), lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_CURRENCY). -exchange({exchange, ValueFrom, CurrencyTypeFrom, ValueTo, CurrencyTypeTo}, Param = #param{next_goal = Next0, - bindings = Bs, choice = Cps, database = Db, var_num = Vn}) -> - - From = ec_support:dderef(ValueFrom, Bs), - To = ec_support:dderef(ValueTo, Bs), - io:format("From ~p, To ~p~n", [From, To]), - ok. +exchange_4({exchange, ValueFrom, CurrencyTypeFrom, ValueTo, CurrencyTypeTo}, Params = #param{next_goal = Next, bindings = Bs0}) -> + From = ec_support:dderef(ValueFrom, Bs0), + Course = lists:concat(lists:sort([CurrencyTypeFrom, CurrencyTypeTo])), + ResultCurrency = case erlog_curr_sync:get_course_by_curr(Course) of + error -> erlog_errors:erlog_error("Unknown currency type!"); + {ok, Currency} -> + case Currency#currency.name of + CurrencyTypeFrom -> From * Currency#currency.buy_course; + CurrencyTypeTo -> From / Currency#currency.sell_course; + _ -> erlog_errors:erlog_error("Unknown currency type!") + end + end, + Bs = ec_support:add_binding(ValueTo, ResultCurrency, Bs0), + ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% @private @@ -45,9 +52,12 @@ check_server(Pid) -> process_info(Pid). %% @private %% Starts supervisor and currency sync server start_server() -> - ok = inets:start(), %start inets if needed - ok = application:start(crypto), - ok = application:start(public_key), - ok = application:start(ssl), + %start deps if not started + catch inets:start(), + catch application:start(crypto), + catch application:start(asn1), + catch application:start(public_key), + catch application:start(ssl), + catch erlog_curr_sup:start_link(), erlog_curr_sup:start_sync_worker(). \ No newline at end of file From 1e072d0e55ceb764b11a9ddc40c496d86a414ac8 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 28 Jul 2014 21:58:43 +0000 Subject: [PATCH 086/251] fix error with var --- src/libs/standard/erlog_time.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libs/standard/erlog_time.erl b/src/libs/standard/erlog_time.erl index 0fe38af..567b6bd 100644 --- a/src/libs/standard/erlog_time.erl +++ b/src/libs/standard/erlog_time.erl @@ -60,7 +60,7 @@ datediff_4({date_diff, TS1, TS2, Format, Res}, Params = #param{next_goal = Next, %% Adds number of seconds T2 in Type format to Time1. Returns timestamp add_time_4({add_time, Time1, Type, T2, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - Diff = check_var(Time1, Bs0) + date_to_seconds(check_var(T2, Bs0), Type), + Diff = check_var(Time1, Bs0) + date_to_seconds(check_var(T2, Bs0), check_var(Type, Bs0)), Bs = ec_support:add_binding(Res, Diff, Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). From 0ba3a66eb9b4263ba5e883c5b6fe901630e3a3e9 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 28 Jul 2014 22:04:04 +0000 Subject: [PATCH 087/251] check one more var --- src/libs/standard/erlog_time.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libs/standard/erlog_time.erl b/src/libs/standard/erlog_time.erl index 567b6bd..9ee20f3 100644 --- a/src/libs/standard/erlog_time.erl +++ b/src/libs/standard/erlog_time.erl @@ -55,7 +55,7 @@ time_4({time, H, M, S, Res}, Params = #param{next_goal = Next, bindings = Bs0}) %% Calculates differense between two timestamps. Returns the result in specifyed format datediff_4({date_diff, TS1, TS2, Format, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> Diff = timer:now_diff(ts_to_date(check_var(TS1, Bs0)), ts_to_date(check_var(TS2, Bs0))) / 1000000, - Bs = ec_support:add_binding(Res, seconds_to_date(Diff, Format), Bs0), + Bs = ec_support:add_binding(Res, seconds_to_date(Diff, check_var(Format, Bs0)), Bs0), ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). %% Adds number of seconds T2 in Type format to Time1. Returns timestamp From 71418a817b465755e2e5ec0999fa2c6c00bfea9c Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 30 Jul 2014 10:51:31 +0000 Subject: [PATCH 088/251] fix retract --- src/core/erlog_errors.erl | 4 +-- src/core/logic/erlog_core.erl | 58 ++++++++++++++++++++--------------- 2 files changed, 35 insertions(+), 27 deletions(-) diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 2b29077..ba285c8 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -78,8 +78,8 @@ fail_clause(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> ec_unify:unify_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private -fail_retract(#cp{data = {Ch, Cb, Cs, Fun}, next = Next, bs = Bs, vn = Vn}, Param) -> - erlog_core:retract_clauses(Ch, Cb, Cs, Fun, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). +fail_retract(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> + erlog_core:retract_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Param) -> diff --git a/src/core/logic/erlog_core.erl b/src/core/logic/erlog_core.erl index 3fb5713..0abc57e 100644 --- a/src/core/logic/erlog_core.erl +++ b/src/core/logic/erlog_core.erl @@ -30,7 +30,9 @@ prove_clause/3, prove_current_predicate/2, prove_ecall/3, - prove_goal/4, retractall/7, retract/7, retract_clauses/5, prove_findall/4]). + prove_goal/4, + prove_findall/4, + retract_clauses/4]). %% Adding to database. -export([load/1]). @@ -158,20 +160,20 @@ prove_goal_clause(G, {_Tag, H0, {B0, _}}, Param = #param{next_goal = Next, bindi %% void. %% Retract clauses in database matching Clause. prove_retract({':-', H, B}, Params) -> - prove_retract(H, B, fun retract/7, Params); + prove_retract(H, B, Params); prove_retract(H, Params) -> - prove_retract(H, true, fun retract/7, Params). + prove_retract(H, true, Params). prove_retractall({':-', H, B}, Params) -> - prove_retract(H, B, fun retractall/7, Params); + prove_retractall(H, B, Params); prove_retractall(H, Params) -> - prove_retract(H, true, fun retractall/7, Params). + prove_retractall(H, true, Params). %% @private -prove_retract(H, B, Fun, Params = #param{database = Db}) -> +prove_retract(H, B, Params = #param{database = Db}) -> Functor = ec_support:functor(H), case erlog_memory:get_procedure(Db, Functor) of - {clauses, Cs} -> retract_clauses(H, B, Cs, Fun, Params); + {clauses, Cs} -> retract_clauses(H, B, Cs, Params); {code, _} -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); built_in -> @@ -180,32 +182,38 @@ prove_retract(H, B, Fun, Params = #param{database = Db}) -> end. %% @private -retract(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1) -> - erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), - Cp = #cp{type = retract, data = {Ch, Cb, Cs, fun retract/7}, next = Next, bs = Bs0, vn = Vn0}, - ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). - -%% @private -retractall(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1) -> - erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), - Cp = #cp{type = retract, data = {Ch, Cb, Cs, fun retractall/7}, next = Next, bs = Bs0, vn = Vn0}, - case Cs of - [] -> - ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); - _ -> - retract_clauses(Ch, Cb, Cs, fun retractall/7, Param#param{choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}) +prove_retractall(H, B, Params = #param{next_goal = Next, bindings = Bs0, var_num = Vn0, database = Db}) -> + Functor = ec_support:functor(H), + case erlog_memory:get_procedure(Db, Functor) of + {clauses, Cs} -> + lists:foreach( + fun(Clause) -> + case ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of + {succeed, _, _} -> + erlog_memory:retract_clause(Db, ec_support:functor(H), element(1, Clause)); + fail -> ok + end + end, Cs), + ec_body:prove_body(Params#param{goal = Next}); + {code, _} -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + built_in -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + undefined -> ec_body:prove_body(Params#param{goal = Next}) end. %% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to retract Head and Body using Clauses which all have the same functor. -retract_clauses(_Ch, _Cb, [], _, Param) -> erlog_errors:fail(Param); -retract_clauses(Ch, Cb, [C | Cs], Fun, Param = #param{bindings = Bs0, var_num = Vn0}) -> %TODO foreach vs handmade recursion? +retract_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param); +retract_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}) -> %TODO foreach vs handmade recursion? case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> %% We have found a right clause so now retract it. - Fun(Ch, Cb, C, Cs, Param, Bs1, Vn1); - fail -> retract_clauses(Ch, Cb, Cs, Fun, Param) + erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), + Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, + ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); + fail -> retract_clauses(Ch, Cb, Cs, Param) end. %% partial_list(Term, Bindings) -> Term. From 828c883fe88ba50bbcbb0ec236bfe55b923e4c27 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 30 Jul 2014 10:58:03 +0000 Subject: [PATCH 089/251] fix db_retract --- src/libs/external/db/erlog_db.erl | 59 ++++++++++++++++++------------- 1 file changed, 35 insertions(+), 24 deletions(-) diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 5d53680..4b33788 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -53,50 +53,61 @@ db_retractall_2({db_retractall, Table, Fact}, Params = #param{bindings = Bs}) -> prove_retract({':-', H, B}, Table, Params) -> - prove_retract(H, B, Table, fun retract/8, Params); + prove_retract(H, B, Table, Params); prove_retract(H, Table, Params) -> - prove_retract(H, true, Table, fun retract/8, Params). + prove_retract(H, true, Table, Params). prove_retractall({':-', H, B}, Table, Params) -> - prove_retract(H, B, Table, fun retractall/8, Params); + prove_retractall(H, B, Table, Params); prove_retractall(H, Table, Params) -> - prove_retract(H, true, Table, fun retractall/8, Params). + prove_retractall(H, true, Table, Params). -prove_retract(H, B, Table, Fun, Params = #param{database = Db}) -> +%% @private +prove_retract(H, B, Table, Params = #param{database = Db}) -> Functor = ec_support:functor(H), case erlog_memory:get_db_procedure(Db, Table, Functor) of - {clauses, Cs} -> retract_clauses(H, B, Cs, Fun, Params, Table); + {clauses, Cs} -> retract_clauses(H, B, Cs, Params, Table); undefined -> erlog_errors:fail(Params) end. %% @private -retract(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1, Table) -> - erlog_memory:db_retract_clause(Db, Table, ec_support:functor(Ch), element(1, C)), - Cp = #cp{type = db_retract, data = {Ch, Cb, Cs, fun retract/8, Table}, next = Next, bs = Bs0, vn = Vn0}, - ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). +prove_retractall(H, B, Table, Params = #param{next_goal = Next, bindings = Bs0, var_num = Vn0, database = Db}) -> + Functor = ec_support:functor(H), + case erlog_memory:get_db_procedure(Db, Table, Functor) of + {clauses, Cs} -> + lists:foreach( + fun(Clause) -> + case ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of + {succeed, _, _} -> + erlog_memory:db_retract_clause(Db, Table, ec_support:functor(H), element(1, Clause)); + fail -> ok + end + end, Cs), + ec_body:prove_body(Params#param{goal = Next}); + {code, _} -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + built_in -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + undefined -> ec_body:prove_body(Params#param{goal = Next}) + end. %% @private -retractall(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1, Table) -> +retract(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1, Table) -> erlog_memory:db_retract_clause(Db, Table, ec_support:functor(Ch), element(1, C)), - Cp = #cp{type = db_retract, data = {Ch, Cb, Cs, fun retractall/8, Table}, next = Next, bs = Bs0, vn = Vn0}, - case Cs of - [] -> - ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); - _ -> - retract_clauses(Ch, Cb, Cs, fun retractall/8, Param#param{choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}, Table) - end. + Cp = #cp{type = db_retract, data = {Ch, Cb, Cs, Table}, next = Next, bs = Bs0, vn = Vn0}, + ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). %% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to retract Head and Body using Clauses which all have the same functor. -retract_clauses(_Ch, _Cb, [], _, Param, _) -> erlog_errors:fail(Param); -retract_clauses(Ch, Cb, [C | Cs], Fun, Param = #param{bindings = Bs0, var_num = Vn0}, Table) -> %TODO foreach vs handmade recursion? +retract_clauses(_Ch, _Cb, [], Param, _) -> erlog_errors:fail(Param); +retract_clauses(Ch, Cb, [C | Cs], Param = #param{bindings = Bs0, var_num = Vn0}, Table) -> %TODO foreach vs handmade recursion? case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> %% We have found a right clause so now retract it. - Fun(Ch, Cb, C, Cs, Param, Bs1, Vn1, Table); - fail -> retract_clauses(Ch, Cb, Cs, Fun, Param, Table) + retract(Ch, Cb, C, Cs, Param, Bs1, Vn1, Table); + fail -> retract_clauses(Ch, Cb, Cs, Param, Table) end. -fail_retract(#cp{data = {Ch, Cb, Cs, Fun, Table}, next = Next, bs = Bs, vn = Vn}, Param) -> - retract_clauses(Ch, Cb, Cs, Fun, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}, Table). \ No newline at end of file +fail_retract(#cp{data = {Ch, Cb, Cs, Table}, next = Next, bs = Bs, vn = Vn}, Param) -> + retract_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}, Table). \ No newline at end of file From 6f0592d009b3f3089063f6045e46f3aa9d5e3c2e Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 31 Jul 2014 21:25:28 +0000 Subject: [PATCH 090/251] improve writeln --- src/core/logic/ec_goals.erl | 4 +++- src/core/logic/ec_support.erl | 8 +++++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/src/core/logic/ec_goals.erl b/src/core/logic/ec_goals.erl index 2357d4b..1380015 100644 --- a/src/core/logic/ec_goals.erl +++ b/src/core/logic/ec_goals.erl @@ -135,7 +135,9 @@ prove_goal(Param = #param{goal = {ecall, C0, Val}, bindings = Bs, database = Db} %% Non-standard but useful. prove_goal(Param = #param{goal = {writeln, T}, next_goal = Next, bindings = Bs, event_man = Evman}) -> %% Display procedure. - gen_event:notify(Evman, ec_support:dderef(T, Bs)), + io:format("writeln ~p~n", [T]), + Res = ec_support:write(T, Bs), + gen_event:notify(Evman, Res), ec_body:prove_body(Param#param{goal = Next}); %% File utils prove_goal(Param = #param{goal = {consult, Name}, next_goal = Next, f_consulter = Fcon, database = Db}) -> diff --git a/src/core/logic/ec_support.erl b/src/core/logic/ec_support.erl index 0047acd..7f742f3 100644 --- a/src/core/logic/ec_support.erl +++ b/src/core/logic/ec_support.erl @@ -15,7 +15,7 @@ -export([new_bindings/0, get_binding/2, add_binding/3, functor/1, cut/3, collect_alternatives/3, update_result/4, update_vars/4, deref/2, dderef_list/2, - make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3]). + make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3, write/2]). %% deref(Term, Bindings) -> Term. %% Dereference a variable, else just return the term. @@ -125,6 +125,12 @@ remove_nth(List, N) -> {A, B} = lists:split(N - 1, List), A ++ tl(B). +write(Res, Bs) when is_list(Res) -> + lists:concat(lists:foldr(fun(Var, Acc) -> [ec_support:dderef(Var, Bs) | Acc] end, [], Res)); +write(Res, Bs) -> + ec_support:dderef(Res, Bs). + + cut(Label, Last, Param = #param{next_goal = Next, choice = [#cut{label = Label} | Cps] = Cps0}) -> if Last -> ec_body:prove_body(Param#param{goal = Next, choice = Cps}); true -> ec_body:prove_body(Param#param{goal = Next, choice = Cps0}) From 015b6497def6b4d5d26a4d555d2c6fdf58ae9912 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 31 Jul 2014 21:58:16 +0000 Subject: [PATCH 091/251] improved writeln once again --- src/core/logic/ec_goals.erl | 1 - src/core/logic/ec_support.erl | 7 +++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/core/logic/ec_goals.erl b/src/core/logic/ec_goals.erl index 1380015..d772225 100644 --- a/src/core/logic/ec_goals.erl +++ b/src/core/logic/ec_goals.erl @@ -135,7 +135,6 @@ prove_goal(Param = #param{goal = {ecall, C0, Val}, bindings = Bs, database = Db} %% Non-standard but useful. prove_goal(Param = #param{goal = {writeln, T}, next_goal = Next, bindings = Bs, event_man = Evman}) -> %% Display procedure. - io:format("writeln ~p~n", [T]), Res = ec_support:write(T, Bs), gen_event:notify(Evman, Res), ec_body:prove_body(Param#param{goal = Next}); diff --git a/src/core/logic/ec_support.erl b/src/core/logic/ec_support.erl index 7f742f3..9ca6b32 100644 --- a/src/core/logic/ec_support.erl +++ b/src/core/logic/ec_support.erl @@ -126,9 +126,12 @@ remove_nth(List, N) -> A ++ tl(B). write(Res, Bs) when is_list(Res) -> - lists:concat(lists:foldr(fun(Var, Acc) -> [ec_support:dderef(Var, Bs) | Acc] end, [], Res)); + case io_lib:printable_list(Res) of + true -> Res; + false -> lists:concat(ec_support:dderef(Res, Bs)) + end; write(Res, Bs) -> - ec_support:dderef(Res, Bs). + write([Res], Bs). cut(Label, Last, Param = #param{next_goal = Next, choice = [#cut{label = Label} | Cps] = Cps0}) -> From 9ddbb7ca907de28b73964672f2eeee837f490910 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 1 Aug 2014 00:06:41 +0000 Subject: [PATCH 092/251] fix consulting through var & little improvements in time --- src/core/logic/ec_goals.erl | 4 ++-- src/libs/standard/erlog_time.erl | 3 +-- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/core/logic/ec_goals.erl b/src/core/logic/ec_goals.erl index d772225..cdd7fe9 100644 --- a/src/core/logic/ec_goals.erl +++ b/src/core/logic/ec_goals.erl @@ -139,8 +139,8 @@ prove_goal(Param = #param{goal = {writeln, T}, next_goal = Next, bindings = Bs, gen_event:notify(Evman, Res), ec_body:prove_body(Param#param{goal = Next}); %% File utils -prove_goal(Param = #param{goal = {consult, Name}, next_goal = Next, f_consulter = Fcon, database = Db}) -> - case erlog_file:consult(Fcon, Name, Db) of +prove_goal(Param = #param{goal = {consult, Name}, next_goal = Next, bindings = Bs, f_consulter = Fcon, database = Db}) -> + case erlog_file:consult(Fcon, ec_support:dderef(Name, Bs), Db) of ok -> ok; {Err, Error} when Err == erlog_error; Err == error -> erlog_errors:erlog_error(Error, Db) diff --git a/src/libs/standard/erlog_time.erl b/src/libs/standard/erlog_time.erl index 9ee20f3..6327c2d 100644 --- a/src/libs/standard/erlog_time.erl +++ b/src/libs/standard/erlog_time.erl @@ -137,5 +137,4 @@ check_var({'-', Var}, Bs) -> Res when is_integer(Res) -> -1 * Res; Res -> Res end; -check_var({Var}, Bs) -> check_var(ec_support:deref({Var}, Bs), Bs); -check_var(Var, _) -> Var. \ No newline at end of file +check_var(Var, Bs) -> check_var(ec_support:deref({Var}, Bs), Bs). \ No newline at end of file From 1acd9a126ce6f105c48ffacae104b52c3dfb1476 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 1 Aug 2014 00:33:33 +0000 Subject: [PATCH 093/251] revert time changing, remove flattering of result in writeln --- src/core/logic/ec_support.erl | 2 +- src/libs/standard/erlog_time.erl | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/core/logic/ec_support.erl b/src/core/logic/ec_support.erl index 9ca6b32..e0c3296 100644 --- a/src/core/logic/ec_support.erl +++ b/src/core/logic/ec_support.erl @@ -128,7 +128,7 @@ remove_nth(List, N) -> write(Res, Bs) when is_list(Res) -> case io_lib:printable_list(Res) of true -> Res; - false -> lists:concat(ec_support:dderef(Res, Bs)) + false -> ec_support:dderef(Res, Bs) end; write(Res, Bs) -> write([Res], Bs). diff --git a/src/libs/standard/erlog_time.erl b/src/libs/standard/erlog_time.erl index 6327c2d..9ee20f3 100644 --- a/src/libs/standard/erlog_time.erl +++ b/src/libs/standard/erlog_time.erl @@ -137,4 +137,5 @@ check_var({'-', Var}, Bs) -> Res when is_integer(Res) -> -1 * Res; Res -> Res end; -check_var(Var, Bs) -> check_var(ec_support:deref({Var}, Bs), Bs). \ No newline at end of file +check_var({Var}, Bs) -> check_var(ec_support:deref({Var}, Bs), Bs); +check_var(Var, _) -> Var. \ No newline at end of file From 44b3516f9a173a5768b786c005efbd07f303fcb2 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 5 Aug 2014 23:53:49 +0000 Subject: [PATCH 094/251] added list length --- include/erlog_lists.hrl | 3 ++- src/libs/standard/erlog_lists.erl | 10 +++++++++- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/include/erlog_lists.hrl b/include/erlog_lists.hrl index 0e6e9ab..3c2ab51 100644 --- a/include/erlog_lists.hrl +++ b/include/erlog_lists.hrl @@ -15,5 +15,6 @@ {{member, 2}, ?MODULE, member_2}, {{memberchk, 2}, ?MODULE, memberchk_2}, {{reverse, 2}, ?MODULE, reverse_2}, - {{sort, 2}, ?MODULE, sort_2} + {{sort, 2}, ?MODULE, sort_2}, + {{length, 2}, ?MODULE, length_2} ]). \ No newline at end of file diff --git a/src/libs/standard/erlog_lists.erl b/src/libs/standard/erlog_lists.erl index e1e04ce..e14f082 100644 --- a/src/libs/standard/erlog_lists.erl +++ b/src/libs/standard/erlog_lists.erl @@ -30,7 +30,7 @@ -export([load/1]). %% Library functions. --export([append_3/2, insert_3/2, member_2/2, memberchk_2/2, reverse_2/2, sort_2/2]). +-export([append_3/2, insert_3/2, member_2/2, memberchk_2/2, reverse_2/2, sort_2/2, length_2/2]). %% load(Database) -> Database. %% Assert predicates into the database. @@ -49,6 +49,14 @@ load(Db) -> {':-', {perm, [{1} | {2}], {3}}, {',', {perm, {2}, {4}}, {insert, {4}, {1}, {3}}}} ]). +length_2({length, ListVar, Len}, Params = #param{next_goal = Next, bindings = Bs0}) -> + case ec_support:deref(ListVar, Bs0) of + List when is_list(List) -> + Bs1 = ec_support:add_binding(Len, length(List), Bs0), + ec_body:prove_body(Params#param{goal = Next, bindings = Bs1}); + _ -> erlog_errors:fail(Params) + end. + %% append_3(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% append([], L, L). %% append([H|T], L, [H|L1]) :- append(T, L, L1). From 1e487d7b533996e6ab0630ca020d3695ae710638 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 11 Aug 2014 23:14:12 +0000 Subject: [PATCH 095/251] added lising command --- include/erlog_core.hrl | 1 + include/erlog_db.hrl | 3 ++- src/core/logic/ec_goals.erl | 4 +++ src/libs/external/db/erlog_db.erl | 14 ++++++++++- src/storage/erlog_dict.erl | 16 +++++++----- src/storage/erlog_ets.erl | 12 +++++++-- src/storage/erlog_memory.erl | 42 +++++++++++++++++++++++++------ src/storage/erlog_storage.erl | 2 ++ 8 files changed, 76 insertions(+), 18 deletions(-) diff --git a/include/erlog_core.hrl b/include/erlog_core.hrl index 8de2532..b32921f 100644 --- a/include/erlog_core.hrl +++ b/include/erlog_core.hrl @@ -79,6 +79,7 @@ {findall, 3}, {bagof, 3}, {setof, 3}, + {listing, 1}, %% Non standart functions {use, 1} %load erlang library module ] diff --git a/include/erlog_db.hrl b/include/erlog_db.hrl index d938849..e1bfc03 100644 --- a/include/erlog_db.hrl +++ b/include/erlog_db.hrl @@ -16,6 +16,7 @@ {{db_assertz, 2}, ?MODULE, db_assert_2}, {{db_retract, 2}, ?MODULE, db_retract_2}, {{db_retractall, 2}, ?MODULE, db_retractall_2}, - {{db_call, 2}, ?MODULE, db_call_2} + {{db_call, 2}, ?MODULE, db_call_2}, + {{db_listing, 2}, ?MODULE, db_listing_2} ] ). \ No newline at end of file diff --git a/src/core/logic/ec_goals.erl b/src/core/logic/ec_goals.erl index cdd7fe9..730516b 100644 --- a/src/core/logic/ec_goals.erl +++ b/src/core/logic/ec_goals.erl @@ -160,6 +160,10 @@ prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db erlog_errors:erlog_error(Error, Db) end, ec_body:prove_body(Param#param{goal = Next}); +prove_goal(Param = #param{goal = {listing, Res}, next_goal = Next, bindings = Bs0, database = Db}) -> + Content = erlog_memory:listing(Db), + Bs = ec_support:add_binding(Res, Content, Bs0), + ec_body:prove_body(Param#param{goal = Next, bindings = Bs}); prove_goal(Param = #param{goal = {findall, T, G, B}}) -> erlog_core:prove_findall(T, G, B, Param); prove_goal(Param = #param{goal = {{findall}, Tag, T0}, bindings = Bs, database = Db}) -> diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 4b33788..03d5402 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -13,7 +13,15 @@ -include("erlog_db.hrl"). %% API --export([load/1, db_assert_2/2, db_asserta_2/2, db_abolish_2/2, db_retract_2/2, db_retractall_2/2, fail_retract/2, db_call_2/2]). +-export([load/1, + db_assert_2/2, + db_asserta_2/2, + db_abolish_2/2, + db_retract_2/2, + db_retractall_2/2, + fail_retract/2, + db_call_2/2, + db_listing_2/2]). load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_DB). @@ -51,6 +59,10 @@ db_retractall_2({db_retractall, Table, Fact}, Params = #param{bindings = Bs}) -> C = ec_support:dderef(Fact, Bs), prove_retractall(C, Table, Params). +db_listing_2({db_listing, Table, Res}, Params = #param{next_goal = Next, database = Db, bindings = Bs0}) -> + Content = erlog_memory:db_listing(Db, Table), + Bs = ec_support:add_binding(Res, Content, Bs0), + ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). prove_retract({':-', H, B}, Table, Params) -> prove_retract(H, B, Table, Params); diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 2568271..1cd4d1a 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -26,7 +26,8 @@ raw_store/2, raw_fetch/2, raw_append/2, - raw_erase/2]). + raw_erase/2, + listing/1]). %% API -export([]). @@ -112,17 +113,20 @@ clause(Head, Body0, Db, ClauseFun) -> ({clauses, T, Cs}) -> ClauseFun(T, Body, Cs) end, {clauses, 1, [{0, Head, Body}]}, Db). -findall(State, {Functor}) -> %TODO implement me! +findall(_State, {_Functor}) -> %TODO implement me! erlang:error(not_implemented). -raw_store(State, {Key, Value}) -> +raw_store(_State, {_Key, _Value}) -> erlang:error(not_implemented). -raw_fetch(State, {Key}) -> +raw_fetch(_State, {_Key}) -> erlang:error(not_implemented). -raw_append(State, {Key, Value}) -> +raw_append(_State, {_Key, _Value}) -> erlang:error(not_implemented). -raw_erase(State, {Key}) -> +raw_erase(_State, {_Key}) -> + erlang:error(not_implemented). + +listing(_State) -> erlang:error(not_implemented). diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 25e6acc..b9e4e80 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -26,7 +26,9 @@ raw_store/2, raw_fetch/2, raw_append/2, - raw_erase/2]). + raw_erase/2, + listing/1, + listing/2]). new() -> {ok, ets:new(eets, [])}. @@ -168,4 +170,10 @@ raw_append(Db, {Key, AppendValue}) -> raw_erase(Db, {Key}) -> ets:delete(Db, Key), - {ok, Db}. \ No newline at end of file + {ok, Db}. + +listing(Db, Collection) -> + Ets = ets_db_storage:get_db(Collection), + {Res, _} = listing(Ets), + {Res, Db}. +listing(Db) -> {ets:foldl(fun(Pred, Acc) -> [Pred | Acc] end, [], Db), Db}. \ No newline at end of file diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index e9e285d..13e1e5f 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -12,12 +12,34 @@ -behaviour(gen_server). %% API --export([start_link/1, start_link/2, add_compiled_proc/2, assertz_clause/3, asserta_clause/3, - retract_clause/3, abolish_clauses/2, get_procedure/2, get_procedure_type/2, - get_interp_functors/1, assertz_clause/2, asserta_clause/2, finadll/2, raw_store/3, raw_fetch/2, raw_append/3, raw_erase/2, db_findall/3]). - --export([db_assertz_clause/3, db_assertz_clause/4, db_asserta_clause/4, db_asserta_clause/3, - db_retract_clause/4, db_abolish_clauses/3, get_db_procedure/3]). +-export([start_link/1, + start_link/2, + add_compiled_proc/2, + assertz_clause/3, + asserta_clause/3, + retract_clause/3, + abolish_clauses/2, + get_procedure/2, + get_procedure_type/2, + get_interp_functors/1, + assertz_clause/2, + asserta_clause/2, + finadll/2, + raw_store/3, + raw_fetch/2, + raw_append/3, + raw_erase/2, + listing/1]). + +-export([db_assertz_clause/3, + db_assertz_clause/4, + db_asserta_clause/4, + db_asserta_clause/3, + db_retract_clause/4, + db_abolish_clauses/3, + get_db_procedure/3, + db_findall/3, + db_listing/2]). -export([add_built_in/2]). @@ -86,6 +108,10 @@ raw_append(Database, Key, Value) -> gen_server:call(Database, {raw_append, {Key, raw_erase(Database, Key) -> gen_server:call(Database, {raw_erase, {Key}}). +listing(Database) -> gen_server:call(Database, listing). + +db_listing(Database, Collection) -> gen_server:call(Database, {listing, Collection}). + %%-------------------------------------------------------------------- %% @doc %% Starts the server @@ -146,8 +172,8 @@ init([Database, Params]) when is_atom(Database) -> handle_call({Fun, Params}, _From, State = #state{state = DbState, database = Database}) -> {Res, NewState} = Database:Fun(DbState, Params), {reply, Res, State#state{state = NewState}}; -handle_call(Fun, _From, State = #state{state = State, database = Database}) -> - {Res, NewState} = Database:Fun(State), +handle_call(Fun, _From, State = #state{state = DbState, database = Database}) -> + {Res, NewState} = Database:Fun(DbState), {reply, Res, State#state{state = NewState}}; handle_call(_Request, _From, State) -> {reply, ok, State}. diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl index 71c6855..83f4be1 100644 --- a/src/storage/erlog_storage.erl +++ b/src/storage/erlog_storage.erl @@ -23,6 +23,8 @@ -callback findall(State :: term(), Functor :: tuple()) -> {Res :: list(), NewState :: term()}. +-callback listing(State :: term()) -> {Res :: list(), NewState :: term()}. + -callback retract_clause(State :: term(), Param :: term()) -> {ok, NewState :: term()}. -callback abolish_clauses(State :: term(), Func :: term()) -> {ok, NewState :: term()}. From 72a95e572fcbb7c00750b5fcc0c72d89f396bae5 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 11 Aug 2014 23:40:06 +0000 Subject: [PATCH 096/251] change lising logic --- src/storage/erlog_ets.erl | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index b9e4e80..051a4e1 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -176,4 +176,8 @@ listing(Db, Collection) -> Ets = ets_db_storage:get_db(Collection), {Res, _} = listing(Ets), {Res, Db}. -listing(Db) -> {ets:foldl(fun(Pred, Acc) -> [Pred | Acc] end, [], Db), Db}. \ No newline at end of file +listing(Db) -> + {ets:foldl( + fun({Fun, clauses, _, _}, Acc) -> [Fun | Acc]; + (_, Acc) -> Acc + end, [], Db), Db}. \ No newline at end of file From e4ac88e7c6fcf7b6e8f5c244ecf27cfd4e611629 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 12 Aug 2014 21:28:39 +0000 Subject: [PATCH 097/251] made stdlib --- include/erlog_dcg.hrl | 4 +- include/erlog_lists.hrl | 14 +- include/erlog_time.hrl | 18 +- src/core/erlog.erl | 2 +- src/core/erlog_errors.erl | 10 +- src/core/logic/ec_body.erl | 18 +- src/core/logic/ec_core.erl | 85 ++++++ src/core/logic/ec_support.erl | 12 +- src/core/logic/ec_unify.erl | 4 +- src/io/erlog_file.erl | 4 +- src/libs/external/currency/erlog_currency.erl | 10 +- src/libs/external/db/erlog_db.erl | 53 ++-- .../logic/eb_logic.erl} | 191 +++----------- src/libs/standard/bips/main/erlog_bips.erl | 148 +++++++++++ .../standard/core/logic/ec_logic.erl} | 241 +++++++++--------- .../standard/core/main/erlog_core.erl} | 179 +++++-------- .../{erlog_dcg.erl => dcg/logic/ed_logic.erl} | 79 ++---- src/libs/standard/dcg/main/erlog_dcg.erl | 39 +++ src/libs/standard/erlog_lists.erl | 187 -------------- src/libs/standard/erlog_stdlib.erl | 18 ++ src/libs/standard/erlog_time.erl | 141 ---------- src/libs/standard/lists/logic/el_logic.erl | 106 ++++++++ src/libs/standard/lists/main/erlog_lists.erl | 94 +++++++ src/libs/standard/time/logic/et_logic.erl | 69 +++++ src/libs/standard/time/main/erlog_time.erl | 73 ++++++ src/storage/erlog_dict.erl | 132 ---------- src/storage/erlog_ets.erl | 26 +- src/storage/erlog_memory.erl | 11 +- src/storage/erlog_storage.erl | 4 +- 29 files changed, 955 insertions(+), 1017 deletions(-) create mode 100644 src/core/logic/ec_core.erl rename src/libs/standard/{erlog_bips.erl => bips/logic/eb_logic.erl} (54%) create mode 100644 src/libs/standard/bips/main/erlog_bips.erl rename src/{core/logic/erlog_core.erl => libs/standard/core/logic/ec_logic.erl} (59%) rename src/{core/logic/ec_goals.erl => libs/standard/core/main/erlog_core.erl} (57%) rename src/libs/standard/{erlog_dcg.erl => dcg/logic/ed_logic.erl} (57%) create mode 100644 src/libs/standard/dcg/main/erlog_dcg.erl delete mode 100644 src/libs/standard/erlog_lists.erl create mode 100644 src/libs/standard/erlog_stdlib.erl delete mode 100644 src/libs/standard/erlog_time.erl create mode 100644 src/libs/standard/lists/logic/el_logic.erl create mode 100644 src/libs/standard/lists/main/erlog_lists.erl create mode 100644 src/libs/standard/time/logic/et_logic.erl create mode 100644 src/libs/standard/time/main/erlog_time.erl delete mode 100644 src/storage/erlog_dict.erl diff --git a/include/erlog_dcg.hrl b/include/erlog_dcg.hrl index 5234481..70f3184 100644 --- a/include/erlog_dcg.hrl +++ b/include/erlog_dcg.hrl @@ -10,6 +10,6 @@ -define(ERLOG_DCG, [ - {{expand_term, 2}, erlog_dcg, expand_term_2}, - {{phrase, 3}, erlog_dcg, phrase_3} + {expand_term, 2}, + {phrase, 3} ]). \ No newline at end of file diff --git a/include/erlog_lists.hrl b/include/erlog_lists.hrl index 3c2ab51..950c12d 100644 --- a/include/erlog_lists.hrl +++ b/include/erlog_lists.hrl @@ -10,11 +10,11 @@ -define(ERLOG_LISTS, [ - {{append, 3}, ?MODULE, append_3}, - {{insert, 3}, ?MODULE, insert_3}, - {{member, 2}, ?MODULE, member_2}, - {{memberchk, 2}, ?MODULE, memberchk_2}, - {{reverse, 2}, ?MODULE, reverse_2}, - {{sort, 2}, ?MODULE, sort_2}, - {{length, 2}, ?MODULE, length_2} + {append, 3}, + {insert, 3}, + {member, 2}, + {memberchk, 2}, + {reverse, 2}, + {sort, 2}, + {length, 2} ]). \ No newline at end of file diff --git a/include/erlog_time.hrl b/include/erlog_time.hrl index 7c34cbb..8079289 100644 --- a/include/erlog_time.hrl +++ b/include/erlog_time.hrl @@ -14,13 +14,13 @@ -define(ERLOG_TIME, [ - {{localtime, 1}, ?MODULE, localtime_1}, - {{date_diff, 4}, ?MODULE, datediff_4}, - {{add_time, 4}, ?MODULE, add_time_4}, - {{date_print, 2}, ?MODULE, dateprint_2}, - {{date_parse, 2}, ?MODULE, dateparse_2}, - {{date, 2}, ?MODULE, date_2}, - {{date, 4}, ?MODULE, date_4}, - {{time, 2}, ?MODULE, time_2}, - {{time, 4}, ?MODULE, time_4} + {localtime, 1}, + {date_diff, 4}, + {add_time, 4}, + {date_print, 2}, + {date_parse, 2}, + {date, 2}, + {date, 4}, + {time, 2}, + {time, 4} ]). \ No newline at end of file diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 8181dc3..d512805 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -193,7 +193,7 @@ prove_goal(Goal0, State = #state{db = Db, f_consulter = Fcon, e_man = Event}) -> Goal1 = erlog_logic:unlistify(Goal0), %% Must use 'catch' here as 'try' does not do last-call %% optimisation. - case erlog_logic:prove_result(catch erlog_core:prove_goal(Goal1, Db, Fcon, Event), Vs) of + case erlog_logic:prove_result(catch ec_core:prove_goal(Goal1, Db, Fcon, Event), Vs) of {succeed, Res, Args} -> {{succeed, Res}, State#state{state = Args}}; OtherRes -> {OtherRes, State} end. diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index ba285c8..793e1a3 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -67,11 +67,11 @@ fail(#param{choice = [], database = Db}) -> {fail, Db}. %% @private fail_disjunction(#cp{next = Next, bs = Bs, vn = Vn}, Param) -> - ec_body:prove_body(Param#param{goal = Next, bindings = Bs, var_num = Vn}). + ec_core:prove_body(Param#param{goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Param) -> - erlog_core:prove_ecall(Efun, Val, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + ec_logic:prove_ecall(Efun, Val, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_clause(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> @@ -79,15 +79,15 @@ fail_clause(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> %% @private fail_retract(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> - erlog_core:retract_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + ec_logic:retract_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Param) -> - erlog_core:prove_predicates(Pi, Fs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + ec_logic:prove_predicates(Pi, Fs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_goal_clauses(#cp{data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> - erlog_core:prove_goal_clauses(G, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + ec_core:prove_goal_clauses(G, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). fail_findall(#cp{next = Next, data = {Tag, Bag}, bs = Bs, vn = Vn0}, Param = #param{database = Db}) -> Data = erlog_memory:raw_fetch(Db, Tag), diff --git a/src/core/logic/ec_body.erl b/src/core/logic/ec_body.erl index 4e71db0..21403b2 100644 --- a/src/core/logic/ec_body.erl +++ b/src/core/logic/ec_body.erl @@ -12,28 +12,14 @@ -include("erlog_core.hrl"). %% API --export([body_instance/5, prove_body/1, unify_prove_body/3, unify_prove_body/5, body_term/3, well_form_body/4, well_form_body/3]). - -%% prove_body(Body, ChoicePoints, Bindings, VarNum, Database) -> -%% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase}. -%% Prove the goals in a body. Remove the first goal and try to prove -%% it. Return when there are no more goals. This is how proving a -%% goal/body succeeds. -prove_body(Params = #param{goal = [G | Gs]}) -> %TODO use lists:foldr instead! - %%io:fwrite("PB: ~p\n", [{G,Gs,Cps}]), - ec_goals:prove_goal(Params#param{goal = G, next_goal = Gs}); -prove_body(#param{goal = [], choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> - %%io:fwrite("Cps: ~p\nCut: ~p\nVar: ~p\nVar: ~p\n", - %% [get(erlog_cps),get(erlog_cut),get(erlog_var),dict:size(Bs)]), - %%io:fwrite("PB: ~p\n", [Cps]), - {succeed, Cps, Bs, Vn, Db}. %No more body %TODO why should we return database? +-export([body_instance/5, unify_prove_body/3, unify_prove_body/5, body_term/3, well_form_body/4, well_form_body/3]). %% unify_prove_body(Term1, Term2, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Unify Term1 = Term2, on success prove body Next else fail. unify_prove_body(T1, T2, Params = #param{next_goal = Next, bindings = Bs0}) -> case ec_unify:unify(T1, T2, Bs0) of - {succeed, Bs1} -> prove_body(Params#param{goal = Next, bindings = Bs1}); + {succeed, Bs1} -> ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); fail -> erlog_errors:fail(Params) end. diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl new file mode 100644 index 0000000..ef37ff7 --- /dev/null +++ b/src/core/logic/ec_core.erl @@ -0,0 +1,85 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 12. Авг. 2014 16:47 +%%%------------------------------------------------------------------- +-module(ec_core). +-author("tihon"). + +-include("erlog_core.hrl"). + +%% API +-export([prove_body/1, prove_goal/1, prove_goal/4, prove_goal_clauses/3]). + +%% prove_goal(Goal, Database) -> Succeed | Fail. +%% This is the main entry point into the interpreter. Check that +%% everything is consistent then prove the goal as a call. +-spec prove_goal(Goal0 :: term(), Db :: pid(), Fcon :: fun(), Event :: pid()) -> term(). +prove_goal(Goal0, Db, Fcon, Event) -> + %% put(erlog_cut, orddict:new()), + %% put(erlog_cps, orddict:new()), + %% put(erlog_var, orddict:new()), + %% Check term and build new instance of term with bindings. + {Goal1, Bs, Vn} = ec_logic:initial_goal(Goal0), + Params = #param{goal = [{call, Goal1}], choice = [], bindings = Bs, var_num = Vn, + event_man = Event, database = Db, f_consulter = Fcon}, + ec_core:prove_body(Params). %TODO use lists:foldr instead! + +%% prove_body(Body, ChoicePoints, Bindings, VarNum, Database) -> +%% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase}. +%% Prove the goals in a body. Remove the first goal and try to prove +%% it. Return when there are no more goals. This is how proving a +%% goal/body succeeds. +prove_body(Params = #param{goal = [G | Gs]}) -> %TODO use lists:foldr instead! + %%io:fwrite("PB: ~p\n", [{G,Gs,Cps}]), + prove_goal(Params#param{goal = G, next_goal = Gs}); +prove_body(#param{goal = [], choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> + %%io:fwrite("Cps: ~p\nCut: ~p\nVar: ~p\nVar: ~p\n", + %% [get(erlog_cps),get(erlog_cut),get(erlog_var),dict:size(Bs)]), + %%io:fwrite("PB: ~p\n", [Cps]), + {succeed, Cps, Bs, Vn, Db}. %No more body %TODO why should we return database? + +prove_goal(Param = #param{goal = G, database = Db}) -> +%% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), + case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of + {built_in, Mod} -> Mod:prove_goal(Param); %kernel space + {code, {Mod, Func}} -> Mod:Func(G, Param); + {clauses, Cs} -> prove_goal_clauses(G, Cs, Param); + undefined -> erlog_errors:fail(Param); + %% Getting built_in here is an error! + {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data + end. + +%% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Try to prove Goal using Clauses which all have the same functor. +prove_goal_clauses(G, [C], Params = #param{choice = Cps, var_num = Vn}) -> + %% Must be smart here and test whether we need to add a cut point. + %% C has the structure {Tag,Head,{Body,BodyHasCut}}. + case element(2, element(3, C)) of + true -> + Cut = #cut{label = Vn}, + prove_goal_clause(G, C, Params#param{choice = [Cut | Cps]}); + false -> + prove_goal_clause(G, C, Params) + end; +%% prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db); +prove_goal_clauses(G, [C | Cs], Params = #param{next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps}) -> + Cp = #cp{type = goal_clauses, label = Vn, data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, + prove_goal_clause(G, C, Params#param{choice = [Cp | Cps]}); +prove_goal_clauses(_G, [], Param) -> erlog_errors:fail(Param). + +prove_goal_clause(G, {_Tag, H0, {B0, _}}, Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0}) -> + %% io:fwrite("PGC1: ~p\n", [{G,H0,B0}]), + Label = Vn0, + case ec_unify:unify_head(G, H0, Bs0, Vn0 + 1) of + {succeed, Rs0, Bs1, Vn1} -> + %% io:fwrite("PGC2: ~p\n", [{Rs0}]), + {B1, _Rs2, Vn2} = ec_body:body_instance(B0, Next, Rs0, Vn1, Label), + %% io:fwrite("PGC3: ~p\n", [{B1,Next,Cps}]), + ec_core:prove_body(Param#param{goal = B1, bindings = Bs1, var_num = Vn2}); + fail -> erlog_errors:fail(Param) + end. \ No newline at end of file diff --git a/src/core/logic/ec_support.erl b/src/core/logic/ec_support.erl index e0c3296..31ea7e1 100644 --- a/src/core/logic/ec_support.erl +++ b/src/core/logic/ec_support.erl @@ -135,12 +135,12 @@ write(Res, Bs) -> cut(Label, Last, Param = #param{next_goal = Next, choice = [#cut{label = Label} | Cps] = Cps0}) -> - if Last -> ec_body:prove_body(Param#param{goal = Next, choice = Cps}); - true -> ec_body:prove_body(Param#param{goal = Next, choice = Cps0}) + if Last -> ec_core:prove_body(Param#param{goal = Next, choice = Cps}); + true -> ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) end; cut(Label, Last, Param = #param{next_goal = Next, choice = [#cp{type = if_then_else, label = Label} | Cps] = Cps0}) -> - if Last -> ec_body:prove_body(Param#param{goal = Next, choice = Cps}); - true -> ec_body:prove_body(Param#param{goal = Next, choice = Cps0}) + if Last -> ec_core:prove_body(Param#param{goal = Next, choice = Cps}); + true -> ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) end; cut(Label, Last, Param = #param{choice = [#cp{type = goal_clauses, label = Label} = Cp | Cps]}) -> cut_goal_clauses(Last, Cp, Param#param{choice = Cps}); @@ -150,8 +150,8 @@ cut(Label, Last, Param = #param{choice = [_Cp | Cps]}) -> %% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db). cut_goal_clauses(true, #cp{label = _}, Param = #param{next_goal = Next}) -> %% Just remove the choice point completely and continue. - ec_body:prove_body(Param#param{goal = Next}); + ec_core:prove_body(Param#param{goal = Next}); cut_goal_clauses(false, #cp{label = L}, Param = #param{next_goal = Next, choice = Cps}) -> %% Replace choice point with cut point then continue. Cut = #cut{label = L}, - ec_body:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). \ No newline at end of file + ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). \ No newline at end of file diff --git a/src/core/logic/ec_unify.erl b/src/core/logic/ec_unify.erl index 7bf49bd..7651195 100644 --- a/src/core/logic/ec_unify.erl +++ b/src/core/logic/ec_unify.erl @@ -41,14 +41,14 @@ unify(T10, T20, Bs0) -> unify_clauses(Ch, Cb, [C], Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0}) -> %% No choice point on last clause case unify_clause(Ch, Cb, C, Bs0, Vn0) of - {succeed, Bs1, Vn1} -> ec_body:prove_body(Param#param{goal = Next, bindings = Bs1, var_num = Vn1}); + {succeed, Bs1, Vn1} -> ec_core:prove_body(Param#param{goal = Next, bindings = Bs1, var_num = Vn1}); fail -> erlog_errors:fail(Param) end; unify_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0, choice = Cps}) -> case unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> Cp = #cp{type = clause, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, - ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); + ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); fail -> unify_clauses(Ch, Cb, Cs, Param) end; unify_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param). diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index d6dc611..b94f840 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -48,14 +48,14 @@ reconsult(Fun, File, Db) -> %% @private -spec consult_assert(Term0 :: term(), Db :: pid()) -> {ok, Db :: pid()}. consult_assert(Term0, Db) -> - Term1 = erlog_dcg:expand_term(Term0), + Term1 = ed_logic:expand_term(Term0), erlog_memory:assertz_clause(Db, Term1), {ok, Db}. %TODO refactor consult_terms not to pass DB everywhere! %% @private -spec reconsult_assert(Term0 :: term(), {Db :: pid(), Seen :: list()}) -> {ok, {Db :: pid(), list()}}. reconsult_assert(Term0, {Db, Seen}) -> - Term1 = erlog_dcg:expand_term(Term0), + Term1 = ed_logic:expand_term(Term0), Func = functor(Term1), case lists:member(Func, Seen) of true -> diff --git a/src/libs/external/currency/erlog_currency.erl b/src/libs/external/currency/erlog_currency.erl index 15431e3..12a6975 100644 --- a/src/libs/external/currency/erlog_currency.erl +++ b/src/libs/external/currency/erlog_currency.erl @@ -17,10 +17,10 @@ load(Db) -> start_sync_if_needed(), - lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_CURRENCY). + lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_CURRENCY). -exchange_4({exchange, ValueFrom, CurrencyTypeFrom, ValueTo, CurrencyTypeTo}, Params = #param{next_goal = Next, bindings = Bs0}) -> - From = ec_support:dderef(ValueFrom, Bs0), +exchange_4({exchange, _, _, _, _} = Goal, Params = #param{next_goal = Next, bindings = Bs0}) -> + {exchange, From, CurrencyTypeFrom, To, CurrencyTypeTo} = ec_support:dderef(Goal, Bs0), Course = lists:concat(lists:sort([CurrencyTypeFrom, CurrencyTypeTo])), ResultCurrency = case erlog_curr_sync:get_course_by_curr(Course) of error -> erlog_errors:erlog_error("Unknown currency type!"); @@ -31,8 +31,8 @@ exchange_4({exchange, ValueFrom, CurrencyTypeFrom, ValueTo, CurrencyTypeTo}, Par _ -> erlog_errors:erlog_error("Unknown currency type!") end end, - Bs = ec_support:add_binding(ValueTo, ResultCurrency, Bs0), - ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). + Bs = ec_support:add_binding(To, ResultCurrency, Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). %% @private diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 03d5402..a1aad54 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -24,45 +24,48 @@ db_listing_2/2]). load(Db) -> - lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_DB). + lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_DB). -db_call_2({db_call, Table, Goal}, Param = #param{database = Db}) -> +db_call_2({db_call, _, _} = Goal, Param = #param{bindings = Bs, database = Db}) -> + {db_call, Table, Goal} = ec_support:dderef(Goal, Bs), %% Only add cut CP to Cps if goal contains a cut. case erlog_memory:db_findall(Db, Table, Goal) of [] -> erlog_errors:fail(Param); - Cs -> erlog_core:prove_goal_clauses(Goal, Cs, Param) + Cs -> ec_core:prove_goal_clauses(Goal, Cs, Param) end. -db_assert_2({db_assert, Table, Fact}, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> - C = ec_support:dderef(Fact, Bs), - erlog_memory:db_assertz_clause(Db, Table, C), - ec_body:prove_body(Params#param{goal = Next}). +db_assert_2({db_assert, _, _} = Goal, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> + {db_assert, Table, Fact} = ec_support:dderef(Goal, Bs), + erlog_memory:db_assertz_clause(Db, Table, Fact), + ec_core:prove_body(Params#param{goal = Next}). -db_asserta_2({db_asserta, Table, Fact}, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> - C = ec_support:dderef(Fact, Bs), - erlog_memory:db_asserta_clause(Db, Table, C), - ec_body:prove_body(Params#param{goal = Next}). +db_asserta_2({db_asserta, _, _} = Goal, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> + {db_asserta, Table, Fact} = ec_support:dderef(Goal, Bs), + erlog_memory:db_asserta_clause(Db, Table, Fact), + ec_core:prove_body(Params#param{goal = Next}). -db_abolish_2({db_abolish, Table, Fact}, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> - case ec_support:dderef(Fact, Bs) of +db_abolish_2({db_abolish, _, _} = Goal, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> + {db_abolish, Table, Fact} = ec_support:dderef(Goal, Bs), + case Fact of {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> erlog_memory:db_abolish_clauses(Db, Table, {N, A}), - ec_body:prove_body(Params#param{goal = Next}); + ec_core:prove_body(Params#param{goal = Next}); Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) end. -db_retract_2({db_retract, Table, Fact}, Params = #param{bindings = Bs}) -> - C = ec_support:dderef(Fact, Bs), - prove_retract(C, Table, Params). +db_retract_2({db_retract, _, _} = Goal, Params = #param{bindings = Bs}) -> + {db_retract, Table, Fact} = ec_support:dderef(Goal, Bs), + prove_retract(Fact, Table, Params). -db_retractall_2({db_retractall, Table, Fact}, Params = #param{bindings = Bs}) -> - C = ec_support:dderef(Fact, Bs), - prove_retractall(C, Table, Params). +db_retractall_2({db_retractall, _, _} = Goal, Params = #param{bindings = Bs}) -> + {db_retractall, Table, Fact} = ec_support:dderef(Goal, Bs), + prove_retractall(Fact, Table, Params). -db_listing_2({db_listing, Table, Res}, Params = #param{next_goal = Next, database = Db, bindings = Bs0}) -> +db_listing_2({db_listing, _, _} = Goal, Params = #param{next_goal = Next, bindings = Bs0, database = Db}) -> + {db_listing, Table, Res} = ec_support:dderef(Goal, Bs0), Content = erlog_memory:db_listing(Db, Table), Bs = ec_support:add_binding(Res, Content, Bs0), - ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). prove_retract({':-', H, B}, Table, Params) -> prove_retract(H, B, Table, Params); @@ -95,19 +98,19 @@ prove_retractall(H, B, Table, Params = #param{next_goal = Next, bindings = Bs0, fail -> ok end end, Cs), - ec_body:prove_body(Params#param{goal = Next}); + ec_core:prove_body(Params#param{goal = Next}); {code, _} -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); built_in -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - undefined -> ec_body:prove_body(Params#param{goal = Next}) + undefined -> ec_core:prove_body(Params#param{goal = Next}) end. %% @private retract(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1, Table) -> erlog_memory:db_retract_clause(Db, Table, ec_support:functor(Ch), element(1, C)), Cp = #cp{type = db_retract, data = {Ch, Cb, Cs, Table}, next = Next, bs = Bs0, vn = Vn0}, - ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). + ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). %% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. diff --git a/src/libs/standard/erlog_bips.erl b/src/libs/standard/bips/logic/eb_logic.erl similarity index 54% rename from src/libs/standard/erlog_bips.erl rename to src/libs/standard/bips/logic/eb_logic.erl index b4bf933..ba0df6a 100644 --- a/src/libs/standard/erlog_bips.erl +++ b/src/libs/standard/bips/logic/eb_logic.erl @@ -1,167 +1,37 @@ -%% Copyright (c) 2008-2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - -%% File : erlog_bips.erl -%% Author : Robert Virding -%% Purpose : Built-in predicates of Erlog interpreter. -%% -%% These are the built-in predicates of the Prolog interpreter which -%% are not control predicates or database predicates. - --module(erlog_bips). +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 12. Авг. 2014 17:24 +%%%------------------------------------------------------------------- +-module(eb_logic). +-author("tihon"). -include("erlog_core.hrl"). --include("erlog_bips.hrl"). - -%% Main interface functions. --export([load/1]). --export([prove_goal/2]). - -%%-compile(export_all). -%% load(Database) -> Database. -%% Assert predicates into the database. -load(Db) -> - lists:foreach(fun(Head) -> erlog_memory:add_built_in(Db, Head) end, ?ERLOG_BIPS). - -%% prove_goal(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> -%% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase} | -%% {fail,NewDatabase}. -%% Prove one goal. We seldom return succeed here but usually go directly to -%% to NextGoal. - -%% Term unification and comparison -prove_goal({'=', L, R}, Params) -> - ec_body:unify_prove_body(L, R, Params); -prove_goal({'\\=', L, R}, Params = #param{next_goal = Next, bindings = Bs0}) -> - case ec_unify:unify(L, R, Bs0) of - {succeed, _Bs1} -> erlog_errors:fail(Params); - fail -> ec_body:prove_body(Params#param{goal = Next}) - end; -prove_goal({'@>', L, R}, Params) -> - term_test_prove_body('>', L, R, Params); -prove_goal({'@>=', L, R}, Params) -> - term_test_prove_body('>=', L, R, Params); -prove_goal({'==', L, R}, Params) -> - term_test_prove_body('==', L, R, Params); -prove_goal({'\\==', L, R}, Params) -> - term_test_prove_body('/=', L, R, Params); -prove_goal({'@<', L, R}, Params) -> - term_test_prove_body('<', L, R, Params); -prove_goal({'@=<', L, R}, Params) -> - term_test_prove_body('=<', L, R, Params); -%% Term creation and decomposition. -prove_goal({arg, I, Ct, A}, Params = #param{bindings = Bs}) -> - prove_arg(ec_support:deref(I, Bs), ec_support:deref(Ct, Bs), A, Params); -prove_goal({copy_term, T0, C}, Params = #param{bindings = Bs, var_num = Vn0}) -> - %% Use term_instance to create the copy, can ignore orddict it creates. - {T, _Nbs, Vn1} = ec_term:term_instance(ec_support:dderef(T0, Bs), Vn0), - ec_body:unify_prove_body(T, C, Params#param{var_num = Vn1}); -prove_goal({functor, T, F, A}, Params = #param{bindings = Bs}) -> - prove_functor(ec_support:dderef(T, Bs), F, A, Params); -prove_goal({'=..', T, L}, Params = #param{bindings = Bs}) -> - prove_univ(ec_support:dderef(T, Bs), L, Params); -%% Type testing. -prove_goal({atom, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> - case ec_support:deref(T0, Bs) of - T when is_atom(T) -> ec_body:prove_body(Params#param{goal = Next}); - _Other -> erlog_errors:fail(Params) - end; -prove_goal({atomic, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> - case ec_support:deref(T0, Bs) of - T when ?IS_ATOMIC(T) -> ec_body:prove_body(Params#param{goal = Next}); - _Other -> erlog_errors:fail(Params) - end; -prove_goal({compound, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> - case ec_support:deref(T0, Bs) of - T when ?IS_ATOMIC(T) -> erlog_errors:fail(Params); - _Other -> ec_body:prove_body(Params#param{goal = Next}) - end; -prove_goal({integer, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> - case ec_support:deref(T0, Bs) of - T when is_integer(T) -> ec_body:prove_body(Params#param{goal = Next}); - _Other -> erlog_errors:fail(Params) - end; -prove_goal({float, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> - case ec_support:deref(T0, Bs) of - T when is_float(T) -> ec_body:prove_body(Params#param{goal = Next}); - _Other -> erlog_errors:fail(Params) - end; -prove_goal({number, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> - case ec_support:deref(T0, Bs) of - T when is_number(T) -> ec_body:prove_body(Params#param{goal = Next}); - _Other -> erlog_errors:fail(Params) - end; -prove_goal({nonvar, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> - case ec_support:deref(T0, Bs) of - {_} -> erlog_errors:fail(Params); - _Other -> ec_body:prove_body(Params#param{goal = Next}) - end; -prove_goal({var, T0}, Params = #param{next_goal = Next, bindings = Bs}) -> - case ec_support:deref(T0, Bs) of - {_} -> ec_body:prove_body(Params#param{goal = Next}); - _Other -> erlog_errors:fail(Params) - end; -%% Atom processing. -prove_goal({atom_chars, A, L}, Params) -> - prove_atom_chars(A, L, Params); -prove_goal({atom_length, A0, L0}, Params = #param{bindings = Bs, database = Db}) -> - case ec_support:dderef(A0, Bs) of - A when is_atom(A) -> - Alen = length(atom_to_list(A)), %No of chars in atom - case ec_support:dderef(L0, Bs) of - L when is_integer(L) -> - ec_body:unify_prove_body(Alen, L, Params); - {_} = Var -> - ec_body:unify_prove_body(Alen, Var, Params); - Other -> erlog_errors:type_error(integer, Other, Db) - end; - {_} -> erlog_errors:instantiation_error(Db); - Other -> erlog_errors:type_error(atom, Other, Db) - end; -%% Arithmetic evalution and comparison. -prove_goal({is, N, E0}, Params = #param{bindings = Bs, database = Db}) -> - E = eval_arith(ec_support:deref(E0, Bs), Bs, Db), - ec_body:unify_prove_body(N, E, Params); -prove_goal({'>', L, R}, Params) -> - arith_test_prove_body('>', L, R, Params); -prove_goal({'>=', L, R}, Params) -> - arith_test_prove_body('>=', L, R, Params); -prove_goal({'=:=', L, R}, Params) -> - arith_test_prove_body('==', L, R, Params); -prove_goal({'=\\=', L, R}, Params) -> - arith_test_prove_body('/=', L, R, Params); -prove_goal({'<', L, R}, Params) -> - arith_test_prove_body('<', L, R, Params); -prove_goal({'=<', L, R}, Params) -> - arith_test_prove_body('=<', L, R, Params). +%% API +-export([term_test_prove_body/4, + prove_arg/4, + prove_functor/4, + prove_univ/3, + prove_atom_chars/3, + arith_test_prove_body/4]). %% term_test_prove_body(Test, Left, Right, Next, ChoicePoints, Bindings, Varnum, Database) -> %% void. - term_test_prove_body(Test, L, R, Params = #param{next_goal = Next, bindings = Bs}) -> case erlang:Test(ec_support:dderef(L, Bs), ec_support:dderef(R, Bs)) of - true -> ec_body:prove_body(Params#param{goal = Next}); + true -> ec_core:prove_body(Params#param{goal = Next}); false -> erlog_errors:fail(Params) end. %% prove_arg(Index, Term, Arg, Next, ChoicePoints, VarNum, Database) -> void. %% Prove the goal arg(I, Ct, Arg), Index and Term have been dereferenced. - prove_arg(I, [H | T], A, Param = #param{database = Db}) when is_integer(I) -> - %% He, he, he! - if I == 1 -> ec_body:unify_prove_body(H, A, Param); + if + I == 1 -> ec_body:unify_prove_body(H, A, Param); I == 2 -> ec_body:unify_prove_body(T, A, Param); true -> {fail, Db} end; @@ -179,7 +49,6 @@ prove_arg(I, Ct, _, #param{database = Db}) -> %% prove_functor(Term, Functor, Arity, Next, ChoicePoints, Bindings, VarNum, Database) -> void. %% Prove the call functor(T, F, A), Term has been dereferenced. - prove_functor(T, F, A, Params) when tuple_size(T) >= 2 -> ec_body:unify_prove_body(F, element(1, T), A, tuple_size(T) - 1, Params); prove_functor(T, F, A, Params) when ?IS_ATOMIC(T) -> @@ -191,14 +60,14 @@ prove_functor({_} = Var, F0, A0, Params = #param{next_goal = Next, bindings = Bs case {ec_support:dderef(F0, Bs0), ec_support:dderef(A0, Bs0)} of {'.', 2} -> %He, he, he! Bs1 = ec_support:add_binding(Var, [{Vn0} | {Vn0 + 1}], Bs0), - ec_body:prove_body(Params#param{goal = Next, bindings = Bs1, var_num = Vn0 + 2}); + ec_core:prove_body(Params#param{goal = Next, bindings = Bs1, var_num = Vn0 + 2}); {F1, 0} when ?IS_ATOMIC(F1) -> Bs1 = ec_support:add_binding(Var, F1, Bs0), - ec_body:prove_body(Params#param{goal = Next, bindings = Bs1}); + ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); {F1, A1} when is_atom(F1), is_integer(A1), A1 > 0 -> As = ec_support:make_vars(A1, Vn0), Bs1 = ec_support:add_binding(Var, list_to_tuple([F1 | As]), Bs0), - ec_body:prove_body(Params#param{goal = Next, bindings = Bs1, var_num = Vn0 + A1}); %!!! + ec_core:prove_body(Params#param{goal = Next, bindings = Bs1, var_num = Vn0 + A1}); %!!! %% Now the error cases. {{_}, _} -> erlog_errors:instantiation_error(Db); {F1, A1} when is_atom(F1) -> erlog_errors:type_error(integer, A1, Db); @@ -207,14 +76,12 @@ prove_functor({_} = Var, F0, A0, Params = #param{next_goal = Next, bindings = Bs %% prove_univ(Term, List, Next, ChoicePoints, Bindings, VarNum, Database) -> void. %% Prove the goal Term =.. List, Term has already been dereferenced. - prove_univ(T, L, Params) when tuple_size(T) >= 2 -> Es = tuple_to_list(T), ec_body:unify_prove_body(Es, L, Params); prove_univ(T, L, Params) when ?IS_ATOMIC(T) -> ec_body:unify_prove_body([T], L, Params); prove_univ([Lh | Lt], L, Params) -> - %% He, he, he! %TODO what does it mean? ec_body:unify_prove_body(['.', Lh, Lt], L, Params); prove_univ({_} = Var, L, Params = #param{next_goal = Next, bindings = Bs0, database = Db}) -> Bs1 = case ec_support:dderef(L, Bs0) of @@ -229,12 +96,11 @@ prove_univ({_} = Var, L, Params = #param{next_goal = Next, bindings = Bs0, datab {_} -> erlog_errors:instantiation_error(Db); Other -> erlog_errors:type_error(list, Other, Db) end, - ec_body:prove_body(Params#param{goal = Next, bindings = Bs1}). + ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}). %% prove_atom_chars(Atom, List, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Prove the atom_chars(Atom, List). - prove_atom_chars(A, L, Params = #param{bindings = Bs, database = Db}) -> %% After a suggestion by Sean Cribbs. case ec_support:dderef(A, Bs) of @@ -264,19 +130,19 @@ prove_atom_chars(A, L, Params = #param{bindings = Bs, database = Db}) -> %% arith_test_prove_body(Test, Left, Right, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. - arith_test_prove_body(Test, L, R, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> case erlang:Test(eval_arith(ec_support:deref(L, Bs), Bs, Db), eval_arith(ec_support:deref(R, Bs), Bs, Db)) of - true -> ec_body:prove_body(Params#param{goal = Next}); + true -> ec_core:prove_body(Params#param{goal = Next}); false -> erlog_errors:fail(Params) end. + +%% @private %% eval_arith(ArithExpr, Bindings, Database) -> Number. %% Evaluate an arithmetic expression, include the database for %% errors. Dereference each level as we go, might fail so save some %% work. Must be called deferenced. - eval_arith({'+', A, B}, Bs, Db) -> eval_arith(ec_support:deref(A, Bs), Bs, Db) + eval_arith(ec_support:deref(B, Bs), Bs, Db); eval_arith({'-', A, B}, Bs, Db) -> @@ -322,13 +188,14 @@ eval_arith([_ | _], _Bs, Db) -> erlog_errors:type_error(evaluable, pred_ind('.', 2), Db); eval_arith(O, _Bs, Db) -> erlog_errors:type_error(evaluable, O, Db). +%% @private %% eval_int(IntegerExpr, Bindings, Database) -> Integer. %% Evaluate an integer expression, include the database for errors. - eval_int(E0, Bs, Db) -> E = eval_arith(E0, Bs, Db), if is_integer(E) -> E; true -> erlog_errors:type_error(integer, E, Db) end. +%% @private pred_ind(N, A) -> {'/', N, A}. \ No newline at end of file diff --git a/src/libs/standard/bips/main/erlog_bips.erl b/src/libs/standard/bips/main/erlog_bips.erl new file mode 100644 index 0000000..d22c3d2 --- /dev/null +++ b/src/libs/standard/bips/main/erlog_bips.erl @@ -0,0 +1,148 @@ +%% Copyright (c) 2008-2013 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : erlog_bips.erl +%% Author : Robert Virding +%% Purpose : Built-in predicates of Erlog interpreter. +%% +%% These are the built-in predicates of the Prolog interpreter which +%% are not control predicates or database predicates. + +-module(erlog_bips). + +-behaviour(erlog_stdlib). + +-include("erlog_core.hrl"). +-include("erlog_bips.hrl"). + +%% Main interface functions. +-export([load/1]). +-export([prove_goal/1]). + +%% load(Database) -> Database. +%% Assert predicates into the database. +load(Db) -> + lists:foreach(fun(Head) -> erlog_memory:load_kernel_space(Db, ?MODULE, Head) end, ?ERLOG_BIPS). + +%% prove_goal(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> +%% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase} | +%% {fail,NewDatabase}. +%% Prove one goal. We seldom return succeed here but usually go directly to +%% to NextGoal. + +%% Term unification and comparison +prove_goal(Params = #param{goal = {'=', L, R}}) -> + ec_body:unify_prove_body(L, R, Params); +prove_goal(Params = #param{goal = {'\\=', L, R}, next_goal = Next, bindings = Bs0}) -> + case ec_unify:unify(L, R, Bs0) of + {succeed, _Bs1} -> erlog_errors:fail(Params); + fail -> ec_core:prove_body(Params#param{goal = Next}) + end; +prove_goal(Params = #param{goal = {'@>', L, R}}) -> + eb_logic:term_test_prove_body('>', L, R, Params); +prove_goal(Params = #param{goal = {'@>=', L, R}}) -> + eb_logic:term_test_prove_body('>=', L, R, Params); +prove_goal(Params = #param{goal = {'==', L, R}}) -> + eb_logic:term_test_prove_body('==', L, R, Params); +prove_goal(Params = #param{goal = {'\\==', L, R}}) -> + eb_logic:term_test_prove_body('/=', L, R, Params); +prove_goal(Params = #param{goal = {'@<', L, R}}) -> + eb_logic:term_test_prove_body('<', L, R, Params); +prove_goal(Params = #param{goal = {'@=<', L, R}}) -> + eb_logic:term_test_prove_body('=<', L, R, Params); +%% Term creation and decomposition. +prove_goal(Params = #param{goal = {arg, I, Ct, A}, bindings = Bs}) -> + eb_logic:prove_arg(ec_support:deref(I, Bs), ec_support:deref(Ct, Bs), A, Params); +prove_goal(Params = #param{goal = {copy_term, T0, C}, bindings = Bs, var_num = Vn0}) -> + %% Use term_instance to create the copy, can ignore orddict it creates. + {T, _Nbs, Vn1} = ec_term:term_instance(ec_support:dderef(T0, Bs), Vn0), + ec_body:unify_prove_body(T, C, Params#param{var_num = Vn1}); +prove_goal(Params = #param{goal = {functor, T, F, A}, bindings = Bs}) -> + eb_logic:prove_functor(ec_support:dderef(T, Bs), F, A, Params); +prove_goal(Params = #param{goal = {'=..', T, L}, bindings = Bs}) -> + eb_logic:prove_univ(ec_support:dderef(T, Bs), L, Params); +%% Type testing. +prove_goal(Params = #param{goal = {atom, T0}, next_goal = Next, bindings = Bs}) -> + case ec_support:deref(T0, Bs) of + T when is_atom(T) -> ec_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) + end; +prove_goal(Params = #param{goal = {atomic, T0}, next_goal = Next, bindings = Bs}) -> + case ec_support:deref(T0, Bs) of + T when ?IS_ATOMIC(T) -> ec_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) + end; +prove_goal(Params = #param{goal = {compound, T0}, next_goal = Next, bindings = Bs}) -> + case ec_support:deref(T0, Bs) of + T when ?IS_ATOMIC(T) -> erlog_errors:fail(Params); + _Other -> ec_core:prove_body(Params#param{goal = Next}) + end; +prove_goal(Params = #param{goal = {integer, T0}, next_goal = Next, bindings = Bs}) -> + case ec_support:deref(T0, Bs) of + T when is_integer(T) -> ec_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) + end; +prove_goal(Params = #param{goal = {float, T0}, next_goal = Next, bindings = Bs}) -> + case ec_support:deref(T0, Bs) of + T when is_float(T) -> ec_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) + end; +prove_goal(Params = #param{goal = {number, T0}, next_goal = Next, bindings = Bs}) -> + case ec_support:deref(T0, Bs) of + T when is_number(T) -> ec_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) + end; +prove_goal(Params = #param{goal = {nonvar, T0}, next_goal = Next, bindings = Bs}) -> + case ec_support:deref(T0, Bs) of + {_} -> erlog_errors:fail(Params); + _Other -> ec_core:prove_body(Params#param{goal = Next}) + end; +prove_goal(Params = #param{goal = {var, T0}, next_goal = Next, bindings = Bs}) -> + case ec_support:deref(T0, Bs) of + {_} -> ec_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) + end; +%% Atom processing. +prove_goal(Params = #param{goal = {atom_chars, A, L}}) -> + eb_logic:prove_atom_chars(A, L, Params); +prove_goal(Params = #param{goal = {atom_length, A0, L0}, bindings = Bs, database = Db}) -> + case ec_support:dderef(A0, Bs) of + A when is_atom(A) -> + Alen = length(atom_to_list(A)), %No of chars in atom + case ec_support:dderef(L0, Bs) of + L when is_integer(L) -> + ec_body:unify_prove_body(Alen, L, Params); + {_} = Var -> + ec_body:unify_prove_body(Alen, Var, Params); + Other -> erlog_errors:type_error(integer, Other, Db) + end; + {_} -> erlog_errors:instantiation_error(Db); + Other -> erlog_errors:type_error(atom, Other, Db) + end; +%% Arithmetic evalution and comparison. +prove_goal(Params = #param{goal = {is, N, E0}, bindings = Bs, database = Db}) -> + E = eb_logic:eval_arith(ec_support:deref(E0, Bs), Bs, Db), + ec_body:unify_prove_body(N, E, Params); +prove_goal(Params = #param{goal = {'>', L, R}}) -> + eb_logic:arith_test_prove_body('>', L, R, Params); +prove_goal(Params = #param{goal = {'>=', L, R}}) -> + eb_logic:arith_test_prove_body('>=', L, R, Params); +prove_goal(Params = #param{goal = {'=:=', L, R}}) -> + eb_logic:arith_test_prove_body('==', L, R, Params); +prove_goal(Params = #param{goal = {'=\\=', L, R}}) -> + eb_logic:arith_test_prove_body('/=', L, R, Params); +prove_goal(Params = #param{goal = {'<', L, R}}) -> + eb_logic:arith_test_prove_body('<', L, R, Params); +prove_goal(Params = #param{goal = {'=<', L, R}}) -> + eb_logic:arith_test_prove_body('=<', L, R, Params). \ No newline at end of file diff --git a/src/core/logic/erlog_core.erl b/src/libs/standard/core/logic/ec_logic.erl similarity index 59% rename from src/core/logic/erlog_core.erl rename to src/libs/standard/core/logic/ec_logic.erl index 0abc57e..4143f14 100644 --- a/src/core/logic/erlog_core.erl +++ b/src/libs/standard/core/logic/ec_logic.erl @@ -1,61 +1,27 @@ -%% Copyright (c) 2008-2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - --module(erlog_core). +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc core logic code of erlog_code functions +%%% +%%% @end +%%% Created : 15. Июль 2014 16:02 +%%%------------------------------------------------------------------- +-module(ec_logic). +-author("tihon"). -include("erlog_core.hrl"). --include("erlog_bips.hrl"). --include("erlog_db.hrl"). --include("erlog_dcg.hrl"). --include("erlog_lists.hrl"). --include("erlog_time.hrl"). - -%% Main execution functions. --export([ + +%% API +-export([initial_goal/1, + check_goal/6, + prove_findall/4, + prove_ecall/3, + prove_clause/3, + prove_current_predicate/2, prove_predicates/3, - prove_goal_clauses/3, prove_retract/2, prove_retractall/2, - prove_clause/3, - prove_current_predicate/2, - prove_ecall/3, - prove_goal/4, - prove_findall/4, retract_clauses/4]). -%% Adding to database. --export([load/1]). - -%% built_in_db(Db) -> Database. -%% Create an initial clause database containing the built-in -%% predicates and predefined library predicates. - -load(Db) -> - lists:foreach(fun(Head) -> erlog_memory:add_built_in(Db, Head) end, ?ERLOG_CORE). %% Add the Erlang built-ins. - -%% prove_goal(Goal, Database) -> Succeed | Fail. -%% This is the main entry point into the interpreter. Check that -%% everything is consistent then prove the goal as a call. --spec prove_goal(Goal0 :: term(), Db :: pid(), Fcon :: fun(), Event :: pid()) -> term(). -prove_goal(Goal0, Db, Fcon, Event) -> - %% put(erlog_cut, orddict:new()), - %% put(erlog_cps, orddict:new()), - %% put(erlog_var, orddict:new()), - %% Check term and build new instance of term with bindings. - {Goal1, Bs, Vn} = ec_goals:initial_goal(Goal0), - Params = #param{goal = [{call, Goal1}], choice = [], bindings = Bs, var_num = Vn, - event_man = Event, database = Db, f_consulter = Fcon}, - ec_body:prove_body(Params). %TODO use lists:foldr instead! %% prove_findall(Term, Goal, Bag, Param) %% Do findall on Goal and return list of each Term in Bag. We are @@ -67,13 +33,13 @@ prove_goal(Goal0, Db, Fcon, Event) -> prove_findall(T, G, B0, Param = #param{bindings = Bs, choice = Cps, next_goal = Next, var_num = Vn, database = Db}) -> Label = Vn, Tag = Vn + 1, %Increment to avoid clashes - {Next1, _} = ec_goals:check_goal(G, [{{findall}, Tag, T}], Bs, Db, false, Label), + {Next1, _} = ec_logic:check_goal(G, [{{findall}, Tag, T}], Bs, Db, false, Label), B1 = partial_list(B0, Bs), Cp = #cp{type = findall, data = {Tag, B1}, next = Next, bs = Bs, vn = Vn}, erlog_memory:raw_store(Db, Tag, []), %Initialise collection %% Catch case where an erlog error occurs when cleanup database. try - ec_body:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], bindings = Bs, var_num = Vn + 1}) + ec_core:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], bindings = Bs, var_num = Vn + 1}) catch throw:{erlog_error, E, Dba} -> Dbb = erlog_memory:raw_erase(Dba, Tag), %Clear special entry @@ -125,37 +91,6 @@ prove_predicates(Pi, [F | Fs], Param = #param{next_goal = Next, choice = Cps, bi ec_body:unify_prove_body(Pi, ec_support:pred_ind(F), Param#param{choice = [Cp | Cps]}); prove_predicates(_Pi, [], Param) -> erlog_errors:fail(Param). -%% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Try to prove Goal using Clauses which all have the same functor. -prove_goal_clauses(G, [C], Params = #param{choice = Cps, var_num = Vn}) -> - %% Must be smart here and test whether we need to add a cut point. - %% C has the structure {Tag,Head,{Body,BodyHasCut}}. - case element(2, element(3, C)) of - true -> - Cut = #cut{label = Vn}, - prove_goal_clause(G, C, Params#param{choice = [Cut | Cps]}); - false -> - prove_goal_clause(G, C, Params) - end; -%% prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db); -prove_goal_clauses(G, [C | Cs], Params = #param{next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps}) -> - Cp = #cp{type = goal_clauses, label = Vn, data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, - prove_goal_clause(G, C, Params#param{choice = [Cp | Cps]}); -prove_goal_clauses(_G, [], Param) -> erlog_errors:fail(Param). - -prove_goal_clause(G, {_Tag, H0, {B0, _}}, Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0}) -> - %% io:fwrite("PGC1: ~p\n", [{G,H0,B0}]), - Label = Vn0, - case ec_unify:unify_head(G, H0, Bs0, Vn0 + 1) of - {succeed, Rs0, Bs1, Vn1} -> - %% io:fwrite("PGC2: ~p\n", [{Rs0}]), - {B1, _Rs2, Vn2} = ec_body:body_instance(B0, Next, Rs0, Vn1, Label), - %% io:fwrite("PGC3: ~p\n", [{B1,Next,Cps}]), - ec_body:prove_body(Param#param{goal = B1, bindings = Bs1, var_num = Vn2}); - fail -> erlog_errors:fail(Param) - end. - %% prove_retract(Clause, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Retract clauses in database matching Clause. @@ -169,6 +104,109 @@ prove_retractall({':-', H, B}, Params) -> prove_retractall(H, Params) -> prove_retractall(H, true, Params). +%% check_goal(Goal, Next, Bindings, Database, CutAfter, CutLabel) -> +%% {WellFormedBody,HasCut}. +%% Check to see that Goal is bound and ensure that it is well-formed. +check_goal(G0, Next, Bs, Db, Cut, Label) -> + case ec_support:dderef(G0, Bs) of + {_} -> erlog_errors:instantiation_error(Db); %Must have something to call + G1 -> + case catch {ok, well_form_goal(G1, Next, Cut, Label)} of + {erlog_error, E} -> erlog_errors:erlog_error(E, Db); + {ok, GC} -> GC %Body and cut + end + end. + +%% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Try to retract Head and Body using Clauses which all have the same functor. +retract_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param); +retract_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}) -> %TODO foreach vs handmade recursion? + case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of + {succeed, Bs1, Vn1} -> + %% We have found a right clause so now retract it. + erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), + Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, + ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); + fail -> retract_clauses(Ch, Cb, Cs, Param) + end. + +%% well_form_goal(Goal, Tail, HasCutAfter, CutLabel) -> {Body,HasCut}. +%% Check that Goal is well-formed, flatten conjunctions, fix cuts and +%% add explicit call to top-level variables. +well_form_goal({',', L, R}, Tail0, Cut0, Label) -> + {Tail1, Cut1} = well_form_goal(R, Tail0, Cut0, Label), + well_form_goal(L, Tail1, Cut1, Label); +well_form_goal({';', {'->', C0, T0}, E0}, Tail, Cut0, Label) -> + {T1, Tc} = well_form_goal(T0, Tail, Cut0, Label), + {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), + {E1, Ec} = well_form_goal(E0, Tail, Cut0, Label), + {[{{if_then_else}, E1, Label} | C1], Tc or Ec}; +well_form_goal({';', L0, R0}, Tail, Cut0, Label) -> + {L1, Lc} = well_form_goal(L0, Tail, Cut0, Label), + {R1, Rc} = well_form_goal(R0, Tail, Cut0, Label), + {[{{disj}, R1} | L1], Lc or Rc}; +well_form_goal({'->', C0, T0}, Tail, Cut0, Label) -> + {T1, Cut1} = well_form_goal(T0, Tail, Cut0, Label), + %% N.B. an extra cut will be added at run-time! + {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), + {[{{if_then}, Label} | C1], Cut1}; +well_form_goal({once, G}, Tail, Cut, Label) -> + {G1, _} = well_form_goal(G, [{{cut}, Label, true} | Tail], true, Label), + {[{{once}, Label} | G1], Cut}; +well_form_goal({V}, Tail, Cut, _Label) -> + {[{call, {V}} | Tail], Cut}; +well_form_goal(true, Tail, Cut, _Label) -> {Tail, Cut}; %No-op +well_form_goal(fail, _Tail, _Cut, _Label) -> {[fail], false}; %No further +well_form_goal('!', Tail, Cut, Label) -> + {[{{cut}, Label, not Cut} | Tail], true}; +well_form_goal(Goal, Tail, Cut, _Label) -> + ec_support:functor(Goal), %Check goal + {[Goal | Tail], Cut}. + +%% initial_goal(Goal) -> {Goal,Bindings,NewVarNum}. +%% initial_goal(Goal, Bindings, VarNum) -> {Goal,NewBindings,NewVarNum}. +%% Check term for well-formedness as an Erlog term and replace '_' +%% variables with unique numbered variables. Error on non-well-formed +%% goals. +initial_goal(Goal) -> initial_goal(Goal, ec_support:new_bindings(), 0). + + +%% @private +initial_goal({'_'}, Bs, Vn) -> {{Vn}, Bs, Vn + 1}; %Anonymous variable +initial_goal({Name} = Var0, Bs, Vn) when is_atom(Name) -> + case ec_support:get_binding(Var0, Bs) of + {ok, Var1} -> {Var1, Bs, Vn}; + error -> + Var1 = {Vn}, + {Var1, ec_support:add_binding(Var0, Var1, Bs), Vn + 1} + end; +initial_goal([H0 | T0], Bs0, Vn0) -> + {H1, Bs1, Vn1} = initial_goal(H0, Bs0, Vn0), + {T1, Bs2, Vn2} = initial_goal(T0, Bs1, Vn1), + {[H1 | T1], Bs2, Vn2}; +initial_goal([], Bs, Vn) -> {[], Bs, Vn}; +initial_goal(S, Bs0, Vn0) when ?IS_FUNCTOR(S) -> + As0 = tl(tuple_to_list(S)), + {As1, Bs1, Vn1} = initial_goal(As0, Bs0, Vn0), + {list_to_tuple([element(1, S) | As1]), Bs1, Vn1}; +initial_goal(T, Bs, Vn) when ?IS_ATOMIC(T) -> {T, Bs, Vn}; +initial_goal(T, _Bs, _Vn) -> erlog_errors:type_error(callable, T). + +%% @private +%% partial_list(Term, Bindings) -> Term. +%% Dereference all variables and check if partial list. +partial_list([], _) -> []; +partial_list([H | T0], Bs) -> + T1 = partial_list(T0, Bs), + [H | T1]; +partial_list({V} = Var, Bs) -> + case ?BIND:find(V, Bs) of + {ok, T} -> partial_list(T, Bs); + error -> Var + end; +partial_list(Other, _) -> erlog_errors:type_error(list, Other). + %% @private prove_retract(H, B, Params = #param{database = Db}) -> Functor = ec_support:functor(H), @@ -194,37 +232,10 @@ prove_retractall(H, B, Params = #param{next_goal = Next, bindings = Bs0, var_num fail -> ok end end, Cs), - ec_body:prove_body(Params#param{goal = Next}); + ec_core:prove_body(Params#param{goal = Next}); {code, _} -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); built_in -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - undefined -> ec_body:prove_body(Params#param{goal = Next}) - end. - -%% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Try to retract Head and Body using Clauses which all have the same functor. -retract_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param); -retract_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}) -> %TODO foreach vs handmade recursion? - case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of - {succeed, Bs1, Vn1} -> - %% We have found a right clause so now retract it. - erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), - Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, - ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); - fail -> retract_clauses(Ch, Cb, Cs, Param) - end. - -%% partial_list(Term, Bindings) -> Term. -%% Dereference all variables and check if partial list. -partial_list([], _) -> []; -partial_list([H | T0], Bs) -> - T1 = partial_list(T0, Bs), - [H | T1]; -partial_list({V} = Var, Bs) -> - case ?BIND:find(V, Bs) of - {ok, T} -> partial_list(T, Bs); - error -> Var - end; -partial_list(Other, _) -> erlog_errors:type_error(list, Other). \ No newline at end of file + undefined -> ec_core:prove_body(Params#param{goal = Next}) + end. \ No newline at end of file diff --git a/src/core/logic/ec_goals.erl b/src/libs/standard/core/main/erlog_core.erl similarity index 57% rename from src/core/logic/ec_goals.erl rename to src/libs/standard/core/main/erlog_core.erl index 730516b..c763f05 100644 --- a/src/core/logic/ec_goals.erl +++ b/src/libs/standard/core/main/erlog_core.erl @@ -1,18 +1,39 @@ -%%%------------------------------------------------------------------- -%%% @author tihon -%%% @copyright (C) 2014, -%%% @doc -%%% -%%% @end -%%% Created : 15. Июль 2014 16:02 -%%%------------------------------------------------------------------- --module(ec_goals). --author("tihon"). +%% Copyright (c) 2008-2013 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +-module(erlog_core). -include("erlog_core.hrl"). +-include("erlog_bips.hrl"). +-include("erlog_db.hrl"). +-include("erlog_dcg.hrl"). +-include("erlog_lists.hrl"). +-include("erlog_time.hrl"). + +-behaviour(erlog_stdlib). + +%% Main execution functions. +-export([prove_goal/1]). +%% Adding to database. +-export([load/1]). -%% API --export([prove_goal/1, initial_goal/1, check_goal/6]). +%% built_in_db(Db) -> Database. +%% Create an initial clause database containing the built-in +%% predicates and predefined library predicates. +load(Db) -> + lists:foreach(fun(Head) -> + erlog_memory:load_kernel_space(Db, ?MODULE, Head) end, ?ERLOG_CORE). %% Add the Erlang built-ins. %% prove_goal(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> %% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase} | @@ -28,12 +49,12 @@ prove_goal(Param = #param{goal = {call, G}, next_goal = Next0, choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> %% Only add cut CP to Cps if goal contains a cut. Label = Vn, - case check_goal(G, Next0, Bs, Db, false, Label) of + case ec_logic:check_goal(G, Next0, Bs, Db, false, Label) of {Next1, true} -> %% Must increment Vn to avoid clashes!!! Cut = #cut{label = Label}, - ec_body:prove_body(Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); - {Next1, false} -> ec_body:prove_body(Param#param{goal = Next1, var_num = Vn + 1}) + ec_core:prove_body(Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); + {Next1, false} -> ec_core:prove_body(Param#param{goal = Next1, var_num = Vn + 1}) end; prove_goal(Param = #param{goal = {{cut}, Label, Last}}) -> %% Cut succeeds and trims back to cut ancestor. @@ -41,7 +62,7 @@ prove_goal(Param = #param{goal = {{cut}, Label, Last}}) -> prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> %% There is no L here, it has already been prepended to Next. Cp = #cp{type = disjunction, next = R, bs = Bs, vn = Vn}, - ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); + ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); prove_goal(Params = #param{goal = fail}) -> erlog_errors:fail(Params); prove_goal(Param = #param{goal = {{if_then}, Label}, next_goal = Next, choice = Cps}) -> %% We effetively implement ( C -> T ) with ( C, !, T ) but cuts in @@ -49,7 +70,7 @@ prove_goal(Param = #param{goal = {{if_then}, Label}, next_goal = Next, choice = %% There is no ( C, !, T ) here, it has already been prepended to Next. %%io:fwrite("PG(->): ~p\n", [{Next}]), Cut = #cut{label = Label}, - ec_body:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); + ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); prove_goal(Param = #param{goal = {{if_then_else}, Else, Label}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> %% Need to push a choicepoint to fail back to inside Cond and a cut %% to cut back to before Then when Cond succeeds. #cp{type=if_then_else} @@ -57,54 +78,54 @@ prove_goal(Param = #param{goal = {{if_then_else}, Else, Label}, next_goal = Next %% There is no ( C, !, T ) here, it has already been prepended to Next. Cp = #cp{type = if_then_else, label = Label, next = Else, bs = Bs, vn = Vn}, %%io:fwrite("PG(->;): ~p\n", [{Next,Else,[Cp|Cps]}]), - ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); + ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); prove_goal(Param = #param{goal = {'\\+', G}, next_goal = Next0, choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> %% We effectively implementing \+ G with ( G -> fail ; true ). Label = Vn, - {Next1, _} = check_goal(G, [{{cut}, Label, true}, fail], Bs, Db, true, Label), + {Next1, _} = ec_logic:check_goal(G, [{{cut}, Label, true}, fail], Bs, Db, true, Label), Cp = #cp{type = if_then_else, label = Label, next = Next0, bs = Bs, vn = Vn}, %%io:fwrite("PG(\\+): ~p\n", [{G1,[Cp|Cps]]), %% Must increment Vn to avoid clashes!!! - ec_body:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], var_num = Vn + 1}); + ec_core:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], var_num = Vn + 1}); prove_goal(Param = #param{goal = {{once}, Label}, next_goal = Next, choice = Cps}) -> %% We effetively implement once(G) with ( G, ! ) but cuts in %% G are local to G. %% There is no ( G, ! ) here, it has already been prepended to Next. Cut = #cut{label = Label}, - ec_body:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); + ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); prove_goal(Param = #param{goal = repeat, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> Cp = #cp{type = disjunction, next = [repeat | Next], bs = Bs, vn = Vn}, - ec_body:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); + ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); %% Clause creation and destruction. prove_goal(Param = #param{goal = {abolish, Pi0}, next_goal = Next, bindings = Bs, database = Db}) -> case ec_support:dderef(Pi0, Bs) of {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> erlog_memory:abolish_clauses(Db, {N, A}), - ec_body:prove_body(Param#param{goal = Next}); + ec_core:prove_body(Param#param{goal = Next}); Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) end; prove_goal(Param = #param{goal = {Assert, C0}, next_goal = Next, bindings = Bs, database = Db}) when Assert == assert; Assert == assertz -> C = ec_support:dderef(C0, Bs), erlog_memory:assertz_clause(Db, C), - ec_body:prove_body(Param#param{goal = Next}); + ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {asserta, C0}, next_goal = Next, bindings = Bs, database = Db}) -> C = ec_support:dderef(C0, Bs), erlog_memory:asserta_clause(Db, C), - ec_body:prove_body(Param#param{goal = Next}); + ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {retract, C0}, bindings = Bs}) -> C = ec_support:dderef(C0, Bs), - erlog_core:prove_retract(C, Param); + ec_logic:prove_retract(C, Param); prove_goal(Param = #param{goal = {retractall, C0}, bindings = Bs}) -> C = ec_support:dderef(C0, Bs), - erlog_core:prove_retractall(C, Param); + ec_logic:prove_retractall(C, Param); %% Clause retrieval and information prove_goal(Param = #param{goal = {clause, H0, B}, bindings = Bs}) -> H1 = ec_support:dderef(H0, Bs), - erlog_core:prove_clause(H1, B, Param); + ec_logic:prove_clause(H1, B, Param); prove_goal(Param = #param{goal = {current_predicate, Pi0}, bindings = Bs}) -> Pi = ec_support:dderef(Pi0, Bs), - erlog_core:prove_current_predicate(Pi, Param); + ec_logic:prove_current_predicate(Pi, Param); prove_goal(Param = #param{goal = {predicate_property, H0, P}, bindings = Bs, database = Db}) -> H = ec_support:dderef(H0, Bs), case catch erlog_memory:get_procedure_type(Db, ec_support:functor(H)) of @@ -131,13 +152,13 @@ prove_goal(Param = #param{goal = {ecall, C0, Val}, bindings = Bs, database = Db} Fun when is_function(Fun) -> Fun; Other -> erlog_errors:type_error(callable, Other, Db) end, - erlog_core:prove_ecall(Efun, Val, Param); + ec_logic:prove_ecall(Efun, Val, Param); %% Non-standard but useful. prove_goal(Param = #param{goal = {writeln, T}, next_goal = Next, bindings = Bs, event_man = Evman}) -> %% Display procedure. Res = ec_support:write(T, Bs), gen_event:notify(Evman, Res), - ec_body:prove_body(Param#param{goal = Next}); + ec_core:prove_body(Param#param{goal = Next}); %% File utils prove_goal(Param = #param{goal = {consult, Name}, next_goal = Next, bindings = Bs, f_consulter = Fcon, database = Db}) -> case erlog_file:consult(Fcon, ec_support:dderef(Name, Bs), Db) of @@ -145,27 +166,27 @@ prove_goal(Param = #param{goal = {consult, Name}, next_goal = Next, bindings = B {Err, Error} when Err == erlog_error; Err == error -> erlog_errors:erlog_error(Error, Db) end, - ec_body:prove_body(Param#param{goal = Next}); + ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {reconsult, Name}, next_goal = Next, f_consulter = Fcon, database = Db}) -> case erlog_file:reconsult(Fcon, Name, Db) of ok -> ok; {Err, Error} when Err == erlog_error; Err == error -> erlog_errors:erlog_error(Error, Db) end, - ec_body:prove_body(Param#param{goal = Next}); + ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db}) -> try Library:load(Db) catch _:Error -> erlog_errors:erlog_error(Error, Db) end, - ec_body:prove_body(Param#param{goal = Next}); + ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {listing, Res}, next_goal = Next, bindings = Bs0, database = Db}) -> Content = erlog_memory:listing(Db), Bs = ec_support:add_binding(Res, Content, Bs0), - ec_body:prove_body(Param#param{goal = Next, bindings = Bs}); + ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); prove_goal(Param = #param{goal = {findall, T, G, B}}) -> - erlog_core:prove_findall(T, G, B, Param); + ec_logic:prove_findall(T, G, B, Param); prove_goal(Param = #param{goal = {{findall}, Tag, T0}, bindings = Bs, database = Db}) -> T1 = ec_support:dderef(T0, Bs), erlog_memory:raw_append(Db, Tag, T1), %Append to saved list @@ -181,88 +202,4 @@ prove_goal(Param = #param{goal = {bagof, Goal, Fun, Res}, choice = Cs0, bindings UpdBs1 = ec_support:update_vars(Goal, FunList, Key, UpdBs0), [#cp{type = disjunction, label = Fun, next = Next, bs = UpdBs1, vn = Vn} | Acc] end, Cs0, Collected), - ec_body:prove_body(Param#param{goal = Next, bindings = UBs#cp.bs, choice = Choises, var_num = Vn + length(Choises)}); -%% Now look up the database. -prove_goal(Param = #param{goal = G, database = Db}) -> -%% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), - case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of - built_in -> erlog_bips:prove_goal(G, Param); - {code, {Mod, Func}} -> Mod:Func(G, Param); - {clauses, Cs} -> erlog_core:prove_goal_clauses(G, Cs, Param); - undefined -> erlog_errors:fail(Param); - %% Getting built_in here is an error! - {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data - end. - -%% check_goal(Goal, Next, Bindings, Database, CutAfter, CutLabel) -> -%% {WellFormedBody,HasCut}. -%% Check to see that Goal is bound and ensure that it is well-formed. -check_goal(G0, Next, Bs, Db, Cut, Label) -> - case ec_support:dderef(G0, Bs) of - {_} -> erlog_errors:instantiation_error(Db); %Must have something to call - G1 -> - case catch {ok, well_form_goal(G1, Next, Cut, Label)} of - {erlog_error, E} -> erlog_errors:erlog_error(E, Db); - {ok, GC} -> GC %Body and cut - end - end. - -%% well_form_goal(Goal, Tail, HasCutAfter, CutLabel) -> {Body,HasCut}. -%% Check that Goal is well-formed, flatten conjunctions, fix cuts and -%% add explicit call to top-level variables. -well_form_goal({',', L, R}, Tail0, Cut0, Label) -> - {Tail1, Cut1} = well_form_goal(R, Tail0, Cut0, Label), - well_form_goal(L, Tail1, Cut1, Label); -well_form_goal({';', {'->', C0, T0}, E0}, Tail, Cut0, Label) -> - {T1, Tc} = well_form_goal(T0, Tail, Cut0, Label), - {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), - {E1, Ec} = well_form_goal(E0, Tail, Cut0, Label), - {[{{if_then_else}, E1, Label} | C1], Tc or Ec}; -well_form_goal({';', L0, R0}, Tail, Cut0, Label) -> - {L1, Lc} = well_form_goal(L0, Tail, Cut0, Label), - {R1, Rc} = well_form_goal(R0, Tail, Cut0, Label), - {[{{disj}, R1} | L1], Lc or Rc}; -well_form_goal({'->', C0, T0}, Tail, Cut0, Label) -> - {T1, Cut1} = well_form_goal(T0, Tail, Cut0, Label), - %% N.B. an extra cut will be added at run-time! - {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), - {[{{if_then}, Label} | C1], Cut1}; -well_form_goal({once, G}, Tail, Cut, Label) -> - {G1, _} = well_form_goal(G, [{{cut}, Label, true} | Tail], true, Label), - {[{{once}, Label} | G1], Cut}; -well_form_goal({V}, Tail, Cut, _Label) -> - {[{call, {V}} | Tail], Cut}; -well_form_goal(true, Tail, Cut, _Label) -> {Tail, Cut}; %No-op -well_form_goal(fail, _Tail, _Cut, _Label) -> {[fail], false}; %No further -well_form_goal('!', Tail, Cut, Label) -> - {[{{cut}, Label, not Cut} | Tail], true}; -well_form_goal(Goal, Tail, Cut, _Label) -> - ec_support:functor(Goal), %Check goal - {[Goal | Tail], Cut}. - -%% initial_goal(Goal) -> {Goal,Bindings,NewVarNum}. -%% initial_goal(Goal, Bindings, VarNum) -> {Goal,NewBindings,NewVarNum}. -%% Check term for well-formedness as an Erlog term and replace '_' -%% variables with unique numbered variables. Error on non-well-formed -%% goals. -initial_goal(Goal) -> initial_goal(Goal, ec_support:new_bindings(), 0). - -initial_goal({'_'}, Bs, Vn) -> {{Vn}, Bs, Vn + 1}; %Anonymous variable -initial_goal({Name} = Var0, Bs, Vn) when is_atom(Name) -> - case ec_support:get_binding(Var0, Bs) of - {ok, Var1} -> {Var1, Bs, Vn}; - error -> - Var1 = {Vn}, - {Var1, ec_support:add_binding(Var0, Var1, Bs), Vn + 1} - end; -initial_goal([H0 | T0], Bs0, Vn0) -> - {H1, Bs1, Vn1} = initial_goal(H0, Bs0, Vn0), - {T1, Bs2, Vn2} = initial_goal(T0, Bs1, Vn1), - {[H1 | T1], Bs2, Vn2}; -initial_goal([], Bs, Vn) -> {[], Bs, Vn}; -initial_goal(S, Bs0, Vn0) when ?IS_FUNCTOR(S) -> - As0 = tl(tuple_to_list(S)), - {As1, Bs1, Vn1} = initial_goal(As0, Bs0, Vn0), - {list_to_tuple([element(1, S) | As1]), Bs1, Vn1}; -initial_goal(T, Bs, Vn) when ?IS_ATOMIC(T) -> {T, Bs, Vn}; -initial_goal(T, _Bs, _Vn) -> erlog_errors:type_error(callable, T). \ No newline at end of file + ec_core:prove_body(Param#param{goal = Next, bindings = UBs#cp.bs, choice = Choises, var_num = Vn + length(Choises)}). \ No newline at end of file diff --git a/src/libs/standard/erlog_dcg.erl b/src/libs/standard/dcg/logic/ed_logic.erl similarity index 57% rename from src/libs/standard/erlog_dcg.erl rename to src/libs/standard/dcg/logic/ed_logic.erl index e6083c1..38ebff9 100644 --- a/src/libs/standard/erlog_dcg.erl +++ b/src/libs/standard/dcg/logic/ed_logic.erl @@ -1,66 +1,18 @@ -%% Copyright (c) 2008-2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - -%% File : erlog_dcg.erl -%% Author : Robert Virding -%% Purpose : DCG conversion and procedures. - --module(erlog_dcg). +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 12. Авг. 2014 17:48 +%%%------------------------------------------------------------------- +-module(ed_logic). +-author("tihon"). -include("erlog_core.hrl"). --include("erlog_dcg.hrl"). - --export([expand_term/1, expand_term/2]). --export([expand_term_2/1, phrase_3/1]). --export([load/1]). -load(Db) -> - %% Compiled DCG predicates. - lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_DCG), - %% Interpreted DCG predicates. - lists:foreach(fun(Clause) -> erlog_memory:assertz_clause(Db, Clause) end, - [ - %% 'C'([H|T], H, T). - %% {'C',[{1}|{2}],{1},{2}}, %For DCGs - %% phrase(V, L) :- phrase(V, L, []). - {':-', {phrase, {1}, {2}}, {phrase, {1}, {2}, []}} - %% phrase(V, L, R) :- - %% V =.. Z, append(Z, [L,R], G), C =.. G, C. - %% {':-',{phrase,{1},{2},{3}}, - %% {',',{'=..',{1},{4}},{',',{append,{4},[{2},{3}],{5}}, - %% {',',{'=..',{6},{5}},{6}}}}} - ]). - -%% expand_term_2(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> -%% void -%% Call the expand_term/2 predicate. -expand_term_2(Param = #param{goal = Goal, bindings = Bs, var_num = Vn0}) -> - {expand_term, DCGRule, A2} = ec_support:dderef(Goal, Bs), - {Exp, Vn1} = expand_term(DCGRule, Vn0), - ec_body:unify_prove_body(A2, Exp, Param#param{var_num = Vn1}). - -%% phrase_3(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> void. -%% Call the phrase/3 preidicate. We could easily do this in prolog -%% except for that it calls dcg_body/4 which is not exported. -%% -%% phrase(GRBody, S0, S) -> dcg_body(GRBody, S0, S, Goal), call(Goal). -phrase_3(Param = #param{goal = Goal, next_goal = Next0, bindings = Bs, var_num = Vn0}) -> - {phrase, GRBody, S0, S} = ec_support:dderef(Goal, Bs), - {Body, Vn1} = dcg_body(GRBody, S0, S, Vn0), - %% io:format("~p\n", [Body]), - Next1 = [{call, Body} | Next0], %Evaluate body - ec_body:prove_body(Param#param{goal = Next1, var_num = Vn1}). +%% API +-export([expand_term/1, phrase/1]). %% expand_term(Term) -> {ExpTerm}. %% expand_term(Term, VarNum) -> {ExpTerm,NewVarNum}. @@ -73,6 +25,13 @@ expand_term({'-->', _, _} = Term, Vn) -> dcg_rule(Term, Vn); expand_term(Term, Vn) -> {Term, Vn}. +phrase(Params = #param{goal = Goal, next_goal = Next0, bindings = Bs, var_num = Vn0}) -> + {phrase, GRBody, S0, S} = ec_support:dderef(Goal, Bs), + {Body, Vn1} = ed_logic:dcg_body(GRBody, S0, S, Vn0), + %% io:format("~p\n", [Body]), + Next1 = [{call, Body} | Next0], %Evaluate body + ec_core:prove_body(Params#param{goal = Next1, var_num = Vn1}). + %% dcg_rule(Term, VarNum) -> {ExpTerm,NewVarNum}. %% dcg_rule(DCGRule, VarIn, VarOout, VarNum) -> {ExpTerm,NewVarNum}. %% dcg_non_term(NonTerminal, VarIn, VarOut) -> ExpTerm. diff --git a/src/libs/standard/dcg/main/erlog_dcg.erl b/src/libs/standard/dcg/main/erlog_dcg.erl new file mode 100644 index 0000000..9023c8a --- /dev/null +++ b/src/libs/standard/dcg/main/erlog_dcg.erl @@ -0,0 +1,39 @@ +%% Copyright (c) 2008-2013 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : erlog_dcg.erl +%% Author : Robert Virding +%% Purpose : DCG conversion and procedures. + +-module(erlog_dcg). + +-include("erlog_core.hrl"). +-include("erlog_dcg.hrl"). + +-behaviour(erlog_stdlib). + +-export([load/1]). +-export([prove_goal/1]). + +load(Db) -> + lists:foreach(fun(Proc) -> erlog_memory:load_kernel_space(Db, ?MODULE, Proc) end, ?ERLOG_DCG). + +prove_goal(Params = #param{goal = {expand_term, _, _} = Goal, bindings = Bs, var_num = Vn0}) -> + {expand_term, DCGRule, A2} = ec_support:dderef(Goal, Bs), + {Exp, Vn1} = ed_logic:expand_term(DCGRule, Vn0), + ec_body:unify_prove_body(A2, Exp, Params#param{var_num = Vn1}); +prove_goal(Params = #param{goal = {phrase, A, B}}) -> + ed_logic:phrase(Params#param{goal = {phrase, A, B, []}}); +prove_goal(Params = #param{goal = {phrase, _, _, _}}) -> + ed_logic:phrase(Params). \ No newline at end of file diff --git a/src/libs/standard/erlog_lists.erl b/src/libs/standard/erlog_lists.erl deleted file mode 100644 index e14f082..0000000 --- a/src/libs/standard/erlog_lists.erl +++ /dev/null @@ -1,187 +0,0 @@ -%% Copyright (c) 2013 Robert Virding -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. - -%% File : erlog_lists.erl -%% Author : Robert Virding -%% Purpose : Standard Erlog lists library. -%% -%% This is a standard lists library for Erlog. Everything here is -%% pretty basic and common to most Prologs. We are experimenting here -%% and some predicates are compiled. We only get a small benefit when -%% only implementing indexing on the first argument. - --module(erlog_lists). - --include("erlog_core.hrl"). --include("erlog_lists.hrl"). - -%% Main interface functions. --export([load/1]). - -%% Library functions. --export([append_3/2, insert_3/2, member_2/2, memberchk_2/2, reverse_2/2, sort_2/2, length_2/2]). - -%% load(Database) -> Database. -%% Assert predicates into the database. -load(Db) -> - %% Compiled common list library. - lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_LISTS), - %% Finally interpreted common list library. - lists:foreach(fun(Clause) -> erlog_memory:assertz_clause(Db, Clause) end, - [ - %% insert(L, X, [X|L]). insert([H|L], X, [H|L1]) :- insert(L, X, L1). - %% delete([X|L], X, L). delete([H|L], X, [H|L1]) :- delete(L, X, L1). - {':-', {delete, {1}, {2}, {3}}, {insert, {3}, {2}, {1}}}, - %% perm([], []). - %% perm([X|Xs], Ys1) :- perm(Xs, Ys), insert(Ys, X, Ys1). - {perm, [], []}, - {':-', {perm, [{1} | {2}], {3}}, {',', {perm, {2}, {4}}, {insert, {4}, {1}, {3}}}} - ]). - -length_2({length, ListVar, Len}, Params = #param{next_goal = Next, bindings = Bs0}) -> - case ec_support:deref(ListVar, Bs0) of - List when is_list(List) -> - Bs1 = ec_support:add_binding(Len, length(List), Bs0), - ec_body:prove_body(Params#param{goal = Next, bindings = Bs1}); - _ -> erlog_errors:fail(Params) - end. - -%% append_3(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. -%% append([], L, L). -%% append([H|T], L, [H|L1]) :- append(T, L, L1). -%% Here we attempt to compile indexing in the first argument. -append_3({append, A1, L, A3}, Params = #param{next_goal = Next0, bindings = Bs0, choice = Cps, - var_num = Vn, f_consulter = Fcon}) -> - case ec_support:deref(A1, Bs0) of - [] -> %Cannot backtrack - ec_body:unify_prove_body(L, A3, Params); - [H | T] -> %Cannot backtrack - L1 = {Vn}, - Next1 = [{append, T, L, L1} | Next0], - ec_body:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, var_num = Vn + 1}); - {_} = Var -> %This can backtrack - FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed - fail_append_3(LCp, Params#param{choice = LCps, database = LDb, f_consulter = Fcon}, Var, L, A3) - end, - Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, - Bs1 = ec_support:add_binding(Var, [], Bs0), - ec_body:unify_prove_body(L, A3, Params#param{choice = [Cp | Cps], bindings = Bs1}); - _ -> erlog_errors:fail(Params) %Will fail here! - end. - -fail_append_3(#cp{next = Next0, bs = Bs0, vn = Vn}, Params, A1, L, A3) -> - H = {Vn}, - T = {Vn + 1}, - L1 = {Vn + 2}, - Bs1 = ec_support:add_binding(A1, [H | T], Bs0), %A1 always a variable here. - Next1 = [{append, T, L, L1} | Next0], - ec_body:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs1, - var_num = Vn + 3}). - -%% insert_3(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. -%% insert(L, X, [X|L]). -%% insert([H|L], X, [H|L1]) :- insert(L, X, L1). -insert_3({insert, A1, A2, A3}, Params = #param{next_goal = Next, bindings = Bs, choice = Cps, var_num = Vn, f_consulter = Fcon}) -> - FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed - fail_insert_3(LCp, Params#param{choice = LCps, database = LDb, f_consulter = Fcon}, A1, A2, A3) - end, - Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, - ec_body:unify_prove_body(A3, [A2 | A1], Params#param{choice = [Cp | Cps]}). - -fail_insert_3(#cp{next = Next0, bs = Bs, vn = Vn}, Params, A1, X, A3) -> - H = {Vn}, - L = {Vn + 1}, - L1 = {Vn + 2}, - Next1 = [{insert, L, X, L1} | Next0], - ec_body:unify_prove_body(A1, [H | L], A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 3}). - -%% member_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. -%% member(X, [X|_]). -%% member(X, [_|T]) :- member(X, T). -member_2({member, A1, A2}, Param = #param{next_goal = Next, bindings = Bs, choice = Cps, var_num = Vn}) -> - FailFun = fun(LCp, LCps, LDb) -> - fail_member_2(LCp, Param#param{choice = LCps, database = LDb}, A1, A2) - end, - Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, - T = {Vn}, - ec_body:unify_prove_body(A2, [A1 | T], Param#param{choice = [Cp | Cps], var_num = Vn + 1}). - -fail_member_2(#cp{next = Next0, bs = Bs, vn = Vn}, Params, A1, A2) -> - H = {Vn}, - T = {Vn + 1}, - Next1 = [{member, A1, T} | Next0], - ec_body:unify_prove_body(A2, [H | T], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 2}). - -%% memberchk_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. -%% memberchk(X, [X|_]) :- !. -%% memberchk(X, [_|T]) :- member(X, T). -%% We don't build the list and we never backtrack so we can be smart -%% and match directly. Should we give a type error? -memberchk_2({memberchk, A1, A2}, Params = #param{next_goal = Next, bindings = Bs0}) -> - case ec_support:deref(A2, Bs0) of - [H | T] -> - case ec_unify:unify(A1, H, Bs0) of - {succeed, Bs1} -> - ec_body:prove_body(Params#param{goal = Next, bindings = Bs1}); - fail -> - memberchk_2({memberchk, A1, T}, Params) - end; - {_} -> erlog_errors:instantiation_error(); - _ -> erlog_errors:fail(Params) - end. - -%% reverse_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. -%% reverse([], []). -%% reverse([H|L1], L) :- reverse(L1, L2), append(L2, [H], L). -%% Here we attempt to compile indexing in the first argument. -reverse_2({reverse, A1, A2}, Params = #param{next_goal = Next0, bindings = Bs0, choice = Cps, var_num = Vn}) -> - case ec_support:deref(A1, Bs0) of - [] -> - ec_body:unify_prove_body(A2, [], Params); - [H | T] -> - L = {Vn}, - L1 = A2, - %% Naive straight expansion of body. - %%Next1 = [{reverse,T,L},{append,L,[H],L1}|Next0], - %%prove_body(Next1, Cps, Bs0, Vn+1, Db); - %% Smarter direct calling of local function. - Next1 = [{append, L, [H], L1} | Next0], - reverse_2({reverse, T, L}, Params#param{next_goal = Next1, var_num = Vn + 1}); - {_} = Var -> - FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed - fail_reverse_2(LCp, Params#param{choice = LCps, database = LDb}, Var, A2) - end, - Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, - Bs1 = ec_support:add_binding(Var, [], Bs0), - ec_body:unify_prove_body(A2, [], Params#param{choice = [Cp | Cps], bindings = Bs1}); - _ -> erlog_errors:fail(Params) %Will fail here! - end. - -fail_reverse_2(#cp{next = Next, bs = Bs0, vn = Vn}, Params, A1, A2) -> - H = {Vn}, - T = {Vn + 1}, - L1 = A2, - L = {Vn + 2}, - Bs1 = ec_support:add_binding(A1, [H | T], Bs0), - %%Next1 = [{reverse,T,L},{apperse,L,[H],L1}|Next], - %%prove_body(Next1, Cps, Bs1, Vn+3, Db). - Next1 = [{append, L, [H], L1} | Next], - reverse_2({reverse, T, L}, Params#param{next_goal = Next1, bindings = Bs1, var_num = Vn + 3}). - -%% sort_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. -%% sort(List, SortedList). -sort_2({sort, L0, S}, Param = #param{bindings = Bs}) -> - %% This may throw an erlog error, we don't catch it here. - L1 = lists:usort(ec_support:dderef_list(L0, Bs)), - ec_body:unify_prove_body(S, L1, Param). \ No newline at end of file diff --git a/src/libs/standard/erlog_stdlib.erl b/src/libs/standard/erlog_stdlib.erl new file mode 100644 index 0000000..7c217fc --- /dev/null +++ b/src/libs/standard/erlog_stdlib.erl @@ -0,0 +1,18 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 12. Авг. 2014 18:31 +%%%------------------------------------------------------------------- +-module(erlog_stdlib). +-author("tihon"). + +-include("erlog_core.hrl"). + +%% load database to kernel space +-callback load(Db :: pid() | atom()) -> ok. + +%% proves goal Goal +-callback prove_goal(Params :: #param{}) -> ok. %TODO what return value? \ No newline at end of file diff --git a/src/libs/standard/erlog_time.erl b/src/libs/standard/erlog_time.erl deleted file mode 100644 index 9ee20f3..0000000 --- a/src/libs/standard/erlog_time.erl +++ /dev/null @@ -1,141 +0,0 @@ -%%%------------------------------------------------------------------- -%%% @author tihon -%%% @copyright (C) 2014, -%%% @doc -%%% -%%% @end -%%% Created : 15. Июль 2014 0:27 -%%%------------------------------------------------------------------- --module(erlog_time). --author("tihon"). - --include("erlog_core.hrl"). --include("erlog_time.hrl"). - -%% API --export([load/1, localtime_1/2]). --export([date_2/2, date_4/2, time_2/2, time_4/2]). --export([datediff_4/2, add_time_4/2, dateprint_2/2, dateparse_2/2]). - -load(Db) -> - lists:foreach(fun(Proc) -> erlog_memory:add_compiled_proc(Db, Proc) end, ?ERLOG_TIME). - -%% Returns current timestamp. -localtime_1({localtime, Var}, Params = #param{next_goal = Next, bindings = Bs0}) -> - {M, S, _} = os:timestamp(), - Bs = ec_support:add_binding(Var, date_to_ts({M, S}), Bs0), - ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). - -%% Returns timestamp for data, ignoring time -date_2({date, DateString, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - {{Y, M, D}, _} = date_string_to_data(check_var(DateString, Bs0)), - DataTS = data_to_ts({{Y, M, D}, {0, 0, 0}}), - Bs = ec_support:add_binding(Res, DataTS, Bs0), - ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). - -%% Returns timestamp for data, ignoring time -date_4({date, D, M, Y, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - DataTS = data_to_ts({{check_var(Y, Bs0), check_var(M, Bs0), check_var(D, Bs0)}, {0, 0, 0}}), - Bs = ec_support:add_binding(Res, DataTS, Bs0), - ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). - -%% Returns timestamp for data, ignoring data. -time_2({time, TimeString, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - {_, {H, M, S}} = date_string_to_data(check_var(TimeString, Bs0)), %cut YMD - TS = S * date_to_seconds(M, minute) * date_to_seconds(H, hour), - Bs = ec_support:add_binding(Res, TS, Bs0), - ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). - -%% Returns timestamp for data, ignoring data. -time_4({time, H, M, S, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - TS = check_var(S, Bs0) * date_to_seconds(check_var(M, Bs0), minute) * date_to_seconds(check_var(H, Bs0), hour), - Bs = ec_support:add_binding(Res, TS, Bs0), - ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). - -%% Calculates differense between two timestamps. Returns the result in specifyed format -datediff_4({date_diff, TS1, TS2, Format, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - Diff = timer:now_diff(ts_to_date(check_var(TS1, Bs0)), ts_to_date(check_var(TS2, Bs0))) / 1000000, - Bs = ec_support:add_binding(Res, seconds_to_date(Diff, check_var(Format, Bs0)), Bs0), - ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). - -%% Adds number of seconds T2 in Type format to Time1. Returns timestamp -add_time_4({add_time, Time1, Type, T2, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - Diff = check_var(Time1, Bs0) + date_to_seconds(check_var(T2, Bs0), check_var(Type, Bs0)), - Bs = ec_support:add_binding(Res, Diff, Bs0), - ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). - -%% Converts timestamp to human readable format -dateprint_2({date_print, TS1, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - {{Year, Month, Day}, {Hour, Minute, Second}} = date_to_data(ts_to_date(check_var(TS1, Bs0))), - DateStr = lists:flatten(io_lib:format("~s ~2w ~4w ~2w:~2..0w:~2..0w", [?MONTH(Month), Day, Year, Hour, Minute, Second])), - Bs = ec_support:add_binding(Res, DateStr, Bs0), - ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). - -%% Parses date string and returns timestamp. -dateparse_2({date_parse, DataStr, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - Data = date_string_to_data(check_var(DataStr, Bs0)), - Bs = ec_support:add_binding(Res, data_to_ts(Data), Bs0), - ec_body:prove_body(Params#param{goal = Next, bindings = Bs}). - -%% @private -%% Time in microseconds, atom for output format --spec seconds_to_date(Time :: integer(), atom()) -> integer(). -seconds_to_date(Time, day) -> Time / 86400; % day = 24 hours -seconds_to_date(Time, hour) -> Time / 3600; % hour = 60 min -seconds_to_date(Time, minute) -> Time / 60; % min = 60 sec -seconds_to_date(Time, sec) -> Time. - -%% @private -%% Converts day|hour|minute to seconds --spec date_to_seconds(integer(), atom()) -> integer(). -date_to_seconds(Time, day) -> Time * 86400; -date_to_seconds(Time, hour) -> Time * 3600; -date_to_seconds(Time, minute) -> Time * 60; -date_to_seconds(Time, sec) -> Time. - -%% @private -%% Converts string date representation to timestamp. Format MM DD YYYY hh:mm:ss --spec date_string_to_data(string()) -> tuple(). -date_string_to_data(DataStr) -> - [MStr, DStr, YStr, HStr, MnStr, SStr] = string:tokens(DataStr, " :"), - Month = ec_support:index_of(MStr, tuple_to_list(?MONTHS)), - {{list_to_integer(YStr), Month, list_to_integer(DStr)}, - {list_to_integer(HStr), list_to_integer(MnStr), list_to_integer(SStr)}}. - -%% @private -%% Converts data tuple to timestamp --spec data_to_ts(tuple()) -> integer(). -data_to_ts(Data) -> - calendar:datetime_to_gregorian_seconds(Data) - 62167219200. - -%% @private -%% Converts data tuple to date tuple {{YYYY,MM,DD},{hh,mm,ss}} --spec date_to_data(tuple()) -> tuple(). -date_to_data(Ts) -> - calendar:now_to_universal_time(Ts). - -%% @private -%% Converts data tuple (part of timestamp: MegaSecs, Secs) to integer seconds --spec date_to_ts(tuple()) -> integer(). -date_to_ts({M1, S1}) -> - TimeStr = lists:concat([M1, S1]), - list_to_integer(TimeStr). - -%% @private -%% Converts timestamp to data tuple --spec ts_to_date(integer()) -> tuple(). -ts_to_date(Timestamp) -> - TSStr = integer_to_list(Timestamp), - {M1, S1} = lists:split(4, TSStr), - {list_to_integer(M1), list_to_integer(S1), 0}. - - -%% @private -%% Checks - if var is normal, or binded, or < 0 (if int). Returns var's value. -check_var({'-', Var}, Bs) -> - case check_var(Var, Bs) of - Res when is_integer(Res) -> -1 * Res; - Res -> Res - end; -check_var({Var}, Bs) -> check_var(ec_support:deref({Var}, Bs), Bs); -check_var(Var, _) -> Var. \ No newline at end of file diff --git a/src/libs/standard/lists/logic/el_logic.erl b/src/libs/standard/lists/logic/el_logic.erl new file mode 100644 index 0000000..eefaa6d --- /dev/null +++ b/src/libs/standard/lists/logic/el_logic.erl @@ -0,0 +1,106 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 12. Авг. 2014 18:01 +%%%------------------------------------------------------------------- +-module(el_logic). +-author("tihon"). + +-include("erlog_core.hrl"). + +%% API +-export([fail_append/5, + fail_insert/5, + fail_member/4, + memberchk/2, + insert/1, + reverse/2]). + +insert(Params = #param{goal = {insert, A1, A2, A3}, next_goal = Next, bindings = Bs, choice = Cps, var_num = Vn, f_consulter = Fcon}) -> + FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed + el_logic:fail_insert(LCp, Params#param{choice = LCps, database = LDb, f_consulter = Fcon}, A1, A2, A3) + end, + Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, + ec_body:unify_prove_body(A3, [A2 | A1], Params#param{choice = [Cp | Cps]}). + +fail_append(#cp{next = Next0, bs = Bs0, vn = Vn}, Params, A1, L, A3) -> + H = {Vn}, + T = {Vn + 1}, + L1 = {Vn + 2}, + Bs1 = ec_support:add_binding(A1, [H | T], Bs0), %A1 always a variable here. + Next1 = [{append, T, L, L1} | Next0], + ec_body:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs1, + var_num = Vn + 3}). + +fail_insert(#cp{next = Next0, bs = Bs, vn = Vn}, Params, A1, X, A3) -> + H = {Vn}, + L = {Vn + 1}, + L1 = {Vn + 2}, + Next1 = [{insert, L, X, L1} | Next0], + ec_body:unify_prove_body(A1, [H | L], A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 3}). + +fail_member(#cp{next = Next0, bs = Bs, vn = Vn}, Params, A1, A2) -> + H = {Vn}, + T = {Vn + 1}, + Next1 = [{member, A1, T} | Next0], + ec_body:unify_prove_body(A2, [H | T], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 2}). + +%% memberchk_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. +%% memberchk(X, [X|_]) :- !. +%% memberchk(X, [_|T]) :- member(X, T). +%% We don't build the list and we never backtrack so we can be smart +%% and match directly. Should we give a type error? +memberchk({memberchk, A1, A2}, Params = #param{next_goal = Next, bindings = Bs0}) -> + case ec_support:deref(A2, Bs0) of + [H | T] -> + case ec_unify:unify(A1, H, Bs0) of + {succeed, Bs1} -> + ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); + fail -> + memberchk({memberchk, A1, T}, Params) + end; + {_} -> erlog_errors:instantiation_error(); + _ -> erlog_errors:fail(Params) + end. + +%% reverse_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. +%% reverse([], []). +%% reverse([H|L1], L) :- reverse(L1, L2), append(L2, [H], L). +%% Here we attempt to compile indexing in the first argument. +reverse({reverse, A1, A2}, Params = #param{next_goal = Next0, bindings = Bs0, choice = Cps, var_num = Vn}) -> + case ec_support:deref(A1, Bs0) of + [] -> + ec_body:unify_prove_body(A2, [], Params); + [H | T] -> + L = {Vn}, + L1 = A2, + %% Naive straight expansion of body. + %%Next1 = [{reverse,T,L},{append,L,[H],L1}|Next0], + %%prove_body(Next1, Cps, Bs0, Vn+1, Db); + %% Smarter direct calling of local function. + Next1 = [{append, L, [H], L1} | Next0], + reverse({reverse, T, L}, Params#param{next_goal = Next1, var_num = Vn + 1}); + {_} = Var -> + FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed + fail_reverse(LCp, Params#param{choice = LCps, database = LDb}, Var, A2) + end, + Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, + Bs1 = ec_support:add_binding(Var, [], Bs0), + ec_body:unify_prove_body(A2, [], Params#param{choice = [Cp | Cps], bindings = Bs1}); + _ -> erlog_errors:fail(Params) %Will fail here! + end. + +%% @private +fail_reverse(#cp{next = Next, bs = Bs0, vn = Vn}, Params, A1, A2) -> + H = {Vn}, + T = {Vn + 1}, + L1 = A2, + L = {Vn + 2}, + Bs1 = ec_support:add_binding(A1, [H | T], Bs0), + %%Next1 = [{reverse,T,L},{apperse,L,[H],L1}|Next], + %%prove_body(Next1, Cps, Bs1, Vn+3, Db). + Next1 = [{append, L, [H], L1} | Next], + reverse({reverse, T, L}, Params#param{next_goal = Next1, bindings = Bs1, var_num = Vn + 3}). \ No newline at end of file diff --git a/src/libs/standard/lists/main/erlog_lists.erl b/src/libs/standard/lists/main/erlog_lists.erl new file mode 100644 index 0000000..1a61fd1 --- /dev/null +++ b/src/libs/standard/lists/main/erlog_lists.erl @@ -0,0 +1,94 @@ +%% Copyright (c) 2013 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : erlog_lists.erl +%% Author : Robert Virding +%% Purpose : Standard Erlog lists library. +%% +%% This is a standard lists library for Erlog. Everything here is +%% pretty basic and common to most Prologs. We are experimenting here +%% and some predicates are compiled. We only get a small benefit when +%% only implementing indexing on the first argument. + +-module(erlog_lists). + +-include("erlog_core.hrl"). +-include("erlog_lists.hrl"). + +-behaviour(erlog_stdlib). + +%% Main interface functions. +-export([load/1]). +-export([prove_goal/1]). + +%% load(Database) -> Database. +%% Assert predicates into the database. +load(Db) -> + lists:foreach(fun(Proc) -> erlog_memory:load_kernel_space(Db, ?MODULE, Proc) end, ?ERLOG_LISTS), + %% Finally interpreted common list library. + lists:foreach(fun(Clause) -> erlog_memory:assertz_clause(Db, Clause) end, %TODO change me to kernelspace + [ + %% perm([], []). + %% perm([X|Xs], Ys1) :- perm(Xs, Ys), insert(Ys, X, Ys1). + {perm, [], []}, + {':-', {perm, [{1} | {2}], {3}}, {',', {perm, {2}, {4}}, {insert, {4}, {1}, {3}}}} + ]). + +prove_goal(Params = #param{goal = {length, ListVar, Len}, next_goal = Next, bindings = Bs0}) -> + case ec_support:deref(ListVar, Bs0) of + List when is_list(List) -> + Bs1 = ec_support:add_binding(Len, length(List), Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); + _ -> erlog_errors:fail(Params) + end; +prove_goal(Params = #param{goal = {append, A1, L, A3}, next_goal = Next0, bindings = Bs0, choice = Cps, + var_num = Vn, f_consulter = Fcon}) -> + case ec_support:deref(A1, Bs0) of + [] -> %Cannot backtrack + ec_body:unify_prove_body(L, A3, Params); + [H | T] -> %Cannot backtrack + L1 = {Vn}, + Next1 = [{append, T, L, L1} | Next0], + ec_body:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, var_num = Vn + 1}); + {_} = Var -> %This can backtrack + FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed + el_logic:fail_append(LCp, Params#param{choice = LCps, database = LDb, f_consulter = Fcon}, Var, L, A3) + end, + Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, + Bs1 = ec_support:add_binding(Var, [], Bs0), + ec_body:unify_prove_body(L, A3, Params#param{choice = [Cp | Cps], bindings = Bs1}); + _ -> erlog_errors:fail(Params) %Will fail here! + end; +prove_goal(Params = #param{goal = {insert, _, _, _}}) -> + el_logic:insert(Params); +prove_goal(Params = #param{goal = {delete, A, B, C}}) -> + el_logic:insert(Params#param{goal = {insert, C, B, A}}); +prove_goal(Params = #param{goal = {member, A1, A2}, next_goal = Next, bindings = Bs, choice = Cps, var_num = Vn}) -> + FailFun = fun(LCp, LCps, LDb) -> + el_logic:fail_member(LCp, Params#param{choice = LCps, database = LDb}, A1, A2) + end, + Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, + T = {Vn}, + ec_body:unify_prove_body(A2, [A1 | T], Params#param{choice = [Cp | Cps], var_num = Vn + 1}); +prove_goal(Params = #param{goal = {memberchk, A1, A2}}) -> + el_logic:memberchk({memberchk, A1, A2}, Params); +prove_goal(Params = #param{goal = {sort, L0, S}, bindings = Bs}) -> + %% This may throw an erlog error, we don't catch it here. + L1 = lists:usort(ec_support:dderef_list(L0, Bs)), + ec_body:unify_prove_body(S, L1, Params); +%% reverse([], []). +%% reverse([H|L1], L) :- reverse(L1, L2), append(L2, [H], L). +%% Here we attempt to compile indexing in the first argument. +prove_goal(Params = #param{goal = {reverse, A1, A2}}) -> + el_logic:reverse({reverse, A1, A2}, Params). \ No newline at end of file diff --git a/src/libs/standard/time/logic/et_logic.erl b/src/libs/standard/time/logic/et_logic.erl new file mode 100644 index 0000000..10e3aad --- /dev/null +++ b/src/libs/standard/time/logic/et_logic.erl @@ -0,0 +1,69 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 12. Авг. 2014 18:10 +%%%------------------------------------------------------------------- +-module(et_logic). +-author("tihon"). + +-include("erlog_time.hrl"). + +%% API +-export([date_to_ts/1, date_string_to_data/1, check_var/2, data_to_ts/1, date_to_seconds/2, seconds_to_date/2, date_to_data/1, ts_to_date/1]). + +%% Time in microseconds, atom for output format +-spec seconds_to_date(Time :: integer(), atom()) -> integer(). +seconds_to_date(Time, day) -> Time / 86400; % day = 24 hours +seconds_to_date(Time, hour) -> Time / 3600; % hour = 60 min +seconds_to_date(Time, minute) -> Time / 60; % min = 60 sec +seconds_to_date(Time, sec) -> Time. + +%% Converts day|hour|minute to seconds +-spec date_to_seconds(integer(), atom()) -> integer(). +date_to_seconds(Time, day) -> Time * 86400; +date_to_seconds(Time, hour) -> Time * 3600; +date_to_seconds(Time, minute) -> Time * 60; +date_to_seconds(Time, sec) -> Time. + +%% Converts string date representation to timestamp. Format MM DD YYYY hh:mm:ss +-spec date_string_to_data(string()) -> tuple(). +date_string_to_data(DataStr) -> + [MStr, DStr, YStr, HStr, MnStr, SStr] = string:tokens(DataStr, " :"), + Month = ec_support:index_of(MStr, tuple_to_list(?MONTHS)), + {{list_to_integer(YStr), Month, list_to_integer(DStr)}, + {list_to_integer(HStr), list_to_integer(MnStr), list_to_integer(SStr)}}. + +%% Converts data tuple to timestamp +-spec data_to_ts(tuple()) -> integer(). +data_to_ts(Data) -> + calendar:datetime_to_gregorian_seconds(Data) - 62167219200. + +%% Converts data tuple to date tuple {{YYYY,MM,DD},{hh,mm,ss}} +-spec date_to_data(tuple()) -> tuple(). +date_to_data(Ts) -> + calendar:now_to_universal_time(Ts). + +%% Converts data tuple (part of timestamp: MegaSecs, Secs) to integer seconds +-spec date_to_ts(tuple()) -> integer(). +date_to_ts({M1, S1}) -> + TimeStr = lists:concat([M1, S1]), + list_to_integer(TimeStr). + +%% Converts timestamp to data tuple +-spec ts_to_date(integer()) -> tuple(). +ts_to_date(Timestamp) -> + TSStr = integer_to_list(Timestamp), + {M1, S1} = lists:split(4, TSStr), + {list_to_integer(M1), list_to_integer(S1), 0}. + +%% Checks - if var is normal, or binded, or < 0 (if int). Returns var's value. +check_var({'-', Var}, Bs) -> + case check_var(Var, Bs) of + Res when is_integer(Res) -> -1 * Res; + Res -> Res + end; +check_var({Var}, Bs) -> check_var(ec_support:deref({Var}, Bs), Bs); +check_var(Var, _) -> Var. \ No newline at end of file diff --git a/src/libs/standard/time/main/erlog_time.erl b/src/libs/standard/time/main/erlog_time.erl new file mode 100644 index 0000000..2fb54ad --- /dev/null +++ b/src/libs/standard/time/main/erlog_time.erl @@ -0,0 +1,73 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 15. Июль 2014 0:27 +%%%------------------------------------------------------------------- +-module(erlog_time). +-author("tihon"). + +-behaviour(erlog_stdlib). + +-include("erlog_core.hrl"). +-include("erlog_time.hrl"). + +%% API +-export([load/1]). +-export([prove_goal/1]). + +load(Db) -> + lists:foreach(fun(Proc) -> erlog_memory:load_kernel_space(Db, ?MODULE, Proc) end, ?ERLOG_TIME). + +%% Returns current timestamp. +prove_goal(Params = #param{goal = {localtime, Var}, next_goal = Next, bindings = Bs0}) -> + {M, S, _} = os:timestamp(), + Bs = ec_support:add_binding(Var, et_logic:date_to_ts({M, S}), Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); +%% Returns timestamp for data, ignoring time +prove_goal(Params = #param{goal = {date, DateString, Res}, next_goal = Next, bindings = Bs0}) -> + {{Y, M, D}, _} = et_logic:date_string_to_data(et_logic:check_var(DateString, Bs0)), + DataTS = et_logic:data_to_ts({{Y, M, D}, {0, 0, 0}}), + Bs = ec_support:add_binding(Res, DataTS, Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); +%% Returns timestamp for data, ignoring time +prove_goal(Params = #param{goal = {date, D, M, Y, Res}, next_goal = Next, bindings = Bs0}) -> + DataTS = et_logic:data_to_ts({{et_logic:check_var(Y, Bs0), et_logic:check_var(M, Bs0), et_logic:check_var(D, Bs0)}, {0, 0, 0}}), + Bs = ec_support:add_binding(Res, DataTS, Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); +%% Returns timestamp for data, ignoring data. +prove_goal(Params = #param{goal = {time, TimeString, Res}, next_goal = Next, bindings = Bs0}) -> + {_, {H, M, S}} = et_logic:date_string_to_data(et_logic:check_var(TimeString, Bs0)), %cut YMD + TS = S * et_logic:date_to_seconds(M, minute) * et_logic:date_to_seconds(H, hour), + Bs = ec_support:add_binding(Res, TS, Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); +%% Returns timestamp for data, ignoring data. +prove_goal(Params = #param{goal = {time, H, M, S, Res}, next_goal = Next, bindings = Bs0}) -> + TS = et_logic:check_var(S, Bs0) + * et_logic:date_to_seconds(et_logic:check_var(M, Bs0), minute) + * et_logic:date_to_seconds(et_logic:check_var(H, Bs0), hour), + Bs = ec_support:add_binding(Res, TS, Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); +%% Calculates differense between two timestamps. Returns the result in specifyed format +prove_goal(Params = #param{goal = {date_diff, TS1, TS2, Format, Res}, next_goal = Next, bindings = Bs0}) -> + Diff = timer:now_diff(et_logic:ts_to_date(et_logic:check_var(TS1, Bs0)), et_logic:ts_to_date(et_logic:check_var(TS2, Bs0))) / 1000000, + Bs = ec_support:add_binding(Res, et_logic:seconds_to_date(Diff, et_logic:check_var(Format, Bs0)), Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); +%% Adds number of seconds T2 in Type format to Time1. Returns timestamp +prove_goal(Params = #param{goal = {add_time, Time1, Type, T2, Res}, next_goal = Next, bindings = Bs0}) -> + Diff = et_logic:check_var(Time1, Bs0) + et_logic:date_to_seconds(et_logic:check_var(T2, Bs0), et_logic:check_var(Type, Bs0)), + Bs = ec_support:add_binding(Res, Diff, Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); +%% Converts timestamp to human readable format +prove_goal(Params = #param{goal = {date_print, TS1, Res}, next_goal = Next, bindings = Bs0}) -> + {{Year, Month, Day}, {Hour, Minute, Second}} = et_logic:date_to_data(et_logic:ts_to_date(et_logic:check_var(TS1, Bs0))), + DateStr = lists:flatten(io_lib:format("~s ~2w ~4w ~2w:~2..0w:~2..0w", [?MONTH(Month), Day, Year, Hour, Minute, Second])), + Bs = ec_support:add_binding(Res, DateStr, Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); +%% Parses date string and returns timestamp. +prove_goal(Params = #param{goal = {date_parse, DataStr, Res}, next_goal = Next, bindings = Bs0}) -> + Data = et_logic:date_string_to_data(et_logic:check_var(DataStr, Bs0)), + Bs = ec_support:add_binding(Res, et_logic:data_to_ts(Data), Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). \ No newline at end of file diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl deleted file mode 100644 index 1cd4d1a..0000000 --- a/src/storage/erlog_dict.erl +++ /dev/null @@ -1,132 +0,0 @@ -%%%------------------------------------------------------------------- -%%% @author tihon -%%% @copyright (C) 2014, -%%% @doc -%%% -%%% @end -%%% Created : 18. июн 2014 18:00 -%%%------------------------------------------------------------------- --module(erlog_dict). --author("tihon"). - --behaviour(erlog_storage). - -%% erlog callbacks --export([new/0, new/1, - add_built_in/2, - add_compiled_proc/2, - assertz_clause/2, - asserta_clause/2, - retract_clause/2, - abolish_clauses/2, - get_procedure/2, - get_procedure_type/2, - get_interp_functors/1, - findall/2, %TODO remove me - raw_store/2, - raw_fetch/2, - raw_append/2, - raw_erase/2, - listing/1]). - -%% API --export([]). - -new() -> {ok, dict:new()}. - -new(_) -> {ok, dict:new()}. - -add_built_in(Db, {Functor}) -> - {ok, dict:store(Functor, built_in, Db)}. - -add_compiled_proc(Db, {{Functor, M, F}}) -> - {ok, dict:update(Functor, - fun(built_in) -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - (_) -> {code, {M, F}} - end, {code, {M, F}}, Db)}. - -assertz_clause(Db, {Head, Body0}) -> - {clause(Head, Body0, Db, - fun(T, Body, Cs) -> - {clauses, T + 1, Cs ++ [{T, Head, Body}]} - end), Db}. - -asserta_clause(Db, {Head, Body0}) -> - {clause(Head, Body0, Db, - fun(T, Body, Cs) -> - {clauses, T + 1, [{T, Head, Body} | Cs]} - end), Db}. - -retract_clause(Db, {Functor, Ct}) -> - {ok, case dict:find(Functor, Db) of - {ok, built_in} -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - {ok, {code, _}} -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - {ok, {clauses, Nt, Cs}} -> - dict:store(Functor, {clauses, Nt, lists:keydelete(Ct, 1, Cs)}, Db); - error -> Db %Do nothing - end}. - -abolish_clauses(Db, {Functor}) -> - {ok, case dict:find(Functor, Db) of - {ok, built_in} -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - {ok, {code, _}} -> dict:erase(Functor, Db); - {ok, {clauses, _, _}} -> dict:erase(Functor, Db); - error -> Db %Do nothing - end}. - -get_procedure(Db, {Functor}) -> - {case dict:find(Functor, Db) of - {ok, built_in} -> built_in; %A built-in - {ok, {code, {_M, _F}} = P} -> P; %Compiled (perhaps someday) - {ok, {clauses, _T, Cs}} -> {clauses, Cs}; %Interpreted clauses - error -> undefined %Undefined - end, Db}. - -get_procedure_type(Db, {Functor}) -> - {case dict:find(Functor, Db) of - {ok, built_in} -> built_in; %A built-in - {ok, {code, _}} -> compiled; %Compiled (perhaps someday) - {ok, {clauses, _, _}} -> interpreted; %Interpreted clauses - error -> undefined %Undefined - end, Db}. - -get_interp_functors(Db) -> - {dict:fold(fun(_Func, built_in, Fs) -> Fs; - (Func, {code, _}, Fs) -> [Func | Fs]; - (Func, {clauses, _, _}, Fs) -> [Func | Fs] - end, [], Db), Db}. - -clause(Head, Body0, Db, ClauseFun) -> - {Functor, Body} = case catch {ok, ec_support:functor(Head), ec_body:well_form_body(Body0, false, sture)} of - {erlog_error, E} -> erlog_errors:erlog_error(E, Db); - {ok, F, B} -> {F, B} - end, - dict:update(Functor, - fun(built_in) -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - ({code, _}) -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - ({clauses, T, Cs}) -> ClauseFun(T, Body, Cs) - end, {clauses, 1, [{0, Head, Body}]}, Db). - -findall(_State, {_Functor}) -> %TODO implement me! - erlang:error(not_implemented). - -raw_store(_State, {_Key, _Value}) -> - erlang:error(not_implemented). - -raw_fetch(_State, {_Key}) -> - erlang:error(not_implemented). - -raw_append(_State, {_Key, _Value}) -> - erlang:error(not_implemented). - -raw_erase(_State, {_Key}) -> - erlang:error(not_implemented). - -listing(_State) -> - erlang:error(not_implemented). diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 051a4e1..0bd6a4a 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -13,8 +13,8 @@ %% erlog callbacks -export([new/0, new/1, - add_built_in/2, - add_compiled_proc/2, + load_kernel_space/2, + load_library_space/2, assertz_clause/2, asserta_clause/2, retract_clause/2, @@ -34,13 +34,13 @@ new() -> {ok, ets:new(eets, [])}. new(_) -> {ok, ets:new(eets, [])}. -add_built_in(Db, {Functor}) -> - true = ets:insert(Db, {Functor, built_in}), +load_kernel_space(Db, {Module, Functor}) -> + true = ets:insert(Db, {Functor, {built_in, Module}}), {ok, Db}. -add_compiled_proc(Db, {{Functor, M, F}}) -> +load_library_space(Db, {{Functor, M, F}}) -> case ets:lookup(Db, Functor) of - [{_, built_in}] -> + [{_, {built_in, _}}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); [_] -> ets:insert(Db, {Functor, code, {M, F}}); [] -> ets:insert(Db, {Functor, code, {M, F}}) @@ -75,7 +75,7 @@ retract_clause(Db, {Collection, Functor, Ct}) -> {Res, Db}; retract_clause(Db, {Functor, Ct}) -> case ets:lookup(Db, Functor) of - [{_, built_in}] -> + [{_, {built_in, _}}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); [{_, code, _}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); @@ -91,7 +91,7 @@ abolish_clauses(Db, {Collection, Functor}) -> {Res, Db}; abolish_clauses(Db, {Functor}) -> case ets:lookup(Db, Functor) of - [{_, built_in}] -> + [{_, {built_in, _}}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); [{_, code, _}] -> ets:delete(Db, Functor); [{_, clauses, _, _}] -> ets:delete(Db, Functor); @@ -110,7 +110,7 @@ findall(Db, {Functor}) -> case ets:lookup(Db, {Fun, Len}) of [{_, clauses, _, Body}] -> {Body, Db}; [{_, code, Body}] -> {Body, Db}; - [{Body, built_in}] -> {Body, Db}; + [{Body, {built_in, _}}] -> {Body, Db}; [] -> {[], Db} end. @@ -120,7 +120,7 @@ get_procedure(Db, {Collection, Functor}) -> {Res, Db}; get_procedure(Db, {Functor}) -> {case ets:lookup(Db, Functor) of - [{_, built_in}] -> built_in; + [{_, {built_in, Module}}] -> {built_in, Module}; [{_, code, C}] -> {code, C}; [{_, clauses, _, Cs}] -> {clauses, Cs}; [] -> undefined @@ -128,14 +128,14 @@ get_procedure(Db, {Functor}) -> get_procedure_type(Db, {Functor}) -> {case ets:lookup(Db, Functor) of - [{_, built_in}] -> built_in; %A built-in + [{_, {built_in, _}}] -> built_in; %A built-in [{_, code, _C}] -> compiled; %Compiled (perhaps someday) [{_, clauses, _, _Cs}] -> interpreted; %Interpreted clauses [] -> undefined %Undefined end, Db}. get_interp_functors(Db) -> - {ets:foldl(fun({_, built_in}, Fs) -> Fs; + {ets:foldl(fun({_, {built_in, _}}, Fs) -> Fs; ({Func, code, _}, Fs) -> [Func | Fs]; ({Func, clauses, _, _}, Fs) -> [Func | Fs] end, [], Db), Db}. @@ -146,7 +146,7 @@ clause(Head, Body0, Db, ClauseFun) -> {ok, F, B} -> {F, B} end, case ets:lookup(Db, Functor) of - [{_, built_in}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + [{_, {built_in, _}}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); [{_, code, _}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); [{_, clauses, Tag, Cs}] -> ClauseFun(Functor, Tag, Cs, Body); [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 13e1e5f..851c8a9 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -14,7 +14,7 @@ %% API -export([start_link/1, start_link/2, - add_compiled_proc/2, + load_library_space/2, assertz_clause/3, asserta_clause/3, retract_clause/3, @@ -41,7 +41,7 @@ db_findall/3, db_listing/2]). --export([add_built_in/2]). +-export([load_kernel_space/3]). %% gen_server callbacks -export([init/1, @@ -62,10 +62,13 @@ %%%=================================================================== %%% API %%%=================================================================== -add_built_in(Database, Element) -> gen_server:call(Database, {add_built_in, {Element}}). +%% kernelspace predicate loading +load_kernel_space(Database, Module, Element) -> gen_server:call(Database, {load_kernel_space, {Module, Element}}). -add_compiled_proc(Database, Proc) -> gen_server:call(Database, {add_compiled_proc, {Proc}}). +%% libraryspace predicate loading +load_library_space(Database, Proc) -> gen_server:call(Database, {load_library_space, {Proc}}). +%% userspace predicate loading assertz_clause(Database, {':-', Head, Body}) -> assertz_clause(Database, Head, Body); assertz_clause(Database, Head) -> assertz_clause(Database, Head, true). assertz_clause(Database, Head, Body) -> gen_server:call(Database, {assertz_clause, {Head, Body}}). diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl index 83f4be1..6cfd4be 100644 --- a/src/storage/erlog_storage.erl +++ b/src/storage/erlog_storage.erl @@ -13,9 +13,9 @@ -callback new(Params :: list()) -> {ok, State :: term()}. --callback add_built_in(State :: term(), Functor :: term()) -> {ok, NewState :: term()}. +-callback load_kernel_space(State :: term(), Functor :: term()) -> {ok, NewState :: term()}. --callback add_compiled_proc(State :: term(), Param :: term()) -> {ok, NewState :: term()}. +-callback load_library_space(State :: term(), Param :: term()) -> {ok, NewState :: term()}. -callback assertz_clause(State :: term(), Param :: term()) -> {ok, NewState :: term()}. From 4b63bbb4d5f238e984607746c975b952f8fa9efa Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 12 Aug 2014 21:56:17 +0000 Subject: [PATCH 098/251] added to_string and to_intege --- include/erlog_core.hrl | 4 +++- src/libs/standard/core/logic/ec_logic.erl | 14 +++++++++++++- src/libs/standard/core/main/erlog_core.erl | 14 +++++++++++++- 3 files changed, 29 insertions(+), 3 deletions(-) diff --git a/include/erlog_core.hrl b/include/erlog_core.hrl index b32921f..edc092a 100644 --- a/include/erlog_core.hrl +++ b/include/erlog_core.hrl @@ -81,6 +81,8 @@ {setof, 3}, {listing, 1}, %% Non standart functions - {use, 1} %load erlang library module + {use, 1}, %load erlang library module + {to_integer, 2}, + {to_string, 2} ] ). \ No newline at end of file diff --git a/src/libs/standard/core/logic/ec_logic.erl b/src/libs/standard/core/logic/ec_logic.erl index 4143f14..3d1d96b 100644 --- a/src/libs/standard/core/logic/ec_logic.erl +++ b/src/libs/standard/core/logic/ec_logic.erl @@ -21,7 +21,7 @@ prove_predicates/3, prove_retract/2, prove_retractall/2, - retract_clauses/4]). + retract_clauses/4, parse_int/1, to_string/1]). %% prove_findall(Term, Goal, Bag, Param) %% Do findall on Goal and return list of each Term in Bag. We are @@ -164,6 +164,18 @@ well_form_goal(Goal, Tail, Cut, _Label) -> ec_support:functor(Goal), %Check goal {[Goal | Tail], Cut}. +parse_int(Float) when is_float(Float) -> round(Float); +parse_int(String) when is_list(String) -> + case string:to_integer(String) of + {error, E} -> throw(E); + {Res, _} -> Res + end; +parse_int(Atom) when is_atom(Atom) -> + parse_int(atom_to_list(Atom)). + +to_string(Int) when is_integer(Int) -> integer_to_list(Int); +to_string(Value) -> lists:flatten(io_lib:format("~p", [Value])). + %% initial_goal(Goal) -> {Goal,Bindings,NewVarNum}. %% initial_goal(Goal, Bindings, VarNum) -> {Goal,NewBindings,NewVarNum}. %% Check term for well-formedness as an Erlog term and replace '_' diff --git a/src/libs/standard/core/main/erlog_core.erl b/src/libs/standard/core/main/erlog_core.erl index c763f05..a326042 100644 --- a/src/libs/standard/core/main/erlog_core.erl +++ b/src/libs/standard/core/main/erlog_core.erl @@ -202,4 +202,16 @@ prove_goal(Param = #param{goal = {bagof, Goal, Fun, Res}, choice = Cs0, bindings UpdBs1 = ec_support:update_vars(Goal, FunList, Key, UpdBs0), [#cp{type = disjunction, label = Fun, next = Next, bs = UpdBs1, vn = Vn} | Acc] end, Cs0, Collected), - ec_core:prove_body(Param#param{goal = Next, bindings = UBs#cp.bs, choice = Choises, var_num = Vn + length(Choises)}). \ No newline at end of file + ec_core:prove_body(Param#param{goal = Next, bindings = UBs#cp.bs, choice = Choises, var_num = Vn + length(Choises)}); +prove_goal(Param = #param{goal = {to_integer, NumV, Res}, next_goal = Next, bindings = Bs0}) -> + Num = ec_support:dderef(NumV, Bs0), + case catch (ec_logic:parse_int(Num)) of + Int when is_integer(Int) -> + Bs = ec_support:add_binding(Res, Int, Bs0), + ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); + _ -> erlog_errors:fail(Param) + end; +prove_goal(Param = #param{goal = {to_string, VarV, Res}, next_goal = Next, bindings = Bs0}) -> + Var = ec_support:dderef(VarV, Bs0), + Bs = ec_support:add_binding(Res, ec_logic:to_string(Var), Bs0), + ec_core:prove_body(Param#param{goal = Next, bindings = Bs}). \ No newline at end of file From ab7ce3aa2009997ed5125d03e4ff496310584014 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 12 Aug 2014 22:07:08 +0000 Subject: [PATCH 099/251] add uuid (temporary) --- include/erlog_uuid.hrl | 15 ++++++++++++ rebar.config | 7 +++++- src/libs/external/currency/erlog_currency.erl | 2 ++ src/libs/external/uuid/erlog_uuid.erl | 24 +++++++++++++++++++ 4 files changed, 47 insertions(+), 1 deletion(-) create mode 100644 include/erlog_uuid.hrl create mode 100644 src/libs/external/uuid/erlog_uuid.erl diff --git a/include/erlog_uuid.hrl b/include/erlog_uuid.hrl new file mode 100644 index 0000000..3fc71e8 --- /dev/null +++ b/include/erlog_uuid.hrl @@ -0,0 +1,15 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 12. Авг. 2014 21:59 +%%%------------------------------------------------------------------- +-author("tihon"). + +-define(ERLOG_UID, + [ + {{id, 1}, ?MODULE, id_1} + ] +). \ No newline at end of file diff --git a/rebar.config b/rebar.config index 1e2b238..01d07cc 100644 --- a/rebar.config +++ b/rebar.config @@ -12,5 +12,10 @@ %% deps { - deps, [{jsx, ".*", {git, "https://github.com/talentdeficit/jsx.git", {branch, "master"}}}] + deps, + [ + {jsx, ".*", {git, "https://github.com/talentdeficit/jsx.git", {branch, "master"}}}, %TODO remove me + {uuid, ".*", {git, "https://github.com/afiskon/erlang-uuid-v4.git", {branch, "master"}}} %TODO remove me + + ] }. \ No newline at end of file diff --git a/src/libs/external/currency/erlog_currency.erl b/src/libs/external/currency/erlog_currency.erl index 12a6975..ce443b9 100644 --- a/src/libs/external/currency/erlog_currency.erl +++ b/src/libs/external/currency/erlog_currency.erl @@ -12,6 +12,8 @@ -include("erlog_currency.hrl"). -include("erlog_core.hrl"). +%TODO remove me from erlog + %% API -export([load/1, exchange_4/2]). diff --git a/src/libs/external/uuid/erlog_uuid.erl b/src/libs/external/uuid/erlog_uuid.erl new file mode 100644 index 0000000..e4714b0 --- /dev/null +++ b/src/libs/external/uuid/erlog_uuid.erl @@ -0,0 +1,24 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 12. Авг. 2014 21:57 +%%%------------------------------------------------------------------- +-module(erlog_uuid). +-author("tihon"). + +%TODO remove me from erlog +-include("erlog_uuid.hrl"). +-include("erlog_core.hrl"). + +%% API +-export([load/1, id_1/2]). + +load(Db) -> + lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_UID). + +id_1({id, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> + Bs = ec_support:add_binding(Res, binary_to_list(uuid:generate()), Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). \ No newline at end of file From 10a88756b5dc0977c9093bf8465cb06db7cddd77 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 13 Aug 2014 22:03:24 +0000 Subject: [PATCH 100/251] fix db_call --- src/libs/external/db/erlog_db.erl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index a1aad54..9d02d0e 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -27,11 +27,11 @@ load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_DB). db_call_2({db_call, _, _} = Goal, Param = #param{bindings = Bs, database = Db}) -> - {db_call, Table, Goal} = ec_support:dderef(Goal, Bs), + {db_call, Table, G} = ec_support:dderef(Goal, Bs), %% Only add cut CP to Cps if goal contains a cut. - case erlog_memory:db_findall(Db, Table, Goal) of + case erlog_memory:db_findall(Db, Table, G) of [] -> erlog_errors:fail(Param); - Cs -> ec_core:prove_goal_clauses(Goal, Cs, Param) + Cs -> ec_core:prove_goal_clauses(G, Cs, Param) end. db_assert_2({db_assert, _, _} = Goal, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> From 644e5085a6175d2e9c76c4c4a44574041bb2694a Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 13 Aug 2014 22:35:56 +0000 Subject: [PATCH 101/251] fix eval --- src/libs/standard/bips/logic/eb_logic.erl | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/libs/standard/bips/logic/eb_logic.erl b/src/libs/standard/bips/logic/eb_logic.erl index ba0df6a..3345758 100644 --- a/src/libs/standard/bips/logic/eb_logic.erl +++ b/src/libs/standard/bips/logic/eb_logic.erl @@ -17,7 +17,7 @@ prove_functor/4, prove_univ/3, prove_atom_chars/3, - arith_test_prove_body/4]). + arith_test_prove_body/4, eval_arith/3]). %% term_test_prove_body(Test, Left, Right, Next, ChoicePoints, Bindings, Varnum, Database) -> %% void. @@ -137,8 +137,6 @@ arith_test_prove_body(Test, L, R, Params = #param{next_goal = Next, bindings = B false -> erlog_errors:fail(Params) end. - -%% @private %% eval_arith(ArithExpr, Bindings, Database) -> Number. %% Evaluate an arithmetic expression, include the database for %% errors. Dereference each level as we go, might fail so save some @@ -188,6 +186,7 @@ eval_arith([_ | _], _Bs, Db) -> erlog_errors:type_error(evaluable, pred_ind('.', 2), Db); eval_arith(O, _Bs, Db) -> erlog_errors:type_error(evaluable, O, Db). + %% @private %% eval_int(IntegerExpr, Bindings, Database) -> Integer. %% Evaluate an integer expression, include the database for errors. From e92c61447ce5d79f98aadf67f4549c0e93ef07a1 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 14 Aug 2014 00:12:12 +0000 Subject: [PATCH 102/251] fix findall --- include/erlog_core.hrl | 1 + src/libs/standard/core/logic/ec_logic.erl | 4 ++-- src/libs/standard/core/main/erlog_core.erl | 6 +++--- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/include/erlog_core.hrl b/include/erlog_core.hrl index edc092a..fc7bb23 100644 --- a/include/erlog_core.hrl +++ b/include/erlog_core.hrl @@ -77,6 +77,7 @@ {writeln, 1}, %% Searching functions {findall, 3}, + {findall, 2}, %support for findall {bagof, 3}, {setof, 3}, {listing, 1}, diff --git a/src/libs/standard/core/logic/ec_logic.erl b/src/libs/standard/core/logic/ec_logic.erl index 3d1d96b..0db84c6 100644 --- a/src/libs/standard/core/logic/ec_logic.erl +++ b/src/libs/standard/core/logic/ec_logic.erl @@ -33,7 +33,7 @@ prove_findall(T, G, B0, Param = #param{bindings = Bs, choice = Cps, next_goal = Next, var_num = Vn, database = Db}) -> Label = Vn, Tag = Vn + 1, %Increment to avoid clashes - {Next1, _} = ec_logic:check_goal(G, [{{findall}, Tag, T}], Bs, Db, false, Label), + {Next1, _} = ec_logic:check_goal(G, [{findall, Tag, T}], Bs, Db, false, Label), B1 = partial_list(B0, Bs), Cp = #cp{type = findall, data = {Tag, B1}, next = Next, bs = Bs, vn = Vn}, erlog_memory:raw_store(Db, Tag, []), %Initialise collection @@ -250,4 +250,4 @@ prove_retractall(H, B, Params = #param{next_goal = Next, bindings = Bs0, var_num built_in -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); undefined -> ec_core:prove_body(Params#param{goal = Next}) - end. \ No newline at end of file + end. diff --git a/src/libs/standard/core/main/erlog_core.erl b/src/libs/standard/core/main/erlog_core.erl index a326042..82b42b7 100644 --- a/src/libs/standard/core/main/erlog_core.erl +++ b/src/libs/standard/core/main/erlog_core.erl @@ -185,9 +185,9 @@ prove_goal(Param = #param{goal = {listing, Res}, next_goal = Next, bindings = Bs Content = erlog_memory:listing(Db), Bs = ec_support:add_binding(Res, Content, Bs0), ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); -prove_goal(Param = #param{goal = {findall, T, G, B}}) -> +prove_goal(Param = #param{goal = {findall, T, G, B}}) -> %findall start ec_logic:prove_findall(T, G, B, Param); -prove_goal(Param = #param{goal = {{findall}, Tag, T0}, bindings = Bs, database = Db}) -> +prove_goal(Param = #param{goal = {findall, Tag, T0}, bindings = Bs, database = Db}) -> %findall finish T1 = ec_support:dderef(T0, Bs), erlog_memory:raw_append(Db, Tag, T1), %Append to saved list erlog_errors:fail(Param); @@ -214,4 +214,4 @@ prove_goal(Param = #param{goal = {to_integer, NumV, Res}, next_goal = Next, bind prove_goal(Param = #param{goal = {to_string, VarV, Res}, next_goal = Next, bindings = Bs0}) -> Var = ec_support:dderef(VarV, Bs0), Bs = ec_support:add_binding(Res, ec_logic:to_string(Var), Bs0), - ec_core:prove_body(Param#param{goal = Next, bindings = Bs}). \ No newline at end of file + ec_core:prove_body(Param#param{goal = Next, bindings = Bs}). From f4e95e1b4eb74252bc0f345e3e1552a641792ee9 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 14 Aug 2014 00:27:53 +0000 Subject: [PATCH 103/251] add spikes for support fuctions --- include/erlog_core.hrl | 10 ++++-- src/core/logic/ec_body.erl | 36 +++++++++++----------- src/libs/standard/core/logic/ec_logic.erl | 16 +++++----- src/libs/standard/core/main/erlog_core.erl | 12 ++++---- 4 files changed, 40 insertions(+), 34 deletions(-) diff --git a/include/erlog_core.hrl b/include/erlog_core.hrl index fc7bb23..42e456b 100644 --- a/include/erlog_core.hrl +++ b/include/erlog_core.hrl @@ -77,13 +77,19 @@ {writeln, 1}, %% Searching functions {findall, 3}, - {findall, 2}, %support for findall {bagof, 3}, {setof, 3}, {listing, 1}, %% Non standart functions {use, 1}, %load erlang library module {to_integer, 2}, - {to_string, 2} + {to_string, 2}, + %% Support functions %TODO do smth with me! + {findall, 2}, + {cut, 2}, + {disj, 1}, + {if_then, 1}, + {if_then_else, 2}, + {once, 1} ] ). \ No newline at end of file diff --git a/src/core/logic/ec_body.erl b/src/core/logic/ec_body.erl index 21403b2..976254c 100644 --- a/src/core/logic/ec_body.erl +++ b/src/core/logic/ec_body.erl @@ -40,30 +40,30 @@ unify_prove_body(A1, B1, A2, B2, Params = #param{bindings = Bs0}) -> %% check Term as it should already be checked. Use term_instance to %% handle goals. N.B. We have to be VERY careful never to go into the %% original tail as this will cause havoc. -body_instance([{{cut} = Cut, _, Last} | Gs0], Tail, Rs0, Vn0, Label) -> +body_instance([{cut = Cut, _, Last} | Gs0], Tail, Rs0, Vn0, Label) -> {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), {[{Cut, Label, Last} | Gs1], Rs1, Vn1}; -body_instance([{{disj} = Disj, L0, R0} | Gs0], Tail, Rs0, Vn0, Label) -> +body_instance([{disj = Disj, L0, R0} | Gs0], Tail, Rs0, Vn0, Label) -> {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), %% Append Gs1 directly to L and R. {L1, Rs2, Vn2} = body_instance(L0, Gs1, Rs1, Vn1, Label), {R1, Rs3, Vn3} = body_instance(R0, Gs1, Rs2, Vn2, Label), {[{Disj, R1} | L1], Rs3, Vn3}; -body_instance([{{if_then} = IT, C0, T0, _} | Gs0], Tail, Rs0, Vn0, Label) -> +body_instance([{if_then = IT, C0, T0, _} | Gs0], Tail, Rs0, Vn0, Label) -> {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), {T1, Rs2, Vn2} = body_instance(T0, Gs1, Rs1, Vn1, Label), - {C1, Rs3, Vn3} = body_instance(C0, [{{cut}, Label, true} | T1], Rs2, Vn2, Label), + {C1, Rs3, Vn3} = body_instance(C0, [{cut, Label, true} | T1], Rs2, Vn2, Label), %% Append Gs1 directly to T1 to C1. {[{IT, Label} | C1], Rs3, Vn3}; -body_instance([{{if_then_else} = ITE, C0, T0, E0, _} | Gs0], Tail, Rs0, Vn0, Label) -> +body_instance([{if_then_else = ITE, C0, T0, E0, _} | Gs0], Tail, Rs0, Vn0, Label) -> {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), {T1, Rs2, Vn2} = body_instance(T0, Gs1, Rs1, Vn1, Label), - {C1, Rs3, Vn3} = body_instance(C0, [{{cut}, Label, true} | T1], Rs2, Vn2, Label), + {C1, Rs3, Vn3} = body_instance(C0, [{cut, Label, true} | T1], Rs2, Vn2, Label), {E1, Rs4, Vn4} = body_instance(E0, Gs1, Rs3, Vn3, Label), {[{ITE, E1, Label} | C1], Rs4, Vn4}; -body_instance([{{once} = Once, G0, _} | Gs0], Tail, Rs0, Vn0, Label) -> +body_instance([{once = Once, G0, _} | Gs0], Tail, Rs0, Vn0, Label) -> {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), - {G1, Rs2, Vn2} = body_instance(G0, [{{cut}, Label, true} | Gs1], Rs1, Vn1, Label), + {G1, Rs2, Vn2} = body_instance(G0, [{cut, Label, true} | Gs1], Rs1, Vn1, Label), {[{Once, Label} | G1], Rs2, Vn2}; body_instance([G0 | Gs0], Tail, Rs0, Vn0, Label) -> {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), @@ -85,26 +85,26 @@ well_form_body({';', {'->', C0, T0}, E0}, Tail, Cut0, Label) -> {E1, Ec} = well_form_body(E0, Cut0, Label), %% N.B. an extra cut will be added at run-time! {C1, _} = well_form_body(C0, true, Label), - {[{{if_then_else}, C1, T1, E1, Label} | Tail], Tc or Ec}; + {[{if_then_else, C1, T1, E1, Label} | Tail], Tc or Ec}; well_form_body({';', L0, R0}, Tail, Cut0, Label) -> {L1, Lc} = well_form_body(L0, Cut0, Label), {R1, Rc} = well_form_body(R0, Cut0, Label), - {[{{disj}, L1, R1} | Tail], Lc or Rc}; + {[{disj, L1, R1} | Tail], Lc or Rc}; well_form_body({'->', C0, T0}, Tail, Cut0, Label) -> {T1, Cut1} = well_form_body(T0, Cut0, Label), %% N.B. an extra cut will be added at run-time! {C1, _} = well_form_body(C0, true, Label), - {[{{if_then}, C1, T1, Label} | Tail], Cut1}; + {[{if_then, C1, T1, Label} | Tail], Cut1}; well_form_body({once, G}, Tail, Cut, Label) -> %% N.B. an extra cut is added at run-time! {G1, _} = well_form_body(G, true, Label), - {[{{once}, G1, Label} | Tail], Cut}; + {[{once, G1, Label} | Tail], Cut}; well_form_body({V}, Tail, Cut, _Label) -> {[{call, {V}} | Tail], Cut}; well_form_body(true, Tail, Cut, _Label) -> {Tail, Cut}; %No-op well_form_body(fail, _Tail, _Cut, _Label) -> {[fail], false}; %No further well_form_body('!', Tail, Cut, Label) -> - {[{{cut}, Label, not Cut} | Tail], true}; + {[{cut, Label, not Cut} | Tail], true}; well_form_body(Goal, Tail, Cut, _Label) -> ec_support:functor(Goal), %Check goal {[Goal | Tail], Cut}. @@ -116,26 +116,26 @@ well_form_body(Goal, Tail, Cut, _Label) -> %% overlapping integer ranges. Don't check Term as it should already %% be checked. Use orddict as there will seldom be many variables and %% it it fast to setup. -body_term([{{cut}, _, _} | Gs0], Rs0, Vn0) -> +body_term([{cut, _, _} | Gs0], Rs0, Vn0) -> {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), {body_conj('!', Gs1), Rs1, Vn1}; -body_term([{{disj}, L0, R0} | Gs0], Rs0, Vn0) -> +body_term([{disj, L0, R0} | Gs0], Rs0, Vn0) -> {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), {L1, Rs2, Vn2} = body_term(L0, Rs1, Vn1), {R1, Rs3, Vn3} = body_term(R0, Rs2, Vn2), {body_conj({';', L1, R1}, Gs1), Rs3, Vn3}; -body_term([{{if_then}, C0, T0, _} | Gs0], Rs0, Vn0) -> +body_term([{if_then, C0, T0, _} | Gs0], Rs0, Vn0) -> {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), {C1, Rs2, Vn2} = body_term(C0, Rs1, Vn1), {T1, Rs3, Vn3} = body_term(T0, Rs2, Vn2), {body_conj({'->', C1, T1}, Gs1), Rs3, Vn3}; -body_term([{{if_then_else}, C0, T0, E0, _} | Gs0], Rs0, Vn0) -> +body_term([{if_then_else, C0, T0, E0, _} | Gs0], Rs0, Vn0) -> {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), {C1, Rs2, Vn2} = body_term(C0, Rs1, Vn1), {T1, Rs3, Vn3} = body_term(T0, Rs2, Vn2), {E1, Rs4, Vn4} = body_term(E0, Rs3, Vn3), {body_conj({';', {'->', C1, T1}, E1}, Gs1), Rs4, Vn4}; -body_term([{{once}, G0, _} | Gs0], Rs0, Vn0) -> +body_term([{once, G0, _} | Gs0], Rs0, Vn0) -> {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), {G1, Rs2, Vn2} = body_term(G0, Rs1, Vn1), {body_conj({once, G1}, Gs1), Rs2, Vn2}; diff --git a/src/libs/standard/core/logic/ec_logic.erl b/src/libs/standard/core/logic/ec_logic.erl index 0db84c6..e2611eb 100644 --- a/src/libs/standard/core/logic/ec_logic.erl +++ b/src/libs/standard/core/logic/ec_logic.erl @@ -139,27 +139,27 @@ well_form_goal({',', L, R}, Tail0, Cut0, Label) -> well_form_goal(L, Tail1, Cut1, Label); well_form_goal({';', {'->', C0, T0}, E0}, Tail, Cut0, Label) -> {T1, Tc} = well_form_goal(T0, Tail, Cut0, Label), - {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), + {C1, _} = well_form_goal(C0, [{cut, Label, true} | T1], true, Label), {E1, Ec} = well_form_goal(E0, Tail, Cut0, Label), - {[{{if_then_else}, E1, Label} | C1], Tc or Ec}; + {[{if_then_else, E1, Label} | C1], Tc or Ec}; well_form_goal({';', L0, R0}, Tail, Cut0, Label) -> {L1, Lc} = well_form_goal(L0, Tail, Cut0, Label), {R1, Rc} = well_form_goal(R0, Tail, Cut0, Label), - {[{{disj}, R1} | L1], Lc or Rc}; + {[{disj, R1} | L1], Lc or Rc}; well_form_goal({'->', C0, T0}, Tail, Cut0, Label) -> {T1, Cut1} = well_form_goal(T0, Tail, Cut0, Label), %% N.B. an extra cut will be added at run-time! - {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), - {[{{if_then}, Label} | C1], Cut1}; + {C1, _} = well_form_goal(C0, [{cut, Label, true} | T1], true, Label), + {[{if_then, Label} | C1], Cut1}; well_form_goal({once, G}, Tail, Cut, Label) -> - {G1, _} = well_form_goal(G, [{{cut}, Label, true} | Tail], true, Label), - {[{{once}, Label} | G1], Cut}; + {G1, _} = well_form_goal(G, [{cut, Label, true} | Tail], true, Label), + {[{once, Label} | G1], Cut}; well_form_goal({V}, Tail, Cut, _Label) -> {[{call, {V}} | Tail], Cut}; well_form_goal(true, Tail, Cut, _Label) -> {Tail, Cut}; %No-op well_form_goal(fail, _Tail, _Cut, _Label) -> {[fail], false}; %No further well_form_goal('!', Tail, Cut, Label) -> - {[{{cut}, Label, not Cut} | Tail], true}; + {[{cut, Label, not Cut} | Tail], true}; well_form_goal(Goal, Tail, Cut, _Label) -> ec_support:functor(Goal), %Check goal {[Goal | Tail], Cut}. diff --git a/src/libs/standard/core/main/erlog_core.erl b/src/libs/standard/core/main/erlog_core.erl index 82b42b7..36b53e7 100644 --- a/src/libs/standard/core/main/erlog_core.erl +++ b/src/libs/standard/core/main/erlog_core.erl @@ -56,22 +56,22 @@ prove_goal(Param = #param{goal = {call, G}, next_goal = Next0, choice = Cps, ec_core:prove_body(Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); {Next1, false} -> ec_core:prove_body(Param#param{goal = Next1, var_num = Vn + 1}) end; -prove_goal(Param = #param{goal = {{cut}, Label, Last}}) -> +prove_goal(Param = #param{goal = {cut, Label, Last}}) -> %% Cut succeeds and trims back to cut ancestor. ec_support:cut(Label, Last, Param); -prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> +prove_goal(Param = #param{goal = {disj, R}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> %% There is no L here, it has already been prepended to Next. Cp = #cp{type = disjunction, next = R, bs = Bs, vn = Vn}, ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); prove_goal(Params = #param{goal = fail}) -> erlog_errors:fail(Params); -prove_goal(Param = #param{goal = {{if_then}, Label}, next_goal = Next, choice = Cps}) -> +prove_goal(Param = #param{goal = {if_then, Label}, next_goal = Next, choice = Cps}) -> %% We effetively implement ( C -> T ) with ( C, !, T ) but cuts in %% C are local to C. %% There is no ( C, !, T ) here, it has already been prepended to Next. %%io:fwrite("PG(->): ~p\n", [{Next}]), Cut = #cut{label = Label}, ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); -prove_goal(Param = #param{goal = {{if_then_else}, Else, Label}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> +prove_goal(Param = #param{goal = {if_then_else, Else, Label}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> %% Need to push a choicepoint to fail back to inside Cond and a cut %% to cut back to before Then when Cond succeeds. #cp{type=if_then_else} %% functions as both as is always removed whatever the outcome. @@ -82,12 +82,12 @@ prove_goal(Param = #param{goal = {{if_then_else}, Else, Label}, next_goal = Next prove_goal(Param = #param{goal = {'\\+', G}, next_goal = Next0, choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> %% We effectively implementing \+ G with ( G -> fail ; true ). Label = Vn, - {Next1, _} = ec_logic:check_goal(G, [{{cut}, Label, true}, fail], Bs, Db, true, Label), + {Next1, _} = ec_logic:check_goal(G, [{cut, Label, true}, fail], Bs, Db, true, Label), Cp = #cp{type = if_then_else, label = Label, next = Next0, bs = Bs, vn = Vn}, %%io:fwrite("PG(\\+): ~p\n", [{G1,[Cp|Cps]]), %% Must increment Vn to avoid clashes!!! ec_core:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], var_num = Vn + 1}); -prove_goal(Param = #param{goal = {{once}, Label}, next_goal = Next, choice = Cps}) -> +prove_goal(Param = #param{goal = {once, Label}, next_goal = Next, choice = Cps}) -> %% We effetively implement once(G) with ( G, ! ) but cuts in %% G are local to G. %% There is no ( G, ! ) here, it has already been prepended to Next. From d94ff46b34ba925068a06b3ced7247a8ac2d0e50 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 14 Aug 2014 23:29:06 +0000 Subject: [PATCH 104/251] Revert "add spikes for support fuctions" This reverts commit f4e95e1b4eb74252bc0f345e3e1552a641792ee9. --- include/erlog_core.hrl | 10 ++---- src/core/logic/ec_body.erl | 36 +++++++++++----------- src/libs/standard/core/logic/ec_logic.erl | 16 +++++----- src/libs/standard/core/main/erlog_core.erl | 12 ++++---- 4 files changed, 34 insertions(+), 40 deletions(-) diff --git a/include/erlog_core.hrl b/include/erlog_core.hrl index 42e456b..fc7bb23 100644 --- a/include/erlog_core.hrl +++ b/include/erlog_core.hrl @@ -77,19 +77,13 @@ {writeln, 1}, %% Searching functions {findall, 3}, + {findall, 2}, %support for findall {bagof, 3}, {setof, 3}, {listing, 1}, %% Non standart functions {use, 1}, %load erlang library module {to_integer, 2}, - {to_string, 2}, - %% Support functions %TODO do smth with me! - {findall, 2}, - {cut, 2}, - {disj, 1}, - {if_then, 1}, - {if_then_else, 2}, - {once, 1} + {to_string, 2} ] ). \ No newline at end of file diff --git a/src/core/logic/ec_body.erl b/src/core/logic/ec_body.erl index 976254c..21403b2 100644 --- a/src/core/logic/ec_body.erl +++ b/src/core/logic/ec_body.erl @@ -40,30 +40,30 @@ unify_prove_body(A1, B1, A2, B2, Params = #param{bindings = Bs0}) -> %% check Term as it should already be checked. Use term_instance to %% handle goals. N.B. We have to be VERY careful never to go into the %% original tail as this will cause havoc. -body_instance([{cut = Cut, _, Last} | Gs0], Tail, Rs0, Vn0, Label) -> +body_instance([{{cut} = Cut, _, Last} | Gs0], Tail, Rs0, Vn0, Label) -> {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), {[{Cut, Label, Last} | Gs1], Rs1, Vn1}; -body_instance([{disj = Disj, L0, R0} | Gs0], Tail, Rs0, Vn0, Label) -> +body_instance([{{disj} = Disj, L0, R0} | Gs0], Tail, Rs0, Vn0, Label) -> {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), %% Append Gs1 directly to L and R. {L1, Rs2, Vn2} = body_instance(L0, Gs1, Rs1, Vn1, Label), {R1, Rs3, Vn3} = body_instance(R0, Gs1, Rs2, Vn2, Label), {[{Disj, R1} | L1], Rs3, Vn3}; -body_instance([{if_then = IT, C0, T0, _} | Gs0], Tail, Rs0, Vn0, Label) -> +body_instance([{{if_then} = IT, C0, T0, _} | Gs0], Tail, Rs0, Vn0, Label) -> {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), {T1, Rs2, Vn2} = body_instance(T0, Gs1, Rs1, Vn1, Label), - {C1, Rs3, Vn3} = body_instance(C0, [{cut, Label, true} | T1], Rs2, Vn2, Label), + {C1, Rs3, Vn3} = body_instance(C0, [{{cut}, Label, true} | T1], Rs2, Vn2, Label), %% Append Gs1 directly to T1 to C1. {[{IT, Label} | C1], Rs3, Vn3}; -body_instance([{if_then_else = ITE, C0, T0, E0, _} | Gs0], Tail, Rs0, Vn0, Label) -> +body_instance([{{if_then_else} = ITE, C0, T0, E0, _} | Gs0], Tail, Rs0, Vn0, Label) -> {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), {T1, Rs2, Vn2} = body_instance(T0, Gs1, Rs1, Vn1, Label), - {C1, Rs3, Vn3} = body_instance(C0, [{cut, Label, true} | T1], Rs2, Vn2, Label), + {C1, Rs3, Vn3} = body_instance(C0, [{{cut}, Label, true} | T1], Rs2, Vn2, Label), {E1, Rs4, Vn4} = body_instance(E0, Gs1, Rs3, Vn3, Label), {[{ITE, E1, Label} | C1], Rs4, Vn4}; -body_instance([{once = Once, G0, _} | Gs0], Tail, Rs0, Vn0, Label) -> +body_instance([{{once} = Once, G0, _} | Gs0], Tail, Rs0, Vn0, Label) -> {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), - {G1, Rs2, Vn2} = body_instance(G0, [{cut, Label, true} | Gs1], Rs1, Vn1, Label), + {G1, Rs2, Vn2} = body_instance(G0, [{{cut}, Label, true} | Gs1], Rs1, Vn1, Label), {[{Once, Label} | G1], Rs2, Vn2}; body_instance([G0 | Gs0], Tail, Rs0, Vn0, Label) -> {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), @@ -85,26 +85,26 @@ well_form_body({';', {'->', C0, T0}, E0}, Tail, Cut0, Label) -> {E1, Ec} = well_form_body(E0, Cut0, Label), %% N.B. an extra cut will be added at run-time! {C1, _} = well_form_body(C0, true, Label), - {[{if_then_else, C1, T1, E1, Label} | Tail], Tc or Ec}; + {[{{if_then_else}, C1, T1, E1, Label} | Tail], Tc or Ec}; well_form_body({';', L0, R0}, Tail, Cut0, Label) -> {L1, Lc} = well_form_body(L0, Cut0, Label), {R1, Rc} = well_form_body(R0, Cut0, Label), - {[{disj, L1, R1} | Tail], Lc or Rc}; + {[{{disj}, L1, R1} | Tail], Lc or Rc}; well_form_body({'->', C0, T0}, Tail, Cut0, Label) -> {T1, Cut1} = well_form_body(T0, Cut0, Label), %% N.B. an extra cut will be added at run-time! {C1, _} = well_form_body(C0, true, Label), - {[{if_then, C1, T1, Label} | Tail], Cut1}; + {[{{if_then}, C1, T1, Label} | Tail], Cut1}; well_form_body({once, G}, Tail, Cut, Label) -> %% N.B. an extra cut is added at run-time! {G1, _} = well_form_body(G, true, Label), - {[{once, G1, Label} | Tail], Cut}; + {[{{once}, G1, Label} | Tail], Cut}; well_form_body({V}, Tail, Cut, _Label) -> {[{call, {V}} | Tail], Cut}; well_form_body(true, Tail, Cut, _Label) -> {Tail, Cut}; %No-op well_form_body(fail, _Tail, _Cut, _Label) -> {[fail], false}; %No further well_form_body('!', Tail, Cut, Label) -> - {[{cut, Label, not Cut} | Tail], true}; + {[{{cut}, Label, not Cut} | Tail], true}; well_form_body(Goal, Tail, Cut, _Label) -> ec_support:functor(Goal), %Check goal {[Goal | Tail], Cut}. @@ -116,26 +116,26 @@ well_form_body(Goal, Tail, Cut, _Label) -> %% overlapping integer ranges. Don't check Term as it should already %% be checked. Use orddict as there will seldom be many variables and %% it it fast to setup. -body_term([{cut, _, _} | Gs0], Rs0, Vn0) -> +body_term([{{cut}, _, _} | Gs0], Rs0, Vn0) -> {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), {body_conj('!', Gs1), Rs1, Vn1}; -body_term([{disj, L0, R0} | Gs0], Rs0, Vn0) -> +body_term([{{disj}, L0, R0} | Gs0], Rs0, Vn0) -> {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), {L1, Rs2, Vn2} = body_term(L0, Rs1, Vn1), {R1, Rs3, Vn3} = body_term(R0, Rs2, Vn2), {body_conj({';', L1, R1}, Gs1), Rs3, Vn3}; -body_term([{if_then, C0, T0, _} | Gs0], Rs0, Vn0) -> +body_term([{{if_then}, C0, T0, _} | Gs0], Rs0, Vn0) -> {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), {C1, Rs2, Vn2} = body_term(C0, Rs1, Vn1), {T1, Rs3, Vn3} = body_term(T0, Rs2, Vn2), {body_conj({'->', C1, T1}, Gs1), Rs3, Vn3}; -body_term([{if_then_else, C0, T0, E0, _} | Gs0], Rs0, Vn0) -> +body_term([{{if_then_else}, C0, T0, E0, _} | Gs0], Rs0, Vn0) -> {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), {C1, Rs2, Vn2} = body_term(C0, Rs1, Vn1), {T1, Rs3, Vn3} = body_term(T0, Rs2, Vn2), {E1, Rs4, Vn4} = body_term(E0, Rs3, Vn3), {body_conj({';', {'->', C1, T1}, E1}, Gs1), Rs4, Vn4}; -body_term([{once, G0, _} | Gs0], Rs0, Vn0) -> +body_term([{{once}, G0, _} | Gs0], Rs0, Vn0) -> {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), {G1, Rs2, Vn2} = body_term(G0, Rs1, Vn1), {body_conj({once, G1}, Gs1), Rs2, Vn2}; diff --git a/src/libs/standard/core/logic/ec_logic.erl b/src/libs/standard/core/logic/ec_logic.erl index e2611eb..0db84c6 100644 --- a/src/libs/standard/core/logic/ec_logic.erl +++ b/src/libs/standard/core/logic/ec_logic.erl @@ -139,27 +139,27 @@ well_form_goal({',', L, R}, Tail0, Cut0, Label) -> well_form_goal(L, Tail1, Cut1, Label); well_form_goal({';', {'->', C0, T0}, E0}, Tail, Cut0, Label) -> {T1, Tc} = well_form_goal(T0, Tail, Cut0, Label), - {C1, _} = well_form_goal(C0, [{cut, Label, true} | T1], true, Label), + {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), {E1, Ec} = well_form_goal(E0, Tail, Cut0, Label), - {[{if_then_else, E1, Label} | C1], Tc or Ec}; + {[{{if_then_else}, E1, Label} | C1], Tc or Ec}; well_form_goal({';', L0, R0}, Tail, Cut0, Label) -> {L1, Lc} = well_form_goal(L0, Tail, Cut0, Label), {R1, Rc} = well_form_goal(R0, Tail, Cut0, Label), - {[{disj, R1} | L1], Lc or Rc}; + {[{{disj}, R1} | L1], Lc or Rc}; well_form_goal({'->', C0, T0}, Tail, Cut0, Label) -> {T1, Cut1} = well_form_goal(T0, Tail, Cut0, Label), %% N.B. an extra cut will be added at run-time! - {C1, _} = well_form_goal(C0, [{cut, Label, true} | T1], true, Label), - {[{if_then, Label} | C1], Cut1}; + {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), + {[{{if_then}, Label} | C1], Cut1}; well_form_goal({once, G}, Tail, Cut, Label) -> - {G1, _} = well_form_goal(G, [{cut, Label, true} | Tail], true, Label), - {[{once, Label} | G1], Cut}; + {G1, _} = well_form_goal(G, [{{cut}, Label, true} | Tail], true, Label), + {[{{once}, Label} | G1], Cut}; well_form_goal({V}, Tail, Cut, _Label) -> {[{call, {V}} | Tail], Cut}; well_form_goal(true, Tail, Cut, _Label) -> {Tail, Cut}; %No-op well_form_goal(fail, _Tail, _Cut, _Label) -> {[fail], false}; %No further well_form_goal('!', Tail, Cut, Label) -> - {[{cut, Label, not Cut} | Tail], true}; + {[{{cut}, Label, not Cut} | Tail], true}; well_form_goal(Goal, Tail, Cut, _Label) -> ec_support:functor(Goal), %Check goal {[Goal | Tail], Cut}. diff --git a/src/libs/standard/core/main/erlog_core.erl b/src/libs/standard/core/main/erlog_core.erl index 36b53e7..82b42b7 100644 --- a/src/libs/standard/core/main/erlog_core.erl +++ b/src/libs/standard/core/main/erlog_core.erl @@ -56,22 +56,22 @@ prove_goal(Param = #param{goal = {call, G}, next_goal = Next0, choice = Cps, ec_core:prove_body(Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); {Next1, false} -> ec_core:prove_body(Param#param{goal = Next1, var_num = Vn + 1}) end; -prove_goal(Param = #param{goal = {cut, Label, Last}}) -> +prove_goal(Param = #param{goal = {{cut}, Label, Last}}) -> %% Cut succeeds and trims back to cut ancestor. ec_support:cut(Label, Last, Param); -prove_goal(Param = #param{goal = {disj, R}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> +prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> %% There is no L here, it has already been prepended to Next. Cp = #cp{type = disjunction, next = R, bs = Bs, vn = Vn}, ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); prove_goal(Params = #param{goal = fail}) -> erlog_errors:fail(Params); -prove_goal(Param = #param{goal = {if_then, Label}, next_goal = Next, choice = Cps}) -> +prove_goal(Param = #param{goal = {{if_then}, Label}, next_goal = Next, choice = Cps}) -> %% We effetively implement ( C -> T ) with ( C, !, T ) but cuts in %% C are local to C. %% There is no ( C, !, T ) here, it has already been prepended to Next. %%io:fwrite("PG(->): ~p\n", [{Next}]), Cut = #cut{label = Label}, ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); -prove_goal(Param = #param{goal = {if_then_else, Else, Label}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> +prove_goal(Param = #param{goal = {{if_then_else}, Else, Label}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> %% Need to push a choicepoint to fail back to inside Cond and a cut %% to cut back to before Then when Cond succeeds. #cp{type=if_then_else} %% functions as both as is always removed whatever the outcome. @@ -82,12 +82,12 @@ prove_goal(Param = #param{goal = {if_then_else, Else, Label}, next_goal = Next, prove_goal(Param = #param{goal = {'\\+', G}, next_goal = Next0, choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> %% We effectively implementing \+ G with ( G -> fail ; true ). Label = Vn, - {Next1, _} = ec_logic:check_goal(G, [{cut, Label, true}, fail], Bs, Db, true, Label), + {Next1, _} = ec_logic:check_goal(G, [{{cut}, Label, true}, fail], Bs, Db, true, Label), Cp = #cp{type = if_then_else, label = Label, next = Next0, bs = Bs, vn = Vn}, %%io:fwrite("PG(\\+): ~p\n", [{G1,[Cp|Cps]]), %% Must increment Vn to avoid clashes!!! ec_core:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], var_num = Vn + 1}); -prove_goal(Param = #param{goal = {once, Label}, next_goal = Next, choice = Cps}) -> +prove_goal(Param = #param{goal = {{once}, Label}, next_goal = Next, choice = Cps}) -> %% We effetively implement once(G) with ( G, ! ) but cuts in %% G are local to G. %% There is no ( G, ! ) here, it has already been prepended to Next. From 3a64007b8c82b8a5259bb80bf9278207ae922c75 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 14 Aug 2014 23:33:16 +0000 Subject: [PATCH 105/251] revert commit and change support functions mechanics --- src/core/logic/ec_core.erl | 29 ++++++++++++++++++++++ src/libs/external/db/erlog_db.erl | 5 ++-- src/libs/standard/core/main/erlog_core.erl | 28 --------------------- 3 files changed, 32 insertions(+), 30 deletions(-) diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index ef37ff7..39696d1 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -42,6 +42,35 @@ prove_body(#param{goal = [], choice = Cps, bindings = Bs, var_num = Vn, database %%io:fwrite("PB: ~p\n", [Cps]), {succeed, Cps, Bs, Vn, Db}. %No more body %TODO why should we return database? +%% Prove support first. Then find in database. +prove_goal(Param = #param{goal = {{once}, Label}, next_goal = Next, choice = Cps}) -> + %% We effetively implement once(G) with ( G, ! ) but cuts in + %% G are local to G. + %% There is no ( G, ! ) here, it has already been prepended to Next. + Cut = #cut{label = Label}, + prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); +prove_goal(Param = #param{goal = {{if_then_else}, Else, Label}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> + %% Need to push a choicepoint to fail back to inside Cond and a cut + %% to cut back to before Then when Cond succeeds. #cp{type=if_then_else} + %% functions as both as is always removed whatever the outcome. + %% There is no ( C, !, T ) here, it has already been prepended to Next. + Cp = #cp{type = if_then_else, label = Label, next = Else, bs = Bs, vn = Vn}, + %%io:fwrite("PG(->;): ~p\n", [{Next,Else,[Cp|Cps]}]), + prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); +prove_goal(Param = #param{goal = {{if_then}, Label}, next_goal = Next, choice = Cps}) -> + %% We effetively implement ( C -> T ) with ( C, !, T ) but cuts in + %% C are local to C. + %% There is no ( C, !, T ) here, it has already been prepended to Next. + %%io:fwrite("PG(->): ~p\n", [{Next}]), + Cut = #cut{label = Label}, + prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); +prove_goal(Param = #param{goal = {{cut}, Label, Last}}) -> + %% Cut succeeds and trims back to cut ancestor. + ec_support:cut(Label, Last, Param); +prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> + %% There is no L here, it has already been prepended to Next. + Cp = #cp{type = disjunction, next = R, bs = Bs, vn = Vn}, + prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); prove_goal(Param = #param{goal = G, database = Db}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 9d02d0e..9cd261e 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -26,12 +26,12 @@ load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_DB). -db_call_2({db_call, _, _} = Goal, Param = #param{bindings = Bs, database = Db}) -> +db_call_2({db_call, _, _} = Goal, Param = #param{bindings = Bs, database = Db, var_num = Vn}) -> {db_call, Table, G} = ec_support:dderef(Goal, Bs), %% Only add cut CP to Cps if goal contains a cut. case erlog_memory:db_findall(Db, Table, G) of [] -> erlog_errors:fail(Param); - Cs -> ec_core:prove_goal_clauses(G, Cs, Param) + Cs -> ec_core:prove_goal_clauses(G, Cs, Param#param{var_num = Vn + 1}) end. db_assert_2({db_assert, _, _} = Goal, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> @@ -112,6 +112,7 @@ retract(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = Cp = #cp{type = db_retract, data = {Ch, Cb, Cs, Table}, next = Next, bs = Bs0, vn = Vn0}, ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). +%% @private %% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to retract Head and Body using Clauses which all have the same functor. diff --git a/src/libs/standard/core/main/erlog_core.erl b/src/libs/standard/core/main/erlog_core.erl index 82b42b7..426d1db 100644 --- a/src/libs/standard/core/main/erlog_core.erl +++ b/src/libs/standard/core/main/erlog_core.erl @@ -56,29 +56,7 @@ prove_goal(Param = #param{goal = {call, G}, next_goal = Next0, choice = Cps, ec_core:prove_body(Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); {Next1, false} -> ec_core:prove_body(Param#param{goal = Next1, var_num = Vn + 1}) end; -prove_goal(Param = #param{goal = {{cut}, Label, Last}}) -> - %% Cut succeeds and trims back to cut ancestor. - ec_support:cut(Label, Last, Param); -prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> - %% There is no L here, it has already been prepended to Next. - Cp = #cp{type = disjunction, next = R, bs = Bs, vn = Vn}, - ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); prove_goal(Params = #param{goal = fail}) -> erlog_errors:fail(Params); -prove_goal(Param = #param{goal = {{if_then}, Label}, next_goal = Next, choice = Cps}) -> - %% We effetively implement ( C -> T ) with ( C, !, T ) but cuts in - %% C are local to C. - %% There is no ( C, !, T ) here, it has already been prepended to Next. - %%io:fwrite("PG(->): ~p\n", [{Next}]), - Cut = #cut{label = Label}, - ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); -prove_goal(Param = #param{goal = {{if_then_else}, Else, Label}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> - %% Need to push a choicepoint to fail back to inside Cond and a cut - %% to cut back to before Then when Cond succeeds. #cp{type=if_then_else} - %% functions as both as is always removed whatever the outcome. - %% There is no ( C, !, T ) here, it has already been prepended to Next. - Cp = #cp{type = if_then_else, label = Label, next = Else, bs = Bs, vn = Vn}, - %%io:fwrite("PG(->;): ~p\n", [{Next,Else,[Cp|Cps]}]), - ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); prove_goal(Param = #param{goal = {'\\+', G}, next_goal = Next0, choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> %% We effectively implementing \+ G with ( G -> fail ; true ). Label = Vn, @@ -87,12 +65,6 @@ prove_goal(Param = #param{goal = {'\\+', G}, next_goal = Next0, choice = Cps, bi %%io:fwrite("PG(\\+): ~p\n", [{G1,[Cp|Cps]]), %% Must increment Vn to avoid clashes!!! ec_core:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], var_num = Vn + 1}); -prove_goal(Param = #param{goal = {{once}, Label}, next_goal = Next, choice = Cps}) -> - %% We effetively implement once(G) with ( G, ! ) but cuts in - %% G are local to G. - %% There is no ( G, ! ) here, it has already been prepended to Next. - Cut = #cut{label = Label}, - ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); prove_goal(Param = #param{goal = repeat, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> Cp = #cp{type = disjunction, next = [repeat | Next], bs = Bs, vn = Vn}, ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); From 3dc2c1340fca4facb13a5b43a5c0b4a826c6f13b Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 15 Aug 2014 16:17:28 +0000 Subject: [PATCH 106/251] removed external lib from erlog --- include/erlog_currency.hrl | 27 --- rebar.config | 7 +- src/core/erlog_errors.erl | 2 +- src/core/logic/ec_core.erl | 20 +- src/libs/external/currency/erlog_curr_sup.erl | 67 ------ .../external/currency/erlog_curr_sync.erl | 201 ------------------ src/libs/external/currency/erlog_currency.erl | 65 ------ src/libs/external/db/erlog_db.erl | 32 +-- .../libs/external/erlog_exlib.erl | 12 +- src/libs/external/uuid/erlog_uuid.erl | 24 --- src/libs/standard/erlog_stdlib.erl | 2 +- 11 files changed, 35 insertions(+), 424 deletions(-) delete mode 100644 include/erlog_currency.hrl delete mode 100644 src/libs/external/currency/erlog_curr_sup.erl delete mode 100644 src/libs/external/currency/erlog_curr_sync.erl delete mode 100644 src/libs/external/currency/erlog_currency.erl rename include/erlog_uuid.hrl => src/libs/external/erlog_exlib.erl (56%) delete mode 100644 src/libs/external/uuid/erlog_uuid.erl diff --git a/include/erlog_currency.hrl b/include/erlog_currency.hrl deleted file mode 100644 index 619cf2d..0000000 --- a/include/erlog_currency.hrl +++ /dev/null @@ -1,27 +0,0 @@ -%%%------------------------------------------------------------------- -%%% @author tihon -%%% @copyright (C) 2014, -%%% @doc -%%% -%%% @end -%%% Created : 24. Июль 2014 20:06 -%%%------------------------------------------------------------------- --author("tihon"). - --define(COURSE_URL, "https://api.privatbank.ua/p24api/pubinfo?jsonp&exchange&coursid=5"). --define(CHECK_PERIOD, 60000). - - --define(ERLOG_CURRENCY, - [ - {{exchange, 4}, ?MODULE, exchange_4} - ] -). - --record(currency, -{ - name, - base_name, - buy_course, - sell_course -}). \ No newline at end of file diff --git a/rebar.config b/rebar.config index 01d07cc..b318795 100644 --- a/rebar.config +++ b/rebar.config @@ -12,10 +12,5 @@ %% deps { - deps, - [ - {jsx, ".*", {git, "https://github.com/talentdeficit/jsx.git", {branch, "master"}}}, %TODO remove me - {uuid, ".*", {git, "https://github.com/afiskon/erlang-uuid-v4.git", {branch, "master"}}} %TODO remove me - - ] + deps, [] }. \ No newline at end of file diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 793e1a3..0755f98 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -87,7 +87,7 @@ fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Para %% @private fail_goal_clauses(#cp{data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> - ec_core:prove_goal_clauses(G, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + ec_core:prove_goal_clauses(Cs, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn}). fail_findall(#cp{next = Next, data = {Tag, Bag}, bs = Bs, vn = Vn0}, Param = #param{database = Db}) -> Data = erlog_memory:raw_fetch(Db, Tag), diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index 39696d1..1df5c97 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -12,7 +12,7 @@ -include("erlog_core.hrl"). %% API --export([prove_body/1, prove_goal/1, prove_goal/4, prove_goal_clauses/3]). +-export([prove_body/1, prove_goal/1, prove_goal/4, prove_goal_clauses/2]). %% prove_goal(Goal, Database) -> Succeed | Fail. %% This is the main entry point into the interpreter. Check that @@ -75,8 +75,8 @@ prove_goal(Param = #param{goal = G, database = Db}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of {built_in, Mod} -> Mod:prove_goal(Param); %kernel space - {code, {Mod, Func}} -> Mod:Func(G, Param); - {clauses, Cs} -> prove_goal_clauses(G, Cs, Param); + {code, {Mod, Func}} -> Mod:Func(Param); %library space + {clauses, Cs} -> prove_goal_clauses(Cs, Param); %user space undefined -> erlog_errors:fail(Param); %% Getting built_in here is an error! {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data @@ -85,23 +85,23 @@ prove_goal(Param = #param{goal = G, database = Db}) -> %% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to prove Goal using Clauses which all have the same functor. -prove_goal_clauses(G, [C], Params = #param{choice = Cps, var_num = Vn}) -> +prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> %% Must be smart here and test whether we need to add a cut point. %% C has the structure {Tag,Head,{Body,BodyHasCut}}. case element(2, element(3, C)) of true -> Cut = #cut{label = Vn}, - prove_goal_clause(G, C, Params#param{choice = [Cut | Cps]}); + prove_goal_clause(C, Params#param{choice = [Cut | Cps]}); false -> - prove_goal_clause(G, C, Params) + prove_goal_clause(C, Params) end; %% prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db); -prove_goal_clauses(G, [C | Cs], Params = #param{next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps}) -> +prove_goal_clauses([C | Cs], Params = #param{goal = G, next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps}) -> Cp = #cp{type = goal_clauses, label = Vn, data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, - prove_goal_clause(G, C, Params#param{choice = [Cp | Cps]}); -prove_goal_clauses(_G, [], Param) -> erlog_errors:fail(Param). + prove_goal_clause(C, Params#param{choice = [Cp | Cps]}); +prove_goal_clauses([], Param) -> erlog_errors:fail(Param). -prove_goal_clause(G, {_Tag, H0, {B0, _}}, Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0}) -> +prove_goal_clause({_Tag, H0, {B0, _}}, Param = #param{goal = G, next_goal = Next, bindings = Bs0, var_num = Vn0}) -> %% io:fwrite("PGC1: ~p\n", [{G,H0,B0}]), Label = Vn0, case ec_unify:unify_head(G, H0, Bs0, Vn0 + 1) of diff --git a/src/libs/external/currency/erlog_curr_sup.erl b/src/libs/external/currency/erlog_curr_sup.erl deleted file mode 100644 index 945ee99..0000000 --- a/src/libs/external/currency/erlog_curr_sup.erl +++ /dev/null @@ -1,67 +0,0 @@ -%%%------------------------------------------------------------------- -%%% @author tihon -%%% @copyright (C) 2014, -%%% @doc -%%% -%%% @end -%%% Created : 24. Июль 2014 20:10 -%%%------------------------------------------------------------------- --module(erlog_curr_sup). --author("tihon"). - --behaviour(supervisor). - -%% API --export([start_link/0, start_sync_worker/0]). - -%% Supervisor callbacks --export([init/1]). - --define(SERVER, ?MODULE). - -%%%=================================================================== -%%% API functions -%%%=================================================================== -start_sync_worker() -> supervisor:start_child(?MODULE, []). - -%%-------------------------------------------------------------------- -%% @doc -%% Starts the supervisor -%% -%% @end -%%-------------------------------------------------------------------- --spec(start_link() -> - {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). -start_link() -> - supervisor:start_link({local, ?SERVER}, ?MODULE, []). - -%%%=================================================================== -%%% Supervisor callbacks -%%%=================================================================== - -%%-------------------------------------------------------------------- -%% @private -%% @doc -%% Whenever a supervisor is started using supervisor:start_link/[2,3], -%% this function is called by the new process to find out about -%% restart strategy, maximum restart frequency and child -%% specifications. -%% -%% @end -%%-------------------------------------------------------------------- --spec(init(Args :: term()) -> - {ok, {SupFlags :: {RestartStrategy :: supervisor:strategy(), - MaxR :: non_neg_integer(), MaxT :: non_neg_integer()}, - [ChildSpec :: supervisor:child_spec()] - }} | - ignore | - {error, Reason :: term()}). -init([]) -> - RestartStrategy = {simple_one_for_one, 10, 60}, - Worker = {erlog_curr_sync, {erlog_curr_sync, start_link, []}, - permanent, 2000, worker, [erlog_curr_sync]}, - {ok, {RestartStrategy, [Worker]}}. - -%%%=================================================================== -%%% Internal functions -%%%=================================================================== diff --git a/src/libs/external/currency/erlog_curr_sync.erl b/src/libs/external/currency/erlog_curr_sync.erl deleted file mode 100644 index d2e35b1..0000000 --- a/src/libs/external/currency/erlog_curr_sync.erl +++ /dev/null @@ -1,201 +0,0 @@ -%%%------------------------------------------------------------------- -%%% @author tihon -%%% @copyright (C) 2014, -%%% @doc -%%% -%%% @end -%%% Created : 24. Июль 2014 20:07 -%%%------------------------------------------------------------------- --module(erlog_curr_sync). --author("tihon"). - --include("erlog_currency.hrl"). - --behaviour(gen_server). - -%% API --export([start_link/0, get_course_by_curr/1]). - -%% gen_server callbacks --export([init/1, - handle_call/3, - handle_cast/2, - handle_info/2, - terminate/2, - code_change/3]). - --define(SERVER, ?MODULE). - --record(state, -{ - course :: dict -}). - -%%%=================================================================== -%%% API -%%%=================================================================== -get_course_by_curr(Currency) -> gen_server:call(?MODULE, {get, Currency}). - -%%-------------------------------------------------------------------- -%% @doc -%% Starts the server -%% -%% @end -%%-------------------------------------------------------------------- --spec(start_link() -> - {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). -start_link() -> - gen_server:start_link({local, ?SERVER}, ?MODULE, [], []). - -%%%=================================================================== -%%% gen_server callbacks -%%%=================================================================== - -%%-------------------------------------------------------------------- -%% @private -%% @doc -%% Initializes the server -%% -%% @spec init(Args) -> {ok, State} | -%% {ok, State, Timeout} | -%% ignore | -%% {stop, Reason} -%% @end -%%-------------------------------------------------------------------- --spec(init(Args :: term()) -> - {ok, State :: #state{}} | {ok, State :: #state{}, timeout() | hibernate} | - {stop, Reason :: term()} | ignore). -init([]) -> - gen_server:cast(self(), check), - timer:send_interval(?CHECK_PERIOD, self(), check), - {ok, #state{course = dict:new()}}. - -%%-------------------------------------------------------------------- -%% @private -%% @doc -%% Handling call messages -%% -%% @end -%%-------------------------------------------------------------------- --spec(handle_call(Request :: term(), From :: {pid(), Tag :: term()}, - State :: #state{}) -> - {reply, Reply :: term(), NewState :: #state{}} | - {reply, Reply :: term(), NewState :: #state{}, timeout() | hibernate} | - {noreply, NewState :: #state{}} | - {noreply, NewState :: #state{}, timeout() | hibernate} | - {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | - {stop, Reason :: term(), NewState :: #state{}}). -handle_call({get, Currency}, _From, State = #state{course = Dict}) -> - Course = dict:find(Currency, Dict), - {reply, Course, State}; -handle_call(_Request, _From, State) -> - {reply, ok, State}. - -%%-------------------------------------------------------------------- -%% @private -%% @doc -%% Handling cast messages -%% -%% @end -%%-------------------------------------------------------------------- --spec(handle_cast(Request :: term(), State :: #state{}) -> - {noreply, NewState :: #state{}} | - {noreply, NewState :: #state{}, timeout() | hibernate} | - {stop, Reason :: term(), NewState :: #state{}}). -handle_cast(check, State = #state{course = Dict}) -> - UpdCourse = check_course(Dict), - {noreply, State#state{course = UpdCourse}}; -handle_cast(_Request, State) -> - {noreply, State}. - -%%-------------------------------------------------------------------- -%% @private -%% @doc -%% Handling all non call/cast messages -%% -%% @spec handle_info(Info, State) -> {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, State} -%% @end -%%-------------------------------------------------------------------- --spec(handle_info(Info :: timeout() | term(), State :: #state{}) -> - {noreply, NewState :: #state{}} | - {noreply, NewState :: #state{}, timeout() | hibernate} | - {stop, Reason :: term(), NewState :: #state{}}). -handle_info(check, State = #state{course = CourseList}) -> - UpdCourse = check_course(CourseList), - {noreply, State#state{course = UpdCourse}}; -handle_info(_Info, State) -> - {noreply, State}. - -%%-------------------------------------------------------------------- -%% @private -%% @doc -%% This function is called by a gen_server when it is about to -%% terminate. It should be the opposite of Module:init/1 and do any -%% necessary cleaning up. When it returns, the gen_server terminates -%% with Reason. The return value is ignored. -%% -%% @spec terminate(Reason, State) -> void() -%% @end -%%-------------------------------------------------------------------- --spec(terminate(Reason :: (normal | shutdown | {shutdown, term()} | term()), - State :: #state{}) -> term()). -terminate(_Reason, _State) -> - ok. - -%%-------------------------------------------------------------------- -%% @private -%% @doc -%% Convert process state when code is changed -%% -%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState} -%% @end -%%-------------------------------------------------------------------- --spec(code_change(OldVsn :: term() | {down, term()}, State :: #state{}, - Extra :: term()) -> - {ok, NewState :: #state{}} | {error, Reason :: term()}). -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%%%=================================================================== -%%% Internal functions -%%%=================================================================== -check_course(Current) -> - CourseJson = get_course(), - Parsed = jsx:decode(CourseJson), - parse_course(Parsed, Current). - -get_course() -> -%% {ok, {{_, 200, _}, _, Body}} = httpc:request(get, {?COURSE_URL, []}, [], []), %TODO! - Body = <<"[{\"ccy\":\"RUR\",\"base_ccy\":\"UAH\",\"buy\":\"0.32500\",\"sale\":\"0.36000\"}, - {\"ccy\":\"EUR\",\"base_ccy\":\"UAH\",\"buy\":\"15.60000\",\"sale\":\"16.60000\"}, - {\"ccy\":\"USD\",\"base_ccy\":\"UAH\",\"buy\":\"11.65000\",\"sale\":\"11.95000\"}]">>, - Body. - --spec update_currency(#currency{}, dict) -> dict. -update_currency(Currency = #currency{base_name = BName, name = Name}, Dict) -> - Key = lists:concat(lists:sort([Name, BName])), - dict:store(Key, Currency, Dict). - --spec parse_course(list(), dict) -> dict. -parse_course(New, Current) -> - lists:foldl( - fun(Proplist, Acc) -> - try update_currency(parse_currency(Proplist), Acc) - catch - _:_ -> Acc - end - end, Current, New). - --spec parse_currency(proplists:proplist()) -> #currency{}. -parse_currency(Currency) -> - Name = parse_value(<<"ccy">>, Currency), - BaseName = parse_value(<<"base_ccy">>, Currency), - Buy = parse_value(<<"buy">>, Currency), - Sell = parse_value(<<"sale">>, Currency), - #currency{name = Name, base_name = BaseName, buy_course = list_to_float(Buy), sell_course = list_to_float(Sell)}. - --spec parse_value(binary(), proplists:proplist()) -> list(). -parse_value(Key, List) -> - binary_to_list(proplists:get_value(Key, List)). \ No newline at end of file diff --git a/src/libs/external/currency/erlog_currency.erl b/src/libs/external/currency/erlog_currency.erl deleted file mode 100644 index ce443b9..0000000 --- a/src/libs/external/currency/erlog_currency.erl +++ /dev/null @@ -1,65 +0,0 @@ -%%%------------------------------------------------------------------- -%%% @author tihon -%%% @copyright (C) 2014, -%%% @doc -%%% -%%% @end -%%% Created : 24. Июль 2014 20:06 -%%%------------------------------------------------------------------- --module(erlog_currency). --author("tihon"). - --include("erlog_currency.hrl"). --include("erlog_core.hrl"). - -%TODO remove me from erlog - -%% API --export([load/1, exchange_4/2]). - -load(Db) -> - start_sync_if_needed(), - lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_CURRENCY). - -exchange_4({exchange, _, _, _, _} = Goal, Params = #param{next_goal = Next, bindings = Bs0}) -> - {exchange, From, CurrencyTypeFrom, To, CurrencyTypeTo} = ec_support:dderef(Goal, Bs0), - Course = lists:concat(lists:sort([CurrencyTypeFrom, CurrencyTypeTo])), - ResultCurrency = case erlog_curr_sync:get_course_by_curr(Course) of - error -> erlog_errors:erlog_error("Unknown currency type!"); - {ok, Currency} -> - case Currency#currency.name of - CurrencyTypeFrom -> From * Currency#currency.buy_course; - CurrencyTypeTo -> From / Currency#currency.sell_course; - _ -> erlog_errors:erlog_error("Unknown currency type!") - end - end, - Bs = ec_support:add_binding(To, ResultCurrency, Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). - - -%% @private -%% Starts erlog_curr_sync server if it is not started. -%% Makes monitor to it. -start_sync_if_needed() -> - case check_server(whereis(erlog_curr_sync)) of - undefined -> start_server(); - _ -> ok - end. - -%% @private -%% Checks if server is registered and running -check_server(undefined) -> undefined; -check_server(Pid) -> process_info(Pid). - -%% @private -%% Starts supervisor and currency sync server -start_server() -> - %start deps if not started - catch inets:start(), - catch application:start(crypto), - catch application:start(asn1), - catch application:start(public_key), - catch application:start(ssl), - - catch erlog_curr_sup:start_link(), - erlog_curr_sup:start_sync_worker(). \ No newline at end of file diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 9cd261e..4a80d5f 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -12,39 +12,41 @@ -include("erlog_core.hrl"). -include("erlog_db.hrl"). +-behaviour(erlog_exlib). + %% API -export([load/1, - db_assert_2/2, - db_asserta_2/2, - db_abolish_2/2, - db_retract_2/2, - db_retractall_2/2, + db_assert_2/1, + db_asserta_2/1, + db_abolish_2/1, + db_retract_2/1, + db_retractall_2/1, fail_retract/2, - db_call_2/2, - db_listing_2/2]). + db_call_2/1, + db_listing_2/1]). load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_DB). -db_call_2({db_call, _, _} = Goal, Param = #param{bindings = Bs, database = Db, var_num = Vn}) -> +db_call_2(Param = #param{goal = {db_call, _, _} = Goal, bindings = Bs, database = Db, var_num = Vn}) -> {db_call, Table, G} = ec_support:dderef(Goal, Bs), %% Only add cut CP to Cps if goal contains a cut. case erlog_memory:db_findall(Db, Table, G) of [] -> erlog_errors:fail(Param); - Cs -> ec_core:prove_goal_clauses(G, Cs, Param#param{var_num = Vn + 1}) + Cs -> ec_core:prove_goal_clauses(Cs, Param#param{var_num = Vn + 1}) end. -db_assert_2({db_assert, _, _} = Goal, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> +db_assert_2(Params = #param{goal = {db_assert, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> {db_assert, Table, Fact} = ec_support:dderef(Goal, Bs), erlog_memory:db_assertz_clause(Db, Table, Fact), ec_core:prove_body(Params#param{goal = Next}). -db_asserta_2({db_asserta, _, _} = Goal, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> +db_asserta_2(Params = #param{goal = {db_asserta, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> {db_asserta, Table, Fact} = ec_support:dderef(Goal, Bs), erlog_memory:db_asserta_clause(Db, Table, Fact), ec_core:prove_body(Params#param{goal = Next}). -db_abolish_2({db_abolish, _, _} = Goal, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> +db_abolish_2(Params = #param{goal = {db_abolish, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> {db_abolish, Table, Fact} = ec_support:dderef(Goal, Bs), case Fact of {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> @@ -53,15 +55,15 @@ db_abolish_2({db_abolish, _, _} = Goal, Params = #param{next_goal = Next, bindin Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) end. -db_retract_2({db_retract, _, _} = Goal, Params = #param{bindings = Bs}) -> +db_retract_2(Params = #param{goal = {db_retract, _, _} = Goal, bindings = Bs}) -> {db_retract, Table, Fact} = ec_support:dderef(Goal, Bs), prove_retract(Fact, Table, Params). -db_retractall_2({db_retractall, _, _} = Goal, Params = #param{bindings = Bs}) -> +db_retractall_2(Params = #param{goal = {db_retractall, _, _} = Goal, bindings = Bs}) -> {db_retractall, Table, Fact} = ec_support:dderef(Goal, Bs), prove_retractall(Fact, Table, Params). -db_listing_2({db_listing, _, _} = Goal, Params = #param{next_goal = Next, bindings = Bs0, database = Db}) -> +db_listing_2(Params = #param{goal = {db_listing, _, _} = Goal, next_goal = Next, bindings = Bs0, database = Db}) -> {db_listing, Table, Res} = ec_support:dderef(Goal, Bs0), Content = erlog_memory:db_listing(Db, Table), Bs = ec_support:add_binding(Res, Content, Bs0), diff --git a/include/erlog_uuid.hrl b/src/libs/external/erlog_exlib.erl similarity index 56% rename from include/erlog_uuid.hrl rename to src/libs/external/erlog_exlib.erl index 3fc71e8..13815b7 100644 --- a/include/erlog_uuid.hrl +++ b/src/libs/external/erlog_exlib.erl @@ -1,15 +1,13 @@ %%%------------------------------------------------------------------- %%% @author tihon %%% @copyright (C) 2014, -%%% @doc +%%% @doc erlog external library interface %%% %%% @end -%%% Created : 12. Авг. 2014 21:59 +%%% Created : 15. Авг. 2014 14:28 %%%------------------------------------------------------------------- +-module(erlog_exlib). -author("tihon"). --define(ERLOG_UID, - [ - {{id, 1}, ?MODULE, id_1} - ] -). \ No newline at end of file +%% load database to kernel space +-callback load(Db :: pid() | atom()) -> ok. \ No newline at end of file diff --git a/src/libs/external/uuid/erlog_uuid.erl b/src/libs/external/uuid/erlog_uuid.erl deleted file mode 100644 index e4714b0..0000000 --- a/src/libs/external/uuid/erlog_uuid.erl +++ /dev/null @@ -1,24 +0,0 @@ -%%%------------------------------------------------------------------- -%%% @author tihon -%%% @copyright (C) 2014, -%%% @doc -%%% -%%% @end -%%% Created : 12. Авг. 2014 21:57 -%%%------------------------------------------------------------------- --module(erlog_uuid). --author("tihon"). - -%TODO remove me from erlog --include("erlog_uuid.hrl"). --include("erlog_core.hrl"). - -%% API --export([load/1, id_1/2]). - -load(Db) -> - lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_UID). - -id_1({id, Res}, Params = #param{next_goal = Next, bindings = Bs0}) -> - Bs = ec_support:add_binding(Res, binary_to_list(uuid:generate()), Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). \ No newline at end of file diff --git a/src/libs/standard/erlog_stdlib.erl b/src/libs/standard/erlog_stdlib.erl index 7c217fc..3f7e839 100644 --- a/src/libs/standard/erlog_stdlib.erl +++ b/src/libs/standard/erlog_stdlib.erl @@ -1,7 +1,7 @@ %%%------------------------------------------------------------------- %%% @author tihon %%% @copyright (C) 2014, -%%% @doc +%%% @doc erlog standart library interface %%% %%% @end %%% Created : 12. Авг. 2014 18:31 From 0a0b810ca953428d1a1d6012b43f450128e73b25 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 15 Aug 2014 18:09:10 +0000 Subject: [PATCH 107/251] added listing/2 listing/3 --- include/erlog_core.hrl | 2 ++ src/libs/standard/core/main/erlog_core.erl | 10 +++++++++- src/storage/erlog_ets.erl | 21 ++++++++++++++++----- src/storage/erlog_memory.erl | 8 ++++---- src/storage/erlog_storage.erl | 2 +- 5 files changed, 32 insertions(+), 11 deletions(-) diff --git a/include/erlog_core.hrl b/include/erlog_core.hrl index fc7bb23..c58c7b7 100644 --- a/include/erlog_core.hrl +++ b/include/erlog_core.hrl @@ -81,6 +81,8 @@ {bagof, 3}, {setof, 3}, {listing, 1}, + {listing, 2}, + {listing, 3}, %% Non standart functions {use, 1}, %load erlang library module {to_integer, 2}, diff --git a/src/libs/standard/core/main/erlog_core.erl b/src/libs/standard/core/main/erlog_core.erl index 426d1db..d2ebb68 100644 --- a/src/libs/standard/core/main/erlog_core.erl +++ b/src/libs/standard/core/main/erlog_core.erl @@ -154,7 +154,15 @@ prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db end, ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {listing, Res}, next_goal = Next, bindings = Bs0, database = Db}) -> - Content = erlog_memory:listing(Db), + Content = erlog_memory:listing(Db, []), + Bs = ec_support:add_binding(Res, Content, Bs0), + ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); +prove_goal(Param = #param{goal = {listing, Pred, Res}, next_goal = Next, bindings = Bs0, database = Db}) -> + Content = erlog_memory:listing(Db, [Pred]), + Bs = ec_support:add_binding(Res, Content, Bs0), + ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); +prove_goal(Param = #param{goal = {listing, Pred, Arity, Res}, next_goal = Next, bindings = Bs0, database = Db}) -> + Content = erlog_memory:listing(Db, [Pred, Arity]), Bs = ec_support:add_binding(Res, Content, Bs0), ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); prove_goal(Param = #param{goal = {findall, T, G, B}}) -> %findall start diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 0bd6a4a..c1b572c 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -27,7 +27,6 @@ raw_fetch/2, raw_append/2, raw_erase/2, - listing/1, listing/2]). new() -> {ok, ets:new(eets, [])}. @@ -172,11 +171,23 @@ raw_erase(Db, {Key}) -> ets:delete(Db, Key), {ok, Db}. -listing(Db, Collection) -> +listing(Db, {Collection, Params}) -> Ets = ets_db_storage:get_db(Collection), - {Res, _} = listing(Ets), - {Res, Db}. -listing(Db) -> + {Res, _} = listing(Ets, Params), + {Res, Db}; +listing(Db, {[Functor, Arity]}) -> + {ets:foldl( + fun({{F, A} = Res, clauses, _, _}, Acc) when F == Functor andalso A == Arity -> + [Res | Acc]; + (_, Acc) -> Acc + end, [], Db), Db}; +listing(Db, {[Functor]}) -> + {ets:foldl( + fun({{F, Arity}, clauses, _, _}, Acc) when F == Functor -> + [{Functor, Arity} | Acc]; + (_, Acc) -> Acc + end, [], Db), Db}; +listing(Db, {[]}) -> {ets:foldl( fun({Fun, clauses, _, _}, Acc) -> [Fun | Acc]; (_, Acc) -> Acc diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 851c8a9..7bdc811 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -29,7 +29,7 @@ raw_fetch/2, raw_append/3, raw_erase/2, - listing/1]). + listing/2]). -export([db_assertz_clause/3, db_assertz_clause/4, @@ -39,7 +39,7 @@ db_abolish_clauses/3, get_db_procedure/3, db_findall/3, - db_listing/2]). + db_listing/3]). -export([load_kernel_space/3]). @@ -111,9 +111,9 @@ raw_append(Database, Key, Value) -> gen_server:call(Database, {raw_append, {Key, raw_erase(Database, Key) -> gen_server:call(Database, {raw_erase, {Key}}). -listing(Database) -> gen_server:call(Database, listing). +listing(Database, Args) -> gen_server:call(Database, {listing, {Args}}). -db_listing(Database, Collection) -> gen_server:call(Database, {listing, Collection}). +db_listing(Database, Collection, Args) -> gen_server:call(Database, {listing, {Collection, Args}}). %%-------------------------------------------------------------------- %% @doc diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl index 6cfd4be..2d6fb4d 100644 --- a/src/storage/erlog_storage.erl +++ b/src/storage/erlog_storage.erl @@ -23,7 +23,7 @@ -callback findall(State :: term(), Functor :: tuple()) -> {Res :: list(), NewState :: term()}. --callback listing(State :: term()) -> {Res :: list(), NewState :: term()}. +-callback listing(State :: term(), Param :: term()) -> {Res :: list(), NewState :: term()}. -callback retract_clause(State :: term(), Param :: term()) -> {ok, NewState :: term()}. From 1ab185c5af0f75762124697dbc0614ee3f85049f Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 15 Aug 2014 18:39:51 +0000 Subject: [PATCH 108/251] added db_listing/2 db_listing/3 --- include/erlog_db.hrl | 4 +++- src/libs/external/db/erlog_db.erl | 18 ++++++++++++++++-- src/storage/erlog_ets.erl | 2 +- 3 files changed, 20 insertions(+), 4 deletions(-) diff --git a/include/erlog_db.hrl b/include/erlog_db.hrl index e1bfc03..60a135d 100644 --- a/include/erlog_db.hrl +++ b/include/erlog_db.hrl @@ -17,6 +17,8 @@ {{db_retract, 2}, ?MODULE, db_retract_2}, {{db_retractall, 2}, ?MODULE, db_retractall_2}, {{db_call, 2}, ?MODULE, db_call_2}, - {{db_listing, 2}, ?MODULE, db_listing_2} + {{db_listing, 2}, ?MODULE, db_listing_2}, + {{db_listing, 3}, ?MODULE, db_listing_3}, + {{db_listing, 4}, ?MODULE, db_listing_4} ] ). \ No newline at end of file diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 4a80d5f..c400fb8 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -23,7 +23,9 @@ db_retractall_2/1, fail_retract/2, db_call_2/1, - db_listing_2/1]). + db_listing_2/1, + db_listing_3/1, + db_listing_4/1]). load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_DB). @@ -65,7 +67,19 @@ db_retractall_2(Params = #param{goal = {db_retractall, _, _} = Goal, bindings = db_listing_2(Params = #param{goal = {db_listing, _, _} = Goal, next_goal = Next, bindings = Bs0, database = Db}) -> {db_listing, Table, Res} = ec_support:dderef(Goal, Bs0), - Content = erlog_memory:db_listing(Db, Table), + Content = erlog_memory:db_listing(Db, Table, []), + Bs = ec_support:add_binding(Res, Content, Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). + +db_listing_3(Params = #param{goal = {db_listing, _, _, _} = Goal, next_goal = Next, bindings = Bs0, database = Db}) -> + {db_listing, Table, Functor, Res} = ec_support:dderef(Goal, Bs0), + Content = erlog_memory:db_listing(Db, Table, [Functor]), + Bs = ec_support:add_binding(Res, Content, Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). + +db_listing_4(Params = #param{goal = {db_listing, _, _, _, _} = Goal, next_goal = Next, bindings = Bs0, database = Db}) -> + {db_listing, Table, Functor, Arity, Res} = ec_support:dderef(Goal, Bs0), + Content = erlog_memory:db_listing(Db, Table, [Functor, Arity]), Bs = ec_support:add_binding(Res, Content, Bs0), ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index c1b572c..8e551e6 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -173,7 +173,7 @@ raw_erase(Db, {Key}) -> listing(Db, {Collection, Params}) -> Ets = ets_db_storage:get_db(Collection), - {Res, _} = listing(Ets, Params), + {Res, _} = listing(Ets, {Params}), {Res, Db}; listing(Db, {[Functor, Arity]}) -> {ets:foldl( From 6ac7e3137feac029dd9bbc0c753b211c1585110d Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 16 Aug 2014 00:28:17 +0000 Subject: [PATCH 109/251] make assert filter duplicates --- src/storage/erlog_ets.erl | 45 ++++++++++++++++++++++++++------------- 1 file changed, 30 insertions(+), 15 deletions(-) diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 8e551e6..7d1fa0d 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -53,7 +53,10 @@ assertz_clause(Db, {Collection, Head, Body0}) -> assertz_clause(Db, {Head, Body0}) -> clause(Head, Body0, Db, fun(Functor, Tag, Cs, Body) -> - ets:insert(Db, {Functor, clauses, Tag + 1, Cs ++ [{Tag, Head, Body}]}) + case check_duplicates(Cs, Head, Body) of + false -> ok; %found - do nothing + _ -> ets:insert(Db, {Functor, clauses, Tag + 1, Cs ++ [{Tag, Head, Body}]}) %not found - insert new + end end), {ok, Db}. @@ -64,7 +67,10 @@ asserta_clause(Db, {Collection, Head, Body0}) -> asserta_clause(Db, {Head, Body0}) -> clause(Head, Body0, Db, fun(Functor, Tag, Cs, Body) -> - ets:insert(Db, {Functor, clauses, Tag + 1, [{Tag, Head, Body} | Cs]}) + case check_duplicates(Cs, Head, Body) of + false -> ok; %found - do nothing + _ -> ets:insert(Db, {Functor, clauses, Tag + 1, [{Tag, Head, Body} | Cs]}) %not found - insert new + end end), {ok, Db}. @@ -139,18 +145,6 @@ get_interp_functors(Db) -> ({Func, clauses, _, _}, Fs) -> [Func | Fs] end, [], Db), Db}. -clause(Head, Body0, Db, ClauseFun) -> - {Functor, Body} = case catch {ok, ec_support:functor(Head), ec_body:well_form_body(Body0, false, sture)} of - {erlog_error, E} -> erlog_errors:erlog_error(E, Db); - {ok, F, B} -> {F, B} - end, - case ets:lookup(Db, Functor) of - [{_, {built_in, _}}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - [{_, code, _}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - [{_, clauses, Tag, Cs}] -> ClauseFun(Functor, Tag, Cs, Body); - [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) - end. - raw_store(Db, {Key, Value}) -> ets:insert(Db, {Key, Value}), {ok, Db}. @@ -191,4 +185,25 @@ listing(Db, {[]}) -> {ets:foldl( fun({Fun, clauses, _, _}, Acc) -> [Fun | Acc]; (_, Acc) -> Acc - end, [], Db), Db}. \ No newline at end of file + end, [], Db), Db}. + +%% @private +clause(Head, Body0, Db, ClauseFun) -> + {Functor, Body} = case catch {ok, ec_support:functor(Head), ec_body:well_form_body(Body0, false, sture)} of + {erlog_error, E} -> erlog_errors:erlog_error(E, Db); + {ok, F, B} -> {F, B} + end, + case ets:lookup(Db, Functor) of + [{_, {built_in, _}}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + [{_, code, _}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + [{_, clauses, Tag, Cs}] -> ClauseFun(Functor, Tag, Cs, Body); + [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) + end. + +%% @private +-spec check_duplicates(list(), tuple(), tuple()) -> boolean(). +check_duplicates(Cs, Head, Body) -> + lists:foldl( + fun({_, H, B}, _) when H == Head andalso B == Body -> false; %find same fact + (_, Acc) -> Acc + end, true, Cs). \ No newline at end of file From afc7b3ad08c772ea334d67b4b9d32f544a55a25f Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 18 Aug 2014 16:38:44 +0000 Subject: [PATCH 110/251] change version to 1 --- src/core/erlog.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index d512805..3e7d6c1 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -28,7 +28,7 @@ -module(erlog). -behaviour(gen_server). --vsn('0.7'). +-vsn('1.0'). -include("erlog_core.hrl"). From 49a69fd6e86a443f4499692f04b7ccb2955f007f Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 18 Aug 2014 21:16:22 +0000 Subject: [PATCH 111/251] add doc for libraries --- doc/erlog.txt | 93 ------------ doc/erlog_shell.txt | 34 ----- doc/libraries.md | 27 ++++ doc/user_guide.txt | 239 ------------------------------ src/libs/external/erlog_exlib.erl | 2 +- 5 files changed, 28 insertions(+), 367 deletions(-) delete mode 100644 doc/erlog.txt delete mode 100644 doc/erlog_shell.txt create mode 100644 doc/libraries.md delete mode 100644 doc/user_guide.txt diff --git a/doc/erlog.txt b/doc/erlog.txt deleted file mode 100644 index 7876f09..0000000 --- a/doc/erlog.txt +++ /dev/null @@ -1,93 +0,0 @@ -MODULE - - erlog - -MODULE SUMMARY - - Interpreter for sub-set of Prolog - -DESCRIPTION - - Erlog is a Prolog interpreter implemented in Erlang and - integrated with the Erlang runtime system. - -EXPORTS - -erlog:new() -> Erlog() - - Start a new Erlog interpreter. The intrepreter is a function - which can be called with the following valid arguments: - - Erlog({prove,Goal}) -> {ProveRet,Erlog()}. - Erlog(next_solution) -> {ProveRet,Erlog()}. - - where ProveRet = {succeed,VarBindings} | fail | Error. - - Goal can also be a list of goals here to simplify writing - conjunctions. - - Erlog({consult,FileName} -> {ok,Erlog()} | {Error,Erlog()}. - Erlog({reconsult,FileName} -> {ok,Erlog()} | {Error,Erlog()}. - - Erlog(get_db) -> {{ok,Database},Erlog()}. - Erlog({set_db,Database}) -> {ok,Erlog()}. - - Get/set the database used by the interpreter to Database. - These functions can be used to save and quickly restore the - database to a predefined state. - - Erlog(halt) -> ok. - This ends the interpreter. - -erlog:start() -> Eint. -erlog:start_link() -> Eint. -erlog:prove(Eint, Goal) -> {succeed,VarBindings} | fail | Error. -erlog:next_solution(Eint) -> {succeed,VarBindings} | fail | Error. -erlog:consult(Eint, FileName) -> ok | Error. -erlog:reconsult(Eint, FileName) -> ok | Error. -erlog:get_db(Eint) -> {ok,Database}. -erlog:set_db(Eint, Database) -> ok. -erlog:halt(Eint) -> ok. - - These functions run the Erlog interpreter as a separate - process, the interface functions correspond to the valid - arguments to the Erlog interpeter function above. - -erlog:is_legal_term(Term) -> bool(). - - Test if Term is a well-formed (legal) Erlog structure. - -erlog:vars_in(Term) -> [{VarName,Variable}]. - - Returns a list of {VariableName,Variable} pairs. - -erlog_parse:term([Token]) -> {ok,Term} | {error,ErrorDescriptor}. -erlog_parse:term([Token], LineNo) -> {ok,Term} | {error,ErrorDescriptor}. - - Parse a list of Erlang tokens as a Prolog term. The line - number (default 1) is used when returning errors. - ErrorDescriptor has the format: - - {LineNo,ModuleName,Error} - -erlog_scan:string(String) -> {ok,[Token],Line} | {error,Error,LineNo}. -erlog_scan:string(String, Line) -> {ok,[Token],Line} | {error,Error,Line}. - - Scan String and return a list of tokens. - -erlog_scan:token(Continuation, Chars, Line) -> - {more,Continuation} | {done,ReturnVal,RestChars}. - - Re-entrant scanner to scan one token. Compatible with io system. - -erlog_scan:tokens(Continuation, Chars, Line) -> - {more,Continuation} | {done,ReturnVal,RestChars}. - - Re-entrant scanner to scan tokens upto an end token. - Compatible with io system. - -AUTHOR - - Robert Virding - robert.virding@telia.com - (with thanks to Richard O'Keefe for explaining some finer - points of the Prolog standard) diff --git a/doc/erlog_shell.txt b/doc/erlog_shell.txt deleted file mode 100644 index 3d5d353..0000000 --- a/doc/erlog_shell.txt +++ /dev/null @@ -1,34 +0,0 @@ -MODULE - - erlog_shell - -MODULE SUMMARY - - Erlog shell. - -DESCRIPTION - - Erlog is a Prolog interpreter implemented in Erlang and - integrated with the Erlang runtime system. This is a simple - prolog like shell to run Erlog. - -EXPORTS - -erlog_shell:start() -> ShellPid. - - Start a simple Erlog shell in a new process. Goals can be - entered at the "?-" prompt. When the goal succeeds the - variables and their values will be printed and the user - prompted. If a line containing a ";" is entered the system - will attempt to find the next solution, otherwise the system - will return to the "?-" prompt. - -erlog_shell:server() -> ok. - - Start a simple Erlog shell in the current process. - -AUTHOR - - Robert Virding - robert.virding@telia.com - (with thanks to Richard O'Keefe for explaining some finer - points of the Prolog standard) diff --git a/doc/libraries.md b/doc/libraries.md new file mode 100644 index 0000000..324a4d2 --- /dev/null +++ b/doc/libraries.md @@ -0,0 +1,27 @@ +### Core libraries +They are standard `built_in` libraries: + + * `erlog_bips` - core built-in functions. + * `erlog_core` - basic language functions. + * `erlog_dcg` - DCG conversion and procedures. + * `erlog_lists` - standard lists support. + * `erlog_time` - date and time support library. +All built-in libraries have same behaviour `erlog_stdlib`. They have `load/1` function and `prove_goal/1` function. +In `load` function - all initialisation of library is made. Starting all needed services, parsing prolog functors, +loading predicates to memory and what not. +When `prove_goal` is called - `#param{}` record with working data is passed to it. Function for goal execution is +searching through pattern matching. +Core libraries are loaded into memory when erlog gen_server starts. + +### External libraries +They are external, user-defined libraries. They should also act as `erlog_exlib` behaviour, with `load/1` function. +`load` function made initialisation of library - as core library. Instead of `prove_goal` function - library functions +are defined in `*.hrl` files as compiled: + + {{Name, Arity}, Module, Function} +`Name` - is name of function in prolog, +`Arity` - is the arity of prolog function, +`Module` - is the erlang module, where processing function is defined, +`Function` - is erlang processing function. +External libraries are load into memory on demand, by calling `use(LibName)` function, where LibName is the name of the +erlang module with exlib behaviour. \ No newline at end of file diff --git a/doc/user_guide.txt b/doc/user_guide.txt deleted file mode 100644 index a63ebf5..0000000 --- a/doc/user_guide.txt +++ /dev/null @@ -1,239 +0,0 @@ - Erlog - ===== - -DESCRIPTION - -Erlog is a Prolog interpreter implemented in Erlang and integrated -with the Erlang runtime system. It follows the Prolog standard and the -following subset of the built-ins have been implemented: - -Logic and control -call/1, ','/2, '!'/0, ';'/2, fail/0, '->'/2 (if-then), -( -> ; )(if-then-else), '\\+'/1, once/1, repeat/0, true/0 - -Term creation and decomposition -arg/3, copy_term/2, functor/3, '=..'/2 - -Clause creation and destruction -abolish/1, assert/1, asserta/1, assertz/1, retract/1, retractall/1. - -Clause retrieval and information -clause/2, current_predicate/1, predicate_property/2 - -Term unification and comparison -'@>'/2, '@>='/2, '=='/2, '\\=='/2, '@>'/2, '@=<'/2, '='/2, '\\='/2 - -Arithmetic evaluation and comparison -'>'/2, '>='/2, '=:='/2, '=\\='/2, '<'/2, '=<'/2, is/2 - -Type testing -atom/1, atomic/1, compound/1, integer/1, float/1, number/1, -nonvar/1, var/1 - -Atom processing -atom_chars/2, atom_length/2 - -Erlang interface -ecall/2 - -Useful but non-standard -expand_term/2, phrase/2, phrase/3 - -Common lists library -append/3, insert/3, delete/3, member/2, memberchk/2, reverse/2, -perm/2, sort/2 - -The following arithmetic operators are implemented: - -+/1, -/1, +/2, -/2, */2, //2, **/2, ///2, mod/2, abs/1, -float/1, truncate/1 - -Prolog terms in Erlog have a very direct representation in Erlang: - -Prolog Erlang ------- ------ -Structures Tuples where the first element - is the functor name (an atom) -Lists Lists -Variables Tuple {VariableName} where VariableName - is an atom -Atomic Atomic - -Note there is no problem with this representation of variables as -structures without arguments, a(), are illegal in Prolog. For example -the Prolog term: - -Goal = insert([1,2,3], atom, Es), call(Goal) - -is represented in Erlang by: - -{',',{'=',{'Goal'},{insert,[1,2,3],atom,{'Es'}}},{call,{'Goal'}}} - -The clauses of the standard append/3 defined by - -append([], L, L). -append([H|T], L, [H|T1]) :- - append(T, L, T1). - -are represented in Erlang by the terms: - -{append,[],{'L'},{'L'}}. -{':-',{append,[{'H'}|{'T'}],{'L'},[{'H'}|{'T1'}]}, - {append,{'T'},{'L'},{'T1'}}}. - -Limited checking is done at run-time, basically only of input terms. -Currently this is done for the top level when clauses are added to the -database and a goal is entered. - -ERLANG INTERFACE - -The interface to Erlang is through the ecall/2 predicate, which -provides a back-trackable interface to Erlang. It has the form: - -ecall(ErlangFunctionCall, ReturnValue) - -It calls the Erlang function and unifies the result with ReturnValue. -For example - -ecall(mymod:onefunc(A1, A2), Ret) -ecall(mymod:otherfunc, Ret) - -where the second form calls a function of no arguments -(funcname() is illegal syntax in Prolog). - -The Erlang function must return: - -{succeed,Value,Continuation} - - The function has succeeded and returns Value which is unified - with the output argument of ecall/2. Continuation will be - called on backtracking to generate the next value. - -{succeed_last,Value} - - This is the last time the function will succeed so no - continuation is returned. It is an optimisation of returning a - continuation which will fail the next time. - -fail - - The function cannot generate more solutions and fails. - -The first example is a simple function which calls an Erlang function -and returns the value: - -efunc(Fcall) -> - %% This is what the operators will generate. - Val = case Fcall of - {':',M,F} when is_atom(M), is_atom(F) -> M:F(); - {':',M,{F,A}} when is_atom(M), is_atom(F) -> M:F(A); - {':',M,T} when is_atom(M), is_tuple(T), size(T) >= 2, - is_atom(element(1, T)) -> - apply(M,element(1, T),tl(tuple_to_list(T))) - end, - {succeed_last,Val}. %Optimisation - -The second example is a function which returns the keys in an Ets -table on backtracking: - -ets_keys(Tab) -> - %% Solution with no look-ahead, get keys when requested. - %% This fun returns next key and itself for continuation. - F = fun (F1, Tab1, Last1) -> - case ets:next(Tab1, Last1) of - '$end_of_table' -> fail; %No more elements - Key1 -> {succeed,Key1, - fun () -> F1(F1, Tab1, Key1) end} - end - end, - case ets:first(Tab) of - '$end_of_table' -> fail; %No elements - Key -> {succeed,Key, fun () -> F(F, Tab, Key) end} - end. - -The third example calls a function which returns a list and returns -elements from this list on backtracking. I KNOW we could just return -the whole list and use member/2 to generate elements from it, but this -is more fun. - -get_list(ListGen) -> - %% This is what the operators will generate. - Vals = case ListGen of - {':',M,F} when is_atom(M), is_atom(F) -> M:F(); - {':',M,{F,A}} when is_atom(M), is_atom(F) -> M:F(A); - {':',M,T} when is_atom(M), is_tuple(T), size(T) >= 2, - is_atom(element(1, T)) -> - apply(M,element(1, T),tl(tuple_to_list(T))) - end, - %% This fun will return head and itself for continuation. - Fun = fun (F1, Es0) -> - case Es0 of - [E] -> {succeed_last,E}; %Optimisation - [E|Es] -> {succeed,E,fun () -> F1(F1, Es) end}; - [] -> fail %No more elements - end - end, - %Call with list of values to return first element. - Fun(Fun, Vals). - - -For example the Erlog goal: - - ecall(erlog_demo:get_list(ets:all),Tab), - ecall(erlog_demo:ets_keys(Tab),Key). - -will on backtracking generate the names of all ETS tables which have -keys and their keys. - -It is a great pity that the implementation of ETS loses greatly if you -want to do more complex selection of elements that just simple -matching. - -DEFINTE CLAUSE GRAMMERS (DCGs) - -Erlog supports DCGs. Expansion of -->/2 terms is done through the -procedure expand_term/2 which can be called explicitly and is called -automatically when consulting files. At present there is no support -for a user defined term_expansion/2 procedure. The expansion uses -phrase/3 to handle variable terms. This is defined by: - - phrase(Term, S0, S1) :- - Term =.. L, append(L, [S0,S1], L1), Call =.. L1, Call. - -PROLOG SYNTAX - -There is a simple Prolog parser, based on a Leex scanner and a -Standard Prolog parser, which will parse most Prolog terms. It -recognises all the standard operators, which have the default -priorities, but does not allow adding new operators. - -Files containing Prolog predicates can be consulted, however -directives and queries in the file are ignored. - -NOTES - -This is only a simple interpreter without a true garbage collector so -for larger evaluations you should adopt a failure driven style. - -There is no smart clause indexing on the first argument in a procedure -in Erlog. - -Yes, there are no I/O predicates provided. - -There is partial support for the equivalence of list notation and -'.'/2 terms, but it might go away later. - -We use the standard Erlang ordering of terms which means that -variables do not have the lowest ordering as they should. - -We use the Erlang definition of arithmetic operators, not standard -Prolog. - -Sometimes the description of the error returned from the parser can be -a little "cryptic". - -AUTHOR - -Robert Virding - robert.virding@telia.com -(with thanks to Richard O'Keefe for explaining some finer points of -the Prolog standard) diff --git a/src/libs/external/erlog_exlib.erl b/src/libs/external/erlog_exlib.erl index 13815b7..cc0b4bb 100644 --- a/src/libs/external/erlog_exlib.erl +++ b/src/libs/external/erlog_exlib.erl @@ -9,5 +9,5 @@ -module(erlog_exlib). -author("tihon"). -%% load database to kernel space +%% load database to library space -callback load(Db :: pid() | atom()) -> ok. \ No newline at end of file From 163e9a9d523d233423f024ea192818e9b7cacd09 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 19 Aug 2014 00:21:16 +0000 Subject: [PATCH 112/251] added cache lib --- doc/libraries.md | 1 + include/erlog_cache.hrl | 16 ++++++++ src/libs/external/cache/erlog_cache.erl | 52 +++++++++++++++++++++++++ 3 files changed, 69 insertions(+) create mode 100644 include/erlog_cache.hrl create mode 100644 src/libs/external/cache/erlog_cache.erl diff --git a/doc/libraries.md b/doc/libraries.md index 324a4d2..004e3e6 100644 --- a/doc/libraries.md +++ b/doc/libraries.md @@ -6,6 +6,7 @@ They are standard `built_in` libraries: * `erlog_dcg` - DCG conversion and procedures. * `erlog_lists` - standard lists support. * `erlog_time` - date and time support library. + All built-in libraries have same behaviour `erlog_stdlib`. They have `load/1` function and `prove_goal/1` function. In `load` function - all initialisation of library is made. Starting all needed services, parsing prolog functors, loading predicates to memory and what not. diff --git a/include/erlog_cache.hrl b/include/erlog_cache.hrl new file mode 100644 index 0000000..e807f87 --- /dev/null +++ b/include/erlog_cache.hrl @@ -0,0 +1,16 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 18. Авг. 2014 21:46 +%%%------------------------------------------------------------------- +-author("tihon"). + +-define(ERLOG_CACHE, + [ + {{put, 2}, ?MODULE, put_2}, + {{get, 2}, ?MODULE, get_2} + ] +). \ No newline at end of file diff --git a/src/libs/external/cache/erlog_cache.erl b/src/libs/external/cache/erlog_cache.erl new file mode 100644 index 0000000..a68c8c7 --- /dev/null +++ b/src/libs/external/cache/erlog_cache.erl @@ -0,0 +1,52 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc local cache library. Includes functions for operating data in ets, +%%% tied to calling process (assuming calling process is erlog gen_server). +%%% +%%% @end +%%% Created : 18. Авг. 2014 21:46 +%%%------------------------------------------------------------------- +-module(erlog_cache). +-author("tihon"). + +-behaviour(erlog_exlib). + +-include("erlog_core.hrl"). +-include("erlog_cache.hrl"). + +%% API +-export([load/1, + put_2/1, + get_2/1]). + +load(Db) -> + case get(erlog_cache) of + undefined -> + Ets = ets:new(erlog_cache, []), + put(erlog_cache, Ets); + _ -> ok + end, + lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_CACHE). + +put_2(Params = #param{goal = {put, _, _} = Goal, next_goal = Next, bindings = Bs}) -> + {put, Key, Value} = ec_support:dderef(Goal, Bs), + case get(erlog_cache) of + undefined -> erlog_errors:fail(Params); + Ets -> + ets:insert(Ets, {Key, Value}), + ec_core:prove_body(Params#param{goal = Next}) + end. + +get_2(Params = #param{goal = {get, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> + {get, Key, Result} = ec_support:dderef(Goal, Bs0), + case get(erlog_cache) of + undefined -> erlog_errors:fail(Params); + Ets -> + case ets:lookup(Ets, Key) of + [{_, Value}] -> + Bs = ec_support:add_binding(Result, Value, Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + [] -> erlog_errors:fail(Params) + end + end. \ No newline at end of file From 901fe935fcaad6872f2c7d00b551f2cd8e1f4f11 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 19 Aug 2014 02:01:49 +0000 Subject: [PATCH 113/251] fix db_call --- src/libs/external/db/erlog_db.erl | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index c400fb8..4b336ee 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -30,12 +30,18 @@ load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_DB). -db_call_2(Param = #param{goal = {db_call, _, _} = Goal, bindings = Bs, database = Db, var_num = Vn}) -> +db_call_2(Param = #param{goal = {db_call, _, _} = Goal, choice = Cps, next_goal = Next0, bindings = Bs, database = Db, var_num = Vn}) -> {db_call, Table, G} = ec_support:dderef(Goal, Bs), -%% Only add cut CP to Cps if goal contains a cut. case erlog_memory:db_findall(Db, Table, G) of [] -> erlog_errors:fail(Param); - Cs -> ec_core:prove_goal_clauses(Cs, Param#param{var_num = Vn + 1}) + Cs -> + case ec_logic:check_goal(G, Next0, Bs, Db, false, Vn) of + {[Next1 | _], true} -> + %% Must increment Vn to avoid clashes!!! + Cut = #cut{label = Vn}, + ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); + {[Next1 | _], false} -> ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, var_num = Vn + 1}) + end end. db_assert_2(Params = #param{goal = {db_assert, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> From b335d41c66fda80aa3d86fe2be4941971e0d2eeb Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 19 Aug 2014 02:39:19 +0000 Subject: [PATCH 114/251] improve db_call --- src/core/logic/ec_core.erl | 1 - src/libs/external/db/erlog_db.erl | 21 +++++++++++++-------- 2 files changed, 13 insertions(+), 9 deletions(-) diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index 1df5c97..75a47aa 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -78,7 +78,6 @@ prove_goal(Param = #param{goal = G, database = Db}) -> {code, {Mod, Func}} -> Mod:Func(Param); %library space {clauses, Cs} -> prove_goal_clauses(Cs, Param); %user space undefined -> erlog_errors:fail(Param); - %% Getting built_in here is an error! {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data end. diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 4b336ee..975ae7a 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -34,14 +34,9 @@ db_call_2(Param = #param{goal = {db_call, _, _} = Goal, choice = Cps, next_goal {db_call, Table, G} = ec_support:dderef(Goal, Bs), case erlog_memory:db_findall(Db, Table, G) of [] -> erlog_errors:fail(Param); - Cs -> - case ec_logic:check_goal(G, Next0, Bs, Db, false, Vn) of - {[Next1 | _], true} -> - %% Must increment Vn to avoid clashes!!! - Cut = #cut{label = Vn}, - ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); - {[Next1 | _], false} -> ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, var_num = Vn + 1}) - end + {erlog_error, E} -> erlog_errors:erlog_error(E, Db); + {clauses, Cs} -> prove_call(G, Cs, Next0, Param); + Cs -> prove_call(G, Cs, Next0, Param) end. db_assert_2(Params = #param{goal = {db_assert, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> @@ -99,6 +94,16 @@ prove_retractall({':-', H, B}, Table, Params) -> prove_retractall(H, Table, Params) -> prove_retractall(H, true, Table, Params). +%% @private +prove_call(G, Cs, Next0, Param = #param{bindings = Bs, choice = Cps, database = Db, var_num = Vn}) -> + case ec_logic:check_goal(G, Next0, Bs, Db, false, Vn) of + {[Next1 | _], true} -> + %% Must increment Vn to avoid clashes!!! + Cut = #cut{label = Vn}, + ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); + {[Next1 | _], false} -> ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, var_num = Vn + 1}) + end. + %% @private prove_retract(H, B, Table, Params = #param{database = Db}) -> Functor = ec_support:functor(H), From 489569c5d5d929af4c51cc1ba9b950a390ed19c7 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 19 Aug 2014 02:49:35 +0000 Subject: [PATCH 115/251] fix erlog_db clauses --- src/libs/external/db/erlog_db.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 975ae7a..e5fcd84 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -30,12 +30,12 @@ load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_DB). -db_call_2(Param = #param{goal = {db_call, _, _} = Goal, choice = Cps, next_goal = Next0, bindings = Bs, database = Db, var_num = Vn}) -> +db_call_2(Param = #param{goal = {db_call, _, _} = Goal, next_goal = Next0, bindings = Bs, database = Db}) -> {db_call, Table, G} = ec_support:dderef(Goal, Bs), case erlog_memory:db_findall(Db, Table, G) of [] -> erlog_errors:fail(Param); {erlog_error, E} -> erlog_errors:erlog_error(E, Db); - {clauses, Cs} -> prove_call(G, Cs, Next0, Param); + {clauses, _, Cs} -> prove_call(G, Cs, Next0, Param); Cs -> prove_call(G, Cs, Next0, Param) end. From feb7ffe2679d74a637139a4ca905972cf2c3ca27 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 20 Aug 2014 10:58:25 +0000 Subject: [PATCH 116/251] fix mistake when terminating --- src/core/erlog.erl | 4 ++-- src/erlog.app.src | 2 +- src/interface/local/erlog_local_shell.erl | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 3e7d6c1..5d1e11e 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -87,8 +87,9 @@ handle_call({select, Command}, _From, State) -> %in selection solutions mode NewState = change_state(Repl), % change state, depending on reply {reply, Res, NewState}. -handle_cast(halt, St = #state{e_man = E}) -> +handle_cast(halt, St = #state{e_man = E, db = Db}) -> gen_event:stop(E), %stom all handlers and event man + gen_server:cast(Db, halt), {stop, normal, St}. handle_info(_, St) -> @@ -130,7 +131,6 @@ init_consulter(Params) -> %% @private load_built_in(Database) -> - link(Database), %TODO some better solution to clean database, close it properly and free memory after erlog terminates %Load basic interpreter predicates lists:foreach(fun(Mod) -> Mod:load(Database) end, [ diff --git a/src/erlog.app.src b/src/erlog.app.src index b6f0fab..9471aad 100644 --- a/src/erlog.app.src +++ b/src/erlog.app.src @@ -1,7 +1,7 @@ {application, erlog, [ {description, "Erlog , Prolog in Erlang"}, - {vsn, "0.6"}, + {vsn, "1.0"}, {registered, []}, {applications, [ kernel, diff --git a/src/interface/local/erlog_local_shell.erl b/src/interface/local/erlog_local_shell.erl index d9d3a5a..21aa164 100644 --- a/src/interface/local/erlog_local_shell.erl +++ b/src/interface/local/erlog_local_shell.erl @@ -42,7 +42,7 @@ server_loop(Core, State, Line) -> end, {NewState, NewLine} = process_execute(Res, State, Line, Term), case Term of - "halt." -> ok; + "halt.\n" -> ok; _ -> server_loop(Core, NewState, NewLine) end. From 96446990f7c2d2cfd36ab14f93f5ae6a2dbabd3c Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 20 Aug 2014 12:50:57 +0000 Subject: [PATCH 117/251] speed improvements, move library and kernel space to local ets --- src/core/erlog.erl | 2 +- src/core/erlog_errors.erl | 2 +- src/erlog.app.src | 2 +- src/storage/erlog_ets.erl | 183 ++++++++++++++++++---------------- src/storage/erlog_memory.erl | 38 +++++-- src/storage/erlog_storage.erl | 30 +++--- 6 files changed, 145 insertions(+), 112 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 5d1e11e..f4320ab 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -28,7 +28,7 @@ -module(erlog). -behaviour(gen_server). --vsn('1.0'). +-vsn('2.0'). -include("erlog_core.hrl"). diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 0755f98..d81711e 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -32,7 +32,7 @@ instantiation_error(Db) -> erlog_error(instantiation_error, Db). instantiation_error() -> erlog_error(instantiation_error). permission_error(Op, Type, Value, Db) -> - erlog_error({permission_error, Op, Type, Value}, Db). + erlog_error({permission_error, Op, Type, Value}, Db). %TODO remove DB!! erlog_error(E, Db) -> throw({erlog_error, E, Db}). erlog_error(E) -> throw({erlog_error, E}). diff --git a/src/erlog.app.src b/src/erlog.app.src index 9471aad..befa1cb 100644 --- a/src/erlog.app.src +++ b/src/erlog.app.src @@ -1,7 +1,7 @@ {application, erlog, [ {description, "Erlog , Prolog in Erlang"}, - {vsn, "1.0"}, + {vsn, "2.0"}, {registered, []}, {applications, [ kernel, diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 7d1fa0d..a13f5bc 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -13,8 +13,6 @@ %% erlog callbacks -export([new/0, new/1, - load_kernel_space/2, - load_library_space/2, assertz_clause/2, asserta_clause/2, retract_clause/2, @@ -22,7 +20,7 @@ get_procedure/2, get_procedure_type/2, get_interp_functors/1, - findall/2, %TODO remove me + findall/2, raw_store/2, raw_fetch/2, raw_append/2, @@ -33,25 +31,12 @@ new() -> {ok, ets:new(eets, [])}. new(_) -> {ok, ets:new(eets, [])}. -load_kernel_space(Db, {Module, Functor}) -> - true = ets:insert(Db, {Functor, {built_in, Module}}), - {ok, Db}. - -load_library_space(Db, {{Functor, M, F}}) -> - case ets:lookup(Db, Functor) of - [{_, {built_in, _}}] -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - [_] -> ets:insert(Db, {Functor, code, {M, F}}); - [] -> ets:insert(Db, {Functor, code, {M, F}}) - end, - {ok, Db}. - -assertz_clause(Db, {Collection, Head, Body0}) -> +assertz_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> Ets = ets_db_storage:get_db(Collection), - {Res, _} = assertz_clause(Ets, {Head, Body0}), + {Res, _} = assertz_clause({StdLib, ExLib, Ets}, {Head, Body0}), {Res, Db}; -assertz_clause(Db, {Head, Body0}) -> - clause(Head, Body0, Db, +assertz_clause({_, _, Db} = Memory, {Head, Body0}) -> + clause(Head, Body0, Memory, fun(Functor, Tag, Cs, Body) -> case check_duplicates(Cs, Head, Body) of false -> ok; %found - do nothing @@ -60,12 +45,12 @@ assertz_clause(Db, {Head, Body0}) -> end), {ok, Db}. -asserta_clause(Db, {Collection, Head, Body0}) -> +asserta_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> Ets = ets_db_storage:get_db(Collection), - {Res, _} = asserta_clause(Ets, {Head, Body0}), + {Res, _} = asserta_clause({StdLib, ExLib, Ets}, {Head, Body0}), {Res, Db}; -asserta_clause(Db, {Head, Body0}) -> - clause(Head, Body0, Db, +asserta_clause({_, _, Db} = Memory, {Head, Body0}) -> + clause(Head, Body0, Memory, fun(Functor, Tag, Cs, Body) -> case check_duplicates(Cs, Head, Body) of false -> ok; %found - do nothing @@ -74,128 +59,152 @@ asserta_clause(Db, {Head, Body0}) -> end), {ok, Db}. -retract_clause(Db, {Collection, Functor, Ct}) -> +retract_clause({StdLib, ExLib, Db}, {Collection, Functor, Ct}) -> Ets = ets_db_storage:get_db(Collection), - {Res, _} = retract_clause(Ets, {Functor, Ct}), + {Res, _} = retract_clause({StdLib, ExLib, Ets}, {Functor, Ct}), {Res, Db}; -retract_clause(Db, {Functor, Ct}) -> +retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> + ok = check_immutable(StdLib, Db, Functor), + ok = check_immutable(ExLib, Db, Functor), case ets:lookup(Db, Functor) of - [{_, {built_in, _}}] -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - [{_, code, _}] -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); [{_, clauses, Nt, Cs}] -> ets:insert(Db, {Functor, clauses, Nt, lists:keydelete(Ct, 1, Cs)}); [] -> ok %Do nothing end, {ok, Db}. -abolish_clauses(Db, {Collection, Functor}) -> +abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> Ets = ets_db_storage:get_db(Collection), - {Res, _} = abolish_clauses(Ets, {Functor}), + {Res, _} = abolish_clauses({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; -abolish_clauses(Db, {Functor}) -> - case ets:lookup(Db, Functor) of - [{_, {built_in, _}}] -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); +abolish_clauses({StdLib, ExLib, Db}, {Functor}) -> + ok = check_immutable(StdLib, Db, Functor), + case ets:lookup(ExLib, Functor) of %delete from library-space [{_, code, _}] -> ets:delete(Db, Functor); - [{_, clauses, _, _}] -> ets:delete(Db, Functor); - [] -> ok %Do nothing + [] -> %if not found - delete from userspace + case ets:lookup(Db, Functor) of + [{_, clauses, _, _}] -> ets:delete(Db, Functor); + [] -> ok %Do nothing + end end, {ok, Db}. -findall(Db, {Collection, Functor}) -> +findall({StdLib, ExLib, Db}, {Collection, Functor}) -> Ets = ets_db_storage:get_db(Collection), - {Res, _} = findall(Ets, {Functor}), + {Res, _} = findall({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; -findall(Db, {Functor}) -> +findall({StdLib, ExLib, Db}, {Functor}) -> Params = tuple_to_list(Functor), Fun = hd(Params), Len = length(Params) - 1, - case ets:lookup(Db, {Fun, Len}) of - [{_, clauses, _, Body}] -> {Body, Db}; - [{_, code, Body}] -> {Body, Db}; - [{Body, {built_in, _}}] -> {Body, Db}; - [] -> {[], Db} + case ets:lookup(StdLib, Functor) of %search built-in first + [{Bin, {built_in, _}}] -> {Bin, Db}; + [] -> + case ets:lookup(ExLib, Functor) of %search libraryspace then + [{_, code, Lib}] -> {Lib, Db}; + [] -> + case ets:lookup(Db, {Fun, Len}) of %search userspace last + [{_, clauses, _, Body}] -> {Body, Db}; + [] -> {[], Db} + end + end end. -get_procedure(Db, {Collection, Functor}) -> +get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> Ets = ets_db_storage:get_db(Collection), - {Res, _} = get_procedure(Ets, {Functor}), + {Res, _} = get_procedure({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; -get_procedure(Db, {Functor}) -> - {case ets:lookup(Db, Functor) of - [{_, {built_in, Module}}] -> {built_in, Module}; - [{_, code, C}] -> {code, C}; - [{_, clauses, _, Cs}] -> {clauses, Cs}; - [] -> undefined - end, Db}. - -get_procedure_type(Db, {Functor}) -> - {case ets:lookup(Db, Functor) of - [{_, {built_in, _}}] -> built_in; %A built-in - [{_, code, _C}] -> compiled; %Compiled (perhaps someday) - [{_, clauses, _, _Cs}] -> interpreted; %Interpreted clauses - [] -> undefined %Undefined - end, Db}. - -get_interp_functors(Db) -> - {ets:foldl(fun({_, {built_in, _}}, Fs) -> Fs; - ({Func, code, _}, Fs) -> [Func | Fs]; - ({Func, clauses, _, _}, Fs) -> [Func | Fs] - end, [], Db), Db}. - -raw_store(Db, {Key, Value}) -> +get_procedure({StdLib, ExLib, Db}, {Functor}) -> + Res = case ets:lookup(StdLib, Functor) of %search built-in first + [{_, {built_in, Module}}] -> {built_in, Module}; + [] -> + case ets:lookup(ExLib, Functor) of %search libraryspace then + [{_, code, C}] -> {code, C}; + [] -> + case ets:lookup(Db, Functor) of %search userspace last + [{_, clauses, _, Cs}] -> {clauses, Cs}; + [] -> undefined + end + end + end, + {Res, Db}. + +get_procedure_type({StdLib, ExLib, Db}, {Functor}) -> + Res = case ets:lookup(StdLib, Functor) of %search built-in first + [{_, {built_in, _}}] -> built_in; + [] -> + case ets:lookup(ExLib, Functor) of %search libraryspace then + [{_, code, _}] -> compiled; + [] -> + case ets:lookup(Db, Functor) of %search userspace last + [{_, clauses, _, _}] -> interpreted; + [] -> undefined + end + end + end, + {Res, Db}. + +get_interp_functors({_, ExLib, Db}) -> + Library = ets:foldl(fun({Func, code, _}, Fs) -> [Func | Fs]; + (_, Fs) -> Fs + end, [], ExLib), + + Res = ets:foldl(fun({Func, clauses, _, _}, Fs) -> [Func | Fs]; + (_, Fs) -> Fs + end, Library, Db), + {Res, Db}. + +raw_store({_, _, Db}, {Key, Value}) -> ets:insert(Db, {Key, Value}), {ok, Db}. -raw_fetch(Db, {Key}) -> +raw_fetch({_, _, Db}, {Key}) -> Res = case ets:lookup(Db, Key) of [] -> []; [{_, Value}] -> Value end, {Res, Db}. -raw_append(Db, {Key, AppendValue}) -> +raw_append({_, _, Db}, {Key, AppendValue}) -> {Value, _} = raw_fetch(Db, {Key}), raw_store(Db, {Key, lists:concat([Value, [AppendValue]])}), {ok, Db}. -raw_erase(Db, {Key}) -> +raw_erase({_, _, Db}, {Key}) -> ets:delete(Db, Key), {ok, Db}. -listing(Db, {Collection, Params}) -> +listing({StdLib, ExLib, Db}, {Collection, Params}) -> Ets = ets_db_storage:get_db(Collection), - {Res, _} = listing(Ets, {Params}), + {Res, _} = listing({StdLib, ExLib, Ets}, {Params}), {Res, Db}; -listing(Db, {[Functor, Arity]}) -> +listing({_, _, Db}, {[Functor, Arity]}) -> {ets:foldl( fun({{F, A} = Res, clauses, _, _}, Acc) when F == Functor andalso A == Arity -> [Res | Acc]; (_, Acc) -> Acc end, [], Db), Db}; -listing(Db, {[Functor]}) -> +listing({_, _, Db}, {[Functor]}) -> {ets:foldl( fun({{F, Arity}, clauses, _, _}, Acc) when F == Functor -> [{Functor, Arity} | Acc]; (_, Acc) -> Acc end, [], Db), Db}; -listing(Db, {[]}) -> +listing({_, _, Db}, {[]}) -> {ets:foldl( fun({Fun, clauses, _, _}, Acc) -> [Fun | Acc]; (_, Acc) -> Acc end, [], Db), Db}. %% @private -clause(Head, Body0, Db, ClauseFun) -> +clause(Head, Body0, {StdLib, ExLib, Db}, ClauseFun) -> {Functor, Body} = case catch {ok, ec_support:functor(Head), ec_body:well_form_body(Body0, false, sture)} of {erlog_error, E} -> erlog_errors:erlog_error(E, Db); {ok, F, B} -> {F, B} end, + ok = check_immutable(StdLib, Db, Functor), %check built-in functions (read only) for clause + ok = check_immutable(ExLib, Db, Functor), %check library functions (read only) for clauses case ets:lookup(Db, Functor) of - [{_, {built_in, _}}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - [{_, code, _}] -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); [{_, clauses, Tag, Cs}] -> ClauseFun(Functor, Tag, Cs, Body); [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) end. @@ -206,4 +215,10 @@ check_duplicates(Cs, Head, Body) -> lists:foldl( fun({_, H, B}, _) when H == Head andalso B == Body -> false; %find same fact (_, Acc) -> Acc - end, true, Cs). \ No newline at end of file + end, true, Cs). + +check_immutable(Ets, Db, Functor) -> + case ets:lookup(Ets, Functor) of + [] -> ok; + _ -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db) + end. \ No newline at end of file diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 7bdc811..94d0f80 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -55,7 +55,9 @@ -record(state, { - database :: atom(), % callback module + stdlib :: ets:tid(), %kernel-space memory + exlib :: ets:tid(), %library-space memory + database :: atom(), % callback module for user-space memory state :: term() % callback state }). @@ -63,7 +65,7 @@ %%% API %%%=================================================================== %% kernelspace predicate loading -load_kernel_space(Database, Module, Element) -> gen_server:call(Database, {load_kernel_space, {Module, Element}}). +load_kernel_space(Database, Module, Functor) -> gen_server:call(Database, {load_kernel_space, {Module, Functor}}). %% libraryspace predicate loading load_library_space(Database, Proc) -> gen_server:call(Database, {load_library_space, {Proc}}). @@ -152,10 +154,10 @@ start_link(Database, Params) -> {stop, Reason :: term()} | ignore). init([Database]) when is_atom(Database) -> {ok, State} = Database:new(), - {ok, #state{database = Database, state = State}}; + {ok, init_memory(#state{database = Database, state = State})}; init([Database, Params]) when is_atom(Database) -> {ok, State} = Database:new(Params), - {ok, #state{database = Database, state = State}}. + {ok, init_memory(#state{database = Database, state = State})}. %%-------------------------------------------------------------------- %% @private @@ -172,11 +174,22 @@ init([Database, Params]) when is_atom(Database) -> {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | {stop, Reason :: term(), NewState :: #state{}}). -handle_call({Fun, Params}, _From, State = #state{state = DbState, database = Database}) -> - {Res, NewState} = Database:Fun(DbState, Params), +handle_call({load_kernel_space, {Module, Functor}}, _From, State = #state{stdlib = StdLib}) -> %load kernel space into memory + Res = ets:insert(StdLib, {Functor, {built_in, Module}}), + {reply, Res, State}; +handle_call({load_library_space, {{Functor, M, F}}}, _From, State = #state{database = Db, stdlib = StdLib, exlib = ExLib}) -> %load library space into memory + Res = case ets:lookup(StdLib, Functor) of + [{_, {built_in, _}}] -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + [_] -> ets:insert(ExLib, {Functor, code, {M, F}}); + [] -> ets:insert(ExLib, {Functor, code, {M, F}}) + end, + {reply, Res, State}; +handle_call({Fun, Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module + {Res, NewState} = Db:Fun({StdLib, ExLib, DbState}, Params), {reply, Res, State#state{state = NewState}}; -handle_call(Fun, _From, State = #state{state = DbState, database = Database}) -> - {Res, NewState} = Database:Fun(DbState), +handle_call(Fun, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module + {Res, NewState} = Db:Fun({StdLib, ExLib, DbState}), {reply, Res, State#state{state = NewState}}; handle_call(_Request, _From, State) -> {reply, ok, State}. @@ -192,6 +205,8 @@ handle_call(_Request, _From, State) -> {noreply, NewState :: #state{}} | {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), NewState :: #state{}}). +handle_cast(halt, State) -> + {stop, normal, State}; handle_cast(_Request, State) -> {noreply, State}. @@ -245,3 +260,10 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== %%% Internal functions %%%=================================================================== +%% @private +%% Initialises two ets tables for kernel and library memory +-spec init_memory(State :: #state{}) -> UpdState :: #state{}. +init_memory(State) -> + KernelMemory = ets:new(kernelMem, []), + LibraryMemory = ets:new(libraryMem, []), + State#state{stdlib = KernelMemory, exlib = LibraryMemory}. \ No newline at end of file diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl index 2d6fb4d..1b15971 100644 --- a/src/storage/erlog_storage.erl +++ b/src/storage/erlog_storage.erl @@ -13,32 +13,28 @@ -callback new(Params :: list()) -> {ok, State :: term()}. --callback load_kernel_space(State :: term(), Functor :: term()) -> {ok, NewState :: term()}. +-callback assertz_clause({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Param :: term()) -> {ok, NewState :: term()}. --callback load_library_space(State :: term(), Param :: term()) -> {ok, NewState :: term()}. +-callback asserta_clause({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Param :: term()) -> {ok, NewState :: term()}. --callback assertz_clause(State :: term(), Param :: term()) -> {ok, NewState :: term()}. +-callback findall({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Functor :: tuple()) -> {Res :: list(), NewState :: term()}. --callback asserta_clause(State :: term(), Param :: term()) -> {ok, NewState :: term()}. +-callback listing({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Param :: term()) -> {Res :: list(), NewState :: term()}. --callback findall(State :: term(), Functor :: tuple()) -> {Res :: list(), NewState :: term()}. +-callback retract_clause({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Param :: term()) -> {ok, NewState :: term()}. --callback listing(State :: term(), Param :: term()) -> {Res :: list(), NewState :: term()}. +-callback abolish_clauses({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Func :: term()) -> {ok, NewState :: term()}. --callback retract_clause(State :: term(), Param :: term()) -> {ok, NewState :: term()}. +-callback get_procedure({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Func :: term()) -> {atom, NewState :: term()} | {term(), NewState :: term()}. --callback abolish_clauses(State :: term(), Func :: term()) -> {ok, NewState :: term()}. +-callback get_procedure_type({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Func :: term()) -> {atom(), NewState :: term()}. --callback get_procedure(State :: term(), Func :: term()) -> {atom, NewState :: term()} | {term(), NewState :: term()}. +-callback get_interp_functors({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}) -> {list(), NewState :: term()}. --callback get_procedure_type(State :: term(), Func :: term()) -> {atom(), NewState :: term()}. +-callback raw_store({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Param :: tuple()) -> {ok, NewState :: term()}. --callback get_interp_functors(State :: term()) -> {list(), NewState :: term()}. +-callback raw_fetch({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Param :: tuple()) -> {Value :: any(), NewState :: term()}. --callback raw_store(State :: term(), Param :: tuple()) -> {ok, NewState :: term()}. +-callback raw_append({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Param :: tuple()) -> {ok, NewState :: term()}. --callback raw_fetch(State :: term(), Param :: tuple()) -> {Value :: any(), NewState :: term()}. - --callback raw_append(State :: term(), Param :: tuple()) -> {ok, NewState :: term()}. - --callback raw_erase(State :: term(), Param :: tuple()) -> {ok, NewState :: term()}. \ No newline at end of file +-callback raw_erase({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Param :: tuple()) -> {ok, NewState :: term()}. \ No newline at end of file From 9cd10dca701a11952cd0692aaba0799890586b9c Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 20 Aug 2014 13:00:28 +0000 Subject: [PATCH 118/251] fix abolish --- src/storage/erlog_ets.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index a13f5bc..a297a65 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -80,7 +80,7 @@ abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> abolish_clauses({StdLib, ExLib, Db}, {Functor}) -> ok = check_immutable(StdLib, Db, Functor), case ets:lookup(ExLib, Functor) of %delete from library-space - [{_, code, _}] -> ets:delete(Db, Functor); + [{_, code, _}] -> ets:delete(ExLib, Functor); [] -> %if not found - delete from userspace case ets:lookup(Db, Functor) of [{_, clauses, _, _}] -> ets:delete(Db, Functor); From 758a1dbc2cf1a5c34cb27dd0d3f23e194d2fdef9 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 20 Aug 2014 14:02:33 +0000 Subject: [PATCH 119/251] fix db_findall --- src/libs/external/db/erlog_db.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index e5fcd84..8550266 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -35,7 +35,7 @@ db_call_2(Param = #param{goal = {db_call, _, _} = Goal, next_goal = Next0, bindi case erlog_memory:db_findall(Db, Table, G) of [] -> erlog_errors:fail(Param); {erlog_error, E} -> erlog_errors:erlog_error(E, Db); - {clauses, _, Cs} -> prove_call(G, Cs, Next0, Param); + {clauses, Cs} -> prove_call(G, Cs, Next0, Param); Cs -> prove_call(G, Cs, Next0, Param) end. From 766b38bf71b997f41ba0f251cc717fbadc4c43f6 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 20 Aug 2014 17:04:53 +0000 Subject: [PATCH 120/251] improved cache --- src/core/logic/ec_support.erl | 7 ++++- src/libs/external/cache/erlog_cache.erl | 42 ++++++++++++++++--------- 2 files changed, 33 insertions(+), 16 deletions(-) diff --git a/src/core/logic/ec_support.erl b/src/core/logic/ec_support.erl index 31ea7e1..ed90143 100644 --- a/src/core/logic/ec_support.erl +++ b/src/core/logic/ec_support.erl @@ -15,7 +15,7 @@ -export([new_bindings/0, get_binding/2, add_binding/3, functor/1, cut/3, collect_alternatives/3, update_result/4, update_vars/4, deref/2, dderef_list/2, - make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3, write/2]). + make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3, write/2, is_bound/1]). %% deref(Term, Bindings) -> Term. %% Dereference a variable, else just return the term. @@ -67,6 +67,11 @@ dderef_list({V}, Bs) -> end; dderef_list(Other, _Bs) -> erlog_errors:type_error(list, Other). +%% detects, whether variable is bound or not +-spec is_bound(term()) -> boolean(). +is_bound({N}) when is_integer(N) -> false; +is_bound(_) -> true. + %% make_vars(Count, VarNum) -> [Var]. %% Make a list of new variables starting at VarNum. make_vars(0, _) -> []; diff --git a/src/libs/external/cache/erlog_cache.erl b/src/libs/external/cache/erlog_cache.erl index a68c8c7..3b05772 100644 --- a/src/libs/external/cache/erlog_cache.erl +++ b/src/libs/external/cache/erlog_cache.erl @@ -31,22 +31,34 @@ load(Db) -> put_2(Params = #param{goal = {put, _, _} = Goal, next_goal = Next, bindings = Bs}) -> {put, Key, Value} = ec_support:dderef(Goal, Bs), - case get(erlog_cache) of - undefined -> erlog_errors:fail(Params); - Ets -> - ets:insert(Ets, {Key, Value}), - ec_core:prove_body(Params#param{goal = Next}) + case ec_support:is_bound(Value) of %Value must exists + true -> case get(erlog_cache) of + undefined -> erlog_errors:fail(Params); + Ets -> + ets:insert(Ets, {Key, Value}), + ec_core:prove_body(Params#param{goal = Next}) + end; + false -> erlog_errors:fail(Params) end. -get_2(Params = #param{goal = {get, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> - {get, Key, Result} = ec_support:dderef(Goal, Bs0), +get_2(Params = #param{goal = {get, _, _} = Goal, bindings = Bs}) -> + {get, Key, Result} = ec_support:dderef(Goal, Bs), case get(erlog_cache) of undefined -> erlog_errors:fail(Params); - Ets -> - case ets:lookup(Ets, Key) of - [{_, Value}] -> - Bs = ec_support:add_binding(Result, Value, Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); - [] -> erlog_errors:fail(Params) - end - end. \ No newline at end of file + Ets -> check_value(ets:lookup(Ets, Key), Result, Params) + end. + + +%% @private +check_value([], _, Params) -> erlog_errors:fail(Params); +check_value([{_, Value}], Result, Params = #param{next_goal = Next, bindings = Bs0}) -> + case ec_support:is_bound(Result) of + true -> %compare value from cache with result + if Result == Value -> ec_core:prove_body(Params#param{goal = Next}); + true -> erlog_errors:fail(Params) + end; + false -> %save value from cache to result + Bs = ec_support:add_binding(Result, Value, Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) + end. + From 2ad67b678107918e6b910aef9c3ea6c172619f0e Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 20 Aug 2014 21:35:31 +0000 Subject: [PATCH 121/251] fix findall --- src/storage/erlog_ets.erl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index a297a65..18c993f 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -165,9 +165,9 @@ raw_fetch({_, _, Db}, {Key}) -> end, {Res, Db}. -raw_append({_, _, Db}, {Key, AppendValue}) -> - {Value, _} = raw_fetch(Db, {Key}), - raw_store(Db, {Key, lists:concat([Value, [AppendValue]])}), +raw_append({_, _, Db} = Param, {Key, AppendValue}) -> + {Value, _} = raw_fetch(Param, {Key}), + raw_store(Param, {Key, lists:concat([Value, [AppendValue]])}), {ok, Db}. raw_erase({_, _, Db}, {Key}) -> From af9347cb8b4ee07b2e7f123358ef75846e980363 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 25 Aug 2014 10:47:00 +0000 Subject: [PATCH 122/251] moved raw_functions for findall to erlog_memory's ets --- src/storage/erlog_ets.erl | 20 -------------------- src/storage/erlog_memory.erl | 27 ++++++++++++++++++++++++++- src/storage/erlog_storage.erl | 10 +--------- 3 files changed, 27 insertions(+), 30 deletions(-) diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 18c993f..0c05dfb 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -154,26 +154,6 @@ get_interp_functors({_, ExLib, Db}) -> end, Library, Db), {Res, Db}. -raw_store({_, _, Db}, {Key, Value}) -> - ets:insert(Db, {Key, Value}), - {ok, Db}. - -raw_fetch({_, _, Db}, {Key}) -> - Res = case ets:lookup(Db, Key) of - [] -> []; - [{_, Value}] -> Value - end, - {Res, Db}. - -raw_append({_, _, Db} = Param, {Key, AppendValue}) -> - {Value, _} = raw_fetch(Param, {Key}), - raw_store(Param, {Key, lists:concat([Value, [AppendValue]])}), - {ok, Db}. - -raw_erase({_, _, Db}, {Key}) -> - ets:delete(Db, Key), - {ok, Db}. - listing({StdLib, ExLib, Db}, {Collection, Params}) -> Ets = ets_db_storage:get_db(Collection), {Res, _} = listing({StdLib, ExLib, Ets}, {Params}), diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 94d0f80..2e26cc8 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -58,6 +58,7 @@ stdlib :: ets:tid(), %kernel-space memory exlib :: ets:tid(), %library-space memory database :: atom(), % callback module for user-space memory + in_mem :: ets:tid(), %integrated memory for findall operations state :: term() % callback state }). @@ -185,6 +186,19 @@ handle_call({load_library_space, {{Functor, M, F}}}, _From, State = #state{datab [] -> ets:insert(ExLib, {Functor, code, {M, F}}) end, {reply, Res, State}; +handle_call({raw_store, {Key, Value}}, _From, State = #state{in_mem = InMem}) -> %findall store + store(Key, Value, InMem), + {reply, ok, State}; +handle_call({raw_fetch, {Key}}, _From, State = #state{in_mem = InMem}) -> %findall fetch + Res = fetch(Key, InMem), + {reply, Res, State}; +handle_call({raw_append, {Key, AppendValue}}, _From, State = #state{in_mem = InMem}) -> %findall append + {Value, _} = fetch(Key, InMem), + store(Key, lists:concat([Value, [AppendValue]]), InMem), + {reply, ok, State}; +handle_call({raw_erase, {Key}}, _From, State = #state{in_mem = InMem}) -> %findall erase + ets:delete(InMem, Key), + {reply, ok, State}; handle_call({Fun, Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module {Res, NewState} = Db:Fun({StdLib, ExLib, DbState}, Params), {reply, Res, State#state{state = NewState}}; @@ -266,4 +280,15 @@ code_change(_OldVsn, State, _Extra) -> init_memory(State) -> KernelMemory = ets:new(kernelMem, []), LibraryMemory = ets:new(libraryMem, []), - State#state{stdlib = KernelMemory, exlib = LibraryMemory}. \ No newline at end of file + InMemory = ets:new(in_memory, []), + State#state{stdlib = KernelMemory, exlib = LibraryMemory, in_mem = InMemory}. + +fetch(Key, Memory) -> + case ets:lookup(Memory, Key) of + [] -> []; + [{_, Value}] -> Value + end. + +store(Key, Value, Memory) -> + ets:insert(Memory, {Key, Value}), + ok. \ No newline at end of file diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl index 1b15971..957d70c 100644 --- a/src/storage/erlog_storage.erl +++ b/src/storage/erlog_storage.erl @@ -29,12 +29,4 @@ -callback get_procedure_type({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Func :: term()) -> {atom(), NewState :: term()}. --callback get_interp_functors({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}) -> {list(), NewState :: term()}. - --callback raw_store({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Param :: tuple()) -> {ok, NewState :: term()}. - --callback raw_fetch({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Param :: tuple()) -> {Value :: any(), NewState :: term()}. - --callback raw_append({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Param :: tuple()) -> {ok, NewState :: term()}. - --callback raw_erase({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Param :: tuple()) -> {ok, NewState :: term()}. \ No newline at end of file +-callback get_interp_functors({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}) -> {list(), NewState :: term()}. \ No newline at end of file From abbc867cac1b745ecf37c48a63af39f3e3594c53 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 25 Aug 2014 11:03:40 +0000 Subject: [PATCH 123/251] findall fixes --- src/storage/erlog_ets.erl | 4 ---- src/storage/erlog_memory.erl | 2 +- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 0c05dfb..cf0e6cf 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -21,10 +21,6 @@ get_procedure_type/2, get_interp_functors/1, findall/2, - raw_store/2, - raw_fetch/2, - raw_append/2, - raw_erase/2, listing/2]). new() -> {ok, ets:new(eets, [])}. diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 2e26cc8..9eec041 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -193,7 +193,7 @@ handle_call({raw_fetch, {Key}}, _From, State = #state{in_mem = InMem}) -> %find Res = fetch(Key, InMem), {reply, Res, State}; handle_call({raw_append, {Key, AppendValue}}, _From, State = #state{in_mem = InMem}) -> %findall append - {Value, _} = fetch(Key, InMem), + Value = fetch(Key, InMem), store(Key, lists:concat([Value, [AppendValue]]), InMem), {reply, ok, State}; handle_call({raw_erase, {Key}}, _From, State = #state{in_mem = InMem}) -> %findall erase From c4c1bf766d8681a36c48e6e08ee80825e41cd9ac Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 25 Aug 2014 11:36:49 +0000 Subject: [PATCH 124/251] make exlib onstart loading --- README.md | 20 ++++++++++++++++++-- src/core/erlog.erl | 8 ++++++++ 2 files changed, 26 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 533f1fd..a2a50e2 100644 --- a/README.md +++ b/README.md @@ -97,7 +97,8 @@ To configure your gen_event module - just pass module and arguments as __event_h #### Working with libraries: Erlog is implemented in erlang modules, called libraries. They can be standard and external. -All predicates from standard functions are loaded to memory when you start erlog core. +All predicates from standard functions are loaded to memory when you start erlog core. +##### Manual loading external libraries But to use predicates from external functions - you should manually load them to memory with the help of `use/1` command: | ?- db_assert(test,foo(a,b)). @@ -109,4 +110,19 @@ But to use predicates from external functions - you should manually load them to This example demonstrates the loading of external database library. First call is false, because there is no such function loaded to memory. Second - library is loaded. -Third - function run successfully. \ No newline at end of file +Third - function run successfully. +__Important!__ If you are working with erlog from poolboy or dynamic creating erlog gen_servers through supervisor, +remember, that two execution requests can be processed on different erlog instance. + + use(some_lib). %returns true + some_lib_fun(some_val). %returns false +In this example system erlog gen server is created one per one separate command (F.e. http request). Firstly - library +`some_lib` is loaded. Than erlog server with loaded library is destroyed (as request is complete) and for another request +`some_lib_fun(some_val)` another erlog server is created, but, without loaded library. +##### Auto loading external libraries on start +For convenient libraries usage you can load all libraries you need when creating a core. It will let you not to call `use/1` +everywhere in your code. Just add param `{libraries, [my_first_lib, my second_lib]}` in your params when starting a core: + + ConfList = [{libraries, [my_first_lib, my second_lib]}], + erlog:start_link(ConfList). +All libraries from array will be loaded. \ No newline at end of file diff --git a/src/core/erlog.erl b/src/core/erlog.erl index f4320ab..4980c4b 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -68,6 +68,7 @@ init([]) -> % use built in database init(Params) -> % use custom database implementation FileCon = init_consulter(Params), {ok, Db} = init_database(Params), + ok = load_external_libraries(Params, Db), {ok, E} = gen_event:start_link(), case proplists:get_value(event_h, Params) of %register handler, if any undefined -> ok; @@ -141,6 +142,13 @@ load_built_in(Database) -> erlog_time %Bindings for working with data and time ]). +%% @private +load_external_libraries(Params, Database) -> + case proplists:get_value(libraries, Params) of + undefined -> ok; + Libraries -> lists:foreach(fun(Mod) -> Mod:load(Database) end, Libraries) + end. + %% @private %% Run scanned command run_command(Command, State) -> From 473c5d8a15d5a4b09a187111b342b0abdb196d2e Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 1 Sep 2014 19:56:08 +0000 Subject: [PATCH 125/251] add profiling --- src/core/logic/ec_core.erl | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index 75a47aa..66e9da9 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -73,13 +73,17 @@ prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bi prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); prove_goal(Param = #param{goal = G, database = Db}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), - case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of - {built_in, Mod} -> Mod:prove_goal(Param); %kernel space - {code, {Mod, Func}} -> Mod:Func(Param); %library space - {clauses, Cs} -> prove_goal_clauses(Cs, Param); %user space - undefined -> erlog_errors:fail(Param); - {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data - end. + Before = os:timestamp(), + Res = case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of + {built_in, Mod} -> Mod:prove_goal(Param); %kernel space + {code, {Mod, Func}} -> Mod:Func(Param); %library space + {clauses, Cs} -> prove_goal_clauses(Cs, Param); %user space + undefined -> erlog_errors:fail(Param); + {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data + end, + After = os:timestamp(), + io:format("run goal ~p for ~p seconds", [G, timer:now_diff(After, Before) / 1000000]), + Res. %% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. From 03c65da8a23910ae56e0cc35a9b86ecd6820b491 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 1 Sep 2014 20:36:17 +0000 Subject: [PATCH 126/251] fix debug --- src/core/logic/ec_core.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index 66e9da9..99b5afa 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -82,7 +82,7 @@ prove_goal(Param = #param{goal = G, database = Db}) -> {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data end, After = os:timestamp(), - io:format("run goal ~p for ~p seconds", [G, timer:now_diff(After, Before) / 1000000]), + io:format("run goal ~p for ~p seconds~n", [ec_support:functor(G), timer:now_diff(After, Before) / 1000000]), Res. %% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> From 83bd21bb78d7b2379249f9f8c785316a7782c397 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 8 Sep 2014 23:46:29 +0000 Subject: [PATCH 127/251] move everything to dict. Made dict - default impl --- src/core/erlog.erl | 4 +- src/storage/erlog_dict.erl | 190 +++++++++++++++++++++++++++++++++++ src/storage/erlog_ets.erl | 116 ++++++++++----------- src/storage/erlog_memory.erl | 68 +++++++------ 4 files changed, 284 insertions(+), 94 deletions(-) create mode 100644 src/storage/erlog_dict.erl diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 4980c4b..a41fe1f 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -60,7 +60,7 @@ start_link(Params) -> gen_server:start_link(?MODULE, Params, []). init([]) -> % use built in database - {ok, Db} = init_database([]), %default database is ets module + {ok, Db} = init_database([]), F = init_consulter([]), {ok, E} = gen_event:start_link(), gen_event:add_handler(E, erlog_simple_printer, []), %set the default debug module @@ -114,7 +114,7 @@ change_state({_, State}) -> State#state{state = normal}. -spec init_database(Params :: proplists:proplist()) -> {ok, Pid :: pid()}. init_database(Params) -> {ok, DbPid} = case proplists:get_value(database, Params) of - undefined -> erlog_memory:start_link(erlog_ets); + undefined -> erlog_memory:start_link(erlog_dict); %default database is ets module Module -> Args = proplists:get_value(arguments, Params), erlog_memory:start_link(Module, Args) diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl new file mode 100644 index 0000000..528794d --- /dev/null +++ b/src/storage/erlog_dict.erl @@ -0,0 +1,190 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 18. июн 2014 18:00 +%%%------------------------------------------------------------------- + +-module(erlog_dict). + +-behaviour(erlog_storage). + +%% erlog callbacks +-export([new/0, new/1, + assertz_clause/2, + asserta_clause/2, + retract_clause/2, + abolish_clauses/2, + get_procedure/2, + get_procedure_type/2, + get_interp_functors/1, + findall/2, + listing/2]). + +new() -> {ok, dict:new()}. + +new(_) -> {ok, dict:new()}. + +assertz_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> + Ets = ets_db_storage:get_db(Collection), + {Res, _} = assertz_clause({StdLib, ExLib, Ets}, {Head, Body0}), + {Res, Db}; +assertz_clause({_, _, Db} = Memory, {Head, Body0}) -> + Udb = clause(Head, Body0, Memory, + fun(Functor, Cs, Body) -> + case check_duplicates(Cs, Head, Body) of + true -> Db; %found - do nothing + _ -> dict:append(Functor, {length(Cs), Head, Body}, Db) %not found - insert new + end + end), + {ok, Udb}. + +asserta_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> + Ets = ets_db_storage:get_db(Collection), + {Res, _} = asserta_clause({StdLib, ExLib, Ets}, {Head, Body0}), + {Res, Db}; +asserta_clause({_, _, Db} = Memory, {Head, Body0}) -> + Udb = clause(Head, Body0, Memory, + fun(Functor, Cs, Body) -> + case check_duplicates(Cs, Head, Body) of + true -> Db; %found - do nothing + _ -> + dict:update(Functor, + fun(Old) -> + [{length(Cs), Head, Body} | Old] + end, [{length(Cs), Head, Body}], Db) %not found - insert new + end + end), + {ok, Udb}. + +retract_clause({StdLib, ExLib, Db}, {Collection, Functor, Ct}) -> + Ets = ets_db_storage:get_db(Collection), + {Res, _} = retract_clause({StdLib, ExLib, Ets}, {Functor, Ct}), + {Res, Db}; +retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> + ok = check_immutable(StdLib, Db, Functor), + ok = check_immutable(ExLib, Db, Functor), + Udb = case dict:is_key(Functor, Db) of + true -> + dict:update(Functor, fun(Old) -> lists:keydelete(Ct, 1, Old) end, [], Db); + false -> Db %Do nothing + end, + {ok, Udb}. + +abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> + Ets = ets_db_storage:get_db(Collection), + {Res, _} = abolish_clauses({StdLib, ExLib, Ets}, {Functor}), + {Res, Db}; +abolish_clauses({StdLib, _, Db}, {Functor}) -> + ok = check_immutable(StdLib, Db, Functor), + Udb = case dict:is_key(Functor, Db) of + true -> dict:erase(Functor, Db); + false -> Db %Do nothing + end, + {ok, Udb}. + +findall({StdLib, ExLib, Db}, {Collection, Functor}) -> + Ets = ets_db_storage:get_db(Collection), + {Res, _} = findall({StdLib, ExLib, Ets}, {Functor}), + {Res, Db}; +findall({StdLib, ExLib, Db}, {Functor}) -> + case dict:is_key(Functor, StdLib) of %search built-in first + true -> {Functor, Db}; + false -> + case dict:is_key(Functor, ExLib) of %search libraryspace then + true -> {Functor, Db}; + false -> + case dict:find(Functor, Db) of %search userspace last + {ok, Cs} -> {Cs, Db}; + error -> {[], Db} + end + end + end. + +get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> + Ets = ets_db_storage:get_db(Collection), + {Res, _} = get_procedure({StdLib, ExLib, Ets}, {Functor}), + {Res, Db}; +get_procedure({StdLib, ExLib, Db}, {Functor}) -> + Res = case dict:find(Functor, StdLib) of %search built-in first + {ok, StFun} -> StFun; + error -> + case dict:find(Functor, ExLib) of %search libraryspace then + {ok, ExFun} -> ExFun; + error -> + case dict:find(Functor, Db) of %search userspace last + {ok, Cs} -> {clauses, Cs}; + error -> undefined + end + end + end, + {Res, Db}. + +get_procedure_type({StdLib, ExLib, Db}, {Functor}) -> + Res = case dict:is_key(Functor, StdLib) of %search built-in first + true -> built_in; + false -> + case dict:is_key(Functor, ExLib) of %search libraryspace then + true -> compiled; + false -> + case dict:is_key(Functor, Db) of %search userspace last + true -> interpreted; + false -> undefined + end + end + end, + {Res, Db}. + +get_interp_functors({_, ExLib, Db}) -> + Library = dict:fetch_keys(ExLib), + UserSpace = dict:fetch_keys(Db), + {lists:concat([Library, UserSpace]), Db}. + +listing({StdLib, ExLib, Db}, {Collection, Params}) -> + Ets = ets_db_storage:get_db(Collection), + {Res, _} = listing({StdLib, ExLib, Ets}, {Params}), + {Res, Db}; +listing({_, _, Db}, {[Functor, Arity]}) -> + {dict:fold( + fun({F, A} = Res, _, Acc) when F == Functor andalso A == Arity -> + [Res | Acc]; + (_, _, Acc) -> Acc + end, [], Db), Db}; +listing({_, _, Db}, {[Functor]}) -> + {dict:fold( + fun({F, Arity}, _, Acc) when F == Functor -> + [{Functor, Arity} | Acc]; + (_, _, Acc) -> Acc + end, [], Db), Db}; +listing({_, _, Db}, {[]}) -> + {dict:fetch_keys(Db), Db}. + +%% @private +clause(Head, Body0, {StdLib, ExLib, Db}, ClauseFun) -> + {Functor, Body} = case catch {ok, ec_support:functor(Head), ec_body:well_form_body(Body0, false, sture)} of + {erlog_error, E} -> erlog_errors:erlog_error(E, Db); + {ok, F, B} -> {F, B} + end, + ok = check_immutable(StdLib, Db, Functor), %check built-in functions (read only) for clause + ok = check_immutable(ExLib, Db, Functor), %check library functions (read only) for clauses + case dict:find(Functor, Db) of + {ok, Cs} -> ClauseFun(Functor, Cs, Body); + error -> dict:append(Functor, {0, Head, Body}, Db) + end. + +%% @private +%% true - duplicate found +-spec check_duplicates(list(), tuple(), tuple()) -> boolean(). +check_duplicates(Cs, Head, Body) -> + catch (lists:foldl( + fun({_, H, B}, _) when H == Head andalso B == Body -> throw(true); %find same fact + (_, Acc) -> Acc + end, false, Cs)). + +check_immutable(Dict, Db, Functor) -> + case dict:is_key(Functor, Dict) of + false -> ok; + true -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db) + end. \ No newline at end of file diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index cf0e6cf..261d49f 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -23,9 +23,9 @@ findall/2, listing/2]). -new() -> {ok, ets:new(eets, [])}. +new() -> {ok, ets:new(eets, [bag, private])}. -new(_) -> {ok, ets:new(eets, [])}. +new(_) -> {ok, ets:new(eets, [bag, private])}. assertz_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> Ets = ets_db_storage:get_db(Collection), @@ -33,10 +33,10 @@ assertz_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> {Res, Db}; assertz_clause({_, _, Db} = Memory, {Head, Body0}) -> clause(Head, Body0, Memory, - fun(Functor, Tag, Cs, Body) -> + fun(Functor, Cs, Body) -> case check_duplicates(Cs, Head, Body) of false -> ok; %found - do nothing - _ -> ets:insert(Db, {Functor, clauses, Tag + 1, Cs ++ [{Tag, Head, Body}]}) %not found - insert new + _ -> ets:insert(Db, {Functor, {length(Cs), Head, Body}}) %not found - insert new end end), {ok, Db}. @@ -47,10 +47,13 @@ asserta_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> {Res, Db}; asserta_clause({_, _, Db} = Memory, {Head, Body0}) -> clause(Head, Body0, Memory, - fun(Functor, Tag, Cs, Body) -> + fun(Functor, Cs, Body) -> case check_duplicates(Cs, Head, Body) of false -> ok; %found - do nothing - _ -> ets:insert(Db, {Functor, clauses, Tag + 1, [{Tag, Head, Body} | Cs]}) %not found - insert new + _ -> + Clauses = [{Functor, {length(Cs), Head, Body}} | Cs], + ets:delete(Db, Functor), + ets:insert(Db, [Clauses]) end end), {ok, Db}. @@ -62,10 +65,11 @@ retract_clause({StdLib, ExLib, Db}, {Collection, Functor, Ct}) -> retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> ok = check_immutable(StdLib, Db, Functor), ok = check_immutable(ExLib, Db, Functor), - case ets:lookup(Db, Functor) of - [{_, clauses, Nt, Cs}] -> - ets:insert(Db, {Functor, clauses, Nt, lists:keydelete(Ct, 1, Cs)}); - [] -> ok %Do nothing + case ets:lookup_element(Db, Functor, 2) of + [] -> ok; + Cs -> + Object = lists:keyfind(Ct, 1, Cs), + ets:delete_object(Db, Object) end, {ok, Db}. @@ -73,16 +77,9 @@ abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> Ets = ets_db_storage:get_db(Collection), {Res, _} = abolish_clauses({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; -abolish_clauses({StdLib, ExLib, Db}, {Functor}) -> +abolish_clauses({StdLib, _, Db}, {Functor}) -> ok = check_immutable(StdLib, Db, Functor), - case ets:lookup(ExLib, Functor) of %delete from library-space - [{_, code, _}] -> ets:delete(ExLib, Functor); - [] -> %if not found - delete from userspace - case ets:lookup(Db, Functor) of - [{_, clauses, _, _}] -> ets:delete(Db, Functor); - [] -> ok %Do nothing - end - end, + ets:delete(Db, Functor), {ok, Db}. findall({StdLib, ExLib, Db}, {Collection, Functor}) -> @@ -90,19 +87,12 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> {Res, _} = findall({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; findall({StdLib, ExLib, Db}, {Functor}) -> - Params = tuple_to_list(Functor), - Fun = hd(Params), - Len = length(Params) - 1, - case ets:lookup(StdLib, Functor) of %search built-in first - [{Bin, {built_in, _}}] -> {Bin, Db}; - [] -> - case ets:lookup(ExLib, Functor) of %search libraryspace then - [{_, code, Lib}] -> {Lib, Db}; - [] -> - case ets:lookup(Db, {Fun, Len}) of %search userspace last - [{_, clauses, _, Body}] -> {Body, Db}; - [] -> {[], Db} - end + case dict:is_key(Functor, StdLib) of %search built-in first + true -> {Functor, Db}; + false -> + case dict:is_key(Functor, ExLib) of %search libraryspace then + true -> {Functor, Db}; + false -> {ets:lookup_element(Db, Functor, 2), Db} %search userspace last end end. @@ -111,41 +101,39 @@ get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> {Res, _} = get_procedure({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; get_procedure({StdLib, ExLib, Db}, {Functor}) -> - Res = case ets:lookup(StdLib, Functor) of %search built-in first - [{_, {built_in, Module}}] -> {built_in, Module}; - [] -> - case ets:lookup(ExLib, Functor) of %search libraryspace then - [{_, code, C}] -> {code, C}; - [] -> - case ets:lookup(Db, Functor) of %search userspace last - [{_, clauses, _, Cs}] -> {clauses, Cs}; - [] -> undefined + Res = case dict:find(Functor, StdLib) of %search built-in first + {ok, StFun} -> StFun; + error -> + case dict:find(Functor, ExLib) of %search libraryspace then + {ok, ExFun} -> ExFun; + error -> + case ets:lookup_element(Db, Functor, 2) of %search userspace last + [] -> undefined; + Cs -> {clauses, Cs} end end end, {Res, Db}. get_procedure_type({StdLib, ExLib, Db}, {Functor}) -> - Res = case ets:lookup(StdLib, Functor) of %search built-in first - [{_, {built_in, _}}] -> built_in; - [] -> - case ets:lookup(ExLib, Functor) of %search libraryspace then - [{_, code, _}] -> compiled; - [] -> - case ets:lookup(Db, Functor) of %search userspace last - [{_, clauses, _, _}] -> interpreted; - [] -> undefined + Res = case dict:is_key(Functor, StdLib) of %search built-in first + true -> built_in; + false -> + case dict:is_key(Functor, ExLib) of %search libraryspace then + true -> compiled; + false -> + case ets:member(Db, Functor) of %search userspace last + true -> interpreted; + false -> undefined end end end, {Res, Db}. get_interp_functors({_, ExLib, Db}) -> - Library = ets:foldl(fun({Func, code, _}, Fs) -> [Func | Fs]; - (_, Fs) -> Fs - end, [], ExLib), + Library = dict:fetch_keys(ExLib), - Res = ets:foldl(fun({Func, clauses, _, _}, Fs) -> [Func | Fs]; + Res = ets:foldl(fun({Func, _}, Fs) -> [Func | Fs]; (_, Fs) -> Fs end, Library, Db), {Res, Db}. @@ -156,19 +144,19 @@ listing({StdLib, ExLib, Db}, {Collection, Params}) -> {Res, Db}; listing({_, _, Db}, {[Functor, Arity]}) -> {ets:foldl( - fun({{F, A} = Res, clauses, _, _}, Acc) when F == Functor andalso A == Arity -> + fun({{F, A} = Res, _}, Acc) when F == Functor andalso A == Arity -> [Res | Acc]; (_, Acc) -> Acc end, [], Db), Db}; listing({_, _, Db}, {[Functor]}) -> {ets:foldl( - fun({{F, Arity}, clauses, _, _}, Acc) when F == Functor -> + fun({{F, Arity}, _}, Acc) when F == Functor -> [{Functor, Arity} | Acc]; (_, Acc) -> Acc end, [], Db), Db}; listing({_, _, Db}, {[]}) -> {ets:foldl( - fun({Fun, clauses, _, _}, Acc) -> [Fun | Acc]; + fun({Fun, _}, Acc) -> [Fun | Acc]; (_, Acc) -> Acc end, [], Db), Db}. @@ -181,20 +169,20 @@ clause(Head, Body0, {StdLib, ExLib, Db}, ClauseFun) -> ok = check_immutable(StdLib, Db, Functor), %check built-in functions (read only) for clause ok = check_immutable(ExLib, Db, Functor), %check library functions (read only) for clauses case ets:lookup(Db, Functor) of - [{_, clauses, Tag, Cs}] -> ClauseFun(Functor, Tag, Cs, Body); - [] -> ets:insert(Db, {Functor, clauses, 1, [{0, Head, Body}]}) + [] -> ets:insert(Db, {Functor, {0, Head, Body}}); + Cs -> ClauseFun(Functor, Cs, Body) end. %% @private -spec check_duplicates(list(), tuple(), tuple()) -> boolean(). check_duplicates(Cs, Head, Body) -> lists:foldl( - fun({_, H, B}, _) when H == Head andalso B == Body -> false; %find same fact + fun({_, {_, H, B}}, _) when H == Head andalso B == Body -> false; %find same fact (_, Acc) -> Acc end, true, Cs). -check_immutable(Ets, Db, Functor) -> - case ets:lookup(Ets, Functor) of - [] -> ok; - _ -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db) +check_immutable(Dict, Db, Functor) -> %TODO may be move me to erlog_memory? + case dict:is_key(Functor, Dict) of + false -> ok; + true -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db) end. \ No newline at end of file diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 9eec041..c5f3e6c 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -55,10 +55,10 @@ -record(state, { - stdlib :: ets:tid(), %kernel-space memory - exlib :: ets:tid(), %library-space memory + stdlib :: dict:dict(), %kernel-space memory + exlib :: dict:dict(), %library-space memory database :: atom(), % callback module for user-space memory - in_mem :: ets:tid(), %integrated memory for findall operations + in_mem :: dict:dict(), %integrated memory for findall operations state :: term() % callback state }). @@ -176,29 +176,35 @@ init([Database, Params]) when is_atom(Database) -> {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | {stop, Reason :: term(), NewState :: #state{}}). handle_call({load_kernel_space, {Module, Functor}}, _From, State = #state{stdlib = StdLib}) -> %load kernel space into memory - Res = ets:insert(StdLib, {Functor, {built_in, Module}}), - {reply, Res, State}; + UStdlib = dict:store(Functor, {built_in, Module}, StdLib), + {reply, ok, State#state{stdlib = UStdlib}}; handle_call({load_library_space, {{Functor, M, F}}}, _From, State = #state{database = Db, stdlib = StdLib, exlib = ExLib}) -> %load library space into memory - Res = case ets:lookup(StdLib, Functor) of - [{_, {built_in, _}}] -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - [_] -> ets:insert(ExLib, {Functor, code, {M, F}}); - [] -> ets:insert(ExLib, {Functor, code, {M, F}}) - end, - {reply, Res, State}; + UExlib = case dict:is_key(Functor, StdLib) of + true -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + false -> + dict:store(Functor, {code, {M, F}}, ExLib) + end, + {reply, ok, State#state{exlib = UExlib}}; handle_call({raw_store, {Key, Value}}, _From, State = #state{in_mem = InMem}) -> %findall store - store(Key, Value, InMem), - {reply, ok, State}; + Umem = store(Key, Value, InMem), + {reply, ok, State#state{in_mem = Umem}}; handle_call({raw_fetch, {Key}}, _From, State = #state{in_mem = InMem}) -> %findall fetch Res = fetch(Key, InMem), {reply, Res, State}; handle_call({raw_append, {Key, AppendValue}}, _From, State = #state{in_mem = InMem}) -> %findall append Value = fetch(Key, InMem), - store(Key, lists:concat([Value, [AppendValue]]), InMem), - {reply, ok, State}; + Umem = store(Key, lists:concat([Value, [AppendValue]]), InMem), + {reply, ok, State#state{in_mem = Umem}}; handle_call({raw_erase, {Key}}, _From, State = #state{in_mem = InMem}) -> %findall erase - ets:delete(InMem, Key), - {reply, ok, State}; + Umem = dict:erase(Key, InMem), + {reply, ok, State#state{in_mem = Umem}}; +handle_call({abolish_clauses, {Func}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module + {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, {Func}), + {reply, Res, State#state{state = NewState, exlib = UpdExlib}}; +handle_call({abolish_clauses, {_, Func} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module + {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, Params), + {reply, Res, State#state{state = NewState, exlib = UpdExlib}}; handle_call({Fun, Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module {Res, NewState} = Db:Fun({StdLib, ExLib, DbState}, Params), {reply, Res, State#state{state = NewState}}; @@ -275,20 +281,26 @@ code_change(_OldVsn, State, _Extra) -> %%% Internal functions %%%=================================================================== %% @private -%% Initialises two ets tables for kernel and library memory +%% Initialises three dicts for kernel, library memory and in_memory for findall operations -spec init_memory(State :: #state{}) -> UpdState :: #state{}. init_memory(State) -> - KernelMemory = ets:new(kernelMem, []), - LibraryMemory = ets:new(libraryMem, []), - InMemory = ets:new(in_memory, []), - State#state{stdlib = KernelMemory, exlib = LibraryMemory, in_mem = InMemory}. + D = dict:new(), + State#state{stdlib = D, exlib = D, in_mem = D}. fetch(Key, Memory) -> - case ets:lookup(Memory, Key) of - [] -> []; - [{_, Value}] -> Value + case dict:find(Key, Memory) of + error -> []; + {ok, Value} -> Value end. store(Key, Value, Memory) -> - ets:insert(Memory, {Key, Value}), - ok. \ No newline at end of file + dict:store(Key, Value, Memory). + +check_abolish(Func, StdLib, ExLib, Db, DbState, Params) -> + case dict:erase(Func, ExLib) of + ExLib -> %dict not changed - was not deleted. Search userspace + {Res, NewState} = Db:abolish_clauses({StdLib, ExLib, DbState}, Params), + {ExLib, NewState, Res}; + UExlib -> %dict changed -> was deleted + {UExlib, DbState, ok} + end. \ No newline at end of file From a834687962d4d94c6a4b79a96308a3e2e55ca341 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 8 Sep 2014 23:59:24 +0000 Subject: [PATCH 128/251] test added --- test/hanoy.pl | 82 +++++++++++++++++++++++++++++++++++++++++++++ test/speed_test.erl | 37 ++++++++++++++++++++ 2 files changed, 119 insertions(+) create mode 100644 test/hanoy.pl create mode 100644 test/speed_test.erl diff --git a/test/hanoy.pl b/test/hanoy.pl new file mode 100644 index 0000000..2af6d02 --- /dev/null +++ b/test/hanoy.pl @@ -0,0 +1,82 @@ +hanoy(1,A,B,_,[A-B]):-!. + +hanoy(N,A,B,C,L):- + + N1 is N-1, + + hanoy(N1,A,C,B,RL), + + hanoy(N1,C,B,A,RR), + + append(RL,[A-B|RR],L). + +subst(1,E,[_|R],[E|R]):-!. + +subst(N,E,[X|L],[X|L2]):-N1 is N-1, subst(N1,E,L,L2). + +moves([],_):-!. + +moves([A-B|T],L):- + + elem(A,L,[X|P1]), subst(A,P1,L,L2), + + elem(B,L,P2), subst(B,[X|P2],L2,L3), + +% writeln(L3), + + moves(T,L3). + + +moves1([],_):-!. + +moves1([A-B|T],L):- + + elem(A,L,[X|P1]), subst(A,P1,L,L2), + + elem(B,L,P2), subst(B,[X|P2],L2,L3), + + writeln(L3), + + moves1(T,L3). + + + + +elem(1,[X|_],X):-!. + +elem(N,[_|T],X) :- N1 is N-1, elem(N1,T,X). + +make2(0,S,S):-!. + +make2(N,T,S):- N1 is N-1, make2(N1,[N|T],S). + + + + +test_all:- + + N=10, + + hanoy(N,1,2,3,X), + + make2(N,[],Z), + + Res=[Z,[],[]], +% writeln(Res), + + moves(X,Res). + + +test_all1:- + + N=10, + + hanoy(N,1,2,3,X), + + make2(N,[],Z), + + Res=[Z,[],[]], + writeln(Res), + + moves1(X,Res). + diff --git a/test/speed_test.erl b/test/speed_test.erl new file mode 100644 index 0000000..98c349c --- /dev/null +++ b/test/speed_test.erl @@ -0,0 +1,37 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 08. Сент. 2014 23:51 +%%%------------------------------------------------------------------- +-module(speed_test). +-author("tihon"). + +-include_lib("eunit/include/eunit.hrl"). + +dict_test() -> + Worker = create_and_load(erlog_dict), + Before = os:timestamp(), + Res = erlog:execute(Worker, "test_all."), + ?debugMsg(Res), + ?assertEqual(true, Res), + After = os:timestamp(), + ?debugFmt("run dict_test for ~p seconds~n", [timer:now_diff(After, Before) / 1000000]). + +ets_test() -> + Worker = create_and_load(erlog_ets), + Before = os:timestamp(), + Res = erlog:execute(Worker, "test_all."), + ?debugMsg(Res), + ?assertEqual(true, Res), + After = os:timestamp(), + ?debugFmt("run ets_test for ~p seconds~n", [timer:now_diff(After, Before) / 1000000]). + +create_and_load(Module) -> + {ok, ErlogWorker} = erlog:start_link([{database, Module}]), + Res = erlog:execute(ErlogWorker, string:join(["consult(", filename:absname("test/" ++ "hanoy.pl"), ")."], "\"")), + ?debugMsg(Res), + ?assertEqual(true, Res), + ErlogWorker. From e0d31ffcc15b41129f0a1e11ee434bf7ad277c75 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 9 Sep 2014 00:34:19 +0000 Subject: [PATCH 129/251] revert ets --- src/storage/erlog_dict.erl | 39 ++++++++++++--------- src/storage/erlog_ets.erl | 39 ++++++++++++--------- src/storage/erlog_memory.erl | 68 +++++++++++++++--------------------- 3 files changed, 73 insertions(+), 73 deletions(-) diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 528794d..0626b94 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -77,11 +77,14 @@ abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> Ets = ets_db_storage:get_db(Collection), {Res, _} = abolish_clauses({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; -abolish_clauses({StdLib, _, Db}, {Functor}) -> +abolish_clauses({StdLib, ExLib, Db}, {Functor}) -> ok = check_immutable(StdLib, Db, Functor), - Udb = case dict:is_key(Functor, Db) of - true -> dict:erase(Functor, Db); - false -> Db %Do nothing + Udb = case ets:member(ExLib, Functor) of %delete from library-space + true -> + ets:delete(ExLib, Functor), + Db; + false -> %if not found - delete from userspace + dict:erase(Functor, Db) end, {ok, Udb}. @@ -90,10 +93,10 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> {Res, _} = findall({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; findall({StdLib, ExLib, Db}, {Functor}) -> - case dict:is_key(Functor, StdLib) of %search built-in first + case ets:member(StdLib, Functor) of %search built-in first true -> {Functor, Db}; false -> - case dict:is_key(Functor, ExLib) of %search libraryspace then + case ets:member(ExLib, Functor) of %search libraryspace then true -> {Functor, Db}; false -> case dict:find(Functor, Db) of %search userspace last @@ -108,12 +111,12 @@ get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> {Res, _} = get_procedure({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; get_procedure({StdLib, ExLib, Db}, {Functor}) -> - Res = case dict:find(Functor, StdLib) of %search built-in first - {ok, StFun} -> StFun; - error -> - case dict:find(Functor, ExLib) of %search libraryspace then - {ok, ExFun} -> ExFun; - error -> + Res = case ets:lookup(StdLib, Functor) of %search built-in first + [{_, StFun}] -> StFun; + [] -> + case ets:lookup(ExLib, Functor) of %search libraryspace then + [{_, code, C}] -> {code, C}; + [] -> case dict:find(Functor, Db) of %search userspace last {ok, Cs} -> {clauses, Cs}; error -> undefined @@ -123,10 +126,10 @@ get_procedure({StdLib, ExLib, Db}, {Functor}) -> {Res, Db}. get_procedure_type({StdLib, ExLib, Db}, {Functor}) -> - Res = case dict:is_key(Functor, StdLib) of %search built-in first + Res = case ets:member(StdLib, Functor) of %search built-in first true -> built_in; false -> - case dict:is_key(Functor, ExLib) of %search libraryspace then + case ets:member(ExLib, Functor) of %search libraryspace then true -> compiled; false -> case dict:is_key(Functor, Db) of %search userspace last @@ -138,7 +141,9 @@ get_procedure_type({StdLib, ExLib, Db}, {Functor}) -> {Res, Db}. get_interp_functors({_, ExLib, Db}) -> - Library = dict:fetch_keys(ExLib), + Library = ets:foldl(fun({Func, code, _}, Fs) -> [Func | Fs]; + (_, Fs) -> Fs + end, [], ExLib), UserSpace = dict:fetch_keys(Db), {lists:concat([Library, UserSpace]), Db}. @@ -183,8 +188,8 @@ check_duplicates(Cs, Head, Body) -> (_, Acc) -> Acc end, false, Cs)). -check_immutable(Dict, Db, Functor) -> - case dict:is_key(Functor, Dict) of +check_immutable(Ets, Db, Functor) -> + case ets:member(Ets, Functor) of false -> ok; true -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db) end. \ No newline at end of file diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 261d49f..e2b3d21 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -77,9 +77,13 @@ abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> Ets = ets_db_storage:get_db(Collection), {Res, _} = abolish_clauses({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; -abolish_clauses({StdLib, _, Db}, {Functor}) -> +abolish_clauses({StdLib, ExLib, Db}, {Functor}) -> ok = check_immutable(StdLib, Db, Functor), - ets:delete(Db, Functor), + case ets:member(ExLib, Functor) of %delete from library-space + true -> ets:delete(ExLib, Functor); + false -> %if not found - delete from userspace + ets:delete(Db, Functor) + end, {ok, Db}. findall({StdLib, ExLib, Db}, {Collection, Functor}) -> @@ -87,12 +91,13 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> {Res, _} = findall({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; findall({StdLib, ExLib, Db}, {Functor}) -> - case dict:is_key(Functor, StdLib) of %search built-in first + case ets:member(StdLib, Functor) of %search built-in first true -> {Functor, Db}; false -> - case dict:is_key(Functor, ExLib) of %search libraryspace then + case ets:member(ExLib, Functor) of %search libraryspace then true -> {Functor, Db}; - false -> {ets:lookup_element(Db, Functor, 2), Db} %search userspace last + false -> + {ets:lookup_element(Db, Functor, 2), Db} %search userspace last end end. @@ -101,12 +106,12 @@ get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> {Res, _} = get_procedure({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; get_procedure({StdLib, ExLib, Db}, {Functor}) -> - Res = case dict:find(Functor, StdLib) of %search built-in first - {ok, StFun} -> StFun; - error -> - case dict:find(Functor, ExLib) of %search libraryspace then - {ok, ExFun} -> ExFun; - error -> + Res = case ets:lookup(StdLib, Functor) of %search built-in first + [{_, StFun}] -> StFun; + [] -> + case ets:lookup(ExLib, Functor) of %search libraryspace then + [{_, code, C}] -> {code, C}; + [] -> case ets:lookup_element(Db, Functor, 2) of %search userspace last [] -> undefined; Cs -> {clauses, Cs} @@ -116,10 +121,10 @@ get_procedure({StdLib, ExLib, Db}, {Functor}) -> {Res, Db}. get_procedure_type({StdLib, ExLib, Db}, {Functor}) -> - Res = case dict:is_key(Functor, StdLib) of %search built-in first + Res = case ets:member(StdLib, Functor) of %search built-in first true -> built_in; false -> - case dict:is_key(Functor, ExLib) of %search libraryspace then + case ets:member(ExLib, Functor) of %search libraryspace then true -> compiled; false -> case ets:member(Db, Functor) of %search userspace last @@ -131,7 +136,9 @@ get_procedure_type({StdLib, ExLib, Db}, {Functor}) -> {Res, Db}. get_interp_functors({_, ExLib, Db}) -> - Library = dict:fetch_keys(ExLib), + Library = ets:foldl(fun({Func, code, _}, Fs) -> [Func | Fs]; + (_, Fs) -> Fs + end, [], ExLib), Res = ets:foldl(fun({Func, _}, Fs) -> [Func | Fs]; (_, Fs) -> Fs @@ -181,8 +188,8 @@ check_duplicates(Cs, Head, Body) -> (_, Acc) -> Acc end, true, Cs). -check_immutable(Dict, Db, Functor) -> %TODO may be move me to erlog_memory? - case dict:is_key(Functor, Dict) of +check_immutable(Ets, Db, Functor) -> + case ets:member(Ets, Functor) of false -> ok; true -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db) end. \ No newline at end of file diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index c5f3e6c..47d6269 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -55,10 +55,10 @@ -record(state, { - stdlib :: dict:dict(), %kernel-space memory - exlib :: dict:dict(), %library-space memory + stdlib :: ets:tid(), %kernel-space memory + exlib :: ets:tid(), %library-space memory database :: atom(), % callback module for user-space memory - in_mem :: dict:dict(), %integrated memory for findall operations + in_mem :: ets:tid(), %integrated memory for findall operations state :: term() % callback state }). @@ -176,35 +176,28 @@ init([Database, Params]) when is_atom(Database) -> {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | {stop, Reason :: term(), NewState :: #state{}}). handle_call({load_kernel_space, {Module, Functor}}, _From, State = #state{stdlib = StdLib}) -> %load kernel space into memory - UStdlib = dict:store(Functor, {built_in, Module}, StdLib), - {reply, ok, State#state{stdlib = UStdlib}}; + Res = ets:insert(StdLib, {Functor, {built_in, Module}}), + {reply, Res, State}; handle_call({load_library_space, {{Functor, M, F}}}, _From, State = #state{database = Db, stdlib = StdLib, exlib = ExLib}) -> %load library space into memory - UExlib = case dict:is_key(Functor, StdLib) of - true -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - false -> - dict:store(Functor, {code, {M, F}}, ExLib) - end, - {reply, ok, State#state{exlib = UExlib}}; + Res = case ets:member(StdLib, Functor) of + true -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + false -> ets:insert(ExLib, {Functor, code, {M, F}}) + end, + {reply, Res, State}; handle_call({raw_store, {Key, Value}}, _From, State = #state{in_mem = InMem}) -> %findall store - Umem = store(Key, Value, InMem), - {reply, ok, State#state{in_mem = Umem}}; + store(Key, Value, InMem), + {reply, ok, State}; handle_call({raw_fetch, {Key}}, _From, State = #state{in_mem = InMem}) -> %findall fetch Res = fetch(Key, InMem), {reply, Res, State}; handle_call({raw_append, {Key, AppendValue}}, _From, State = #state{in_mem = InMem}) -> %findall append Value = fetch(Key, InMem), - Umem = store(Key, lists:concat([Value, [AppendValue]]), InMem), - {reply, ok, State#state{in_mem = Umem}}; + store(Key, lists:concat([Value, [AppendValue]]), InMem), + {reply, ok, State}; handle_call({raw_erase, {Key}}, _From, State = #state{in_mem = InMem}) -> %findall erase - Umem = dict:erase(Key, InMem), - {reply, ok, State#state{in_mem = Umem}}; -handle_call({abolish_clauses, {Func}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module - {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, {Func}), - {reply, Res, State#state{state = NewState, exlib = UpdExlib}}; -handle_call({abolish_clauses, {_, Func} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module - {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, Params), - {reply, Res, State#state{state = NewState, exlib = UpdExlib}}; + ets:delete(InMem, Key), + {reply, ok, State}; handle_call({Fun, Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module {Res, NewState} = Db:Fun({StdLib, ExLib, DbState}, Params), {reply, Res, State#state{state = NewState}}; @@ -281,26 +274,21 @@ code_change(_OldVsn, State, _Extra) -> %%% Internal functions %%%=================================================================== %% @private -%% Initialises three dicts for kernel, library memory and in_memory for findall operations +%% Initialises two ets tables for kernel and library memory -spec init_memory(State :: #state{}) -> UpdState :: #state{}. init_memory(State) -> - D = dict:new(), - State#state{stdlib = D, exlib = D, in_mem = D}. + KernelMemory = ets:new(kernelMem, []), + LibraryMemory = ets:new(libraryMem, []), + InMemory = ets:new(in_memory, []), + State#state{stdlib = KernelMemory, exlib = LibraryMemory, in_mem = InMemory}. fetch(Key, Memory) -> - case dict:find(Key, Memory) of - error -> []; - {ok, Value} -> Value + case ets:lookup(Memory, Key) of + [] -> []; + [{_, Value}] -> Value end. store(Key, Value, Memory) -> - dict:store(Key, Value, Memory). - -check_abolish(Func, StdLib, ExLib, Db, DbState, Params) -> - case dict:erase(Func, ExLib) of - ExLib -> %dict not changed - was not deleted. Search userspace - {Res, NewState} = Db:abolish_clauses({StdLib, ExLib, DbState}, Params), - {ExLib, NewState, Res}; - UExlib -> %dict changed -> was deleted - {UExlib, DbState, ok} - end. \ No newline at end of file + ets:insert(Memory, {Key, Value}), + + ok. \ No newline at end of file From d07d516c349b3e8cb29c89be00ba60f7af10fc02 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 11 Sep 2014 16:12:58 +0000 Subject: [PATCH 130/251] Revert "revert ets" This reverts commit e0d31ffcc15b41129f0a1e11ee434bf7ad277c75. --- src/storage/erlog_dict.erl | 39 +++++++++------------ src/storage/erlog_ets.erl | 39 +++++++++------------ src/storage/erlog_memory.erl | 68 +++++++++++++++++++++--------------- 3 files changed, 73 insertions(+), 73 deletions(-) diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 0626b94..528794d 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -77,14 +77,11 @@ abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> Ets = ets_db_storage:get_db(Collection), {Res, _} = abolish_clauses({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; -abolish_clauses({StdLib, ExLib, Db}, {Functor}) -> +abolish_clauses({StdLib, _, Db}, {Functor}) -> ok = check_immutable(StdLib, Db, Functor), - Udb = case ets:member(ExLib, Functor) of %delete from library-space - true -> - ets:delete(ExLib, Functor), - Db; - false -> %if not found - delete from userspace - dict:erase(Functor, Db) + Udb = case dict:is_key(Functor, Db) of + true -> dict:erase(Functor, Db); + false -> Db %Do nothing end, {ok, Udb}. @@ -93,10 +90,10 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> {Res, _} = findall({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; findall({StdLib, ExLib, Db}, {Functor}) -> - case ets:member(StdLib, Functor) of %search built-in first + case dict:is_key(Functor, StdLib) of %search built-in first true -> {Functor, Db}; false -> - case ets:member(ExLib, Functor) of %search libraryspace then + case dict:is_key(Functor, ExLib) of %search libraryspace then true -> {Functor, Db}; false -> case dict:find(Functor, Db) of %search userspace last @@ -111,12 +108,12 @@ get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> {Res, _} = get_procedure({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; get_procedure({StdLib, ExLib, Db}, {Functor}) -> - Res = case ets:lookup(StdLib, Functor) of %search built-in first - [{_, StFun}] -> StFun; - [] -> - case ets:lookup(ExLib, Functor) of %search libraryspace then - [{_, code, C}] -> {code, C}; - [] -> + Res = case dict:find(Functor, StdLib) of %search built-in first + {ok, StFun} -> StFun; + error -> + case dict:find(Functor, ExLib) of %search libraryspace then + {ok, ExFun} -> ExFun; + error -> case dict:find(Functor, Db) of %search userspace last {ok, Cs} -> {clauses, Cs}; error -> undefined @@ -126,10 +123,10 @@ get_procedure({StdLib, ExLib, Db}, {Functor}) -> {Res, Db}. get_procedure_type({StdLib, ExLib, Db}, {Functor}) -> - Res = case ets:member(StdLib, Functor) of %search built-in first + Res = case dict:is_key(Functor, StdLib) of %search built-in first true -> built_in; false -> - case ets:member(ExLib, Functor) of %search libraryspace then + case dict:is_key(Functor, ExLib) of %search libraryspace then true -> compiled; false -> case dict:is_key(Functor, Db) of %search userspace last @@ -141,9 +138,7 @@ get_procedure_type({StdLib, ExLib, Db}, {Functor}) -> {Res, Db}. get_interp_functors({_, ExLib, Db}) -> - Library = ets:foldl(fun({Func, code, _}, Fs) -> [Func | Fs]; - (_, Fs) -> Fs - end, [], ExLib), + Library = dict:fetch_keys(ExLib), UserSpace = dict:fetch_keys(Db), {lists:concat([Library, UserSpace]), Db}. @@ -188,8 +183,8 @@ check_duplicates(Cs, Head, Body) -> (_, Acc) -> Acc end, false, Cs)). -check_immutable(Ets, Db, Functor) -> - case ets:member(Ets, Functor) of +check_immutable(Dict, Db, Functor) -> + case dict:is_key(Functor, Dict) of false -> ok; true -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db) end. \ No newline at end of file diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index e2b3d21..261d49f 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -77,13 +77,9 @@ abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> Ets = ets_db_storage:get_db(Collection), {Res, _} = abolish_clauses({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; -abolish_clauses({StdLib, ExLib, Db}, {Functor}) -> +abolish_clauses({StdLib, _, Db}, {Functor}) -> ok = check_immutable(StdLib, Db, Functor), - case ets:member(ExLib, Functor) of %delete from library-space - true -> ets:delete(ExLib, Functor); - false -> %if not found - delete from userspace - ets:delete(Db, Functor) - end, + ets:delete(Db, Functor), {ok, Db}. findall({StdLib, ExLib, Db}, {Collection, Functor}) -> @@ -91,13 +87,12 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> {Res, _} = findall({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; findall({StdLib, ExLib, Db}, {Functor}) -> - case ets:member(StdLib, Functor) of %search built-in first + case dict:is_key(Functor, StdLib) of %search built-in first true -> {Functor, Db}; false -> - case ets:member(ExLib, Functor) of %search libraryspace then + case dict:is_key(Functor, ExLib) of %search libraryspace then true -> {Functor, Db}; - false -> - {ets:lookup_element(Db, Functor, 2), Db} %search userspace last + false -> {ets:lookup_element(Db, Functor, 2), Db} %search userspace last end end. @@ -106,12 +101,12 @@ get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> {Res, _} = get_procedure({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; get_procedure({StdLib, ExLib, Db}, {Functor}) -> - Res = case ets:lookup(StdLib, Functor) of %search built-in first - [{_, StFun}] -> StFun; - [] -> - case ets:lookup(ExLib, Functor) of %search libraryspace then - [{_, code, C}] -> {code, C}; - [] -> + Res = case dict:find(Functor, StdLib) of %search built-in first + {ok, StFun} -> StFun; + error -> + case dict:find(Functor, ExLib) of %search libraryspace then + {ok, ExFun} -> ExFun; + error -> case ets:lookup_element(Db, Functor, 2) of %search userspace last [] -> undefined; Cs -> {clauses, Cs} @@ -121,10 +116,10 @@ get_procedure({StdLib, ExLib, Db}, {Functor}) -> {Res, Db}. get_procedure_type({StdLib, ExLib, Db}, {Functor}) -> - Res = case ets:member(StdLib, Functor) of %search built-in first + Res = case dict:is_key(Functor, StdLib) of %search built-in first true -> built_in; false -> - case ets:member(ExLib, Functor) of %search libraryspace then + case dict:is_key(Functor, ExLib) of %search libraryspace then true -> compiled; false -> case ets:member(Db, Functor) of %search userspace last @@ -136,9 +131,7 @@ get_procedure_type({StdLib, ExLib, Db}, {Functor}) -> {Res, Db}. get_interp_functors({_, ExLib, Db}) -> - Library = ets:foldl(fun({Func, code, _}, Fs) -> [Func | Fs]; - (_, Fs) -> Fs - end, [], ExLib), + Library = dict:fetch_keys(ExLib), Res = ets:foldl(fun({Func, _}, Fs) -> [Func | Fs]; (_, Fs) -> Fs @@ -188,8 +181,8 @@ check_duplicates(Cs, Head, Body) -> (_, Acc) -> Acc end, true, Cs). -check_immutable(Ets, Db, Functor) -> - case ets:member(Ets, Functor) of +check_immutable(Dict, Db, Functor) -> %TODO may be move me to erlog_memory? + case dict:is_key(Functor, Dict) of false -> ok; true -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db) end. \ No newline at end of file diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 47d6269..c5f3e6c 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -55,10 +55,10 @@ -record(state, { - stdlib :: ets:tid(), %kernel-space memory - exlib :: ets:tid(), %library-space memory + stdlib :: dict:dict(), %kernel-space memory + exlib :: dict:dict(), %library-space memory database :: atom(), % callback module for user-space memory - in_mem :: ets:tid(), %integrated memory for findall operations + in_mem :: dict:dict(), %integrated memory for findall operations state :: term() % callback state }). @@ -176,28 +176,35 @@ init([Database, Params]) when is_atom(Database) -> {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | {stop, Reason :: term(), NewState :: #state{}}). handle_call({load_kernel_space, {Module, Functor}}, _From, State = #state{stdlib = StdLib}) -> %load kernel space into memory - Res = ets:insert(StdLib, {Functor, {built_in, Module}}), - {reply, Res, State}; + UStdlib = dict:store(Functor, {built_in, Module}, StdLib), + {reply, ok, State#state{stdlib = UStdlib}}; handle_call({load_library_space, {{Functor, M, F}}}, _From, State = #state{database = Db, stdlib = StdLib, exlib = ExLib}) -> %load library space into memory - Res = case ets:member(StdLib, Functor) of - true -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - false -> ets:insert(ExLib, {Functor, code, {M, F}}) - end, - {reply, Res, State}; + UExlib = case dict:is_key(Functor, StdLib) of + true -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + false -> + dict:store(Functor, {code, {M, F}}, ExLib) + end, + {reply, ok, State#state{exlib = UExlib}}; handle_call({raw_store, {Key, Value}}, _From, State = #state{in_mem = InMem}) -> %findall store - store(Key, Value, InMem), - {reply, ok, State}; + Umem = store(Key, Value, InMem), + {reply, ok, State#state{in_mem = Umem}}; handle_call({raw_fetch, {Key}}, _From, State = #state{in_mem = InMem}) -> %findall fetch Res = fetch(Key, InMem), {reply, Res, State}; handle_call({raw_append, {Key, AppendValue}}, _From, State = #state{in_mem = InMem}) -> %findall append Value = fetch(Key, InMem), - store(Key, lists:concat([Value, [AppendValue]]), InMem), - {reply, ok, State}; + Umem = store(Key, lists:concat([Value, [AppendValue]]), InMem), + {reply, ok, State#state{in_mem = Umem}}; handle_call({raw_erase, {Key}}, _From, State = #state{in_mem = InMem}) -> %findall erase - ets:delete(InMem, Key), - {reply, ok, State}; + Umem = dict:erase(Key, InMem), + {reply, ok, State#state{in_mem = Umem}}; +handle_call({abolish_clauses, {Func}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module + {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, {Func}), + {reply, Res, State#state{state = NewState, exlib = UpdExlib}}; +handle_call({abolish_clauses, {_, Func} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module + {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, Params), + {reply, Res, State#state{state = NewState, exlib = UpdExlib}}; handle_call({Fun, Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module {Res, NewState} = Db:Fun({StdLib, ExLib, DbState}, Params), {reply, Res, State#state{state = NewState}}; @@ -274,21 +281,26 @@ code_change(_OldVsn, State, _Extra) -> %%% Internal functions %%%=================================================================== %% @private -%% Initialises two ets tables for kernel and library memory +%% Initialises three dicts for kernel, library memory and in_memory for findall operations -spec init_memory(State :: #state{}) -> UpdState :: #state{}. init_memory(State) -> - KernelMemory = ets:new(kernelMem, []), - LibraryMemory = ets:new(libraryMem, []), - InMemory = ets:new(in_memory, []), - State#state{stdlib = KernelMemory, exlib = LibraryMemory, in_mem = InMemory}. + D = dict:new(), + State#state{stdlib = D, exlib = D, in_mem = D}. fetch(Key, Memory) -> - case ets:lookup(Memory, Key) of - [] -> []; - [{_, Value}] -> Value + case dict:find(Key, Memory) of + error -> []; + {ok, Value} -> Value end. store(Key, Value, Memory) -> - ets:insert(Memory, {Key, Value}), - - ok. \ No newline at end of file + dict:store(Key, Value, Memory). + +check_abolish(Func, StdLib, ExLib, Db, DbState, Params) -> + case dict:erase(Func, ExLib) of + ExLib -> %dict not changed - was not deleted. Search userspace + {Res, NewState} = Db:abolish_clauses({StdLib, ExLib, DbState}, Params), + {ExLib, NewState, Res}; + UExlib -> %dict changed -> was deleted + {UExlib, DbState, ok} + end. \ No newline at end of file From eeb3133f4e24ab69b4586d12f9925af7be386493 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 11 Sep 2014 16:28:57 +0000 Subject: [PATCH 131/251] fix r16 compatibility --- src/storage/erlog_memory.erl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index c5f3e6c..5d1ed77 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -55,10 +55,10 @@ -record(state, { - stdlib :: dict:dict(), %kernel-space memory - exlib :: dict:dict(), %library-space memory + stdlib :: dict, %kernel-space memory + exlib :: dict, %library-space memory database :: atom(), % callback module for user-space memory - in_mem :: dict:dict(), %integrated memory for findall operations + in_mem :: dict, %integrated memory for findall operations state :: term() % callback state }). From bf495726946138b4243df695124200d6d293ce32 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 11 Sep 2014 19:38:55 +0000 Subject: [PATCH 132/251] added possibility to call execute with custom timeout --- src/core/erlog.erl | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index a41fe1f..5b8cf94 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -33,7 +33,7 @@ -include("erlog_core.hrl"). %% Interface to server. --export([start_link/1, start_link/0, execute/2, select/2]). +-export([start_link/1, start_link/0, execute/2, select/2, execute/3]). %% Gen server callbacs. -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). @@ -47,6 +47,9 @@ state = normal :: normal | list() %state for solution selecting. }). +execute(Worker, Command, undefined) -> execute(Worker, Command); +execute(Worker, Command, Timeout) -> gen_server:call(Worker, {execute, trim_command(Command)}, Timeout). + execute(Worker, Command) -> gen_server:call(Worker, {execute, trim_command(Command)}). select(Worker, Command) -> gen_server:call(Worker, {select, trim_command(Command)}). From feb9845990428d857017b1cfda1b2bfa61245391 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 12 Sep 2014 11:34:39 +0000 Subject: [PATCH 133/251] fix db_storage & make errlog_local_shell execute without timeouts --- src/interface/local/erlog_local_shell.erl | 4 +-- ...ts_db_storage.erl => erlog_db_storage.erl} | 36 ++++++++++++------- src/storage/erlog_dict.erl | 35 ++++++++++-------- src/storage/erlog_ets.erl | 14 ++++---- 4 files changed, 53 insertions(+), 36 deletions(-) rename src/libs/external/db/{ets_db_storage.erl => erlog_db_storage.erl} (81%) diff --git a/src/interface/local/erlog_local_shell.erl b/src/interface/local/erlog_local_shell.erl index 21aa164..72bdf85 100644 --- a/src/interface/local/erlog_local_shell.erl +++ b/src/interface/local/erlog_local_shell.erl @@ -27,7 +27,7 @@ start() -> [erlang:system_info(version)]), {ok, Core} = erlog:start_link(), link(Core), - {ok, Proc} = ets_db_storage:start_link(), %start default ets-implementation of stand-alone database-module + {ok, Proc} = erlog_db_storage:start_link(), %start default ets-implementation of stand-alone database-module link(Proc), server_loop(Core, normal, []). @@ -38,7 +38,7 @@ server_loop(Core, State, Line) -> Term = io:get_line('| ?- '), Res = case State of select -> erlog:select(Core, lists:append(Line, Term)); - _ -> erlog:execute(Core, lists:append(Line, Term)) + _ -> erlog:execute(Core, lists:append(Line, Term), infinity) end, {NewState, NewLine} = process_execute(Res, State, Line, Term), case Term of diff --git a/src/libs/external/db/ets_db_storage.erl b/src/libs/external/db/erlog_db_storage.erl similarity index 81% rename from src/libs/external/db/ets_db_storage.erl rename to src/libs/external/db/erlog_db_storage.erl index f9002fd..511af0a 100644 --- a/src/libs/external/db/ets_db_storage.erl +++ b/src/libs/external/db/erlog_db_storage.erl @@ -7,13 +7,13 @@ %%% @end %%% Created : 22. Июль 2014 0:49 %%%------------------------------------------------------------------- --module(ets_db_storage). +-module(erlog_db_storage). -author("tihon"). -behaviour(gen_server). %% API --export([start_link/0, get_db/1]). +-export([start_link/0, get_db/2, update_db/2]). %% gen_server callbacks -export([init/1, @@ -27,15 +27,16 @@ -record(state, { - ets = [] :: proplists:proplist() + memory = [] :: dict }). %%%=================================================================== %%% API %%%=================================================================== --spec get_db(atom()) -> ets. -get_db(Collection) -> gen_server:call(?MODULE, {get_db, Collection}). +-spec get_db(atom(), atom()) -> ets. +get_db(Type, Collection) -> gen_server:call(?MODULE, {get_db, Type, Collection}). +update_db(Collection, Db) -> gen_server:call(?MODULE, {update_db, Collection, Db}). %%-------------------------------------------------------------------- %% @doc %% Starts the server @@ -66,7 +67,7 @@ start_link() -> {ok, State :: #state{}} | {ok, State :: #state{}, timeout() | hibernate} | {stop, Reason :: term()} | ignore). init([]) -> - {ok, #state{}}. + {ok, #state{memory = dict:new()}}. %%-------------------------------------------------------------------- %% @private @@ -83,13 +84,15 @@ init([]) -> {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | {stop, Reason :: term(), NewState :: #state{}}). -handle_call({get_db, Collection}, _From, State = #state{ets = Dbs}) -> - case proplists:get_value(Collection, Dbs) of - undefined -> - Ets = ets:new(Collection, [public]), - {reply, Ets, State#state{ets = [{Collection, Ets} | Dbs]}}; - Ets -> {reply, Ets, State} - end; +handle_call({get_db, ets, Collection}, _From, State = #state{memory = Dbs}) -> + {Ets, Memory} = get_db(Collection, fun() -> ets:new(Collection, [public]) end, Dbs), + {reply, Ets, State#state{memory = Memory}}; +handle_call({get_db, dict, Collection}, _From, State = #state{memory = Dbs}) -> + {Dict, Memory} = get_db(Collection, fun() -> dict:new() end, Dbs), + {reply, Dict, State#state{memory = Memory}}; +handle_call({update_db, Collection, Db}, _From, State = #state{memory = Dbs}) -> + Umemory = dict:store(Collection, Db, Dbs), + {reply, ok, State#state{memory = Umemory}}; handle_call(_Request, _From, State) -> {reply, ok, State}. @@ -157,3 +160,10 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== %%% Internal functions %%%=================================================================== +get_db(Collection, Dbs, CreateFun) -> + case dict:find(Collection, Dbs) of + error -> + Db = CreateFun(), + {Db, [{Collection, Db} | Dbs]}; + {ok, Db} -> {Db, Dbs} + end. \ No newline at end of file diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 528794d..3f38322 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -28,8 +28,9 @@ new() -> {ok, dict:new()}. new(_) -> {ok, dict:new()}. assertz_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> - Ets = ets_db_storage:get_db(Collection), - {Res, _} = assertz_clause({StdLib, ExLib, Ets}, {Head, Body0}), + Ets = erlog_db_storage:get_db(dict, Collection), + {Res, Udict} = assertz_clause({StdLib, ExLib, Ets}, {Head, Body0}), + erlog_db_storage:update_db(Collection, Udict), {Res, Db}; assertz_clause({_, _, Db} = Memory, {Head, Body0}) -> Udb = clause(Head, Body0, Memory, @@ -42,8 +43,9 @@ assertz_clause({_, _, Db} = Memory, {Head, Body0}) -> {ok, Udb}. asserta_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> - Ets = ets_db_storage:get_db(Collection), - {Res, _} = asserta_clause({StdLib, ExLib, Ets}, {Head, Body0}), + Ets = erlog_db_storage:get_db(dict, Collection), + {Res, Udict} = asserta_clause({StdLib, ExLib, Ets}, {Head, Body0}), + erlog_db_storage:update_db(Collection, Udict), {Res, Db}; asserta_clause({_, _, Db} = Memory, {Head, Body0}) -> Udb = clause(Head, Body0, Memory, @@ -60,8 +62,9 @@ asserta_clause({_, _, Db} = Memory, {Head, Body0}) -> {ok, Udb}. retract_clause({StdLib, ExLib, Db}, {Collection, Functor, Ct}) -> - Ets = ets_db_storage:get_db(Collection), - {Res, _} = retract_clause({StdLib, ExLib, Ets}, {Functor, Ct}), + Ets = erlog_db_storage:get_db(dict, Collection), + {Res, Udict} = retract_clause({StdLib, ExLib, Ets}, {Functor, Ct}), + erlog_db_storage:update_db(Collection, Udict), {Res, Db}; retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> ok = check_immutable(StdLib, Db, Functor), @@ -74,8 +77,9 @@ retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> {ok, Udb}. abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> - Ets = ets_db_storage:get_db(Collection), - {Res, _} = abolish_clauses({StdLib, ExLib, Ets}, {Functor}), + Ets = erlog_db_storage:get_db(dict, Collection), + {Res, Udict} = abolish_clauses({StdLib, ExLib, Ets}, {Functor}), + erlog_db_storage:update_db(Collection, Udict), {Res, Db}; abolish_clauses({StdLib, _, Db}, {Functor}) -> ok = check_immutable(StdLib, Db, Functor), @@ -86,8 +90,9 @@ abolish_clauses({StdLib, _, Db}, {Functor}) -> {ok, Udb}. findall({StdLib, ExLib, Db}, {Collection, Functor}) -> - Ets = ets_db_storage:get_db(Collection), - {Res, _} = findall({StdLib, ExLib, Ets}, {Functor}), + Dict = erlog_db_storage:get_db(dict, Collection), + {Res, Udict} = findall({StdLib, ExLib, Dict}, {Functor}), + erlog_db_storage:update_db(Collection, Udict), {Res, Db}; findall({StdLib, ExLib, Db}, {Functor}) -> case dict:is_key(Functor, StdLib) of %search built-in first @@ -104,8 +109,9 @@ findall({StdLib, ExLib, Db}, {Functor}) -> end. get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> - Ets = ets_db_storage:get_db(Collection), - {Res, _} = get_procedure({StdLib, ExLib, Ets}, {Functor}), + Ets = erlog_db_storage:get_db(dict, Collection), + {Res, Udict} = get_procedure({StdLib, ExLib, Ets}, {Functor}), + erlog_db_storage:update_db(Collection, Udict), {Res, Db}; get_procedure({StdLib, ExLib, Db}, {Functor}) -> Res = case dict:find(Functor, StdLib) of %search built-in first @@ -143,8 +149,9 @@ get_interp_functors({_, ExLib, Db}) -> {lists:concat([Library, UserSpace]), Db}. listing({StdLib, ExLib, Db}, {Collection, Params}) -> - Ets = ets_db_storage:get_db(Collection), - {Res, _} = listing({StdLib, ExLib, Ets}, {Params}), + Ets = erlog_db_storage:get_db(dict, Collection), + {Res, Udict} = listing({StdLib, ExLib, Ets}, {Params}), + erlog_db_storage:update_db(Collection, Udict), {Res, Db}; listing({_, _, Db}, {[Functor, Arity]}) -> {dict:fold( diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 261d49f..8590c6c 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -28,7 +28,7 @@ new() -> {ok, ets:new(eets, [bag, private])}. new(_) -> {ok, ets:new(eets, [bag, private])}. assertz_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> - Ets = ets_db_storage:get_db(Collection), + Ets = erlog_db_storage:get_db(ets, Collection), {Res, _} = assertz_clause({StdLib, ExLib, Ets}, {Head, Body0}), {Res, Db}; assertz_clause({_, _, Db} = Memory, {Head, Body0}) -> @@ -42,7 +42,7 @@ assertz_clause({_, _, Db} = Memory, {Head, Body0}) -> {ok, Db}. asserta_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> - Ets = ets_db_storage:get_db(Collection), + Ets = erlog_db_storage:get_db(ets, Collection), {Res, _} = asserta_clause({StdLib, ExLib, Ets}, {Head, Body0}), {Res, Db}; asserta_clause({_, _, Db} = Memory, {Head, Body0}) -> @@ -59,7 +59,7 @@ asserta_clause({_, _, Db} = Memory, {Head, Body0}) -> {ok, Db}. retract_clause({StdLib, ExLib, Db}, {Collection, Functor, Ct}) -> - Ets = ets_db_storage:get_db(Collection), + Ets = erlog_db_storage:get_db(ets, Collection), {Res, _} = retract_clause({StdLib, ExLib, Ets}, {Functor, Ct}), {Res, Db}; retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> @@ -74,7 +74,7 @@ retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> {ok, Db}. abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> - Ets = ets_db_storage:get_db(Collection), + Ets = erlog_db_storage:get_db(ets, Collection), {Res, _} = abolish_clauses({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; abolish_clauses({StdLib, _, Db}, {Functor}) -> @@ -83,7 +83,7 @@ abolish_clauses({StdLib, _, Db}, {Functor}) -> {ok, Db}. findall({StdLib, ExLib, Db}, {Collection, Functor}) -> - Ets = ets_db_storage:get_db(Collection), + Ets = erlog_db_storage:get_db(ets, Collection), {Res, _} = findall({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; findall({StdLib, ExLib, Db}, {Functor}) -> @@ -97,7 +97,7 @@ findall({StdLib, ExLib, Db}, {Functor}) -> end. get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> - Ets = ets_db_storage:get_db(Collection), + Ets = erlog_db_storage:get_db(ets, Collection), {Res, _} = get_procedure({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; get_procedure({StdLib, ExLib, Db}, {Functor}) -> @@ -139,7 +139,7 @@ get_interp_functors({_, ExLib, Db}) -> {Res, Db}. listing({StdLib, ExLib, Db}, {Collection, Params}) -> - Ets = ets_db_storage:get_db(Collection), + Ets = erlog_db_storage:get_db(ets, Collection), {Res, _} = listing({StdLib, ExLib, Ets}, {Params}), {Res, Db}; listing({_, _, Db}, {[Functor, Arity]}) -> From a14efc888456051e7e197f440475155dc38c58dc Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 12 Sep 2014 19:11:34 +0000 Subject: [PATCH 134/251] fix storage --- src/libs/external/db/erlog_db_storage.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libs/external/db/erlog_db_storage.erl b/src/libs/external/db/erlog_db_storage.erl index 511af0a..10c2821 100644 --- a/src/libs/external/db/erlog_db_storage.erl +++ b/src/libs/external/db/erlog_db_storage.erl @@ -164,6 +164,6 @@ get_db(Collection, Dbs, CreateFun) -> case dict:find(Collection, Dbs) of error -> Db = CreateFun(), - {Db, [{Collection, Db} | Dbs]}; + {Db, dict:store(Collection, Db, Dbs)}; {ok, Db} -> {Db, Dbs} end. \ No newline at end of file From 02fcb048403f6aab6303391fe7ca3bb49357c079 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 12 Sep 2014 20:09:15 +0000 Subject: [PATCH 135/251] fix get_dbs --- src/libs/external/db/erlog_db_storage.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libs/external/db/erlog_db_storage.erl b/src/libs/external/db/erlog_db_storage.erl index 10c2821..89ab09a 100644 --- a/src/libs/external/db/erlog_db_storage.erl +++ b/src/libs/external/db/erlog_db_storage.erl @@ -160,7 +160,7 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== %%% Internal functions %%%=================================================================== -get_db(Collection, Dbs, CreateFun) -> +get_db(Collection, CreateFun, Dbs) -> case dict:find(Collection, Dbs) of error -> Db = CreateFun(), From 8fa4efb039f746da560cb5bd37ac1ede00a8b43d Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 16 Sep 2014 00:35:45 +0000 Subject: [PATCH 136/251] fix possible crashes --- src/storage/erlog_ets.erl | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 8590c6c..c0f60de 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -65,11 +65,11 @@ retract_clause({StdLib, ExLib, Db}, {Collection, Functor, Ct}) -> retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> ok = check_immutable(StdLib, Db, Functor), ok = check_immutable(ExLib, Db, Functor), - case ets:lookup_element(Db, Functor, 2) of - [] -> ok; - Cs -> + case catch ets:lookup_element(Db, Functor, 2) of + Cs when is_list(Cs) -> Object = lists:keyfind(Ct, 1, Cs), - ets:delete_object(Db, Object) + ets:delete_object(Db, Object); + _ -> ok end, {ok, Db}. @@ -92,7 +92,12 @@ findall({StdLib, ExLib, Db}, {Functor}) -> false -> case dict:is_key(Functor, ExLib) of %search libraryspace then true -> {Functor, Db}; - false -> {ets:lookup_element(Db, Functor, 2), Db} %search userspace last + false -> + CS = case catch ets:lookup_element(Db, Functor, 2) of %search userspace last + Cs when is_list(Cs) -> Cs; + _ -> [] + end, + {CS, Db} end end. @@ -107,9 +112,9 @@ get_procedure({StdLib, ExLib, Db}, {Functor}) -> case dict:find(Functor, ExLib) of %search libraryspace then {ok, ExFun} -> ExFun; error -> - case ets:lookup_element(Db, Functor, 2) of %search userspace last - [] -> undefined; - Cs -> {clauses, Cs} + case catch ets:lookup_element(Db, Functor, 2) of %search userspace last + Cs when is_list(Cs) -> {clauses, Cs}; + _ -> undefined end end end, From c3df84e1335bff1da49695fa476928bde7f2bf26 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 16 Sep 2014 18:54:00 +0000 Subject: [PATCH 137/251] remove profiling --- src/core/logic/ec_core.erl | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index 99b5afa..75a47aa 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -73,17 +73,13 @@ prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bi prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); prove_goal(Param = #param{goal = G, database = Db}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), - Before = os:timestamp(), - Res = case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of - {built_in, Mod} -> Mod:prove_goal(Param); %kernel space - {code, {Mod, Func}} -> Mod:Func(Param); %library space - {clauses, Cs} -> prove_goal_clauses(Cs, Param); %user space - undefined -> erlog_errors:fail(Param); - {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data - end, - After = os:timestamp(), - io:format("run goal ~p for ~p seconds~n", [ec_support:functor(G), timer:now_diff(After, Before) / 1000000]), - Res. + case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of + {built_in, Mod} -> Mod:prove_goal(Param); %kernel space + {code, {Mod, Func}} -> Mod:Func(Param); %library space + {clauses, Cs} -> prove_goal_clauses(Cs, Param); %user space + undefined -> erlog_errors:fail(Param); + {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data + end. %% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. From 25660e8fb04a93214f433a16d077b822b614f5e5 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 16 Sep 2014 22:00:13 +0000 Subject: [PATCH 138/251] fix db_call --- src/libs/external/db/erlog_db.erl | 2 +- src/storage/erlog_dict.erl | 36 +++++++++++++++---------------- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 8550266..3ed33ff 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -32,7 +32,7 @@ load(Db) -> db_call_2(Param = #param{goal = {db_call, _, _} = Goal, next_goal = Next0, bindings = Bs, database = Db}) -> {db_call, Table, G} = ec_support:dderef(Goal, Bs), - case erlog_memory:db_findall(Db, Table, G) of + case erlog_memory:db_findall(Db, Table, ec_support:functor(G)) of [] -> erlog_errors:fail(Param); {erlog_error, E} -> erlog_errors:erlog_error(E, Db); {clauses, Cs} -> prove_call(G, Cs, Next0, Param); diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 3f38322..37ebb3a 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -28,8 +28,8 @@ new() -> {ok, dict:new()}. new(_) -> {ok, dict:new()}. assertz_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> - Ets = erlog_db_storage:get_db(dict, Collection), - {Res, Udict} = assertz_clause({StdLib, ExLib, Ets}, {Head, Body0}), + Dict = erlog_db_storage:get_db(dict, Collection), + {Res, Udict} = assertz_clause({StdLib, ExLib, Dict}, {Head, Body0}), erlog_db_storage:update_db(Collection, Udict), {Res, Db}; assertz_clause({_, _, Db} = Memory, {Head, Body0}) -> @@ -43,8 +43,8 @@ assertz_clause({_, _, Db} = Memory, {Head, Body0}) -> {ok, Udb}. asserta_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> - Ets = erlog_db_storage:get_db(dict, Collection), - {Res, Udict} = asserta_clause({StdLib, ExLib, Ets}, {Head, Body0}), + Dict = erlog_db_storage:get_db(dict, Collection), + {Res, Udict} = asserta_clause({StdLib, ExLib, Dict}, {Head, Body0}), erlog_db_storage:update_db(Collection, Udict), {Res, Db}; asserta_clause({_, _, Db} = Memory, {Head, Body0}) -> @@ -62,8 +62,8 @@ asserta_clause({_, _, Db} = Memory, {Head, Body0}) -> {ok, Udb}. retract_clause({StdLib, ExLib, Db}, {Collection, Functor, Ct}) -> - Ets = erlog_db_storage:get_db(dict, Collection), - {Res, Udict} = retract_clause({StdLib, ExLib, Ets}, {Functor, Ct}), + Dict = erlog_db_storage:get_db(dict, Collection), + {Res, Udict} = retract_clause({StdLib, ExLib, Dict}, {Functor, Ct}), erlog_db_storage:update_db(Collection, Udict), {Res, Db}; retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> @@ -77,8 +77,8 @@ retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> {ok, Udb}. abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> - Ets = erlog_db_storage:get_db(dict, Collection), - {Res, Udict} = abolish_clauses({StdLib, ExLib, Ets}, {Functor}), + Dict = erlog_db_storage:get_db(dict, Collection), + {Res, Udict} = abolish_clauses({StdLib, ExLib, Dict}, {Functor}), erlog_db_storage:update_db(Collection, Udict), {Res, Db}; abolish_clauses({StdLib, _, Db}, {Functor}) -> @@ -95,12 +95,12 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> erlog_db_storage:update_db(Collection, Udict), {Res, Db}; findall({StdLib, ExLib, Db}, {Functor}) -> - case dict:is_key(Functor, StdLib) of %search built-in first - true -> {Functor, Db}; - false -> - case dict:is_key(Functor, ExLib) of %search libraryspace then - true -> {Functor, Db}; - false -> + case dict:find(Functor, StdLib) of %search built-in first + {ok, StFun} -> {StFun, Db}; + error -> + case dict:find(Functor, ExLib) of %search libraryspace then + {ok, ExFun} -> {ExFun, Db}; + error -> case dict:find(Functor, Db) of %search userspace last {ok, Cs} -> {Cs, Db}; error -> {[], Db} @@ -109,8 +109,8 @@ findall({StdLib, ExLib, Db}, {Functor}) -> end. get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> - Ets = erlog_db_storage:get_db(dict, Collection), - {Res, Udict} = get_procedure({StdLib, ExLib, Ets}, {Functor}), + Dict = erlog_db_storage:get_db(dict, Collection), + {Res, Udict} = get_procedure({StdLib, ExLib, Dict}, {Functor}), erlog_db_storage:update_db(Collection, Udict), {Res, Db}; get_procedure({StdLib, ExLib, Db}, {Functor}) -> @@ -149,8 +149,8 @@ get_interp_functors({_, ExLib, Db}) -> {lists:concat([Library, UserSpace]), Db}. listing({StdLib, ExLib, Db}, {Collection, Params}) -> - Ets = erlog_db_storage:get_db(dict, Collection), - {Res, Udict} = listing({StdLib, ExLib, Ets}, {Params}), + Dict = erlog_db_storage:get_db(dict, Collection), + {Res, Udict} = listing({StdLib, ExLib, Dict}, {Params}), erlog_db_storage:update_db(Collection, Udict), {Res, Db}; listing({_, _, Db}, {[Functor, Arity]}) -> From 9b07c398784815897bed00b828b5c6f20ce14010 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 19 Sep 2014 17:36:03 +0000 Subject: [PATCH 139/251] added simple debugger - just listing --- README.md | 11 + include/erlog_core.hrl | 5 +- src/core/erlog.erl | 200 +++++++++--------- src/core/logic/ec_core.erl | 146 +++++++------ .../debugger/erlog_simple_debugger.erl | 166 +++++++++++++++ src/interface/local/erlog_local_shell.erl | 16 +- 6 files changed, 368 insertions(+), 176 deletions(-) create mode 100644 src/interface/debugger/erlog_simple_debugger.erl diff --git a/README.md b/README.md index a2a50e2..99cd740 100644 --- a/README.md +++ b/README.md @@ -25,6 +25,17 @@ And connect to it via console: telnet 127.0.0.1 8080 Port can be set up in `src/erlog.app.src`. +#### Debugger +Debugger can be passed to erlog as a parameter {debugger, Fun}, where `Fun` is your fun of calling debugger: + + {ok, Core} = erlog:start_link([{debugger, fun(Status, Functor, Result) -> gen_server:call(Debugger, {Status, Functor, Result}) end}]), +Where __Status__ is a status of command - `ok|failed`, __Functor__ is current working functor, __Result__ is a result +prolog term - complex structure with all data. +As an example you can use `erlog_simple_debugger` with `erlog_local_shell`: + + {ok, Pid} = erlog_simple_debugger:start_link(). + erlog_local_shell:start(Pid). + #### Processing prolog code from erlang: ##### Starting Spawn new logic core: diff --git a/include/erlog_core.hrl b/include/erlog_core.hrl index c58c7b7..8aca913 100644 --- a/include/erlog_core.hrl +++ b/include/erlog_core.hrl @@ -29,7 +29,7 @@ %% Define the choice point record -record(cp, {type, label, data, next, bs, vn}). -record(cut, {label, next}). -%TODO move me to different hrl files (one lib - one file) + %% record for passing arguments to erlog_core:prove_goal -record(param, { @@ -40,7 +40,8 @@ var_num, database, event_man, - f_consulter + f_consulter, + debugger }). -define(ERLOG_CORE, diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 5b8cf94..b30098d 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -41,10 +41,11 @@ %% Erlang server code. -record(state, { - db :: atom(), %database - f_consulter :: fun(), %file consulter - e_man :: pid(), %event manager, used for debuging and other output (not for return) - state = normal :: normal | list() %state for solution selecting. + db :: atom(), %database + f_consulter :: fun(), %file consulter + debugger :: fun(), %debugger function + e_man :: pid(), %event manager, used for debuging and other output (not for return) + state = normal :: normal | list() %state for solution selecting. }). execute(Worker, Command, undefined) -> execute(Worker, Command); @@ -55,52 +56,53 @@ select(Worker, Command) -> gen_server:call(Worker, {select, trim_command(Command -spec start_link() -> pid(). start_link() -> - gen_server:start_link(?MODULE, [], []). + gen_server:start_link(?MODULE, [], []). %% Database is your callback module. Params will be send to it's new(Params) callback -spec start_link(Params :: proplists:proplist()) -> pid(). start_link(Params) -> - gen_server:start_link(?MODULE, Params, []). + gen_server:start_link(?MODULE, Params, []). init([]) -> % use built in database - {ok, Db} = init_database([]), - F = init_consulter([]), - {ok, E} = gen_event:start_link(), - gen_event:add_handler(E, erlog_simple_printer, []), %set the default debug module - {ok, #state{db = Db, f_consulter = F, e_man = E}}; + {ok, Db} = init_database([]), + F = init_consulter([]), + {ok, E} = gen_event:start_link(), + gen_event:add_handler(E, erlog_simple_printer, []), %set the default debug module + {ok, #state{db = Db, f_consulter = F, e_man = E}}; init(Params) -> % use custom database implementation - FileCon = init_consulter(Params), - {ok, Db} = init_database(Params), - ok = load_external_libraries(Params, Db), - {ok, E} = gen_event:start_link(), - case proplists:get_value(event_h, Params) of %register handler, if any - undefined -> ok; - {Module, Arguments} -> gen_event:add_handler(E, Module, Arguments) - end, - {ok, #state{db = Db, f_consulter = FileCon, e_man = E}}. + FileCon = init_consulter(Params), + {ok, Db} = init_database(Params), + ok = load_external_libraries(Params, Db), + {ok, E} = gen_event:start_link(), + Debugger = init_debugger(Params), + case proplists:get_value(event_h, Params) of %register handler, if any + undefined -> ok; + {Module, Arguments} -> gen_event:add_handler(E, Module, Arguments) + end, + {ok, #state{db = Db, f_consulter = FileCon, e_man = E, debugger = Debugger}}. handle_call({execute, Command}, _From, State) -> %running prolog code in normal mode - {Res, _} = Repl = case erlog_scan:tokens([], Command, 1) of - {done, Result, _Rest} -> run_command(Result, State); % command is finished, run. - {more, _} -> {{ok, more}, State} % unfinished command. Report it and do nothing. - end, - NewState = change_state(Repl), - {reply, Res, NewState}; + {Res, _} = Repl = case erlog_scan:tokens([], Command, 1) of + {done, Result, _Rest} -> run_command(Result, State); % command is finished, run. + {more, _} -> {{ok, more}, State} % unfinished command. Report it and do nothing. + end, + NewState = change_state(Repl), + {reply, Res, NewState}; handle_call({select, Command}, _From, State) -> %in selection solutions mode - {Res, _} = Repl = preprocess_command({select, Command}, State), - NewState = change_state(Repl), % change state, depending on reply - {reply, Res, NewState}. + {Res, _} = Repl = preprocess_command({select, Command}, State), + NewState = change_state(Repl), % change state, depending on reply + {reply, Res, NewState}. handle_cast(halt, St = #state{e_man = E, db = Db}) -> - gen_event:stop(E), %stom all handlers and event man - gen_server:cast(Db, halt), - {stop, normal, St}. + gen_event:stop(E), %stom all handlers and event man + gen_server:cast(Db, halt), + {stop, normal, St}. handle_info(_, St) -> - {noreply, St}. + {noreply, St}. terminate(_, _) -> - ok. + ok. code_change(_, _, St) -> {ok, St}. @@ -116,103 +118,103 @@ change_state({_, State}) -> State#state{state = normal}. %% Configurates database with arguments, populates it and returns. -spec init_database(Params :: proplists:proplist()) -> {ok, Pid :: pid()}. init_database(Params) -> - {ok, DbPid} = case proplists:get_value(database, Params) of - undefined -> erlog_memory:start_link(erlog_dict); %default database is ets module - Module -> - Args = proplists:get_value(arguments, Params), - erlog_memory:start_link(Module, Args) - end, - load_built_in(DbPid), - {ok, DbPid}. + {ok, DbPid} = case proplists:get_value(database, Params) of + undefined -> erlog_memory:start_link(erlog_dict); %default database is ets module + Module -> + Args = proplists:get_value(arguments, Params), + erlog_memory:start_link(Module, Args) + end, + load_built_in(DbPid), + {ok, DbPid}. %% @private -spec init_consulter(Params :: proplists:proplist()) -> fun() | any(). init_consulter(Params) -> - case proplists:get_value(f_consulter, Params) of %get function from params or default - undefined -> fun erlog_io:read_file/1; - Other -> Other - end. + proplists:get_value(f_consulter, Params, fun erlog_io:read_file/1). %get function from params or default + +init_debugger(Params) -> + proplists:get_value(debugger, Params, fun(_, _, _) -> ok end). %% @private load_built_in(Database) -> - %Load basic interpreter predicates - lists:foreach(fun(Mod) -> Mod:load(Database) end, - [ - erlog_core, %Core predicates - erlog_bips, %Built in predicates - erlog_dcg, %DCG predicates - erlog_lists, %Common lists library - erlog_time %Bindings for working with data and time - ]). + %Load basic interpreter predicates + lists:foreach(fun(Mod) -> Mod:load(Database) end, + [ + erlog_core, %Core predicates + erlog_bips, %Built in predicates + erlog_dcg, %DCG predicates + erlog_lists, %Common lists library + erlog_time %Bindings for working with data and time + ]). %% @private load_external_libraries(Params, Database) -> - case proplists:get_value(libraries, Params) of - undefined -> ok; - Libraries -> lists:foreach(fun(Mod) -> Mod:load(Database) end, Libraries) - end. + case proplists:get_value(libraries, Params) of + undefined -> ok; + Libraries -> lists:foreach(fun(Mod) -> Mod:load(Database) end, Libraries) + end. %% @private %% Run scanned command run_command(Command, State) -> - case erlog_parse:parse_prolog_term(Command) of - {ok, halt} -> - gen_server:cast(self(), halt), - {true, State}; - PrologCmd -> preprocess_command(PrologCmd, State) - end. + case erlog_parse:parse_prolog_term(Command) of + {ok, halt} -> + gen_server:cast(self(), halt), + {true, State}; + PrologCmd -> preprocess_command(PrologCmd, State) + end. %% @private %% Preprocess command preprocess_command({ok, Command}, State = #state{f_consulter = Fun, db = Db}) when is_list(Command) -> %TODO may be remove me? - case erlog_logic:reconsult_files(Command, Db, Fun) of - ok -> - {true, State}; - {error, {L, Pm, Pe}} -> - {erlog_io:format_error([L, Pm:format_error(Pe)]), State}; - {Error, Message} when Error == error; Error == erlog_error -> - {erlog_io:format_error([Message]), State} - end; + case erlog_logic:reconsult_files(Command, Db, Fun) of + ok -> + {true, State}; + {error, {L, Pm, Pe}} -> + {erlog_io:format_error([L, Pm:format_error(Pe)]), State}; + {Error, Message} when Error == error; Error == erlog_error -> + {erlog_io:format_error([Message]), State} + end; preprocess_command({ok, Command}, State) -> - {Result, NewState} = process_command({prove, Command}, State), - {erlog_logic:shell_prove_result(Result), NewState}; + {Result, NewState} = process_command({prove, Command}, State), + {erlog_logic:shell_prove_result(Result), NewState}; preprocess_command({error, {_, Em, E}}, State) -> {erlog_io:format_error([Em:format_error(E)]), State}; preprocess_command({select, Value}, State) -> - {Next, NewState} = process_command(next, State), - {erlog_logic:select_bindings(Value, Next), NewState}. + {Next, NewState} = process_command(next, State), + {erlog_logic:select_bindings(Value, Next), NewState}. %% @private %% Process command, modify state. Return {Result, NewState} -spec process_command(tuple() | atom(), State :: #state{}) -> tuple(). process_command({prove, Goal}, State) -> - prove_goal(Goal, State); + prove_goal(Goal, State); process_command(next, State = #state{state = normal}) -> % can't select solution, when not in select mode - {fail, State}; + {fail, State}; process_command(next, State = #state{state = [Vs, Cps], db = Db, f_consulter = Fcon}) -> - case erlog_logic:prove_result(catch erlog_errors:fail(#param{choice = Cps, database = Db, f_consulter = Fcon}), Vs) of - {Atom, Res, Args} -> {{Atom, Res}, State#state{state = Args}}; - Other -> {Other, State} - end; + case erlog_logic:prove_result(catch erlog_errors:fail(#param{choice = Cps, database = Db, f_consulter = Fcon}), Vs) of + {Atom, Res, Args} -> {{Atom, Res}, State#state{state = Args}}; + Other -> {Other, State} + end; process_command(halt, State) -> - gen_server:cast(self(), halt), - {ok, State}. + gen_server:cast(self(), halt), + {ok, State}. %% @private -prove_goal(Goal0, State = #state{db = Db, f_consulter = Fcon, e_man = Event}) -> - Vs = erlog_logic:vars_in(Goal0), - %% Goal may be a list of goals, ensure proper goal. - Goal1 = erlog_logic:unlistify(Goal0), - %% Must use 'catch' here as 'try' does not do last-call - %% optimisation. - case erlog_logic:prove_result(catch ec_core:prove_goal(Goal1, Db, Fcon, Event), Vs) of - {succeed, Res, Args} -> {{succeed, Res}, State#state{state = Args}}; - OtherRes -> {OtherRes, State} - end. +prove_goal(Goal0, State = #state{db = Db, f_consulter = Fcon, e_man = Event, debugger = Deb}) -> + Vs = erlog_logic:vars_in(Goal0), + %% Goal may be a list of goals, ensure proper goal. + Goal1 = erlog_logic:unlistify(Goal0), + %% Must use 'catch' here as 'try' does not do last-call + %% optimisation. + case erlog_logic:prove_result(catch ec_core:prove_goal(Goal1, Db, Fcon, Event, Deb), Vs) of + {succeed, Res, Args} -> {{succeed, Res}, State#state{state = Args}}; + OtherRes -> {OtherRes, State} + end. %% @private %% Adds "\r\n" to command. We need this, as erlog_scan reply more on commands without such ending trim_command(Command) -> - case lists:suffix([13, 10], Command) of - true -> Command; - _ -> lists:append(Command, [13, 10]) - end. \ No newline at end of file + case lists:suffix([13, 10], Command) of + true -> Command; + _ -> lists:append(Command, [13, 10]) + end. \ No newline at end of file diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index 75a47aa..f539aff 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -12,21 +12,21 @@ -include("erlog_core.hrl"). %% API --export([prove_body/1, prove_goal/1, prove_goal/4, prove_goal_clauses/2]). +-export([prove_body/1, prove_goal/1, prove_goal/5, prove_goal_clauses/2]). %% prove_goal(Goal, Database) -> Succeed | Fail. %% This is the main entry point into the interpreter. Check that %% everything is consistent then prove the goal as a call. --spec prove_goal(Goal0 :: term(), Db :: pid(), Fcon :: fun(), Event :: pid()) -> term(). -prove_goal(Goal0, Db, Fcon, Event) -> - %% put(erlog_cut, orddict:new()), - %% put(erlog_cps, orddict:new()), - %% put(erlog_var, orddict:new()), - %% Check term and build new instance of term with bindings. - {Goal1, Bs, Vn} = ec_logic:initial_goal(Goal0), - Params = #param{goal = [{call, Goal1}], choice = [], bindings = Bs, var_num = Vn, - event_man = Event, database = Db, f_consulter = Fcon}, - ec_core:prove_body(Params). %TODO use lists:foldr instead! +-spec prove_goal(Goal0 :: term(), Db :: pid(), Fcon :: fun(), Event :: pid(), Deb :: fun()) -> term(). +prove_goal(Goal0, Db, Fcon, Event, Deb) -> + %% put(erlog_cut, orddict:new()), + %% put(erlog_cps, orddict:new()), + %% put(erlog_var, orddict:new()), + %% Check term and build new instance of term with bindings. + {Goal1, Bs, Vn} = ec_logic:initial_goal(Goal0), + Params = #param{goal = [{call, Goal1}], choice = [], bindings = Bs, var_num = Vn, + event_man = Event, database = Db, f_consulter = Fcon, debugger = Deb}, + ec_core:prove_body(Params). %TODO use lists:foldr instead! %% prove_body(Body, ChoicePoints, Bindings, VarNum, Database) -> %% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase}. @@ -34,80 +34,88 @@ prove_goal(Goal0, Db, Fcon, Event) -> %% it. Return when there are no more goals. This is how proving a %% goal/body succeeds. prove_body(Params = #param{goal = [G | Gs]}) -> %TODO use lists:foldr instead! - %%io:fwrite("PB: ~p\n", [{G,Gs,Cps}]), - prove_goal(Params#param{goal = G, next_goal = Gs}); + %%io:fwrite("PB: ~p\n", [{G,Gs,Cps}]), + prove_goal(Params#param{goal = G, next_goal = Gs}); prove_body(#param{goal = [], choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> - %%io:fwrite("Cps: ~p\nCut: ~p\nVar: ~p\nVar: ~p\n", - %% [get(erlog_cps),get(erlog_cut),get(erlog_var),dict:size(Bs)]), - %%io:fwrite("PB: ~p\n", [Cps]), - {succeed, Cps, Bs, Vn, Db}. %No more body %TODO why should we return database? + %%io:fwrite("Cps: ~p\nCut: ~p\nVar: ~p\nVar: ~p\n", + %% [get(erlog_cps),get(erlog_cut),get(erlog_var),dict:size(Bs)]), + %%io:fwrite("PB: ~p\n", [Cps]), + {succeed, Cps, Bs, Vn, Db}. %No more body %TODO why should we return database? %% Prove support first. Then find in database. prove_goal(Param = #param{goal = {{once}, Label}, next_goal = Next, choice = Cps}) -> - %% We effetively implement once(G) with ( G, ! ) but cuts in - %% G are local to G. - %% There is no ( G, ! ) here, it has already been prepended to Next. - Cut = #cut{label = Label}, - prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); + %% We effetively implement once(G) with ( G, ! ) but cuts in + %% G are local to G. + %% There is no ( G, ! ) here, it has already been prepended to Next. + Cut = #cut{label = Label}, + prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); prove_goal(Param = #param{goal = {{if_then_else}, Else, Label}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> - %% Need to push a choicepoint to fail back to inside Cond and a cut - %% to cut back to before Then when Cond succeeds. #cp{type=if_then_else} - %% functions as both as is always removed whatever the outcome. - %% There is no ( C, !, T ) here, it has already been prepended to Next. - Cp = #cp{type = if_then_else, label = Label, next = Else, bs = Bs, vn = Vn}, - %%io:fwrite("PG(->;): ~p\n", [{Next,Else,[Cp|Cps]}]), - prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); + %% Need to push a choicepoint to fail back to inside Cond and a cut + %% to cut back to before Then when Cond succeeds. #cp{type=if_then_else} + %% functions as both as is always removed whatever the outcome. + %% There is no ( C, !, T ) here, it has already been prepended to Next. + Cp = #cp{type = if_then_else, label = Label, next = Else, bs = Bs, vn = Vn}, + %%io:fwrite("PG(->;): ~p\n", [{Next,Else,[Cp|Cps]}]), + prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); prove_goal(Param = #param{goal = {{if_then}, Label}, next_goal = Next, choice = Cps}) -> - %% We effetively implement ( C -> T ) with ( C, !, T ) but cuts in - %% C are local to C. - %% There is no ( C, !, T ) here, it has already been prepended to Next. - %%io:fwrite("PG(->): ~p\n", [{Next}]), - Cut = #cut{label = Label}, - prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); + %% We effetively implement ( C -> T ) with ( C, !, T ) but cuts in + %% C are local to C. + %% There is no ( C, !, T ) here, it has already been prepended to Next. + %%io:fwrite("PG(->): ~p\n", [{Next}]), + Cut = #cut{label = Label}, + prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); prove_goal(Param = #param{goal = {{cut}, Label, Last}}) -> - %% Cut succeeds and trims back to cut ancestor. - ec_support:cut(Label, Last, Param); + %% Cut succeeds and trims back to cut ancestor. + ec_support:cut(Label, Last, Param); prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> - %% There is no L here, it has already been prepended to Next. - Cp = #cp{type = disjunction, next = R, bs = Bs, vn = Vn}, - prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); -prove_goal(Param = #param{goal = G, database = Db}) -> + %% There is no L here, it has already been prepended to Next. + Cp = #cp{type = disjunction, next = R, bs = Bs, vn = Vn}, + prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); +prove_goal(Param = #param{goal = G, database = Db, bindings = Bs, debugger = Deb}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), - case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of - {built_in, Mod} -> Mod:prove_goal(Param); %kernel space - {code, {Mod, Func}} -> Mod:Func(Param); %library space - {clauses, Cs} -> prove_goal_clauses(Cs, Param); %user space - undefined -> erlog_errors:fail(Param); - {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data - end. + try + Res = case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of + {built_in, Mod} -> Mod:prove_goal(Param); %kernel space + {code, {Mod, Func}} -> Mod:Func(Param); %library space + {clauses, Cs} -> prove_goal_clauses(Cs, Param); %user space + undefined -> erlog_errors:fail(Param); + {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data + end, + Deb(ok, ec_support:dderef(G, Bs), Res), + Res + catch + throw:M -> + Deb(fail, ec_support:dderef(G, Bs), M), + throw(M) + end. %% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to prove Goal using Clauses which all have the same functor. prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> - %% Must be smart here and test whether we need to add a cut point. - %% C has the structure {Tag,Head,{Body,BodyHasCut}}. - case element(2, element(3, C)) of - true -> - Cut = #cut{label = Vn}, - prove_goal_clause(C, Params#param{choice = [Cut | Cps]}); - false -> - prove_goal_clause(C, Params) - end; + %% Must be smart here and test whether we need to add a cut point. + %% C has the structure {Tag,Head,{Body,BodyHasCut}}. + case element(2, element(3, C)) of + true -> + Cut = #cut{label = Vn}, + prove_goal_clause(C, Params#param{choice = [Cut | Cps]}); + false -> + prove_goal_clause(C, Params) + end; %% prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db); prove_goal_clauses([C | Cs], Params = #param{goal = G, next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps}) -> - Cp = #cp{type = goal_clauses, label = Vn, data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, - prove_goal_clause(C, Params#param{choice = [Cp | Cps]}); + Cp = #cp{type = goal_clauses, label = Vn, data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, + prove_goal_clause(C, Params#param{choice = [Cp | Cps]}); prove_goal_clauses([], Param) -> erlog_errors:fail(Param). prove_goal_clause({_Tag, H0, {B0, _}}, Param = #param{goal = G, next_goal = Next, bindings = Bs0, var_num = Vn0}) -> - %% io:fwrite("PGC1: ~p\n", [{G,H0,B0}]), - Label = Vn0, - case ec_unify:unify_head(G, H0, Bs0, Vn0 + 1) of - {succeed, Rs0, Bs1, Vn1} -> - %% io:fwrite("PGC2: ~p\n", [{Rs0}]), - {B1, _Rs2, Vn2} = ec_body:body_instance(B0, Next, Rs0, Vn1, Label), - %% io:fwrite("PGC3: ~p\n", [{B1,Next,Cps}]), - ec_core:prove_body(Param#param{goal = B1, bindings = Bs1, var_num = Vn2}); - fail -> erlog_errors:fail(Param) - end. \ No newline at end of file + %% io:fwrite("PGC1: ~p\n", [{G,H0,B0}]), + Label = Vn0, + case ec_unify:unify_head(G, H0, Bs0, Vn0 + 1) of + {succeed, Rs0, Bs1, Vn1} -> + %% io:fwrite("PGC2: ~p\n", [{Rs0}]), + {B1, _Rs2, Vn2} = ec_body:body_instance(B0, Next, Rs0, Vn1, Label), + %% io:fwrite("PGC3: ~p\n", [{B1,Next,Cps}]), + ec_core:prove_body(Param#param{goal = B1, bindings = Bs1, var_num = Vn2}); + fail -> erlog_errors:fail(Param) + end. \ No newline at end of file diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl new file mode 100644 index 0000000..b17c655 --- /dev/null +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -0,0 +1,166 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 19. Сент. 2014 16:09 +%%%------------------------------------------------------------------- +-module(erlog_simple_debugger). +-author("tihon"). + +-behaviour(gen_server). + +%% API +-export([start_link/0, configure/2]). + +%% gen_server callbacks +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). + +-define(SERVER, ?MODULE). + +-record(state, {}). + +%%%=================================================================== +%%% API +%%%=================================================================== + +%%-------------------------------------------------------------------- +%% @doc +%% Starts the server +%% +%% @end +%%-------------------------------------------------------------------- +-spec(start_link() -> + {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). +start_link() -> + gen_server:start_link({local, ?SERVER}, ?MODULE, [], []). + +%%%=================================================================== +%%% gen_server callbacks +%%%=================================================================== +configure(Debugger, State) -> gen_server:call(Debugger, {conf, State}). + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Initializes the server +%% +%% @spec init(Args) -> {ok, State} | +%% {ok, State, Timeout} | +%% ignore | +%% {stop, Reason} +%% @end +%%-------------------------------------------------------------------- +-spec(init(Args :: term()) -> + {ok, State :: #state{}} | {ok, State :: #state{}, timeout() | hibernate} | + {stop, Reason :: term()} | ignore). +init([]) -> + {ok, #state{}}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Handling call messages +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_call(Request :: term(), From :: {pid(), Tag :: term()}, + State :: #state{}) -> + {reply, Reply :: term(), NewState :: #state{}} | + {reply, Reply :: term(), NewState :: #state{}, timeout() | hibernate} | + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | + {stop, Reason :: term(), NewState :: #state{}}). +handle_call({_Res, Functor, Result}, _From, State) -> + io:format("Execute ~p, got ~p~n", [Functor, process_reply(Result)]), + {reply, ok, State}; +handle_call(_Request, _From, State) -> + {reply, ok, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Handling cast messages +%% +%% @end +%%-------------------------------------------------------------------- +-spec(handle_cast(Request :: term(), State :: #state{}) -> + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), NewState :: #state{}}). +handle_cast(_Request, State = #state{}) -> + {noreply, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Handling all non call/cast messages +%% +%% @spec handle_info(Info, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} +%% @end +%%-------------------------------------------------------------------- +-spec(handle_info(Info :: timeout() | term(), State :: #state{}) -> + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), NewState :: #state{}}). +handle_info(_Info, State) -> + {noreply, State}. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% This function is called by a gen_server when it is about to +%% terminate. It should be the opposite of Module:init/1 and do any +%% necessary cleaning up. When it returns, the gen_server terminates +%% with Reason. The return value is ignored. +%% +%% @spec terminate(Reason, State) -> void() +%% @end +%%-------------------------------------------------------------------- +-spec(terminate(Reason :: (normal | shutdown | {shutdown, term()} | term()), + State :: #state{}) -> term()). +terminate(_Reason, _State) -> + ok. + +%%-------------------------------------------------------------------- +%% @private +%% @doc +%% Convert process state when code is changed +%% +%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState} +%% @end +%%-------------------------------------------------------------------- +-spec(code_change(OldVsn :: term() | {down, term()}, State :: #state{}, + Extra :: term()) -> + {ok, NewState :: #state{}} | {error, Reason :: term()}). +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%%=================================================================== +%%% Internal functions +%%%=================================================================== +process_reply({fail, _}) -> "false"; +process_reply({succeed, _, Dict, _, _}) -> + case dict:is_empty(Dict) of + true -> "true"; + false -> + Keys = dict:fetch_keys(Dict), + {"true : ", lists:foldl( + fun(Key, Res) -> + case dict:find(Key, Dict) of + {ok, {K}} -> + {ok, V} = dict:find(K, Dict), + [{Key, V} | Res]; + _ -> Res + end + end, [], Keys)} + end. diff --git a/src/interface/local/erlog_local_shell.erl b/src/interface/local/erlog_local_shell.erl index 72bdf85..7356c24 100644 --- a/src/interface/local/erlog_local_shell.erl +++ b/src/interface/local/erlog_local_shell.erl @@ -18,17 +18,21 @@ -module(erlog_local_shell). --export([start/0]). - --import(lists, [foldl/3, foreach/2]). +-export([start/0, start/1]). start() -> io:fwrite("Erlog Shell V~s (abort with ^G)\n", [erlang:system_info(version)]), {ok, Core} = erlog:start_link(), - link(Core), - {ok, Proc} = erlog_db_storage:start_link(), %start default ets-implementation of stand-alone database-module - link(Proc), + {ok, _} = erlog_db_storage:start_link(), %start default ets-implementation of stand-alone database-module + server_loop(Core, normal, []). + +start(Debugger) -> + io:fwrite("Erlog Shell V~s with debugger (abort with ^G)\n", + [erlang:system_info(version)]), + {ok, Core} = erlog:start_link( + [{debugger, fun(Status, Functor, Result) -> gen_server:call(Debugger, {Status, Functor, Result}) end}]), + {ok, _} = erlog_db_storage:start_link(), %start default ets-implementation of stand-alone database-module server_loop(Core, normal, []). %% A simple Erlog shell similar to a "normal" Prolog shell. It allows From 2b17e10493d553cff8c74c8a07227d6be6a4a023 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 23 Sep 2014 00:15:50 +0000 Subject: [PATCH 140/251] fix default debugger fun --- src/core/erlog.erl | 3 ++- src/interface/debugger/erlog_simple_debugger.erl | 6 +++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index b30098d..b1ad3d0 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -67,8 +67,9 @@ init([]) -> % use built in database {ok, Db} = init_database([]), F = init_consulter([]), {ok, E} = gen_event:start_link(), + Debugger = init_debugger([]), gen_event:add_handler(E, erlog_simple_printer, []), %set the default debug module - {ok, #state{db = Db, f_consulter = F, e_man = E}}; + {ok, #state{db = Db, f_consulter = F, e_man = E, debugger = Debugger}}; init(Params) -> % use custom database implementation FileCon = init_consulter(Params), {ok, Db} = init_database(Params), diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl index b17c655..4683b7f 100644 --- a/src/interface/debugger/erlog_simple_debugger.erl +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -24,7 +24,11 @@ -define(SERVER, ?MODULE). --record(state, {}). +-record(state, +{ + policy = listing %default policy of debugger is listing. +}). +%% policy can be step - make N commands and %%%=================================================================== %%% API From 69a29e89c2c19c420d30b8c666575500d832d0c2 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 23 Sep 2014 01:26:23 +0000 Subject: [PATCH 141/251] add stopping by counter --- .../debugger/erlog_simple_debugger.erl | 55 +++- src/interface/local/erlog_local_shell.erl | 2 +- src/libs/standard/core/main/erlog_core.erl | 244 +++++++++--------- 3 files changed, 175 insertions(+), 126 deletions(-) diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl index 4683b7f..4dddc27 100644 --- a/src/interface/debugger/erlog_simple_debugger.erl +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -12,7 +12,7 @@ -behaviour(gen_server). %% API --export([start_link/0, configure/2]). +-export([start_link/0, configure/1]). %% gen_server callbacks -export([init/1, @@ -48,7 +48,8 @@ start_link() -> %%%=================================================================== %%% gen_server callbacks %%%=================================================================== -configure(Debugger, State) -> gen_server:call(Debugger, {conf, State}). +-spec configure(pid()) -> ok. +configure(Debugger) -> gen_server:call(Debugger, conf, infinity). %%-------------------------------------------------------------------- %% @private @@ -82,7 +83,28 @@ init([]) -> {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | {stop, Reason :: term(), NewState :: #state{}}). -handle_call({_Res, Functor, Result}, _From, State) -> +handle_call(conf, _From, State) -> + Policy = process_action(), + {reply, ok, State#state{policy = Policy}}; +handle_call({_, Functor, Result}, _From, State = #state{policy = {stop, Pred}}) -> %stopping + Polisy = case lists:flatten(io_lib:format("~p", [Functor])) of + Pred -> + io:fwrite("Erlog debugger stopped execution on command ~s with result ~p.~n", [Pred, process_reply(Result)]), + process_action(); + Other -> + io:format("~p - ~p ~p~n", [Pred, Other, Pred == Other]), + io:format("Skip ~s~n", [Other]), + {stop, Pred} + end, + {reply, ok, State#state{policy = Polisy}}; +handle_call({_, Functor, Result}, _From, State = #state{policy = {next, N}}) when N =< 1 -> %counting steps ending + io:fwrite("Erlog debugger stopped execution on command ~p with result ~p.~n", [Functor, process_reply(Result)]), + Policy = process_action(), + {reply, ok, State#state{policy = Policy}}; +handle_call({_, Functor, _}, _From, State = #state{policy = {next, N}}) -> %counting steps + io:fwrite("Skip ~p~n", [Functor]), + {reply, ok, State#state{policy = {next, N - 1}}}; +handle_call({_Res, Functor, Result}, _From, State) -> %listing io:format("Execute ~p, got ~p~n", [Functor, process_reply(Result)]), {reply, ok, State}; handle_call(_Request, _From, State) -> @@ -168,3 +190,30 @@ process_reply({succeed, _, Dict, _, _}) -> end end, [], Keys)} end. + +%% @private +%% Is called when code execution is stopped. Waits for user action. +process_action() -> + io:format("Select action~n"), + Order = io:get_line('| ?- '), + Listing = lists:prefix("listing", Order), + Next = lists:prefix("next", Order), + Stop = lists:prefix("stop", Order), + if + Listing -> listing; + Next -> process_next(Order); + Stop -> process_stop(Order); + true -> + io:format("Wrong action!~n"), + process_action() + end. + +%% @private +process_next(Next) -> + N = Next -- "next ", + {Num, _Rest} = string:to_integer(N), + {next, Num}. + +%% @private +process_stop(Stop) -> + {stop, Stop -- "stop \n"}. \ No newline at end of file diff --git a/src/interface/local/erlog_local_shell.erl b/src/interface/local/erlog_local_shell.erl index 7356c24..5a31ee9 100644 --- a/src/interface/local/erlog_local_shell.erl +++ b/src/interface/local/erlog_local_shell.erl @@ -31,7 +31,7 @@ start(Debugger) -> io:fwrite("Erlog Shell V~s with debugger (abort with ^G)\n", [erlang:system_info(version)]), {ok, Core} = erlog:start_link( - [{debugger, fun(Status, Functor, Result) -> gen_server:call(Debugger, {Status, Functor, Result}) end}]), + [{debugger, fun(Status, Functor, Result) -> gen_server:call(Debugger, {Status, Functor, Result}, infinity) end}]), {ok, _} = erlog_db_storage:start_link(), %start default ets-implementation of stand-alone database-module server_loop(Core, normal, []). diff --git a/src/libs/standard/core/main/erlog_core.erl b/src/libs/standard/core/main/erlog_core.erl index d2ebb68..0b846f1 100644 --- a/src/libs/standard/core/main/erlog_core.erl +++ b/src/libs/standard/core/main/erlog_core.erl @@ -32,8 +32,8 @@ %% Create an initial clause database containing the built-in %% predicates and predefined library predicates. load(Db) -> - lists:foreach(fun(Head) -> - erlog_memory:load_kernel_space(Db, ?MODULE, Head) end, ?ERLOG_CORE). %% Add the Erlang built-ins. + lists:foreach(fun(Head) -> + erlog_memory:load_kernel_space(Db, ?MODULE, Head) end, ?ERLOG_CORE). %% Add the Erlang built-ins. %% prove_goal(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> %% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase} | @@ -46,152 +46,152 @@ load(Db) -> %% Logic and control. Conjunctions are handled in prove_body and true %% has been compiled away. prove_goal(Param = #param{goal = {call, G}, next_goal = Next0, choice = Cps, - bindings = Bs, var_num = Vn, database = Db}) -> - %% Only add cut CP to Cps if goal contains a cut. - Label = Vn, - case ec_logic:check_goal(G, Next0, Bs, Db, false, Label) of - {Next1, true} -> - %% Must increment Vn to avoid clashes!!! - Cut = #cut{label = Label}, - ec_core:prove_body(Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); - {Next1, false} -> ec_core:prove_body(Param#param{goal = Next1, var_num = Vn + 1}) - end; + bindings = Bs, var_num = Vn, database = Db}) -> + %% Only add cut CP to Cps if goal contains a cut. + Label = Vn, + case ec_logic:check_goal(G, Next0, Bs, Db, false, Label) of + {Next1, true} -> + %% Must increment Vn to avoid clashes!!! + Cut = #cut{label = Label}, + ec_core:prove_body(Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); + {Next1, false} -> ec_core:prove_body(Param#param{goal = Next1, var_num = Vn + 1}) + end; prove_goal(Params = #param{goal = fail}) -> erlog_errors:fail(Params); prove_goal(Param = #param{goal = {'\\+', G}, next_goal = Next0, choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> - %% We effectively implementing \+ G with ( G -> fail ; true ). - Label = Vn, - {Next1, _} = ec_logic:check_goal(G, [{{cut}, Label, true}, fail], Bs, Db, true, Label), - Cp = #cp{type = if_then_else, label = Label, next = Next0, bs = Bs, vn = Vn}, - %%io:fwrite("PG(\\+): ~p\n", [{G1,[Cp|Cps]]), - %% Must increment Vn to avoid clashes!!! - ec_core:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], var_num = Vn + 1}); + %% We effectively implementing \+ G with ( G -> fail ; true ). + Label = Vn, + {Next1, _} = ec_logic:check_goal(G, [{{cut}, Label, true}, fail], Bs, Db, true, Label), + Cp = #cp{type = if_then_else, label = Label, next = Next0, bs = Bs, vn = Vn}, + %%io:fwrite("PG(\\+): ~p\n", [{G1,[Cp|Cps]]), + %% Must increment Vn to avoid clashes!!! + ec_core:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], var_num = Vn + 1}); prove_goal(Param = #param{goal = repeat, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> - Cp = #cp{type = disjunction, next = [repeat | Next], bs = Bs, vn = Vn}, - ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); + Cp = #cp{type = disjunction, next = [repeat | Next], bs = Bs, vn = Vn}, + ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); %% Clause creation and destruction. prove_goal(Param = #param{goal = {abolish, Pi0}, next_goal = Next, bindings = Bs, database = Db}) -> - case ec_support:dderef(Pi0, Bs) of - {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> - erlog_memory:abolish_clauses(Db, {N, A}), - ec_core:prove_body(Param#param{goal = Next}); - Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) - end; + case ec_support:dderef(Pi0, Bs) of + {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> + erlog_memory:abolish_clauses(Db, {N, A}), + ec_core:prove_body(Param#param{goal = Next}); + Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) + end; prove_goal(Param = #param{goal = {Assert, C0}, next_goal = Next, bindings = Bs, database = Db}) - when Assert == assert; Assert == assertz -> - C = ec_support:dderef(C0, Bs), - erlog_memory:assertz_clause(Db, C), - ec_core:prove_body(Param#param{goal = Next}); + when Assert == assert; Assert == assertz -> + C = ec_support:dderef(C0, Bs), + erlog_memory:assertz_clause(Db, C), + ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {asserta, C0}, next_goal = Next, bindings = Bs, database = Db}) -> - C = ec_support:dderef(C0, Bs), - erlog_memory:asserta_clause(Db, C), - ec_core:prove_body(Param#param{goal = Next}); + C = ec_support:dderef(C0, Bs), + erlog_memory:asserta_clause(Db, C), + ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {retract, C0}, bindings = Bs}) -> - C = ec_support:dderef(C0, Bs), - ec_logic:prove_retract(C, Param); + C = ec_support:dderef(C0, Bs), + ec_logic:prove_retract(C, Param); prove_goal(Param = #param{goal = {retractall, C0}, bindings = Bs}) -> - C = ec_support:dderef(C0, Bs), - ec_logic:prove_retractall(C, Param); + C = ec_support:dderef(C0, Bs), + ec_logic:prove_retractall(C, Param); %% Clause retrieval and information prove_goal(Param = #param{goal = {clause, H0, B}, bindings = Bs}) -> - H1 = ec_support:dderef(H0, Bs), - ec_logic:prove_clause(H1, B, Param); + H1 = ec_support:dderef(H0, Bs), + ec_logic:prove_clause(H1, B, Param); prove_goal(Param = #param{goal = {current_predicate, Pi0}, bindings = Bs}) -> - Pi = ec_support:dderef(Pi0, Bs), - ec_logic:prove_current_predicate(Pi, Param); + Pi = ec_support:dderef(Pi0, Bs), + ec_logic:prove_current_predicate(Pi, Param); prove_goal(Param = #param{goal = {predicate_property, H0, P}, bindings = Bs, database = Db}) -> - H = ec_support:dderef(H0, Bs), - case catch erlog_memory:get_procedure_type(Db, ec_support:functor(H)) of - built_in -> ec_body:unify_prove_body(P, built_in, Param); - compiled -> ec_body:unify_prove_body(P, compiled, Param); - interpreted -> ec_body:unify_prove_body(P, interpreted, Param); - undefined -> erlog_errors:fail(Param); - {erlog_error, E} -> erlog_errors:erlog_error(E, Db) - end; + H = ec_support:dderef(H0, Bs), + case catch erlog_memory:get_procedure_type(Db, ec_support:functor(H)) of + built_in -> ec_body:unify_prove_body(P, built_in, Param); + compiled -> ec_body:unify_prove_body(P, compiled, Param); + interpreted -> ec_body:unify_prove_body(P, interpreted, Param); + undefined -> erlog_errors:fail(Param); + {erlog_error, E} -> erlog_errors:erlog_error(E, Db) + end; %% External interface prove_goal(Param = #param{goal = {ecall, C0, Val}, bindings = Bs, database = Db}) -> - %% Build the initial call. - %%io:fwrite("PG(ecall): ~p\n ~p\n ~p\n", [dderef(C0, Bs),Next,Cps]), - Efun = case ec_support:dderef(C0, Bs) of - {':', M, F} when is_atom(M), is_atom(F) -> - fun() -> M:F() end; - {':', M, {F, A}} when is_atom(M), is_atom(F) -> - fun() -> M:F(A) end; - {':', M, {F, A1, A2}} when is_atom(M), is_atom(F) -> - fun() -> M:F(A1, A2) end; - {':', M, T} when is_atom(M), ?IS_FUNCTOR(T) -> - L = tuple_to_list(T), - fun() -> apply(M, hd(L), tl(L)) end; - Fun when is_function(Fun) -> Fun; - Other -> erlog_errors:type_error(callable, Other, Db) - end, - ec_logic:prove_ecall(Efun, Val, Param); + %% Build the initial call. + %%io:fwrite("PG(ecall): ~p\n ~p\n ~p\n", [dderef(C0, Bs),Next,Cps]), + Efun = case ec_support:dderef(C0, Bs) of + {':', M, F} when is_atom(M), is_atom(F) -> + fun() -> M:F() end; + {':', M, {F, A}} when is_atom(M), is_atom(F) -> + fun() -> M:F(A) end; + {':', M, {F, A1, A2}} when is_atom(M), is_atom(F) -> + fun() -> M:F(A1, A2) end; + {':', M, T} when is_atom(M), ?IS_FUNCTOR(T) -> + L = tuple_to_list(T), + fun() -> apply(M, hd(L), tl(L)) end; + Fun when is_function(Fun) -> Fun; + Other -> erlog_errors:type_error(callable, Other, Db) + end, + ec_logic:prove_ecall(Efun, Val, Param); %% Non-standard but useful. prove_goal(Param = #param{goal = {writeln, T}, next_goal = Next, bindings = Bs, event_man = Evman}) -> - %% Display procedure. - Res = ec_support:write(T, Bs), - gen_event:notify(Evman, Res), - ec_core:prove_body(Param#param{goal = Next}); + %% Display procedure. + Res = ec_support:write(T, Bs), + gen_event:notify(Evman, Res), + ec_core:prove_body(Param#param{goal = Next}); %% File utils prove_goal(Param = #param{goal = {consult, Name}, next_goal = Next, bindings = Bs, f_consulter = Fcon, database = Db}) -> - case erlog_file:consult(Fcon, ec_support:dderef(Name, Bs), Db) of - ok -> ok; - {Err, Error} when Err == erlog_error; Err == error -> - erlog_errors:erlog_error(Error, Db) - end, - ec_core:prove_body(Param#param{goal = Next}); + case erlog_file:consult(Fcon, ec_support:dderef(Name, Bs), Db) of + ok -> ok; + {Err, Error} when Err == erlog_error; Err == error -> + erlog_errors:erlog_error(Error, Db) + end, + ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {reconsult, Name}, next_goal = Next, f_consulter = Fcon, database = Db}) -> - case erlog_file:reconsult(Fcon, Name, Db) of - ok -> ok; - {Err, Error} when Err == erlog_error; Err == error -> - erlog_errors:erlog_error(Error, Db) - end, - ec_core:prove_body(Param#param{goal = Next}); + case erlog_file:reconsult(Fcon, Name, Db) of + ok -> ok; + {Err, Error} when Err == erlog_error; Err == error -> + erlog_errors:erlog_error(Error, Db) + end, + ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db}) -> - try Library:load(Db) - catch - _:Error -> - erlog_errors:erlog_error(Error, Db) - end, - ec_core:prove_body(Param#param{goal = Next}); + try Library:load(Db) + catch + _:Error -> + erlog_errors:erlog_error(Error, Db) + end, + ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {listing, Res}, next_goal = Next, bindings = Bs0, database = Db}) -> - Content = erlog_memory:listing(Db, []), - Bs = ec_support:add_binding(Res, Content, Bs0), - ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); + Content = erlog_memory:listing(Db, []), + Bs = ec_support:add_binding(Res, Content, Bs0), + ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); prove_goal(Param = #param{goal = {listing, Pred, Res}, next_goal = Next, bindings = Bs0, database = Db}) -> - Content = erlog_memory:listing(Db, [Pred]), - Bs = ec_support:add_binding(Res, Content, Bs0), - ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); + Content = erlog_memory:listing(Db, [Pred]), + Bs = ec_support:add_binding(Res, Content, Bs0), + ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); prove_goal(Param = #param{goal = {listing, Pred, Arity, Res}, next_goal = Next, bindings = Bs0, database = Db}) -> - Content = erlog_memory:listing(Db, [Pred, Arity]), - Bs = ec_support:add_binding(Res, Content, Bs0), - ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); + Content = erlog_memory:listing(Db, [Pred, Arity]), + Bs = ec_support:add_binding(Res, Content, Bs0), + ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); prove_goal(Param = #param{goal = {findall, T, G, B}}) -> %findall start - ec_logic:prove_findall(T, G, B, Param); + ec_logic:prove_findall(T, G, B, Param); prove_goal(Param = #param{goal = {findall, Tag, T0}, bindings = Bs, database = Db}) -> %findall finish - T1 = ec_support:dderef(T0, Bs), - erlog_memory:raw_append(Db, Tag, T1), %Append to saved list - erlog_errors:fail(Param); + T1 = ec_support:dderef(T0, Bs), + erlog_memory:raw_append(Db, Tag, T1), %Append to saved list + erlog_errors:fail(Param); prove_goal(Param = #param{goal = {bagof, Goal, Fun, Res}, choice = Cs0, bindings = Bs0, next_goal = Next, var_num = Vn, database = Db}) -> - Predicates = erlog_memory:finadll(Db, Fun), - FunList = tuple_to_list(Fun), - ResultDict = ec_support:collect_alternatives(Goal, FunList, Predicates), - Collected = dict:fetch_keys(ResultDict), - [UBs | Choises] = lists:foldr( - fun(Key, Acc) -> - UpdBs0 = ec_support:update_result(Key, ResultDict, Res, Bs0), - UpdBs1 = ec_support:update_vars(Goal, FunList, Key, UpdBs0), - [#cp{type = disjunction, label = Fun, next = Next, bs = UpdBs1, vn = Vn} | Acc] - end, Cs0, Collected), - ec_core:prove_body(Param#param{goal = Next, bindings = UBs#cp.bs, choice = Choises, var_num = Vn + length(Choises)}); + Predicates = erlog_memory:finadll(Db, Fun), + FunList = tuple_to_list(Fun), + ResultDict = ec_support:collect_alternatives(Goal, FunList, Predicates), + Collected = dict:fetch_keys(ResultDict), + [UBs | Choises] = lists:foldr( + fun(Key, Acc) -> + UpdBs0 = ec_support:update_result(Key, ResultDict, Res, Bs0), + UpdBs1 = ec_support:update_vars(Goal, FunList, Key, UpdBs0), + [#cp{type = disjunction, label = Fun, next = Next, bs = UpdBs1, vn = Vn} | Acc] + end, Cs0, Collected), + ec_core:prove_body(Param#param{goal = Next, bindings = UBs#cp.bs, choice = Choises, var_num = Vn + length(Choises)}); prove_goal(Param = #param{goal = {to_integer, NumV, Res}, next_goal = Next, bindings = Bs0}) -> - Num = ec_support:dderef(NumV, Bs0), - case catch (ec_logic:parse_int(Num)) of - Int when is_integer(Int) -> - Bs = ec_support:add_binding(Res, Int, Bs0), - ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); - _ -> erlog_errors:fail(Param) - end; + Num = ec_support:dderef(NumV, Bs0), + case catch (ec_logic:parse_int(Num)) of + Int when is_integer(Int) -> + Bs = ec_support:add_binding(Res, Int, Bs0), + ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); + _ -> erlog_errors:fail(Param) + end; prove_goal(Param = #param{goal = {to_string, VarV, Res}, next_goal = Next, bindings = Bs0}) -> - Var = ec_support:dderef(VarV, Bs0), - Bs = ec_support:add_binding(Res, ec_logic:to_string(Var), Bs0), - ec_core:prove_body(Param#param{goal = Next, bindings = Bs}). + Var = ec_support:dderef(VarV, Bs0), + Bs = ec_support:add_binding(Res, ec_logic:to_string(Var), Bs0), + ec_core:prove_body(Param#param{goal = Next, bindings = Bs}). From 7463707322814187b174ecf509dc31116fe4700d Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 23 Sep 2014 10:32:23 +0000 Subject: [PATCH 142/251] update docs, improve debugger --- README.md | 13 ++--- doc/debugger.md | 54 +++++++++++++++++++ doc/libraries.md | 36 ++++++++++++- src/core/logic/ec_core.erl | 26 ++++----- .../debugger/erlog_simple_debugger.erl | 22 ++++---- src/interface/local/erlog_local_shell.erl | 4 +- 6 files changed, 116 insertions(+), 39 deletions(-) create mode 100644 doc/debugger.md diff --git a/README.md b/README.md index 99cd740..1f25ad4 100644 --- a/README.md +++ b/README.md @@ -35,6 +35,7 @@ As an example you can use `erlog_simple_debugger` with `erlog_local_shell`: {ok, Pid} = erlog_simple_debugger:start_link(). erlog_local_shell:start(Pid). +More in [docs](https://github.com/comtihon/erlog/blob/master/doc/debugger.md "debugger"). #### Processing prolog code from erlang: ##### Starting @@ -103,7 +104,7 @@ All debug events from such debug functions as `writeln/1` will be passed there. See `erlog_simple_printer` as a default implementation of console printer as an example, or `erlog_remote_eh`, which is intended to print debug to remote client. To configure your gen_event module - just pass module and arguments as __event_h__ in configuration: - ConfList = [{event_h, {my_event_handler, Args}], + ConfList = [{event_h, {my_event_handler, Args}}], erlog:start_link(ConfList). #### Working with libraries: @@ -129,11 +130,5 @@ remember, that two execution requests can be processed on different erlog instan some_lib_fun(some_val). %returns false In this example system erlog gen server is created one per one separate command (F.e. http request). Firstly - library `some_lib` is loaded. Than erlog server with loaded library is destroyed (as request is complete) and for another request -`some_lib_fun(some_val)` another erlog server is created, but, without loaded library. -##### Auto loading external libraries on start -For convenient libraries usage you can load all libraries you need when creating a core. It will let you not to call `use/1` -everywhere in your code. Just add param `{libraries, [my_first_lib, my second_lib]}` in your params when starting a core: - - ConfList = [{libraries, [my_first_lib, my second_lib]}], - erlog:start_link(ConfList). -All libraries from array will be loaded. \ No newline at end of file +`some_lib_fun(some_val)` another erlog server is created, but, without loaded library. +More in [docs](https://github.com/comtihon/erlog/blob/master/doc/libraries.md "libraries"). \ No newline at end of file diff --git a/doc/debugger.md b/doc/debugger.md new file mode 100644 index 0000000..0dc6492 --- /dev/null +++ b/doc/debugger.md @@ -0,0 +1,54 @@ +### Using debugger +Debugger is started in `listing` mode by default. Listing just log every goal call and memory after previous call. For +more efficient usage - stop points can be added. + +#### Stopping with counter +To stop commands execution after N executed commands - configure debugger with `next N`, where N is a positive integer. +After N goals code execution will be stopped and you will be asked again to configure debugger. +Example: + + 1> {ok, Pid} = erlog_simple_debugger:start_link(). + {ok,<0.34.0>} + 2> erlog_simple_debugger:configure(Pid). + Select action + | ?- next 5 + ok + 3> erlog_local_shell:start(Pid). + Erlog Shell V6.1 with debugger (abort with ^G)ert(foo(a,b)), foo(a,b), writeln("world"). + Skip {call,{',',{assert,{foo,a,c}}, + | ?- assert(foo(a,c)), writeln("hello"), retract(foo(a,c)), ass + {',',{writeln,"hello"}, + {',',{retract,{foo,a,c}}, + {',',{assert,{foo,a,b}}, + {',',{foo,a,b},{writeln,"world"}}}}}}} + Skip {assert,{foo,a,c}} + Skip {writeln,"hello"} + Skip {retract,{foo,a,c}} + Erlog debugger stopped execution on command {assert,{foo,a,b}} with memory: []. + Select action + +#### Stopping with goal +To stop commands execution after special command (breakpoint) - configure debugger with `stop G`, where G is a prolog term. +When such goal will be executed - debugger will stop code execution and ask you for next configuration. If you want to skip +all code up to an end - just use `listing`. +Example: + + 1> {ok, Pid} = erlog_simple_debugger:start_link(). + {ok,<0.34.0>} + 2> erlog_simple_debugger:configure(Pid). + Select action + | ?- stop {assert,{foo,a,b}} + ok + 3> erlog_local_shell:start(Pid). + Erlog Shell V6.1 with debugger (abort with ^G) + | ?- assert(foo(a,c)), writeln("hello"), retract(foo(a,c)), assert(foo(a,b)), foo(a,b), writeln("world"). + Skip {call,{',',{assert,{foo,a,c}}, + {',',{writeln,"hello"}, + {',',{retract,{foo,a,c}}, + {',',{assert,{foo,a,b}}, + {',',{foo,a,b},{writeln,"world"}}}}}}} + Skip {assert,{foo,a,c}} + Skip {writeln,"hello"} + Skip {retract,{foo,a,c}} + Erlog debugger stopped execution on command {assert,{foo,a,b}} with memory: []. + Select action \ No newline at end of file diff --git a/doc/libraries.md b/doc/libraries.md index 004e3e6..02b9f66 100644 --- a/doc/libraries.md +++ b/doc/libraries.md @@ -25,4 +25,38 @@ are defined in `*.hrl` files as compiled: `Module` - is the erlang module, where processing function is defined, `Function` - is erlang processing function. External libraries are load into memory on demand, by calling `use(LibName)` function, where LibName is the name of the -erlang module with exlib behaviour. \ No newline at end of file +erlang module with exlib behaviour. + +### Library autoload +For convenient libraries usage you can load all libraries you need when creating a core. It will let you not to call `use/1` +everywhere in your code. Just add param `{libraries, [my_first_lib, my second_lib]}` in your params when starting a core: + + ConfList = [{libraries, [my_first_lib, my second_lib]}], + erlog:start_link(ConfList). +All libraries from array will be loaded. + +### Writing your own libraries +You can write your own external libraries. For doing so - just setup behaviour `erlog_exlib`. It has one callback function +`load(Db)` for initialisation library. Then you should define your execution functions. See __External libraries__ for +instructions of library execution functions format. +Example: +_File `erlog_uid.hrl`_ + + -define(ERLOG_UID, + [ + {{id, 1}, ?MODULE, id_1} + ]). +_File `erlog_uid.erl`_ + + -behaviour(erlog_exlib). + -include("ep_uuid.hrl"). + -include("erlog_core.hrl"). + + -export([load/1, id_1/1]). + + load(Db) -> + lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_UID). + + id_1(Params = #param{goal = {id, Res}, next_goal = Next, bindings = Bs0}) -> + Bs = ec_support:add_binding(Res, binary_to_list(uuid:generate()), Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). \ No newline at end of file diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index f539aff..668a2c4 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -33,8 +33,9 @@ prove_goal(Goal0, Db, Fcon, Event, Deb) -> %% Prove the goals in a body. Remove the first goal and try to prove %% it. Return when there are no more goals. This is how proving a %% goal/body succeeds. -prove_body(Params = #param{goal = [G | Gs]}) -> %TODO use lists:foldr instead! +prove_body(Params = #param{goal = [G | Gs], debugger = Deb, bindings = Bs}) -> %TODO use lists:foldr instead! %%io:fwrite("PB: ~p\n", [{G,Gs,Cps}]), + Deb(ok, ec_support:dderef(G, Bs), Bs), prove_goal(Params#param{goal = G, next_goal = Gs}); prove_body(#param{goal = [], choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> %%io:fwrite("Cps: ~p\nCut: ~p\nVar: ~p\nVar: ~p\n", @@ -71,24 +72,17 @@ prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bi %% There is no L here, it has already been prepended to Next. Cp = #cp{type = disjunction, next = R, bs = Bs, vn = Vn}, prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); -prove_goal(Param = #param{goal = G, database = Db, bindings = Bs, debugger = Deb}) -> +prove_goal(Param = #param{goal = G, database = Db}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), - try - Res = case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of - {built_in, Mod} -> Mod:prove_goal(Param); %kernel space - {code, {Mod, Func}} -> Mod:Func(Param); %library space - {clauses, Cs} -> prove_goal_clauses(Cs, Param); %user space - undefined -> erlog_errors:fail(Param); - {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data - end, - Deb(ok, ec_support:dderef(G, Bs), Res), - Res - catch - throw:M -> - Deb(fail, ec_support:dderef(G, Bs), M), - throw(M) + case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of + {built_in, Mod} -> Mod:prove_goal(Param); %kernel space + {code, {Mod, Func}} -> Mod:Func(Param); %library space + {clauses, Cs} -> prove_goal_clauses(Cs, Param); %user space + undefined -> erlog_errors:fail(Param); + {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data end. + %% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to prove Goal using Clauses which all have the same functor. diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl index 4dddc27..3049ae5 100644 --- a/src/interface/debugger/erlog_simple_debugger.erl +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -86,26 +86,25 @@ init([]) -> handle_call(conf, _From, State) -> Policy = process_action(), {reply, ok, State#state{policy = Policy}}; -handle_call({_, Functor, Result}, _From, State = #state{policy = {stop, Pred}}) -> %stopping +handle_call({_, Functor, Vars}, _From, State = #state{policy = {stop, Pred}}) -> %stopping Polisy = case lists:flatten(io_lib:format("~p", [Functor])) of Pred -> - io:fwrite("Erlog debugger stopped execution on command ~s with result ~p.~n", [Pred, process_reply(Result)]), + io:fwrite("Erlog debugger stopped execution on command ~s with memory: ~p.~n", [Pred, process_reply(Vars)]), process_action(); Other -> - io:format("~p - ~p ~p~n", [Pred, Other, Pred == Other]), io:format("Skip ~s~n", [Other]), {stop, Pred} end, {reply, ok, State#state{policy = Polisy}}; -handle_call({_, Functor, Result}, _From, State = #state{policy = {next, N}}) when N =< 1 -> %counting steps ending - io:fwrite("Erlog debugger stopped execution on command ~p with result ~p.~n", [Functor, process_reply(Result)]), +handle_call({_, Functor, Vars}, _From, State = #state{policy = {next, N}}) when N =< 1 -> %counting steps ending + io:fwrite("Erlog debugger stopped execution on command ~p with memory: ~p.~n", [Functor, process_reply(Vars)]), Policy = process_action(), {reply, ok, State#state{policy = Policy}}; handle_call({_, Functor, _}, _From, State = #state{policy = {next, N}}) -> %counting steps io:fwrite("Skip ~p~n", [Functor]), {reply, ok, State#state{policy = {next, N - 1}}}; -handle_call({_Res, Functor, Result}, _From, State) -> %listing - io:format("Execute ~p, got ~p~n", [Functor, process_reply(Result)]), +handle_call({_Res, Functor, Vars}, _From, State) -> %listing + io:format("Execute ~p, memory: ~p~n", [Functor, process_reply(Vars)]), {reply, ok, State}; handle_call(_Request, _From, State) -> {reply, ok, State}. @@ -174,13 +173,12 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== %%% Internal functions %%%=================================================================== -process_reply({fail, _}) -> "false"; -process_reply({succeed, _, Dict, _, _}) -> +process_reply(Dict) -> case dict:is_empty(Dict) of - true -> "true"; + true -> []; false -> Keys = dict:fetch_keys(Dict), - {"true : ", lists:foldl( + lists:foldl( fun(Key, Res) -> case dict:find(Key, Dict) of {ok, {K}} -> @@ -188,7 +186,7 @@ process_reply({succeed, _, Dict, _, _}) -> [{Key, V} | Res]; _ -> Res end - end, [], Keys)} + end, [], Keys) end. %% @private diff --git a/src/interface/local/erlog_local_shell.erl b/src/interface/local/erlog_local_shell.erl index 5a31ee9..de82a77 100644 --- a/src/interface/local/erlog_local_shell.erl +++ b/src/interface/local/erlog_local_shell.erl @@ -31,7 +31,9 @@ start(Debugger) -> io:fwrite("Erlog Shell V~s with debugger (abort with ^G)\n", [erlang:system_info(version)]), {ok, Core} = erlog:start_link( - [{debugger, fun(Status, Functor, Result) -> gen_server:call(Debugger, {Status, Functor, Result}, infinity) end}]), + [ + {event_h, {erlog_simple_printer, []}}, + {debugger, fun(Status, Functor, Result) -> gen_server:call(Debugger, {Status, Functor, Result}, infinity) end}]), {ok, _} = erlog_db_storage:start_link(), %start default ets-implementation of stand-alone database-module server_loop(Core, normal, []). From 7634da7bbc7af5502c76a02d23212bd8881c38e0 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 23 Sep 2014 14:33:51 +0000 Subject: [PATCH 143/251] change erlog_memory for cursor usage --- src/core/logic/ec_core.erl | 4 +- src/storage/erlog_memory.erl | 248 +++++++++++++++++++---------------- 2 files changed, 140 insertions(+), 112 deletions(-) diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index 668a2c4..2e29ba5 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -86,6 +86,7 @@ prove_goal(Param = #param{goal = G, database = Db}) -> %% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to prove Goal using Clauses which all have the same functor. +prove_goal_clauses([], Param) -> erlog_errors:fail(Param); prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> %% Must be smart here and test whether we need to add a cut point. %% C has the structure {Tag,Head,{Body,BodyHasCut}}. @@ -99,8 +100,7 @@ prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> %% prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db); prove_goal_clauses([C | Cs], Params = #param{goal = G, next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps}) -> Cp = #cp{type = goal_clauses, label = Vn, data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, - prove_goal_clause(C, Params#param{choice = [Cp | Cps]}); -prove_goal_clauses([], Param) -> erlog_errors:fail(Param). + prove_goal_clause(C, Params#param{choice = [Cp | Cps]}). prove_goal_clause({_Tag, H0, {B0, _}}, Param = #param{goal = G, next_goal = Next, bindings = Bs0, var_num = Vn0}) -> %% io:fwrite("PGC1: ~p\n", [{G,H0,B0}]), diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 5d1ed77..5eb2efe 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -13,53 +13,56 @@ %% API -export([start_link/1, - start_link/2, - load_library_space/2, - assertz_clause/3, - asserta_clause/3, - retract_clause/3, - abolish_clauses/2, - get_procedure/2, - get_procedure_type/2, - get_interp_functors/1, - assertz_clause/2, - asserta_clause/2, - finadll/2, - raw_store/3, - raw_fetch/2, - raw_append/3, - raw_erase/2, - listing/2]). + start_link/2, + load_library_space/2, + assertz_clause/3, + asserta_clause/3, + retract_clause/3, + abolish_clauses/2, + get_procedure/2, + get_procedure_type/2, + get_interp_functors/1, + assertz_clause/2, + asserta_clause/2, + finadll/2, + raw_store/3, + raw_fetch/2, + raw_append/3, + raw_erase/2, + listing/2, + next/1]). -export([db_assertz_clause/3, - db_assertz_clause/4, - db_asserta_clause/4, - db_asserta_clause/3, - db_retract_clause/4, - db_abolish_clauses/3, - get_db_procedure/3, - db_findall/3, - db_listing/3]). + db_assertz_clause/4, + db_asserta_clause/4, + db_asserta_clause/3, + db_retract_clause/4, + db_abolish_clauses/3, + get_db_procedure/3, + db_findall/3, + db_listing/3, + db_next/1]). -export([load_kernel_space/3]). %% gen_server callbacks -export([init/1, - handle_call/3, - handle_cast/2, - handle_info/2, - terminate/2, - code_change/3]). + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). -define(SERVER, ?MODULE). -record(state, { - stdlib :: dict, %kernel-space memory - exlib :: dict, %library-space memory - database :: atom(), % callback module for user-space memory - in_mem :: dict, %integrated memory for findall operations - state :: term() % callback state + stdlib :: dict, %kernel-space memory + exlib :: dict, %library-space memory + database :: atom(), % callback module for user-space memory + in_mem :: dict, %integrated memory for findall operations + state :: term(), % callback state + cursors :: {pid(), pid()} %cursors for db and normal operations }). %%%=================================================================== @@ -79,7 +82,7 @@ assertz_clause(Database, Head, Body) -> gen_server:call(Database, {assertz_claus db_assertz_clause(Database, Collection, {':-', Head, Body}) -> db_assertz_clause(Database, Collection, Head, Body); db_assertz_clause(Database, Collection, Head) -> db_assertz_clause(Database, Collection, Head, true). db_assertz_clause(Database, Collection, Head, Body) -> - gen_server:call(Database, {assertz_clause, {Collection, Head, Body}}). + gen_server:call(Database, {assertz_clause, {Collection, Head, Body}}). asserta_clause(Database, {':-', H, B}) -> asserta_clause(Database, H, B); asserta_clause(Database, H) -> asserta_clause(Database, H, true). @@ -88,11 +91,14 @@ asserta_clause(Database, Head, Body) -> gen_server:call(Database, {asserta_claus db_asserta_clause(Database, Collection, {':-', H, B}) -> db_asserta_clause(Database, Collection, H, B); db_asserta_clause(Database, Collection, H) -> db_asserta_clause(Database, Collection, H, true). db_asserta_clause(Database, Collection, Head, Body) -> - gen_server:call(Database, {asserta_clause, {Collection, Head, Body}}). + gen_server:call(Database, {asserta_clause, {Collection, Head, Body}}). db_findall(Database, Collection, Fun) -> gen_server:call(Database, {findall, {Collection, Fun}}). finadll(Database, Fun) -> gen_server:call(Database, {findall, {Fun}}). +db_next(Database) -> gen_server:call(Database, db_next). +next(Database) -> gen_server:call(Database, next). + retract_clause(Database, F, Ct) -> gen_server:call(Database, {retract_clause, {F, Ct}}). db_retract_clause(Database, Collection, F, Ct) -> gen_server:call(Database, {retract_clause, {Collection, F, Ct}}). @@ -125,15 +131,15 @@ db_listing(Database, Collection, Args) -> gen_server:call(Database, {listing, {C %% @end %%-------------------------------------------------------------------- -spec(start_link(Database :: atom()) -> - {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). + {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). start_link(Database) -> - gen_server:start_link(?MODULE, [Database], []). + gen_server:start_link(?MODULE, [Database], []). -spec(start_link(Database :: atom(), Params :: list() | atom()) -> - {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). + {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). start_link(Database, undefined) -> - start_link(Database); + start_link(Database); start_link(Database, Params) -> - gen_server:start_link(?MODULE, [Database, Params], []). + gen_server:start_link(?MODULE, [Database, Params], []). %%%=================================================================== %%% gen_server callbacks @@ -151,14 +157,14 @@ start_link(Database, Params) -> %% @end %%-------------------------------------------------------------------- -spec(init(Args :: term()) -> - {ok, State :: #state{}} | {ok, State :: #state{}, timeout() | hibernate} | - {stop, Reason :: term()} | ignore). + {ok, State :: #state{}} | {ok, State :: #state{}, timeout() | hibernate} | + {stop, Reason :: term()} | ignore). init([Database]) when is_atom(Database) -> - {ok, State} = Database:new(), - {ok, init_memory(#state{database = Database, state = State})}; + {ok, State} = Database:new(), + {ok, init_memory(#state{database = Database, state = State})}; init([Database, Params]) when is_atom(Database) -> - {ok, State} = Database:new(Params), - {ok, init_memory(#state{database = Database, state = State})}. + {ok, State} = Database:new(Params), + {ok, init_memory(#state{database = Database, state = State})}. %%-------------------------------------------------------------------- %% @private @@ -168,51 +174,73 @@ init([Database, Params]) when is_atom(Database) -> %% @end %%-------------------------------------------------------------------- -spec(handle_call(Request :: term(), From :: {pid(), Tag :: term()}, - State :: #state{}) -> - {reply, Reply :: term(), NewState :: #state{}} | - {reply, Reply :: term(), NewState :: #state{}, timeout() | hibernate} | - {noreply, NewState :: #state{}} | - {noreply, NewState :: #state{}, timeout() | hibernate} | - {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | - {stop, Reason :: term(), NewState :: #state{}}). + State :: #state{}) -> + {reply, Reply :: term(), NewState :: #state{}} | + {reply, Reply :: term(), NewState :: #state{}, timeout() | hibernate} | + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | + {stop, Reason :: term(), NewState :: #state{}}). handle_call({load_kernel_space, {Module, Functor}}, _From, State = #state{stdlib = StdLib}) -> %load kernel space into memory - UStdlib = dict:store(Functor, {built_in, Module}, StdLib), - {reply, ok, State#state{stdlib = UStdlib}}; + UStdlib = dict:store(Functor, {built_in, Module}, StdLib), + {reply, ok, State#state{stdlib = UStdlib}}; handle_call({load_library_space, {{Functor, M, F}}}, _From, State = #state{database = Db, stdlib = StdLib, exlib = ExLib}) -> %load library space into memory - UExlib = case dict:is_key(Functor, StdLib) of - true -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - false -> - dict:store(Functor, {code, {M, F}}, ExLib) - end, - {reply, ok, State#state{exlib = UExlib}}; + UExlib = case dict:is_key(Functor, StdLib) of + true -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + false -> + dict:store(Functor, {code, {M, F}}, ExLib) + end, + {reply, ok, State#state{exlib = UExlib}}; handle_call({raw_store, {Key, Value}}, _From, State = #state{in_mem = InMem}) -> %findall store - Umem = store(Key, Value, InMem), - {reply, ok, State#state{in_mem = Umem}}; + Umem = store(Key, Value, InMem), + {reply, ok, State#state{in_mem = Umem}}; handle_call({raw_fetch, {Key}}, _From, State = #state{in_mem = InMem}) -> %findall fetch - Res = fetch(Key, InMem), - {reply, Res, State}; + Res = fetch(Key, InMem), + {reply, Res, State}; handle_call({raw_append, {Key, AppendValue}}, _From, State = #state{in_mem = InMem}) -> %findall append - Value = fetch(Key, InMem), - Umem = store(Key, lists:concat([Value, [AppendValue]]), InMem), - {reply, ok, State#state{in_mem = Umem}}; + Value = fetch(Key, InMem), + Umem = store(Key, lists:concat([Value, [AppendValue]]), InMem), + {reply, ok, State#state{in_mem = Umem}}; handle_call({raw_erase, {Key}}, _From, State = #state{in_mem = InMem}) -> %findall erase - Umem = dict:erase(Key, InMem), - {reply, ok, State#state{in_mem = Umem}}; + Umem = dict:erase(Key, InMem), + {reply, ok, State#state{in_mem = Umem}}; handle_call({abolish_clauses, {Func}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module - {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, {Func}), - {reply, Res, State#state{state = NewState, exlib = UpdExlib}}; + {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, {Func}), + {reply, Res, State#state{state = NewState, exlib = UpdExlib}}; handle_call({abolish_clauses, {_, Func} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module - {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, Params), - {reply, Res, State#state{state = NewState, exlib = UpdExlib}}; + {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, Params), + {reply, Res, State#state{state = NewState, exlib = UpdExlib}}; +handle_call({get_procedure, {Func}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, + exlib = ExLib, cursors = {Core, External}}) -> + Db:close(Core), %close old cursor + {UCore, {Res, UState}} = case Db:get_procedure({StdLib, ExLib, DbState}, {Func}) of %take new cursor if needed + {Cursor, Res} when is_pid(Cursor) -> {Cursor, Res}; + Other -> {Core, Other} + end, + {reply, Res, State#state{state = UState, cursors = {UCore, External}}}; +handle_call({get_procedure, {Collection, Func}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, + exlib = ExLib, cursors = {Core, External}}) -> + Db:close(External), %close old cursor + {UExternal, {Res, UState}} = case Db:get_procedure({StdLib, ExLib, DbState}, {Collection, Func}) of %take new cursor if needed + {Cursor, Res} when is_pid(Cursor) -> {Cursor, Res}; + Other -> {External, Other} + end, + {reply, Res, State#state{state = UState, cursors = {Core, UExternal}}}; +handle_call(next, _From, State = #state{database = Db, cursors = {Core, _}}) -> %get next result by cursor + {Res, NewState} = Db:next(Core), + {reply, Res, State#state{state = NewState}}; +handle_call(db_next, _From, State = #state{database = Db, cursors = {_, External}}) -> %get next result by cursor + {Res, NewState} = Db:next(External), + {reply, Res, State#state{state = NewState}}; handle_call({Fun, Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module - {Res, NewState} = Db:Fun({StdLib, ExLib, DbState}, Params), - {reply, Res, State#state{state = NewState}}; + {Res, NewState} = Db:Fun({StdLib, ExLib, DbState}, Params), + {reply, Res, State#state{state = NewState}}; handle_call(Fun, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module - {Res, NewState} = Db:Fun({StdLib, ExLib, DbState}), - {reply, Res, State#state{state = NewState}}; + {Res, NewState} = Db:Fun({StdLib, ExLib, DbState}), + {reply, Res, State#state{state = NewState}}; handle_call(_Request, _From, State) -> - {reply, ok, State}. + {reply, ok, State}. %%-------------------------------------------------------------------- %% @private @@ -222,13 +250,13 @@ handle_call(_Request, _From, State) -> %% @end %%-------------------------------------------------------------------- -spec(handle_cast(Request :: term(), State :: #state{}) -> - {noreply, NewState :: #state{}} | - {noreply, NewState :: #state{}, timeout() | hibernate} | - {stop, Reason :: term(), NewState :: #state{}}). + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), NewState :: #state{}}). handle_cast(halt, State) -> - {stop, normal, State}; + {stop, normal, State}; handle_cast(_Request, State) -> - {noreply, State}. + {noreply, State}. %%-------------------------------------------------------------------- %% @private @@ -241,11 +269,11 @@ handle_cast(_Request, State) -> %% @end %%-------------------------------------------------------------------- -spec(handle_info(Info :: timeout() | term(), State :: #state{}) -> - {noreply, NewState :: #state{}} | - {noreply, NewState :: #state{}, timeout() | hibernate} | - {stop, Reason :: term(), NewState :: #state{}}). + {noreply, NewState :: #state{}} | + {noreply, NewState :: #state{}, timeout() | hibernate} | + {stop, Reason :: term(), NewState :: #state{}}). handle_info(_Info, State) -> - {noreply, State}. + {noreply, State}. %%-------------------------------------------------------------------- %% @private @@ -259,9 +287,9 @@ handle_info(_Info, State) -> %% @end %%-------------------------------------------------------------------- -spec(terminate(Reason :: (normal | shutdown | {shutdown, term()} | term()), - State :: #state{}) -> term()). + State :: #state{}) -> term()). terminate(_Reason, _State) -> - ok. + ok. %%-------------------------------------------------------------------- %% @private @@ -272,10 +300,10 @@ terminate(_Reason, _State) -> %% @end %%-------------------------------------------------------------------- -spec(code_change(OldVsn :: term() | {down, term()}, State :: #state{}, - Extra :: term()) -> - {ok, NewState :: #state{}} | {error, Reason :: term()}). + Extra :: term()) -> + {ok, NewState :: #state{}} | {error, Reason :: term()}). code_change(_OldVsn, State, _Extra) -> - {ok, State}. + {ok, State}. %%%=================================================================== %%% Internal functions @@ -284,23 +312,23 @@ code_change(_OldVsn, State, _Extra) -> %% Initialises three dicts for kernel, library memory and in_memory for findall operations -spec init_memory(State :: #state{}) -> UpdState :: #state{}. init_memory(State) -> - D = dict:new(), - State#state{stdlib = D, exlib = D, in_mem = D}. + D = dict:new(), + State#state{stdlib = D, exlib = D, in_mem = D}. fetch(Key, Memory) -> - case dict:find(Key, Memory) of - error -> []; - {ok, Value} -> Value - end. + case dict:find(Key, Memory) of + error -> []; + {ok, Value} -> Value + end. store(Key, Value, Memory) -> - dict:store(Key, Value, Memory). + dict:store(Key, Value, Memory). check_abolish(Func, StdLib, ExLib, Db, DbState, Params) -> - case dict:erase(Func, ExLib) of - ExLib -> %dict not changed - was not deleted. Search userspace - {Res, NewState} = Db:abolish_clauses({StdLib, ExLib, DbState}, Params), - {ExLib, NewState, Res}; - UExlib -> %dict changed -> was deleted - {UExlib, DbState, ok} - end. \ No newline at end of file + case dict:erase(Func, ExLib) of + ExLib -> %dict not changed - was not deleted. Search userspace + {Res, NewState} = Db:abolish_clauses({StdLib, ExLib, DbState}, Params), + {ExLib, NewState, Res}; + UExlib -> %dict changed -> was deleted + {UExlib, DbState, ok} + end. \ No newline at end of file From ed834997be8dc05324a324115187e37844586a83 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 23 Sep 2014 22:53:46 +0000 Subject: [PATCH 144/251] refactoring of ec_core --- src/core/logic/ec_core.erl | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index 668a2c4..b9bcd3d 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -77,7 +77,9 @@ prove_goal(Param = #param{goal = G, database = Db}) -> case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of {built_in, Mod} -> Mod:prove_goal(Param); %kernel space {code, {Mod, Func}} -> Mod:Func(Param); %library space - {clauses, Cs} -> prove_goal_clauses(Cs, Param); %user space + {clauses, Cs} -> + io:format("clauses ~p~n", [Cs]), + prove_goal_clauses(Cs, Param); %user space undefined -> erlog_errors:fail(Param); {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data end. @@ -87,6 +89,7 @@ prove_goal(Param = #param{goal = G, database = Db}) -> %% void. %% Try to prove Goal using Clauses which all have the same functor. prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> + io:format("clause ~p~n", [C]), %% Must be smart here and test whether we need to add a cut point. %% C has the structure {Tag,Head,{Body,BodyHasCut}}. case element(2, element(3, C)) of @@ -98,18 +101,23 @@ prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> end; %% prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db); prove_goal_clauses([C | Cs], Params = #param{goal = G, next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps}) -> + io:format("clause ~p~n", [C]), Cp = #cp{type = goal_clauses, label = Vn, data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, prove_goal_clause(C, Params#param{choice = [Cp | Cps]}); -prove_goal_clauses([], Param) -> erlog_errors:fail(Param). +prove_goal_clauses([], Param) -> + io:format("empty~n"), + erlog_errors:fail(Param). prove_goal_clause({_Tag, H0, {B0, _}}, Param = #param{goal = G, next_goal = Next, bindings = Bs0, var_num = Vn0}) -> %% io:fwrite("PGC1: ~p\n", [{G,H0,B0}]), + io:format("prove goal clause ~p~n", [G]), Label = Vn0, case ec_unify:unify_head(G, H0, Bs0, Vn0 + 1) of {succeed, Rs0, Bs1, Vn1} -> %% io:fwrite("PGC2: ~p\n", [{Rs0}]), {B1, _Rs2, Vn2} = ec_body:body_instance(B0, Next, Rs0, Vn1, Label), %% io:fwrite("PGC3: ~p\n", [{B1,Next,Cps}]), + io:format("prove body ~p~n", [B1]), ec_core:prove_body(Param#param{goal = B1, bindings = Bs1, var_num = Vn2}); - fail -> erlog_errors:fail(Param) + fail -> io:format("prove fail~n"), erlog_errors:fail(Param) end. \ No newline at end of file From 9e4621d952df272e80bd137bf178929e4e130472 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 23 Sep 2014 23:27:04 +0000 Subject: [PATCH 145/251] fix debugger empty vars --- src/core/logic/ec_core.erl | 8 +---- .../debugger/erlog_simple_debugger.erl | 32 ++++++++++++------- 2 files changed, 22 insertions(+), 18 deletions(-) diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index b9bcd3d..fc3f488 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -78,7 +78,6 @@ prove_goal(Param = #param{goal = G, database = Db}) -> {built_in, Mod} -> Mod:prove_goal(Param); %kernel space {code, {Mod, Func}} -> Mod:Func(Param); %library space {clauses, Cs} -> - io:format("clauses ~p~n", [Cs]), prove_goal_clauses(Cs, Param); %user space undefined -> erlog_errors:fail(Param); {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data @@ -89,7 +88,6 @@ prove_goal(Param = #param{goal = G, database = Db}) -> %% void. %% Try to prove Goal using Clauses which all have the same functor. prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> - io:format("clause ~p~n", [C]), %% Must be smart here and test whether we need to add a cut point. %% C has the structure {Tag,Head,{Body,BodyHasCut}}. case element(2, element(3, C)) of @@ -101,23 +99,19 @@ prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> end; %% prove_goal_clause(G, C, Next, Cps, Bs, Vn, Db); prove_goal_clauses([C | Cs], Params = #param{goal = G, next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps}) -> - io:format("clause ~p~n", [C]), Cp = #cp{type = goal_clauses, label = Vn, data = {G, Cs}, next = Next, bs = Bs, vn = Vn}, prove_goal_clause(C, Params#param{choice = [Cp | Cps]}); prove_goal_clauses([], Param) -> - io:format("empty~n"), erlog_errors:fail(Param). prove_goal_clause({_Tag, H0, {B0, _}}, Param = #param{goal = G, next_goal = Next, bindings = Bs0, var_num = Vn0}) -> %% io:fwrite("PGC1: ~p\n", [{G,H0,B0}]), - io:format("prove goal clause ~p~n", [G]), Label = Vn0, case ec_unify:unify_head(G, H0, Bs0, Vn0 + 1) of {succeed, Rs0, Bs1, Vn1} -> %% io:fwrite("PGC2: ~p\n", [{Rs0}]), {B1, _Rs2, Vn2} = ec_body:body_instance(B0, Next, Rs0, Vn1, Label), %% io:fwrite("PGC3: ~p\n", [{B1,Next,Cps}]), - io:format("prove body ~p~n", [B1]), ec_core:prove_body(Param#param{goal = B1, bindings = Bs1, var_num = Vn2}); - fail -> io:format("prove fail~n"), erlog_errors:fail(Param) + fail -> erlog_errors:fail(Param) end. \ No newline at end of file diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl index 3049ae5..bed991f 100644 --- a/src/interface/debugger/erlog_simple_debugger.erl +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -173,20 +173,30 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== %%% Internal functions %%%=================================================================== +%% @private process_reply(Dict) -> case dict:is_empty(Dict) of true -> []; - false -> - Keys = dict:fetch_keys(Dict), - lists:foldl( - fun(Key, Res) -> - case dict:find(Key, Dict) of - {ok, {K}} -> - {ok, V} = dict:find(K, Dict), - [{Key, V} | Res]; - _ -> Res - end - end, [], Keys) + false -> process_vars(Dict) + end. + +%% @private +process_vars(Dict) -> + Keys = dict:fetch_keys(Dict), + lists:foldl( + fun(Key, Res) -> + case dict:find(Key, Dict) of + {ok, {K}} -> + process_values(Key, K, Dict, Res); + _ -> Res + end + end, [], Keys). + +%% @private +process_values(Key, K, Dict, Res) -> + case dict:find(K, Dict) of + {ok, V} -> [{Key, V} | Res]; + error -> Res end. %% @private From 9208726213e0fde7c71feaf1f39d2c691769958b Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 24 Sep 2014 21:26:54 +0000 Subject: [PATCH 146/251] made db_lib working --- src/storage/erlog_dict.erl | 57 +++++++++++++++++++++----------- src/storage/erlog_ets.erl | 64 +++++++++++++++++++++++------------- src/storage/erlog_memory.erl | 35 +++++++++++++------- 3 files changed, 103 insertions(+), 53 deletions(-) diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index b02502b..045f273 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -91,12 +91,21 @@ abolish_clauses({StdLib, _, Db}, {Functor}) -> end, {ok, Udb}. -findall({StdLib, ExLib, Db}, {Collection, Functor}) -> +findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call Dict = erlog_db_storage:get_db(dict, Collection), - {Res, Udict} = findall({StdLib, ExLib, Dict}, {Functor}), - erlog_db_storage:update_db(Collection, Udict), - {Res, Db}; -findall({StdLib, ExLib, Db}, {Functor}) -> + case dict:find(Functor, StdLib) of %search built-in first + {ok, StFun} -> {StFun, Db}; + error -> + case dict:find(Functor, ExLib) of %search libraryspace then + {ok, ExFun} -> {ExFun, Db}; + error -> + case dict:find(Functor, Dict) of %search userspace last + {ok, Cs} -> {{external, {clauses, form_clauses(Cs, external)}}, Db}; + error -> {[], Db} + end + end + end; +findall({StdLib, ExLib, Db}, {Functor}) -> %for bagof case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> {StFun, Db}; error -> @@ -110,24 +119,30 @@ findall({StdLib, ExLib, Db}, {Functor}) -> end end. -close(_) -> - put(cursor, queue:new()). %save empty queue +close(Cursor) -> + put(Cursor, queue:new()). %save empty queue -next(_) -> - Queue = get(cursor), %get clauses +next(Cursor) -> + Queue = get(Cursor), %get clauses case queue:out(Queue) of %take variant {{value, Val}, UQ} -> - put(cursor, UQ), %save others + put(Cursor, UQ), %save others Val; %return it {empty, _} -> [] %nothing to return end. get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> Dict = erlog_db_storage:get_db(dict, Collection), - {Res, Udict} = get_procedure({StdLib, ExLib, Dict}, {Functor}), - erlog_db_storage:update_db(Collection, Udict), - {Res, Db}; -get_procedure({StdLib, ExLib, Db}, {Functor}) -> + case get_procedure({StdLib, ExLib, Dict}, {{Functor}, external}) of + {external, {Res, Udict}} -> %return with cursor + erlog_db_storage:update_db(Collection, Udict), + {{external, Res}, Db}; + {Res, Udict} -> + erlog_db_storage:update_db(Collection, Udict), + {Res, Db} %normal return + end; +get_procedure({StdLib, ExLib, Db}, Param) -> + {Functor, Cursor} = check_param(Param), Res = case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> StFun; error -> @@ -135,7 +150,7 @@ get_procedure({StdLib, ExLib, Db}, {Functor}) -> {ok, ExFun} -> ExFun; error -> case dict:find(Functor, Db) of %search userspace last - {ok, Cs} -> {clauses, form_clauses(Cs)}; + {ok, Cs} -> {Cursor, {clauses, form_clauses(Cs, Cursor)}}; error -> undefined end end @@ -212,8 +227,12 @@ check_immutable(Dict, Db, Functor) -> end. %% @private -form_clauses(Loaded) when length(Loaded) =< 1 -> Loaded; -form_clauses([First | Loaded]) -> +form_clauses(Loaded, _) when length(Loaded) =< 1 -> Loaded; +form_clauses([First | Loaded], Cursor) -> Queue = queue:from_list(Loaded), - put(cursor, Queue), - First. \ No newline at end of file + put(Cursor, Queue), + First. + +%% @private +check_param({Functor}) -> {Functor, cursor}; +check_param({{Functor}, external}) -> {Functor, external}. \ No newline at end of file diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index c5d9372..b93c136 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -84,17 +84,28 @@ abolish_clauses({StdLib, _, Db}, {Functor}) -> ets:delete(Db, Functor), {ok, Db}. -findall({StdLib, ExLib, Db}, {Collection, Functor}) -> +findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call Ets = erlog_db_storage:get_db(ets, Collection), - {Res, _} = findall({StdLib, ExLib, Ets}, {Functor}), - {Res, Db}; + case dict:find(Functor, StdLib) of %search built-in first + {ok, StFun} -> {StFun, Db}; + error -> + case dict:find(Functor, ExLib) of %search libraryspace then + {ok, ExFun} -> {ExFun, Db}; + error -> + CS = case catch ets:lookup_element(Ets, Functor, 2) of %search userspace last + Cs when is_list(Cs) -> Cs; + _ -> [] + end, + {{external, {clauses, form_clauses(CS, external)}}, Db} + end + end; findall({StdLib, ExLib, Db}, {Functor}) -> - case dict:is_key(Functor, StdLib) of %search built-in first - true -> {Functor, Db}; - false -> - case dict:is_key(Functor, ExLib) of %search libraryspace then - true -> {Functor, Db}; - false -> + case dict:find(Functor, StdLib) of %search built-in first + {ok, StFun} -> {StFun, Db}; + error -> + case dict:find(Functor, ExLib) of %search libraryspace then + {ok, ExFun} -> {ExFun, Db}; + error -> CS = case catch ets:lookup_element(Db, Functor, 2) of %search userspace last Cs when is_list(Cs) -> Cs; _ -> [] @@ -103,23 +114,28 @@ findall({StdLib, ExLib, Db}, {Functor}) -> end end. -close(_) -> - put(cursor, queue:new()). %save empty queue +close(Cursor) -> + put(Cursor, queue:new()). %save empty queue -next(_) -> - Queue = get(cursor), %get clauses +next(Cursor) -> + Queue = get(Cursor), %get clauses case queue:out(Queue) of %take variant {{value, Val}, UQ} -> - put(cursor, UQ), %save others + put(Cursor, UQ), %save others Val; %return it {empty, _} -> [] %nothing to return end. get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> Ets = erlog_db_storage:get_db(ets, Collection), - {Res, _} = get_procedure({StdLib, ExLib, Ets}, {Functor}), - {Res, Db}; -get_procedure({StdLib, ExLib, Db}, {Functor}) -> + case get_procedure({StdLib, ExLib, Ets}, {{Functor}, external}) of + {external, {Res, _}} -> %return with cursor + {{external, Res}, Db}; + {Res, _} -> + {Res, Db} %normal return + end; +get_procedure({StdLib, ExLib, Db}, Param) -> + {Functor, Cursor} = check_param(Param), Res = case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> StFun; error -> @@ -127,7 +143,7 @@ get_procedure({StdLib, ExLib, Db}, {Functor}) -> {ok, ExFun} -> ExFun; error -> case catch ets:lookup_element(Db, Functor, 2) of %search userspace last - Cs when is_list(Cs) -> {clauses, form_clauses(Cs)}; + Cs when is_list(Cs) -> {Cursor, {clauses, form_clauses(Cs, Cursor)}}; _ -> undefined end end @@ -208,8 +224,12 @@ check_immutable(Dict, Db, Functor) -> %TODO may be move me to erlog_memory? end. %% @private -form_clauses(Loaded) when length(Loaded) =< 1 -> Loaded; -form_clauses([First | Loaded]) -> +form_clauses(Loaded, _) when length(Loaded) =< 1 -> Loaded; +form_clauses([First | Loaded], Cursor) -> Queue = queue:from_list(Loaded), - put(cursor, Queue), - First. \ No newline at end of file + put(Cursor, Queue), + First. + +%% @private +check_param({Functor}) -> {Functor, cursor}; +check_param({{Functor}, external}) -> {Functor, external}. \ No newline at end of file diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 6e0bd71..6632477 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -62,8 +62,8 @@ database :: atom(), % callback module for user-space memory in_mem :: dict, %integrated memory for findall operations state :: term(), % callback state - core_cursor :: pid(), %cursors for db and normal operations - external_cursor :: pid() + core_cursor :: pid() | atom(), %cursors for db and normal operations + external_cursor :: pid() | atom() }). %%%=================================================================== @@ -212,22 +212,33 @@ handle_call({abolish_clauses, {Func}}, _From, State = #state{state = DbState, da handle_call({abolish_clauses, {_, Func} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, Params), {reply, Res, State#state{state = NewState, exlib = UpdExlib}}; +handle_call({findall, {Collection, Fun}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, + exlib = ExLib, external_cursor = External}) -> + Db:close(External), %close old cursor + case Db:findall({StdLib, ExLib, DbState}, {Collection, Fun}) of %take new cursor if needed + {{Cursor, Res}, UState} when is_pid(Cursor); Cursor == external -> + {reply, Res, State#state{state = UState, external_cursor = Cursor}}; + {Res, UState} -> + {reply, Res, State#state{state = UState}} + end; handle_call({get_procedure, {Func}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib, core_cursor = Core}) -> Db:close(Core), %close old cursor - {UCore, {Res, UState}} = case Db:get_procedure({StdLib, ExLib, DbState}, {Func}) of %take new cursor if needed - {Cursor, R} when is_pid(Cursor) -> {Cursor, R}; - Other -> {Core, Other} - end, - {reply, Res, State#state{state = UState, core_cursor = UCore}}; + case Db:get_procedure({StdLib, ExLib, DbState}, {Func}) of %take new cursor if needed + {{Cursor, Res}, UState} when is_pid(Cursor); Cursor == cursor -> + {reply, Res, State#state{state = UState, core_cursor = Cursor}}; + {Res, UState} -> + {reply, Res, State#state{state = UState}} + end; handle_call({get_procedure, {Collection, Func}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib, external_cursor = External}) -> Db:close(External), %close old cursor - {UExternal, {Res, UState}} = case Db:get_procedure({StdLib, ExLib, DbState}, {Collection, Func}) of %take new cursor if needed - {Cursor, R} when is_pid(Cursor) -> {Cursor, R}; - Other -> {External, Other} - end, - {reply, Res, State#state{state = UState, external_cursor = UExternal}}; + case Db:get_procedure({StdLib, ExLib, DbState}, {Collection, Func}) of %take new cursor if needed + {{Cursor, Res}, UState} when is_pid(Cursor); Cursor == external -> + {reply, Res, State#state{state = UState, external_cursor = Cursor}}; + {Res, UState} -> + {reply, Res, State#state{state = UState}} + end; handle_call(next, _From, State = #state{database = Db, core_cursor = Core}) -> %get next result by cursor Res = Db:next(Core), {reply, Res, State}; From f84cbf758e86f68dfc55d22bd36047799c79660e Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 24 Sep 2014 21:49:17 +0000 Subject: [PATCH 147/251] fix cutpoint ending --- src/core/erlog_errors.erl | 57 ++++++++++++++++++++------------------ src/core/logic/ec_core.erl | 14 ++++++++-- 2 files changed, 42 insertions(+), 29 deletions(-) diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index d6c6279..9aaccd9 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -13,7 +13,7 @@ %% API -export([type_error/3, instantiation_error/1, permission_error/4, - type_error/2, instantiation_error/0, erlog_error/2, erlog_error/1, fail/1]). + type_error/2, instantiation_error/0, erlog_error/2, erlog_error/1, fail/1]). %% Errors %% To keep dialyzer quiet. @@ -32,7 +32,7 @@ instantiation_error(Db) -> erlog_error(instantiation_error, Db). instantiation_error() -> erlog_error(instantiation_error). permission_error(Op, Type, Value, Db) -> - erlog_error({permission_error, Op, Type, Value}, Db). %TODO remove DB!! + erlog_error({permission_error, Op, Type, Value}, Db). %TODO remove DB!! erlog_error(E, Db) -> throw({erlog_error, E, Db}). erlog_error(E) -> throw({erlog_error, E}). @@ -44,57 +44,60 @@ erlog_error(E) -> throw({erlog_error, E}). %% backtracks to next choicepoint skipping cut labels cut steps %% backwards over choice points until matching cut. fail(Param = #param{choice = [#cp{type = goal_clauses} = Cp | Cps]}) -> - fail_goal_clauses(Cp, Param#param{choice = Cps}); + fail_goal_clauses(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = Type} = Cp | Cps]}) when Type == disjunction; Type == if_then_else -> - fail_disjunction(Cp, Param#param{choice = Cps}); + fail_disjunction(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = clause} = Cp | Cps]}) -> - fail_clause(Cp, Param#param{choice = Cps}); + fail_clause(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = findall} = Cp | Cps]}) -> - fail_findall(Cp, Param#param{choice = Cps}); + fail_findall(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = retract} = Cp | Cps]}) -> - fail_retract(Cp, Param#param{choice = Cps}); + fail_retract(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = db_retract} = Cp | Cps]}) -> - erlog_db:fail_retract(Cp, Param#param{choice = Cps}); + erlog_db:fail_retract(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = current_predicate} = Cp | Cps]}) -> - fail_current_predicate(Cp, Param#param{choice = Cps}); + fail_current_predicate(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = ecall} = Cp | Cps]}) -> - fail_ecall(Cp, Param#param{choice = Cps}); + fail_ecall(Cp, Param#param{choice = Cps}); fail(#param{choice = [#cp{type = compiled, data = F} = Cp | Cps], database = Db}) -> - F(Cp, Cps, Db); %TODO test this + F(Cp, Cps, Db); %TODO test this fail(Param = #param{choice = [#cut{} | Cps]}) -> - fail(Param#param{choice = Cps}); %Fail over cut points. + fail(Param#param{choice = Cps}); %Fail over cut points. fail(#param{choice = [], database = Db}) -> {fail, Db}. %% @private fail_disjunction(#cp{next = Next, bs = Bs, vn = Vn}, Param) -> - ec_core:prove_body(Param#param{goal = Next, bindings = Bs, var_num = Vn}). + ec_core:prove_body(Param#param{goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Param) -> - ec_logic:prove_ecall(Efun, Val, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + ec_logic:prove_ecall(Efun, Val, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_clause(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> - ec_unify:unify_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + ec_unify:unify_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_retract(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> - ec_logic:retract_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + ec_logic:retract_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Param) -> - ec_logic:prove_predicates(Pi, Fs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + ec_logic:prove_predicates(Pi, Fs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private -fail_goal_clauses(#cp{data = {G, Db}, next = Next, bs = Bs, vn = Vn}, Param) -> - NextClause = erlog_memory:next(Db), - ec_core:prove_goal_clauses(NextClause, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn}). +fail_goal_clauses(#cp{data = {G, Db, C}, next = Next, bs = Bs, vn = Vn}, Param) -> + NextClause = case erlog_memory:next(Db) of + [] -> [C]; + N -> N + end, + ec_core:prove_goal_clauses(NextClause, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn}). fail_findall(#cp{next = Next, data = {Tag, Bag}, bs = Bs, vn = Vn0}, Param = #param{database = Db}) -> - Data = erlog_memory:raw_fetch(Db, Tag), - erlog_memory:raw_erase(Db, Tag), %Clear special entry - {Bs1, Vn1} = lists:mapfoldl(fun(B0, V0) -> %Create proper instances - {B1, _, V1} = ec_term:term_instance(ec_support:dderef(B0, Bs), V0), - {B1, V1} - end, Vn0, Data), - ec_body:unify_prove_body(Bag, Bs1, Param#param{next_goal = Next, var_num = Vn1}). \ No newline at end of file + Data = erlog_memory:raw_fetch(Db, Tag), + erlog_memory:raw_erase(Db, Tag), %Clear special entry + {Bs1, Vn1} = lists:mapfoldl(fun(B0, V0) -> %Create proper instances + {B1, _, V1} = ec_term:term_instance(ec_support:dderef(B0, Bs), V0), + {B1, V1} + end, Vn0, Data), + ec_body:unify_prove_body(Bag, Bs1, Param#param{next_goal = Next, var_num = Vn1}). \ No newline at end of file diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index eb52104..c2c2d18 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -77,6 +77,7 @@ prove_goal(Param = #param{goal = G, database = Db}) -> case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of {built_in, Mod} -> Mod:prove_goal(Param); %kernel space {code, {Mod, Func}} -> Mod:Func(Param); %library space + {clauses, []} -> erlog_errors:fail(Param); {clauses, Cs} -> prove_goal_clauses(Cs, Param); %user space undefined -> erlog_errors:fail(Param); {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data @@ -86,9 +87,18 @@ prove_goal(Param = #param{goal = G, database = Db}) -> %% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to prove Goal using Clauses which all have the same functor. -prove_goal_clauses([], Param) -> erlog_errors:fail(Param); +prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> + %% Must be smart here and test whether we need to add a cut point. + %% C has the structure {Tag,Head,{Body,BodyHasCut}}. + case element(2, element(3, C)) of + true -> + Cut = #cut{label = Vn}, + erlog_errors:fail(Params#param{choice = [Cut | Cps]}); + false -> + erlog_errors:fail(Params) + end; prove_goal_clauses(C, Params = #param{goal = G, next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps, database = Db}) -> - Cp = #cp{type = goal_clauses, label = Vn, data = {G, Db}, next = Next, bs = Bs, vn = Vn}, + Cp = #cp{type = goal_clauses, label = Vn, data = {G, Db, C}, next = Next, bs = Bs, vn = Vn}, prove_goal_clause(C, Params#param{choice = [Cp | Cps]}). prove_goal_clause([L], Param) -> prove_goal_clause(L, Param); From beff4f545691935b026f70d41ab1b8f30a02676b Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 24 Sep 2014 22:10:41 +0000 Subject: [PATCH 148/251] made db_call working with multiple clauses --- src/core/erlog_errors.erl | 10 ++ src/core/logic/ec_core.erl | 3 +- src/libs/external/db/erlog_db.erl | 199 ++++++++++++++++-------------- src/storage/erlog_dict.erl | 5 +- src/storage/erlog_ets.erl | 5 +- 5 files changed, 125 insertions(+), 97 deletions(-) diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 9aaccd9..8d2756c 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -45,6 +45,8 @@ erlog_error(E) -> throw({erlog_error, E}). %% backwards over choice points until matching cut. fail(Param = #param{choice = [#cp{type = goal_clauses} = Cp | Cps]}) -> fail_goal_clauses(Cp, Param#param{choice = Cps}); +fail(Param = #param{choice = [#cp{type = db_goal_clauses} = Cp | Cps]}) -> + fail_db_goal_clauses(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = Type} = Cp | Cps]}) when Type == disjunction; Type == if_then_else -> fail_disjunction(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = clause} = Cp | Cps]}) -> @@ -93,6 +95,14 @@ fail_goal_clauses(#cp{data = {G, Db, C}, next = Next, bs = Bs, vn = Vn}, Param) end, ec_core:prove_goal_clauses(NextClause, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn}). +%% @private +fail_db_goal_clauses(#cp{data = {G, Db, C}, next = Next, bs = Bs, vn = Vn}, Param) -> + NextClause = case erlog_memory:db_next(Db) of + [] -> [C]; + N -> N + end, + ec_core:prove_goal_clauses(NextClause, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn}). + fail_findall(#cp{next = Next, data = {Tag, Bag}, bs = Bs, vn = Vn0}, Param = #param{database = Db}) -> Data = erlog_memory:raw_fetch(Db, Tag), erlog_memory:raw_erase(Db, Tag), %Clear special entry diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index c2c2d18..ac9cdd8 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -12,7 +12,7 @@ -include("erlog_core.hrl"). %% API --export([prove_body/1, prove_goal/1, prove_goal/5, prove_goal_clauses/2]). +-export([prove_body/1, prove_goal/1, prove_goal/5, prove_goal_clauses/2, prove_goal_clause/2]). %% prove_goal(Goal, Database) -> Succeed | Fail. %% This is the main entry point into the interpreter. Check that @@ -83,7 +83,6 @@ prove_goal(Param = #param{goal = G, database = Db}) -> {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data end. - %% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to prove Goal using Clauses which all have the same functor. diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 3ed33ff..a78f2fe 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -16,128 +16,128 @@ %% API -export([load/1, - db_assert_2/1, - db_asserta_2/1, - db_abolish_2/1, - db_retract_2/1, - db_retractall_2/1, - fail_retract/2, - db_call_2/1, - db_listing_2/1, - db_listing_3/1, - db_listing_4/1]). + db_assert_2/1, + db_asserta_2/1, + db_abolish_2/1, + db_retract_2/1, + db_retractall_2/1, + fail_retract/2, + db_call_2/1, + db_listing_2/1, + db_listing_3/1, + db_listing_4/1]). load(Db) -> - lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_DB). + lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_DB). db_call_2(Param = #param{goal = {db_call, _, _} = Goal, next_goal = Next0, bindings = Bs, database = Db}) -> - {db_call, Table, G} = ec_support:dderef(Goal, Bs), - case erlog_memory:db_findall(Db, Table, ec_support:functor(G)) of - [] -> erlog_errors:fail(Param); - {erlog_error, E} -> erlog_errors:erlog_error(E, Db); - {clauses, Cs} -> prove_call(G, Cs, Next0, Param); - Cs -> prove_call(G, Cs, Next0, Param) - end. + {db_call, Table, G} = ec_support:dderef(Goal, Bs), + case erlog_memory:db_findall(Db, Table, ec_support:functor(G)) of + [] -> erlog_errors:fail(Param); + {erlog_error, E} -> erlog_errors:erlog_error(E, Db); + {clauses, Cs} -> prove_call(G, Cs, Next0, Param); + Cs -> prove_call(G, Cs, Next0, Param) + end. db_assert_2(Params = #param{goal = {db_assert, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> - {db_assert, Table, Fact} = ec_support:dderef(Goal, Bs), - erlog_memory:db_assertz_clause(Db, Table, Fact), - ec_core:prove_body(Params#param{goal = Next}). + {db_assert, Table, Fact} = ec_support:dderef(Goal, Bs), + erlog_memory:db_assertz_clause(Db, Table, Fact), + ec_core:prove_body(Params#param{goal = Next}). db_asserta_2(Params = #param{goal = {db_asserta, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> - {db_asserta, Table, Fact} = ec_support:dderef(Goal, Bs), - erlog_memory:db_asserta_clause(Db, Table, Fact), - ec_core:prove_body(Params#param{goal = Next}). + {db_asserta, Table, Fact} = ec_support:dderef(Goal, Bs), + erlog_memory:db_asserta_clause(Db, Table, Fact), + ec_core:prove_body(Params#param{goal = Next}). db_abolish_2(Params = #param{goal = {db_abolish, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> - {db_abolish, Table, Fact} = ec_support:dderef(Goal, Bs), - case Fact of - {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> - erlog_memory:db_abolish_clauses(Db, Table, {N, A}), - ec_core:prove_body(Params#param{goal = Next}); - Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) - end. + {db_abolish, Table, Fact} = ec_support:dderef(Goal, Bs), + case Fact of + {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> + erlog_memory:db_abolish_clauses(Db, Table, {N, A}), + ec_core:prove_body(Params#param{goal = Next}); + Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) + end. db_retract_2(Params = #param{goal = {db_retract, _, _} = Goal, bindings = Bs}) -> - {db_retract, Table, Fact} = ec_support:dderef(Goal, Bs), - prove_retract(Fact, Table, Params). + {db_retract, Table, Fact} = ec_support:dderef(Goal, Bs), + prove_retract(Fact, Table, Params). db_retractall_2(Params = #param{goal = {db_retractall, _, _} = Goal, bindings = Bs}) -> - {db_retractall, Table, Fact} = ec_support:dderef(Goal, Bs), - prove_retractall(Fact, Table, Params). + {db_retractall, Table, Fact} = ec_support:dderef(Goal, Bs), + prove_retractall(Fact, Table, Params). db_listing_2(Params = #param{goal = {db_listing, _, _} = Goal, next_goal = Next, bindings = Bs0, database = Db}) -> - {db_listing, Table, Res} = ec_support:dderef(Goal, Bs0), - Content = erlog_memory:db_listing(Db, Table, []), - Bs = ec_support:add_binding(Res, Content, Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). + {db_listing, Table, Res} = ec_support:dderef(Goal, Bs0), + Content = erlog_memory:db_listing(Db, Table, []), + Bs = ec_support:add_binding(Res, Content, Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). db_listing_3(Params = #param{goal = {db_listing, _, _, _} = Goal, next_goal = Next, bindings = Bs0, database = Db}) -> - {db_listing, Table, Functor, Res} = ec_support:dderef(Goal, Bs0), - Content = erlog_memory:db_listing(Db, Table, [Functor]), - Bs = ec_support:add_binding(Res, Content, Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). + {db_listing, Table, Functor, Res} = ec_support:dderef(Goal, Bs0), + Content = erlog_memory:db_listing(Db, Table, [Functor]), + Bs = ec_support:add_binding(Res, Content, Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). db_listing_4(Params = #param{goal = {db_listing, _, _, _, _} = Goal, next_goal = Next, bindings = Bs0, database = Db}) -> - {db_listing, Table, Functor, Arity, Res} = ec_support:dderef(Goal, Bs0), - Content = erlog_memory:db_listing(Db, Table, [Functor, Arity]), - Bs = ec_support:add_binding(Res, Content, Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). + {db_listing, Table, Functor, Arity, Res} = ec_support:dderef(Goal, Bs0), + Content = erlog_memory:db_listing(Db, Table, [Functor, Arity]), + Bs = ec_support:add_binding(Res, Content, Bs0), + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). prove_retract({':-', H, B}, Table, Params) -> - prove_retract(H, B, Table, Params); + prove_retract(H, B, Table, Params); prove_retract(H, Table, Params) -> - prove_retract(H, true, Table, Params). + prove_retract(H, true, Table, Params). prove_retractall({':-', H, B}, Table, Params) -> - prove_retractall(H, B, Table, Params); + prove_retractall(H, B, Table, Params); prove_retractall(H, Table, Params) -> - prove_retractall(H, true, Table, Params). + prove_retractall(H, true, Table, Params). %% @private prove_call(G, Cs, Next0, Param = #param{bindings = Bs, choice = Cps, database = Db, var_num = Vn}) -> - case ec_logic:check_goal(G, Next0, Bs, Db, false, Vn) of - {[Next1 | _], true} -> - %% Must increment Vn to avoid clashes!!! - Cut = #cut{label = Vn}, - ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); - {[Next1 | _], false} -> ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, var_num = Vn + 1}) - end. + case ec_logic:check_goal(G, Next0, Bs, Db, false, Vn) of + {[Next1 | _], true} -> + %% Must increment Vn to avoid clashes!!! + Cut = #cut{label = Vn}, + prove_goal_clauses(Cs, Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); + {[Next1 | _], false} -> prove_goal_clauses(Cs, Param#param{goal = Next1, var_num = Vn + 1}) + end. %% @private prove_retract(H, B, Table, Params = #param{database = Db}) -> - Functor = ec_support:functor(H), - case erlog_memory:get_db_procedure(Db, Table, Functor) of - {clauses, Cs} -> retract_clauses(H, B, Cs, Params, Table); - undefined -> erlog_errors:fail(Params) - end. + Functor = ec_support:functor(H), + case erlog_memory:get_db_procedure(Db, Table, Functor) of + {clauses, Cs} -> retract_clauses(H, B, Cs, Params, Table); + undefined -> erlog_errors:fail(Params) + end. %% @private prove_retractall(H, B, Table, Params = #param{next_goal = Next, bindings = Bs0, var_num = Vn0, database = Db}) -> - Functor = ec_support:functor(H), - case erlog_memory:get_db_procedure(Db, Table, Functor) of - {clauses, Cs} -> - lists:foreach( - fun(Clause) -> - case ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of - {succeed, _, _} -> - erlog_memory:db_retract_clause(Db, Table, ec_support:functor(H), element(1, Clause)); - fail -> ok - end - end, Cs), - ec_core:prove_body(Params#param{goal = Next}); - {code, _} -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - built_in -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - undefined -> ec_core:prove_body(Params#param{goal = Next}) - end. + Functor = ec_support:functor(H), + case erlog_memory:get_db_procedure(Db, Table, Functor) of + {clauses, Cs} -> + lists:foreach( + fun(Clause) -> + case ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of + {succeed, _, _} -> + erlog_memory:db_retract_clause(Db, Table, ec_support:functor(H), element(1, Clause)); + fail -> ok + end + end, Cs), + ec_core:prove_body(Params#param{goal = Next}); + {code, _} -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + built_in -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + undefined -> ec_core:prove_body(Params#param{goal = Next}) + end. %% @private retract(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1, Table) -> - erlog_memory:db_retract_clause(Db, Table, ec_support:functor(Ch), element(1, C)), - Cp = #cp{type = db_retract, data = {Ch, Cb, Cs, Table}, next = Next, bs = Bs0, vn = Vn0}, - ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). + erlog_memory:db_retract_clause(Db, Table, ec_support:functor(Ch), element(1, C)), + Cp = #cp{type = db_retract, data = {Ch, Cb, Cs, Table}, next = Next, bs = Bs0, vn = Vn0}, + ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). %% @private %% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> @@ -145,12 +145,29 @@ retract(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = %% Try to retract Head and Body using Clauses which all have the same functor. retract_clauses(_Ch, _Cb, [], Param, _) -> erlog_errors:fail(Param); retract_clauses(Ch, Cb, [C | Cs], Param = #param{bindings = Bs0, var_num = Vn0}, Table) -> %TODO foreach vs handmade recursion? - case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of - {succeed, Bs1, Vn1} -> - %% We have found a right clause so now retract it. - retract(Ch, Cb, C, Cs, Param, Bs1, Vn1, Table); - fail -> retract_clauses(Ch, Cb, Cs, Param, Table) - end. + case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of + {succeed, Bs1, Vn1} -> + %% We have found a right clause so now retract it. + retract(Ch, Cb, C, Cs, Param, Bs1, Vn1, Table); + fail -> retract_clauses(Ch, Cb, Cs, Param, Table) + end. fail_retract(#cp{data = {Ch, Cb, Cs, Table}, next = Next, bs = Bs, vn = Vn}, Param) -> - retract_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}, Table). \ No newline at end of file + retract_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}, Table). + +%% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Try to prove Goal using Clauses which all have the same functor. +prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> + %% Must be smart here and test whether we need to add a cut point. + %% C has the structure {Tag,Head,{Body,BodyHasCut}}. + case element(2, element(3, C)) of + true -> + Cut = #cut{label = Vn}, + erlog_errors:fail(Params#param{choice = [Cut | Cps]}); + false -> + erlog_errors:fail(Params) + end; +prove_goal_clauses(C, Params = #param{goal = G, next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps, database = Db}) -> + Cp = #cp{type = db_goal_clauses, label = Vn, data = {G, Db, C}, next = Next, bs = Bs, vn = Vn}, + ec_core:prove_goal_clause(C, Params#param{choice = [Cp | Cps]}). \ No newline at end of file diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 045f273..9e243ce 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -119,9 +119,10 @@ findall({StdLib, ExLib, Db}, {Functor}) -> %for bagof end end. -close(Cursor) -> - put(Cursor, queue:new()). %save empty queue +close(undefined) -> ok; +close(Cursor) -> put(Cursor, queue:new()). %save empty queue +next(undefined) -> []; next(Cursor) -> Queue = get(Cursor), %get clauses case queue:out(Queue) of %take variant diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index b93c136..f702407 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -114,9 +114,10 @@ findall({StdLib, ExLib, Db}, {Functor}) -> end end. -close(Cursor) -> - put(Cursor, queue:new()). %save empty queue +close(undefined) -> ok; +close(Cursor) -> put(Cursor, queue:new()). %save empty queue +next(undefined) -> []; next(Cursor) -> Queue = get(Cursor), %get clauses case queue:out(Queue) of %take variant From 660e3c8035e46f6956eaee04aa5f422ed9062b1c Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 25 Sep 2014 17:44:29 +0000 Subject: [PATCH 149/251] make r16b03 compatible --- src/interface/debugger/erlog_simple_debugger.erl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl index bed991f..cdbf4e5 100644 --- a/src/interface/debugger/erlog_simple_debugger.erl +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -175,9 +175,9 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== %% @private process_reply(Dict) -> - case dict:is_empty(Dict) of - true -> []; - false -> process_vars(Dict) + case dict:size(Dict) of + 0 -> []; + _ -> process_vars(Dict) end. %% @private From 151630c35344234e20c3c34776577ef06f5dd8c6 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 26 Sep 2014 15:58:52 +0000 Subject: [PATCH 150/251] fix clauses with body issue --- Makefile | 1 - src/core/erlog_errors.erl | 2 +- src/core/logic/ec_core.erl | 8 +++++--- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/Makefile b/Makefile index 03e70e4..e3a67fb 100644 --- a/Makefile +++ b/Makefile @@ -33,7 +33,6 @@ compile: then rebar compile; \ else $(MAKE) $(MFLAGS) erlc_compile; \ fi - cp deps/jsx/ebin/*.* ebin ## Compile using erlc erlc_compile: $(addprefix $(EBINDIR)/, $(EBINS)) diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 8d2756c..3764456 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -90,7 +90,7 @@ fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Para %% @private fail_goal_clauses(#cp{data = {G, Db, C}, next = Next, bs = Bs, vn = Vn}, Param) -> NextClause = case erlog_memory:next(Db) of - [] -> [C]; + [] -> [{next, C}]; N -> N end, ec_core:prove_goal_clauses(NextClause, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn}). diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index ac9cdd8..c423d9d 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -86,15 +86,17 @@ prove_goal(Param = #param{goal = G, database = Db}) -> %% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to prove Goal using Clauses which all have the same functor. -prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> +prove_goal_clauses([{next, _}], Params) -> %end of checking clauses + erlog_errors:fail(Params); +prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> %for clauses with body %% Must be smart here and test whether we need to add a cut point. %% C has the structure {Tag,Head,{Body,BodyHasCut}}. case element(2, element(3, C)) of true -> Cut = #cut{label = Vn}, - erlog_errors:fail(Params#param{choice = [Cut | Cps]}); + prove_goal_clause(C, Params#param{choice = [Cut | Cps]}); false -> - erlog_errors:fail(Params) + prove_goal_clause(C, Params) end; prove_goal_clauses(C, Params = #param{goal = G, next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps, database = Db}) -> Cp = #cp{type = goal_clauses, label = Vn, data = {G, Db, C}, next = Next, bs = Bs, vn = Vn}, From 0b873f0f6232783488d5ac94cb12821e0e6ccfff Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 26 Sep 2014 23:22:46 +0000 Subject: [PATCH 151/251] fix permission denied errors --- src/core/erlog_errors.erl | 10 +-- src/io/erlog_file.erl | 82 +++++++++++++---------- src/libs/external/db/erlog_db.erl | 4 +- src/libs/standard/core/logic/ec_logic.erl | 12 ++-- src/storage/erlog_dict.erl | 14 ++-- src/storage/erlog_ets.erl | 14 ++-- src/storage/erlog_memory.erl | 47 ++++++++----- 7 files changed, 106 insertions(+), 77 deletions(-) diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 3764456..31955e9 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -12,7 +12,7 @@ -include("erlog_core.hrl"). %% API --export([type_error/3, instantiation_error/1, permission_error/4, +-export([type_error/3, instantiation_error/1, permission_error/3, type_error/2, instantiation_error/0, erlog_error/2, erlog_error/1, fail/1]). %% Errors @@ -21,7 +21,7 @@ -spec type_error(_, _, _) -> no_return(). -spec instantiation_error() -> no_return(). -spec instantiation_error(_) -> no_return(). --spec permission_error(_, _, _, _) -> no_return(). +-spec permission_error(_, _, _) -> no_return(). -spec erlog_error(_) -> no_return(). -spec erlog_error(_, _) -> no_return(). @@ -31,10 +31,10 @@ type_error(Type, Value) -> erlog_error({type_error, Type, Value}). instantiation_error(Db) -> erlog_error(instantiation_error, Db). instantiation_error() -> erlog_error(instantiation_error). -permission_error(Op, Type, Value, Db) -> - erlog_error({permission_error, Op, Type, Value}, Db). %TODO remove DB!! +permission_error(Op, Type, Value) -> + erlog_error({permission_error, Op, Type, Value}). -erlog_error(E, Db) -> throw({erlog_error, E, Db}). +erlog_error(E, Db) -> throw({erlog_error, E, Db}). %TODO remove DB!! erlog_error(E) -> throw({erlog_error, E}). %% fail(ChoicePoints, Database) -> {fail,Database}. diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index b94f840..1b977ed 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -29,43 +29,43 @@ %% abolish old definitons of clauses. -spec consult(fun(), File :: string(), Db :: pid()) -> ok | tuple(). consult(Fun, File, Db) -> - case Fun(File) of %default is erlog_io:read_file/1 - {ok, Terms} -> consult_terms(fun consult_assert/2, Db, Terms); - Error -> Error - end. + case Fun(File) of %default is erlog_io:read_file/1 + {ok, Terms} -> consult_terms(fun consult_assert/2, Db, Terms); + Error -> Error + end. -spec reconsult(fun(), File :: string(), Db :: pid()) -> ok | tuple(). reconsult(Fun, File, Db) -> - case Fun(File) of %default is erlog_io:read_file/1 - {ok, Terms} -> - case consult_terms(fun reconsult_assert/2, {Db, []}, Terms) of - ok -> ok; - Error -> Error - end; - Error -> Error - end. + case Fun(File) of %default is erlog_io:read_file/1 + {ok, Terms} -> + case consult_terms(fun reconsult_assert/2, {Db, []}, Terms) of + ok -> ok; + Error -> Error + end; + Error -> Error + end. %% @private -spec consult_assert(Term0 :: term(), Db :: pid()) -> {ok, Db :: pid()}. consult_assert(Term0, Db) -> - Term1 = ed_logic:expand_term(Term0), - erlog_memory:assertz_clause(Db, Term1), - {ok, Db}. %TODO refactor consult_terms not to pass DB everywhere! + Term1 = ed_logic:expand_term(Term0), + check_assert(Db, Term1), + {ok, Db}. %TODO refactor consult_terms not to pass DB everywhere! %% @private -spec reconsult_assert(Term0 :: term(), {Db :: pid(), Seen :: list()}) -> {ok, {Db :: pid(), list()}}. reconsult_assert(Term0, {Db, Seen}) -> - Term1 = ed_logic:expand_term(Term0), - Func = functor(Term1), - case lists:member(Func, Seen) of - true -> - erlog_memory:assertz_clause(Db, Term1), - {ok, {Db, Seen}}; %TODO refactor consult_terms not to pass DB everywhere! - false -> - erlog_memory:abolish_clauses(Db, Func), - erlog_memory:assertz_clause(Db, Term1), - {ok, {Db, [Func | Seen]}} - end. + Term1 = ed_logic:expand_term(Term0), + Func = functor(Term1), + case lists:member(Func, Seen) of + true -> + check_assert(Db, Term1), + {ok, {Db, Seen}}; %TODO refactor consult_terms not to pass DB everywhere! + false -> + check_abolish(Db, Func), + check_assert(Db, Term1), + {ok, {Db, [Func | Seen]}} + end. %% @private %% consult_terms(InsertFun, Database, Terms) -> @@ -74,17 +74,31 @@ reconsult_assert(Term0, {Db, Seen}) -> %% queries. -spec consult_terms(fun(), any(), list()) -> ok | tuple(). consult_terms(Ifun, Params, [{':-', _} | Ts]) -> %TODO refactor me to make interface for Params unifyed! (or may be lists:foreach will be better this hand made recursion) - consult_terms(Ifun, Params, Ts); + consult_terms(Ifun, Params, Ts); consult_terms(Ifun, Params, [{'?-', _} | Ts]) -> - consult_terms(Ifun, Params, Ts); + consult_terms(Ifun, Params, Ts); consult_terms(Ifun, Params, [Term | Ts]) -> - case catch Ifun(Term, Params) of - {ok, UpdParams} -> consult_terms(Ifun, UpdParams, Ts); - {erlog_error, E, _} -> {erlog_error, E}; - {erlog_error, E} -> {erlog_error, E} - end; + case catch Ifun(Term, Params) of + {ok, UpdParams} -> consult_terms(Ifun, UpdParams, Ts); + {erlog_error, E, _} -> {erlog_error, E}; + {erlog_error, E} -> {erlog_error, E} + end; consult_terms(_, _, []) -> ok. %% @private functor({':-', H, _B}) -> ec_support:functor(H); -functor(T) -> ec_support:functor(T). \ No newline at end of file +functor(T) -> ec_support:functor(T). + +%% @private +check_assert(Db, Term) -> + case erlog_memory:assertz_clause(Db, Term) of + {erlog_error, E} -> erlog_errors:erlog_error(E); + _ -> ok + end. + +%% @private +check_abolish(Db, Term) -> + case erlog_memory:abolish_clauses(Db, Term) of + {erlog_error, E} -> erlog_errors:erlog_error(E); + _ -> ok + end. \ No newline at end of file diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index a78f2fe..03ccaa4 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -127,9 +127,9 @@ prove_retractall(H, B, Table, Params = #param{next_goal = Next, bindings = Bs0, end, Cs), ec_core:prove_body(Params#param{goal = Next}); {code, _} -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); built_in -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); undefined -> ec_core:prove_body(Params#param{goal = Next}) end. diff --git a/src/libs/standard/core/logic/ec_logic.erl b/src/libs/standard/core/logic/ec_logic.erl index 0db84c6..9c26ebf 100644 --- a/src/libs/standard/core/logic/ec_logic.erl +++ b/src/libs/standard/core/logic/ec_logic.erl @@ -68,9 +68,9 @@ prove_clause(H, B, Param = #param{database = Db}) -> case erlog_memory:get_procedure(Db, Functor) of {clauses, Cs} -> ec_unify:unify_clauses(H, B, Cs, Param); {code, _} -> - erlog_errors:permission_error(access, private_procedure, ec_support:pred_ind(Functor), Db); + erlog_errors:permission_error(access, private_procedure, ec_support:pred_ind(Functor)); built_in -> - erlog_errors:permission_error(access, private_procedure, ec_support:pred_ind(Functor), Db); + erlog_errors:permission_error(access, private_procedure, ec_support:pred_ind(Functor)); undefined -> erlog_errors:fail(Param) end. @@ -225,9 +225,9 @@ prove_retract(H, B, Params = #param{database = Db}) -> case erlog_memory:get_procedure(Db, Functor) of {clauses, Cs} -> retract_clauses(H, B, Cs, Params); {code, _} -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); built_in -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); undefined -> erlog_errors:fail(Params) end. @@ -246,8 +246,8 @@ prove_retractall(H, B, Params = #param{next_goal = Next, bindings = Bs0, var_num end, Cs), ec_core:prove_body(Params#param{goal = Next}); {code, _} -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); built_in -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); undefined -> ec_core:prove_body(Params#param{goal = Next}) end. diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 9e243ce..69b7e71 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -69,8 +69,8 @@ retract_clause({StdLib, ExLib, Db}, {Collection, Functor, Ct}) -> erlog_db_storage:update_db(Collection, Udict), {Res, Db}; retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> - ok = check_immutable(StdLib, Db, Functor), - ok = check_immutable(ExLib, Db, Functor), + ok = check_immutable(StdLib, Functor), + ok = check_immutable(ExLib, Functor), Udb = case dict:is_key(Functor, Db) of true -> dict:update(Functor, fun(Old) -> lists:keydelete(Ct, 1, Old) end, [], Db); @@ -84,7 +84,7 @@ abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> erlog_db_storage:update_db(Collection, Udict), {Res, Db}; abolish_clauses({StdLib, _, Db}, {Functor}) -> - ok = check_immutable(StdLib, Db, Functor), + ok = check_immutable(StdLib, Functor), Udb = case dict:is_key(Functor, Db) of true -> dict:erase(Functor, Db); false -> Db %Do nothing @@ -204,8 +204,8 @@ clause(Head, Body0, {StdLib, ExLib, Db}, ClauseFun) -> {erlog_error, E} -> erlog_errors:erlog_error(E, Db); {ok, F, B} -> {F, B} end, - ok = check_immutable(StdLib, Db, Functor), %check built-in functions (read only) for clause - ok = check_immutable(ExLib, Db, Functor), %check library functions (read only) for clauses + ok = check_immutable(StdLib, Functor), %check built-in functions (read only) for clause + ok = check_immutable(ExLib, Functor), %check library functions (read only) for clauses case dict:find(Functor, Db) of {ok, Cs} -> ClauseFun(Functor, Cs, Body); error -> dict:append(Functor, {0, Head, Body}, Db) @@ -221,10 +221,10 @@ check_duplicates(Cs, Head, Body) -> end, false, Cs)). %% @private -check_immutable(Dict, Db, Functor) -> +check_immutable(Dict, Functor) -> case dict:is_key(Functor, Dict) of false -> ok; - true -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db) + true -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)) end. %% @private diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index f702407..3efda5e 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -65,8 +65,8 @@ retract_clause({StdLib, ExLib, Db}, {Collection, Functor, Ct}) -> {Res, _} = retract_clause({StdLib, ExLib, Ets}, {Functor, Ct}), {Res, Db}; retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> - ok = check_immutable(StdLib, Db, Functor), - ok = check_immutable(ExLib, Db, Functor), + ok = check_immutable(StdLib, Functor), + ok = check_immutable(ExLib, Functor), case catch ets:lookup_element(Db, Functor, 2) of Cs when is_list(Cs) -> Object = lists:keyfind(Ct, 1, Cs), @@ -80,7 +80,7 @@ abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> {Res, _} = abolish_clauses({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; abolish_clauses({StdLib, _, Db}, {Functor}) -> - ok = check_immutable(StdLib, Db, Functor), + ok = check_immutable(StdLib, Functor), ets:delete(Db, Functor), {ok, Db}. @@ -202,8 +202,8 @@ clause(Head, Body0, {StdLib, ExLib, Db}, ClauseFun) -> {erlog_error, E} -> erlog_errors:erlog_error(E, Db); {ok, F, B} -> {F, B} end, - ok = check_immutable(StdLib, Db, Functor), %check built-in functions (read only) for clause - ok = check_immutable(ExLib, Db, Functor), %check library functions (read only) for clauses + ok = check_immutable(StdLib, Functor), %check built-in functions (read only) for clause + ok = check_immutable(ExLib, Functor), %check library functions (read only) for clauses case ets:lookup(Db, Functor) of [] -> ets:insert(Db, {Functor, {0, Head, Body}}); Cs -> ClauseFun(Functor, Cs, Body) @@ -218,10 +218,10 @@ check_duplicates(Cs, Head, Body) -> end, true, Cs). %% @private -check_immutable(Dict, Db, Functor) -> %TODO may be move me to erlog_memory? +check_immutable(Dict, Functor) -> %TODO may be move me to erlog_memory? case dict:is_key(Functor, Dict) of false -> ok; - true -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db) + true -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)) end. %% @private diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 6632477..94afcdc 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -185,14 +185,13 @@ init([Database, Params]) when is_atom(Database) -> handle_call({load_kernel_space, {Module, Functor}}, _From, State = #state{stdlib = StdLib}) -> %load kernel space into memory UStdlib = dict:store(Functor, {built_in, Module}, StdLib), {reply, ok, State#state{stdlib = UStdlib}}; -handle_call({load_library_space, {{Functor, M, F}}}, _From, State = #state{database = Db, stdlib = StdLib, exlib = ExLib}) -> %load library space into memory - UExlib = case dict:is_key(Functor, StdLib) of - true -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor), Db); - false -> - dict:store(Functor, {code, {M, F}}, ExLib) - end, - {reply, ok, State#state{exlib = UExlib}}; +handle_call({load_library_space, {{Functor, M, F}}}, _From, State = #state{stdlib = StdLib, exlib = ExLib}) -> %load library space into memory + case dict:is_key(Functor, StdLib) of + true -> + {reply, {erlog_error, {modify, static_procedure, ec_support:pred_ind(Functor)}}, State}; + false -> + {reply, ok, State#state{exlib = dict:store(Functor, {code, {M, F}}, ExLib)}} + end; handle_call({raw_store, {Key, Value}}, _From, State = #state{in_mem = InMem}) -> %findall store Umem = store(Key, Value, InMem), {reply, ok, State#state{in_mem = Umem}}; @@ -207,11 +206,19 @@ handle_call({raw_erase, {Key}}, _From, State = #state{in_mem = InMem}) -> %find Umem = dict:erase(Key, InMem), {reply, ok, State#state{in_mem = Umem}}; handle_call({abolish_clauses, {Func}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module - {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, {Func}), - {reply, Res, State#state{state = NewState, exlib = UpdExlib}}; + try + {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, {Func}), + {reply, Res, State#state{state = NewState, exlib = UpdExlib}} + catch + throw:E -> {reply, E, State} + end; handle_call({abolish_clauses, {_, Func} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module - {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, Params), - {reply, Res, State#state{state = NewState, exlib = UpdExlib}}; + try + {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, Params), + {reply, Res, State#state{state = NewState, exlib = UpdExlib}} + catch + throw:E -> {reply, E, State} + end; handle_call({findall, {Collection, Fun}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib, external_cursor = External}) -> Db:close(External), %close old cursor @@ -246,11 +253,19 @@ handle_call(db_next, _From, State = #state{database = Db, external_cursor = Exte Res = Db:next(External), {reply, Res, State}; handle_call({Fun, Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module - {Res, NewState} = Db:Fun({StdLib, ExLib, DbState}, Params), - {reply, Res, State#state{state = NewState}}; + try + {Res, NewState} = Db:Fun({StdLib, ExLib, DbState}, Params), + {reply, Res, State#state{state = NewState}} + catch + throw:E -> {reply, E, State} + end; handle_call(Fun, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module - {Res, NewState} = Db:Fun({StdLib, ExLib, DbState}), - {reply, Res, State#state{state = NewState}}; + try + {Res, NewState} = Db:Fun({StdLib, ExLib, DbState}), + {reply, Res, State#state{state = NewState}} + catch + throw:E -> {reply, E, State} + end; handle_call(_Request, _From, State) -> {reply, ok, State}. From b32ed97c6c1119f6a1d1da7b2843fc86afe43fd4 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 30 Sep 2014 00:50:32 +0000 Subject: [PATCH 152/251] erlog memory refactoring --- include/erlog_core.hrl | 10 +++- include/erlog_db.hrl | 24 +++++----- src/core/erlog_errors.erl | 3 +- src/core/logic/ec_core.erl | 14 ++++-- src/storage/erlog_dict.erl | 31 +++++++++--- src/storage/erlog_memory.erl | 93 +++++++++++++++++++----------------- 6 files changed, 108 insertions(+), 67 deletions(-) diff --git a/include/erlog_core.hrl b/include/erlog_core.hrl index 8aca913..8814343 100644 --- a/include/erlog_core.hrl +++ b/include/erlog_core.hrl @@ -89,4 +89,12 @@ {to_integer, 2}, {to_string, 2} ] -). \ No newline at end of file +). + +-record(cursor, +{ + type :: core | external, %type of cursor. Ordinary cursor, or external cursor for db_library + function :: atom(), %function, which used cursor last + functor :: tuple(), %functor, which was searched through cursor last + data :: atom() | pid() %cursor initial data, pid of database cursor's connection or smth else +}). \ No newline at end of file diff --git a/include/erlog_db.hrl b/include/erlog_db.hrl index 60a135d..2739960 100644 --- a/include/erlog_db.hrl +++ b/include/erlog_db.hrl @@ -9,16 +9,16 @@ -author("tihon"). -define(ERLOG_DB, - [ - {{db_abolish, 2}, ?MODULE, db_abolish_2}, - {{db_assert, 2}, ?MODULE, db_assert_2}, - {{db_asserta, 2}, ?MODULE, db_asserta_2}, - {{db_assertz, 2}, ?MODULE, db_assert_2}, - {{db_retract, 2}, ?MODULE, db_retract_2}, - {{db_retractall, 2}, ?MODULE, db_retractall_2}, - {{db_call, 2}, ?MODULE, db_call_2}, - {{db_listing, 2}, ?MODULE, db_listing_2}, - {{db_listing, 3}, ?MODULE, db_listing_3}, - {{db_listing, 4}, ?MODULE, db_listing_4} - ] + [ + {{db_abolish, 2}, ?MODULE, db_abolish_2}, + {{db_assert, 2}, ?MODULE, db_assert_2}, + {{db_asserta, 2}, ?MODULE, db_asserta_2}, + {{db_assertz, 2}, ?MODULE, db_assert_2}, + {{db_retract, 2}, ?MODULE, db_retract_2}, + {{db_retractall, 2}, ?MODULE, db_retractall_2}, + {{db_call, 2}, ?MODULE, db_call_2}, + {{db_listing, 2}, ?MODULE, db_listing_2}, + {{db_listing, 3}, ?MODULE, db_listing_3}, + {{db_listing, 4}, ?MODULE, db_listing_4} + ] ). \ No newline at end of file diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 31955e9..7264f12 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -90,9 +90,10 @@ fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Para %% @private fail_goal_clauses(#cp{data = {G, Db, C}, next = Next, bs = Bs, vn = Vn}, Param) -> NextClause = case erlog_memory:next(Db) of - [] -> [{next, C}]; + [] -> io:format("empty next!~n"),[{next, C}]; N -> N end, + io:format("fail_goal_clauses next ~p~n", [NextClause]), ec_core:prove_goal_clauses(NextClause, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn}). %% @private diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index c423d9d..7764db7 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -74,11 +74,12 @@ prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bi prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); prove_goal(Param = #param{goal = G, database = Db}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), + io:format("prove goal ~p~n", [ec_support:functor(G)]), case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of {built_in, Mod} -> Mod:prove_goal(Param); %kernel space {code, {Mod, Func}} -> Mod:Func(Param); %library space - {clauses, []} -> erlog_errors:fail(Param); - {clauses, Cs} -> prove_goal_clauses(Cs, Param); %user space + {clauses, []} -> io:format("empty~n"), erlog_errors:fail(Param); + {clauses, Cs} -> io:format("found ~p~n", [Cs]), prove_goal_clauses(Cs, Param); %user space undefined -> erlog_errors:fail(Param); {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data end. @@ -87,27 +88,34 @@ prove_goal(Param = #param{goal = G, database = Db}) -> %% void. %% Try to prove Goal using Clauses which all have the same functor. prove_goal_clauses([{next, _}], Params) -> %end of checking clauses + io:format("just end~n"), erlog_errors:fail(Params); prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> %for clauses with body %% Must be smart here and test whether we need to add a cut point. %% C has the structure {Tag,Head,{Body,BodyHasCut}}. + io:format("prove last~n"), case element(2, element(3, C)) of true -> Cut = #cut{label = Vn}, + io:format("add cut point~n"), prove_goal_clause(C, Params#param{choice = [Cut | Cps]}); false -> + io:format("just prove~n"), prove_goal_clause(C, Params) end; prove_goal_clauses(C, Params = #param{goal = G, next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps, database = Db}) -> Cp = #cp{type = goal_clauses, label = Vn, data = {G, Db, C}, next = Next, bs = Bs, vn = Vn}, + io:format("ordinary prove~n"), prove_goal_clause(C, Params#param{choice = [Cp | Cps]}). prove_goal_clause([L], Param) -> prove_goal_clause(L, Param); prove_goal_clause({_Tag, H0, {B0, _}}, Param = #param{goal = G, next_goal = Next, bindings = Bs0, var_num = Vn0}) -> Label = Vn0, + io:format("prove goal clause ~p ~p~n", [H0, B0]), case ec_unify:unify_head(G, H0, Bs0, Vn0 + 1) of {succeed, Rs0, Bs1, Vn1} -> {B1, _Rs2, Vn2} = ec_body:body_instance(B0, Next, Rs0, Vn1, Label), + io:format("succeed, prove ~p~n", [B1]), ec_core:prove_body(Param#param{goal = B1, bindings = Bs1, var_num = Vn2}); - fail -> erlog_errors:fail(Param) + fail -> io:format("failed~n"), erlog_errors:fail(Param) end. \ No newline at end of file diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 69b7e71..d2fa444 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -9,6 +9,8 @@ -module(erlog_dict). +-include("erlog_core.hrl"). + -behaviour(erlog_storage). %% erlog callbacks @@ -100,7 +102,13 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call {ok, ExFun} -> {ExFun, Db}; error -> case dict:find(Functor, Dict) of %search userspace last - {ok, Cs} -> {{external, {clauses, form_clauses(Cs, external)}}, Db}; + {ok, Cs} -> + { + {#cursor{type = external, function = findall, functor = Functor}, + {clauses, form_clauses(Cs, external)} + }, + Db + }; error -> {[], Db} end end @@ -120,11 +128,14 @@ findall({StdLib, ExLib, Db}, {Functor}) -> %for bagof end. close(undefined) -> ok; -close(Cursor) -> put(Cursor, queue:new()). %save empty queue +close(Cursor) -> + io:format("close queue~n"), + put(Cursor, queue:new()). %save empty queue next(undefined) -> []; next(Cursor) -> Queue = get(Cursor), %get clauses + io:format("get queue ~p~n", [Queue]), case queue:out(Queue) of %take variant {{value, Val}, UQ} -> put(Cursor, UQ), %save others @@ -134,10 +145,10 @@ next(Cursor) -> get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> Dict = erlog_db_storage:get_db(dict, Collection), - case get_procedure({StdLib, ExLib, Dict}, {{Functor}, external}) of - {external, {Res, Udict}} -> %return with cursor + case get_procedure({StdLib, ExLib, Dict}, {Functor, external}) of + {Cursor, {Res, Udict}} when is_record(Cursor, cursor) -> %return with cursor erlog_db_storage:update_db(Collection, Udict), - {{external, Res}, Db}; + {{Cursor, Res}, Db}; {Res, Udict} -> erlog_db_storage:update_db(Collection, Udict), {Res, Db} %normal return @@ -151,7 +162,11 @@ get_procedure({StdLib, ExLib, Db}, Param) -> {ok, ExFun} -> ExFun; error -> case dict:find(Functor, Db) of %search userspace last - {ok, Cs} -> {Cursor, {clauses, form_clauses(Cs, Cursor)}}; + {ok, Cs} -> io:format("db search ~p~n", [Param]), + { + #cursor{type = Cursor, function = get_procedure, functor = Functor, data = Cursor}, + {clauses, form_clauses(Cs, Cursor)} + }; error -> undefined end end @@ -231,9 +246,11 @@ check_immutable(Dict, Functor) -> form_clauses(Loaded, _) when length(Loaded) =< 1 -> Loaded; form_clauses([First | Loaded], Cursor) -> Queue = queue:from_list(Loaded), + io:format("put queue ~p~n", [Queue]), put(Cursor, Queue), First. %% @private -check_param({Functor}) -> {Functor, cursor}; +%% Spike for imitation normal cursors, as separate processes +check_param({Functor}) -> {Functor, core}; check_param({{Functor}, external}) -> {Functor, external}. \ No newline at end of file diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 94afcdc..02dd1c0 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -9,6 +9,8 @@ -module(erlog_memory). -author("tihon"). +-include("erlog_core.hrl"). + -behaviour(gen_server). %% API @@ -62,8 +64,8 @@ database :: atom(), % callback module for user-space memory in_mem :: dict, %integrated memory for findall operations state :: term(), % callback state - core_cursor :: pid() | atom(), %cursors for db and normal operations - external_cursor :: pid() | atom() + core_cursor = #cursor{} :: #cursor{}, %cursors for db and normal operations + external_cursor = #cursor{} :: #cursor{} }). %%%=================================================================== @@ -83,7 +85,7 @@ assertz_clause(Database, Head, Body) -> gen_server:call(Database, {assertz_claus db_assertz_clause(Database, Collection, {':-', Head, Body}) -> db_assertz_clause(Database, Collection, Head, Body); db_assertz_clause(Database, Collection, Head) -> db_assertz_clause(Database, Collection, Head, true). db_assertz_clause(Database, Collection, Head, Body) -> - gen_server:call(Database, {assertz_clause, {Collection, Head, Body}}). + gen_server:call(Database, {db, {assertz_clause, {Collection, Head, Body}}}). asserta_clause(Database, {':-', H, B}) -> asserta_clause(Database, H, B); asserta_clause(Database, H) -> asserta_clause(Database, H, true). @@ -92,22 +94,24 @@ asserta_clause(Database, Head, Body) -> gen_server:call(Database, {asserta_claus db_asserta_clause(Database, Collection, {':-', H, B}) -> db_asserta_clause(Database, Collection, H, B); db_asserta_clause(Database, Collection, H) -> db_asserta_clause(Database, Collection, H, true). db_asserta_clause(Database, Collection, Head, Body) -> - gen_server:call(Database, {asserta_clause, {Collection, Head, Body}}). + gen_server:call(Database, {db, {asserta_clause, {Collection, Head, Body}}}). -db_findall(Database, Collection, Fun) -> gen_server:call(Database, {findall, {Collection, Fun}}). +db_findall(Database, Collection, Fun) -> gen_server:call(Database, {db, {findall, {Collection, Fun}}}). finadll(Database, Fun) -> gen_server:call(Database, {findall, {Fun}}). db_next(Database) -> gen_server:call(Database, db_next). next(Database) -> gen_server:call(Database, next). retract_clause(Database, F, Ct) -> gen_server:call(Database, {retract_clause, {F, Ct}}). -db_retract_clause(Database, Collection, F, Ct) -> gen_server:call(Database, {retract_clause, {Collection, F, Ct}}). +db_retract_clause(Database, Collection, F, Ct) -> + gen_server:call(Database, {db, {retract_clause, {Collection, F, Ct}}}). abolish_clauses(Database, Func) -> gen_server:call(Database, {abolish_clauses, {Func}}). -db_abolish_clauses(Database, Collection, Func) -> gen_server:call(Database, {abolish_clauses, {Collection, Func}}). +db_abolish_clauses(Database, Collection, Func) -> + gen_server:call(Database, {db, {abolish_clauses, {Collection, Func}}}). get_procedure(Database, Func) -> gen_server:call(Database, {get_procedure, {Func}}). -get_db_procedure(Database, Collection, Func) -> gen_server:call(Database, {get_procedure, {Collection, Func}}). +get_db_procedure(Database, Collection, Func) -> gen_server:call(Database, {db, {get_procedure, {Collection, Func}}}). get_procedure_type(Database, Func) -> gen_server:call(Database, {get_procedure_type, {Func}}). @@ -123,7 +127,7 @@ raw_erase(Database, Key) -> gen_server:call(Database, {raw_erase, {Key}}). listing(Database, Args) -> gen_server:call(Database, {listing, {Args}}). -db_listing(Database, Collection, Args) -> gen_server:call(Database, {listing, {Collection, Args}}). +db_listing(Database, Collection, Args) -> gen_server:call(Database, {db, {listing, {Collection, Args}}}). %%-------------------------------------------------------------------- %% @doc @@ -212,50 +216,28 @@ handle_call({abolish_clauses, {Func}}, _From, State = #state{state = DbState, da catch throw:E -> {reply, E, State} end; -handle_call({abolish_clauses, {_, Func} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module +handle_call({db, {abolish_clauses, {_, Func} = Params}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module try {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, Params), {reply, Res, State#state{state = NewState, exlib = UpdExlib}} catch throw:E -> {reply, E, State} end; -handle_call({findall, {Collection, Fun}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, - exlib = ExLib, external_cursor = External}) -> - Db:close(External), %close old cursor - case Db:findall({StdLib, ExLib, DbState}, {Collection, Fun}) of %take new cursor if needed - {{Cursor, Res}, UState} when is_pid(Cursor); Cursor == external -> - {reply, Res, State#state{state = UState, external_cursor = Cursor}}; - {Res, UState} -> - {reply, Res, State#state{state = UState}} - end; -handle_call({get_procedure, {Func}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, - exlib = ExLib, core_cursor = Core}) -> - Db:close(Core), %close old cursor - case Db:get_procedure({StdLib, ExLib, DbState}, {Func}) of %take new cursor if needed - {{Cursor, Res}, UState} when is_pid(Cursor); Cursor == cursor -> - {reply, Res, State#state{state = UState, core_cursor = Cursor}}; - {Res, UState} -> - {reply, Res, State#state{state = UState}} - end; -handle_call({get_procedure, {Collection, Func}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, - exlib = ExLib, external_cursor = External}) -> - Db:close(External), %close old cursor - case Db:get_procedure({StdLib, ExLib, DbState}, {Collection, Func}) of %take new cursor if needed - {{Cursor, Res}, UState} when is_pid(Cursor); Cursor == external -> - {reply, Res, State#state{state = UState, external_cursor = Cursor}}; - {Res, UState} -> - {reply, Res, State#state{state = UState}} - end; handle_call(next, _From, State = #state{database = Db, core_cursor = Core}) -> %get next result by cursor - Res = Db:next(Core), + Res = Db:next(Core#cursor.data), {reply, Res, State}; handle_call(db_next, _From, State = #state{database = Db, external_cursor = External}) -> %get next result by cursor - Res = Db:next(External), + Res = Db:next(External#cursor.data), {reply, Res, State}; -handle_call({Fun, Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module +handle_call({Fun, Params}, _From, State = #state{core_cursor = Core}) -> %call third-party db module try - {Res, NewState} = Db:Fun({StdLib, ExLib, DbState}, Params), - {reply, Res, State#state{state = NewState}} + check_cursor(Core, Fun, Params, State) + catch + throw:E -> {reply, E, State} + end; +handle_call({db, {Fun, Params}}, _From, State = #state{external_cursor = External}) -> %call third-party db module + try + check_cursor(External, Fun, Params, State) catch throw:E -> {reply, E, State} end; @@ -342,15 +324,18 @@ init_memory(State) -> D = dict:new(), State#state{stdlib = D, exlib = D, in_mem = D}. +%% @private fetch(Key, Memory) -> case dict:find(Key, Memory) of error -> []; {ok, Value} -> Value end. +%% @private store(Key, Value, Memory) -> dict:store(Key, Value, Memory). +%% @private check_abolish(Func, StdLib, ExLib, Db, DbState, Params) -> case dict:erase(Func, ExLib) of ExLib -> %dict not changed - was not deleted. Search userspace @@ -358,4 +343,26 @@ check_abolish(Func, StdLib, ExLib, Db, DbState, Params) -> {ExLib, NewState, Res}; UExlib -> %dict changed -> was deleted {UExlib, DbState, ok} - end. \ No newline at end of file + end. + +check_cursor(#cursor{type = external, function = Fun, functor = Functor, data = Data}, Fun, {_, Functor}, State = #state{database = Db}) -> %request to same cursor + Res = Db:next(Data), + io:format("next for functor ~p~n", [Functor]), + {reply, Res, State}; +check_cursor(#cursor{type = core, function = Fun, functor = Functor, data = Data}, Fun,{Functor}, State = #state{database = Db}) -> %request to same cursor + Res = Db:next(Data), + io:format("next for functor ~p~n", [Functor]), + {reply, Res, State}; +check_cursor(#cursor{function = F, functor = F1, data = Data}, Fun, Params, State = #state{database = Db, stdlib = StdLib, exlib = ExLib, state = DbState}) -> %no match + Db:close(Data), + io:format("cursor mismatch - ext ~p ~p ~p ~p~n", [F, F1, Fun, Params]), + check_result(Db:Fun({StdLib, ExLib, DbState}, Params), State). + +%% @private +%% Update cursor, if we got it +check_result({{Cursor = #cursor{type = external}, Res}, UState}, State) -> + {reply, Res, State#state{state = UState, external_cursor = Cursor}}; +check_result({{Cursor = #cursor{type = core}, Res}, UState}, State) -> + {reply, Res, State#state{state = UState, core_cursor = Cursor}}; +check_result({Res, UState}, State) -> + {reply, Res, State#state{state = UState}}. From 1035f51debcd1d31dd9a10edf3cd01249d376d8d Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 30 Sep 2014 12:23:12 +0000 Subject: [PATCH 153/251] fix closing cursor issue --- src/core/erlog_errors.erl | 3 +- src/core/logic/ec_core.erl | 14 +---- src/interface/local/erlog_local_shell.erl | 69 +++++++++++++---------- src/storage/erlog_dict.erl | 37 +++++------- src/storage/erlog_ets.erl | 28 +++++---- src/storage/erlog_memory.erl | 56 ++++++++---------- 6 files changed, 95 insertions(+), 112 deletions(-) diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 7264f12..31955e9 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -90,10 +90,9 @@ fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Para %% @private fail_goal_clauses(#cp{data = {G, Db, C}, next = Next, bs = Bs, vn = Vn}, Param) -> NextClause = case erlog_memory:next(Db) of - [] -> io:format("empty next!~n"),[{next, C}]; + [] -> [{next, C}]; N -> N end, - io:format("fail_goal_clauses next ~p~n", [NextClause]), ec_core:prove_goal_clauses(NextClause, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn}). %% @private diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index 7764db7..c423d9d 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -74,12 +74,11 @@ prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bi prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); prove_goal(Param = #param{goal = G, database = Db}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), - io:format("prove goal ~p~n", [ec_support:functor(G)]), case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of {built_in, Mod} -> Mod:prove_goal(Param); %kernel space {code, {Mod, Func}} -> Mod:Func(Param); %library space - {clauses, []} -> io:format("empty~n"), erlog_errors:fail(Param); - {clauses, Cs} -> io:format("found ~p~n", [Cs]), prove_goal_clauses(Cs, Param); %user space + {clauses, []} -> erlog_errors:fail(Param); + {clauses, Cs} -> prove_goal_clauses(Cs, Param); %user space undefined -> erlog_errors:fail(Param); {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data end. @@ -88,34 +87,27 @@ prove_goal(Param = #param{goal = G, database = Db}) -> %% void. %% Try to prove Goal using Clauses which all have the same functor. prove_goal_clauses([{next, _}], Params) -> %end of checking clauses - io:format("just end~n"), erlog_errors:fail(Params); prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> %for clauses with body %% Must be smart here and test whether we need to add a cut point. %% C has the structure {Tag,Head,{Body,BodyHasCut}}. - io:format("prove last~n"), case element(2, element(3, C)) of true -> Cut = #cut{label = Vn}, - io:format("add cut point~n"), prove_goal_clause(C, Params#param{choice = [Cut | Cps]}); false -> - io:format("just prove~n"), prove_goal_clause(C, Params) end; prove_goal_clauses(C, Params = #param{goal = G, next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps, database = Db}) -> Cp = #cp{type = goal_clauses, label = Vn, data = {G, Db, C}, next = Next, bs = Bs, vn = Vn}, - io:format("ordinary prove~n"), prove_goal_clause(C, Params#param{choice = [Cp | Cps]}). prove_goal_clause([L], Param) -> prove_goal_clause(L, Param); prove_goal_clause({_Tag, H0, {B0, _}}, Param = #param{goal = G, next_goal = Next, bindings = Bs0, var_num = Vn0}) -> Label = Vn0, - io:format("prove goal clause ~p ~p~n", [H0, B0]), case ec_unify:unify_head(G, H0, Bs0, Vn0 + 1) of {succeed, Rs0, Bs1, Vn1} -> {B1, _Rs2, Vn2} = ec_body:body_instance(B0, Next, Rs0, Vn1, Label), - io:format("succeed, prove ~p~n", [B1]), ec_core:prove_body(Param#param{goal = B1, bindings = Bs1, var_num = Vn2}); - fail -> io:format("failed~n"), erlog_errors:fail(Param) + fail -> erlog_errors:fail(Param) end. \ No newline at end of file diff --git a/src/interface/local/erlog_local_shell.erl b/src/interface/local/erlog_local_shell.erl index de82a77..6476824 100644 --- a/src/interface/local/erlog_local_shell.erl +++ b/src/interface/local/erlog_local_shell.erl @@ -21,58 +21,65 @@ -export([start/0, start/1]). start() -> - io:fwrite("Erlog Shell V~s (abort with ^G)\n", - [erlang:system_info(version)]), - {ok, Core} = erlog:start_link(), - {ok, _} = erlog_db_storage:start_link(), %start default ets-implementation of stand-alone database-module - server_loop(Core, normal, []). + io:fwrite("Erlog Shell V~s (abort with ^G)\n", + [erlang:system_info(version)]), + {ok, Core} = erlog:start_link(), + start_db_if_needed(), %start default ets-implementation of stand-alone database-module + server_loop(Core, normal, []). start(Debugger) -> - io:fwrite("Erlog Shell V~s with debugger (abort with ^G)\n", - [erlang:system_info(version)]), - {ok, Core} = erlog:start_link( + io:fwrite("Erlog Shell V~s with debugger (abort with ^G)\n", + [erlang:system_info(version)]), + {ok, Core} = erlog:start_link( [ {event_h, {erlog_simple_printer, []}}, {debugger, fun(Status, Functor, Result) -> gen_server:call(Debugger, {Status, Functor, Result}, infinity) end}]), - {ok, _} = erlog_db_storage:start_link(), %start default ets-implementation of stand-alone database-module - server_loop(Core, normal, []). + start_db_if_needed(), %start default ets-implementation of stand-alone database-module + server_loop(Core, normal, []). %% A simple Erlog shell similar to a "normal" Prolog shell. It allows %% user to enter goals, see resulting bindings and request next %% solution. server_loop(Core, State, Line) -> - Term = io:get_line('| ?- '), - Res = case State of - select -> erlog:select(Core, lists:append(Line, Term)); - _ -> erlog:execute(Core, lists:append(Line, Term), infinity) - end, - {NewState, NewLine} = process_execute(Res, State, Line, Term), - case Term of - "halt.\n" -> ok; - _ -> server_loop(Core, NewState, NewLine) - end. + Term = io:get_line('| ?- '), + Res = case State of + select -> erlog:select(Core, lists:append(Line, Term)); + _ -> erlog:execute(Core, lists:append(Line, Term), infinity) + end, + {NewState, NewLine} = process_execute(Res, State, Line, Term), + case Term of + "halt.\n" -> ok; + _ -> server_loop(Core, NewState, NewLine) + end. %% Processes return value after execution. -spec process_execute(tuple(), atom(), list(), string()) -> tuple(). process_execute({ok, more}, State, Line, Command) -> - {State, lists:append(Line, Command)}; + {State, lists:append(Line, Command)}; process_execute({ok, halt}, _, _, _) -> - io:format("OK."), - exit(normal); + io:format("OK."), + exit(normal); process_execute(Reply, _, _, _) -> - process_reply(Reply). + process_reply(Reply). %% Processes reply from prolog. Form it to normal view. -spec process_reply(tuple()) -> tuple(). process_reply({Res, select}) -> - print_res(Res), - {select, []}; + print_res(Res), + {select, []}; process_reply(Res) -> - print_res(Res), - {normal, []}. + print_res(Res), + {normal, []}. print_res({Bool, Bindings}) -> - io:format("~p~n", [Bool]), - lists:foreach(fun({Var, Value}) -> io:format("~p = ~p~n", [Var, Value]) end, Bindings); + io:format("~p~n", [Bool]), + lists:foreach(fun({Var, Value}) -> io:format("~p = ~p~n", [Var, Value]) end, Bindings); print_res(Res) -> - io:format("~p~n", [Res]). \ No newline at end of file + io:format("~p~n", [Res]). + +start_db_if_needed() -> + case whereis(erlog_db_storage) of + undefined -> + {ok, _} = erlog_db_storage:start_link(); + _ -> ok + end. \ No newline at end of file diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index d2fa444..f0962ba 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -103,12 +103,8 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call error -> case dict:find(Functor, Dict) of %search userspace last {ok, Cs} -> - { - {#cursor{type = external, function = findall, functor = Functor}, - {clauses, form_clauses(Cs, external)} - }, - Db - }; + Cursor = #cursor{type = external, function = findall, functor = Functor, data = stub}, + {{Cursor, {clauses, form_clauses(Cs, Cursor)}}, Db}; error -> {[], Db} end end @@ -127,18 +123,16 @@ findall({StdLib, ExLib, Db}, {Functor}) -> %for bagof end end. -close(undefined) -> ok; -close(Cursor) -> - io:format("close queue~n"), - put(Cursor, queue:new()). %save empty queue +close(#cursor{data = undefined}) -> ok; +close(#cursor{functor = Functor}) -> + put(Functor, queue:new()). %save empty queue next(undefined) -> []; -next(Cursor) -> - Queue = get(Cursor), %get clauses - io:format("get queue ~p~n", [Queue]), +next(#cursor{functor = Functor}) -> + Queue = get(Functor), %get clauses case queue:out(Queue) of %take variant {{value, Val}, UQ} -> - put(Cursor, UQ), %save others + put(Functor, UQ), %save others Val; %return it {empty, _} -> [] %nothing to return end. @@ -154,7 +148,7 @@ get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> {Res, Db} %normal return end; get_procedure({StdLib, ExLib, Db}, Param) -> - {Functor, Cursor} = check_param(Param), + {Functor, Type} = check_param(Param), Res = case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> StFun; error -> @@ -162,11 +156,9 @@ get_procedure({StdLib, ExLib, Db}, Param) -> {ok, ExFun} -> ExFun; error -> case dict:find(Functor, Db) of %search userspace last - {ok, Cs} -> io:format("db search ~p~n", [Param]), - { - #cursor{type = Cursor, function = get_procedure, functor = Functor, data = Cursor}, - {clauses, form_clauses(Cs, Cursor)} - }; + {ok, Cs} -> + Cursor = #cursor{type = Type, function = get_procedure, functor = Functor, data = stub}, + {Cursor, {clauses, form_clauses(Cs, Cursor)}}; error -> undefined end end @@ -244,10 +236,9 @@ check_immutable(Dict, Functor) -> %% @private form_clauses(Loaded, _) when length(Loaded) =< 1 -> Loaded; -form_clauses([First | Loaded], Cursor) -> +form_clauses([First | Loaded], #cursor{functor = Functor}) -> Queue = queue:from_list(Loaded), - io:format("put queue ~p~n", [Queue]), - put(Cursor, Queue), + put(Functor, Queue), First. %% @private diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 3efda5e..6a7780e 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -9,6 +9,8 @@ -module(erlog_ets). +-include("erlog_core.hrl"). + -behaviour(erlog_storage). %% erlog callbacks @@ -96,7 +98,8 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call Cs when is_list(Cs) -> Cs; _ -> [] end, - {{external, {clauses, form_clauses(CS, external)}}, Db} + Cursor = #cursor{type = external, function = findall, functor = Functor, data = stub}, + {{Cursor, {clauses, form_clauses(CS, Cursor)}}, Db} end end; findall({StdLib, ExLib, Db}, {Functor}) -> @@ -114,15 +117,16 @@ findall({StdLib, ExLib, Db}, {Functor}) -> end end. -close(undefined) -> ok; -close(Cursor) -> put(Cursor, queue:new()). %save empty queue +close(#cursor{data = undefined}) -> ok; +close(#cursor{functor = Functor}) -> + put(Functor, queue:new()). %save empty queue next(undefined) -> []; -next(Cursor) -> - Queue = get(Cursor), %get clauses +next(#cursor{functor = Functor}) -> + Queue = get(Functor), %get clauses case queue:out(Queue) of %take variant {{value, Val}, UQ} -> - put(Cursor, UQ), %save others + put(Functor, UQ), %save others Val; %return it {empty, _} -> [] %nothing to return end. @@ -136,7 +140,7 @@ get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> {Res, Db} %normal return end; get_procedure({StdLib, ExLib, Db}, Param) -> - {Functor, Cursor} = check_param(Param), + {Functor, Type} = check_param(Param), Res = case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> StFun; error -> @@ -144,7 +148,9 @@ get_procedure({StdLib, ExLib, Db}, Param) -> {ok, ExFun} -> ExFun; error -> case catch ets:lookup_element(Db, Functor, 2) of %search userspace last - Cs when is_list(Cs) -> {Cursor, {clauses, form_clauses(Cs, Cursor)}}; + Cs when is_list(Cs) -> + Cursor = #cursor{type = Type, function = get_procedure, functor = Functor, data = stub}, + {Cursor, {clauses, form_clauses(Cs, Cursor)}}; _ -> undefined end end @@ -226,11 +232,11 @@ check_immutable(Dict, Functor) -> %TODO may be move me to erlog_memory? %% @private form_clauses(Loaded, _) when length(Loaded) =< 1 -> Loaded; -form_clauses([First | Loaded], Cursor) -> +form_clauses([First | Loaded], #cursor{functor = Functor}) -> Queue = queue:from_list(Loaded), - put(Cursor, Queue), + put(Functor, Queue), First. %% @private -check_param({Functor}) -> {Functor, cursor}; +check_param({Functor}) -> {Functor, core}; check_param({{Functor}, external}) -> {Functor, external}. \ No newline at end of file diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 02dd1c0..15b79b1 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -85,7 +85,7 @@ assertz_clause(Database, Head, Body) -> gen_server:call(Database, {assertz_claus db_assertz_clause(Database, Collection, {':-', Head, Body}) -> db_assertz_clause(Database, Collection, Head, Body); db_assertz_clause(Database, Collection, Head) -> db_assertz_clause(Database, Collection, Head, true). db_assertz_clause(Database, Collection, Head, Body) -> - gen_server:call(Database, {db, {assertz_clause, {Collection, Head, Body}}}). + gen_server:call(Database, {assertz_clause, {Collection, Head, Body}}). asserta_clause(Database, {':-', H, B}) -> asserta_clause(Database, H, B); asserta_clause(Database, H) -> asserta_clause(Database, H, true). @@ -94,9 +94,9 @@ asserta_clause(Database, Head, Body) -> gen_server:call(Database, {asserta_claus db_asserta_clause(Database, Collection, {':-', H, B}) -> db_asserta_clause(Database, Collection, H, B); db_asserta_clause(Database, Collection, H) -> db_asserta_clause(Database, Collection, H, true). db_asserta_clause(Database, Collection, Head, Body) -> - gen_server:call(Database, {db, {asserta_clause, {Collection, Head, Body}}}). + gen_server:call(Database, {asserta_clause, {Collection, Head, Body}}). -db_findall(Database, Collection, Fun) -> gen_server:call(Database, {db, {findall, {Collection, Fun}}}). +db_findall(Database, Collection, Fun) -> gen_server:call(Database, {findall, {Collection, Fun}}). finadll(Database, Fun) -> gen_server:call(Database, {findall, {Fun}}). db_next(Database) -> gen_server:call(Database, db_next). @@ -104,14 +104,14 @@ next(Database) -> gen_server:call(Database, next). retract_clause(Database, F, Ct) -> gen_server:call(Database, {retract_clause, {F, Ct}}). db_retract_clause(Database, Collection, F, Ct) -> - gen_server:call(Database, {db, {retract_clause, {Collection, F, Ct}}}). + gen_server:call(Database, {retract_clause, {Collection, F, Ct}}). abolish_clauses(Database, Func) -> gen_server:call(Database, {abolish_clauses, {Func}}). db_abolish_clauses(Database, Collection, Func) -> - gen_server:call(Database, {db, {abolish_clauses, {Collection, Func}}}). + gen_server:call(Database, {abolish_clauses, {Collection, Func}}). get_procedure(Database, Func) -> gen_server:call(Database, {get_procedure, {Func}}). -get_db_procedure(Database, Collection, Func) -> gen_server:call(Database, {db, {get_procedure, {Collection, Func}}}). +get_db_procedure(Database, Collection, Func) -> gen_server:call(Database, {get_procedure, {Collection, Func}}). get_procedure_type(Database, Func) -> gen_server:call(Database, {get_procedure_type, {Func}}). @@ -127,7 +127,7 @@ raw_erase(Database, Key) -> gen_server:call(Database, {raw_erase, {Key}}). listing(Database, Args) -> gen_server:call(Database, {listing, {Args}}). -db_listing(Database, Collection, Args) -> gen_server:call(Database, {db, {listing, {Collection, Args}}}). +db_listing(Database, Collection, Args) -> gen_server:call(Database, {listing, {Collection, Args}}). %%-------------------------------------------------------------------- %% @doc @@ -216,7 +216,7 @@ handle_call({abolish_clauses, {Func}}, _From, State = #state{state = DbState, da catch throw:E -> {reply, E, State} end; -handle_call({db, {abolish_clauses, {_, Func} = Params}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module +handle_call({abolish_clauses, {_, Func} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module try {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, Params), {reply, Res, State#state{state = NewState, exlib = UpdExlib}} @@ -224,20 +224,14 @@ handle_call({db, {abolish_clauses, {_, Func} = Params}}, _From, State = #state{s throw:E -> {reply, E, State} end; handle_call(next, _From, State = #state{database = Db, core_cursor = Core}) -> %get next result by cursor - Res = Db:next(Core#cursor.data), + Res = Db:next(Core), {reply, Res, State}; handle_call(db_next, _From, State = #state{database = Db, external_cursor = External}) -> %get next result by cursor - Res = Db:next(External#cursor.data), + Res = Db:next(External), {reply, Res, State}; -handle_call({Fun, Params}, _From, State = #state{core_cursor = Core}) -> %call third-party db module +handle_call({Fun, Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module try - check_cursor(Core, Fun, Params, State) - catch - throw:E -> {reply, E, State} - end; -handle_call({db, {Fun, Params}}, _From, State = #state{external_cursor = External}) -> %call third-party db module - try - check_cursor(External, Fun, Params, State) + check_result(Db:Fun({StdLib, ExLib, DbState}, Params), State) catch throw:E -> {reply, E, State} end; @@ -262,7 +256,9 @@ handle_call(_Request, _From, State) -> {noreply, NewState :: #state{}} | {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), NewState :: #state{}}). -handle_cast(halt, State) -> +handle_cast(halt, State = #state{core_cursor = Core, external_cursor = External, database = Db}) -> + Db:close(Core), + Db:close(External), {stop, normal, State}; handle_cast(_Request, State) -> {noreply, State}. @@ -345,24 +341,16 @@ check_abolish(Func, StdLib, ExLib, Db, DbState, Params) -> {UExlib, DbState, ok} end. -check_cursor(#cursor{type = external, function = Fun, functor = Functor, data = Data}, Fun, {_, Functor}, State = #state{database = Db}) -> %request to same cursor - Res = Db:next(Data), - io:format("next for functor ~p~n", [Functor]), - {reply, Res, State}; -check_cursor(#cursor{type = core, function = Fun, functor = Functor, data = Data}, Fun,{Functor}, State = #state{database = Db}) -> %request to same cursor - Res = Db:next(Data), - io:format("next for functor ~p~n", [Functor]), - {reply, Res, State}; -check_cursor(#cursor{function = F, functor = F1, data = Data}, Fun, Params, State = #state{database = Db, stdlib = StdLib, exlib = ExLib, state = DbState}) -> %no match - Db:close(Data), - io:format("cursor mismatch - ext ~p ~p ~p ~p~n", [F, F1, Fun, Params]), - check_result(Db:Fun({StdLib, ExLib, DbState}, Params), State). - %% @private %% Update cursor, if we got it -check_result({{Cursor = #cursor{type = external}, Res}, UState}, State) -> +check_result({{Cursor = #cursor{type = external}, Res}, UState}, State = #state{external_cursor = Old, database = Db}) -> + close_cursor(Cursor, Old, Db), {reply, Res, State#state{state = UState, external_cursor = Cursor}}; -check_result({{Cursor = #cursor{type = core}, Res}, UState}, State) -> +check_result({{Cursor = #cursor{type = core}, Res}, UState}, State = #state{core_cursor = Old, database = Db}) -> + close_cursor(Cursor, Old, Db), {reply, Res, State#state{state = UState, core_cursor = Cursor}}; check_result({Res, UState}, State) -> {reply, Res, State#state{state = UState}}. + +close_cursor(Same, Same, _) -> ok; +close_cursor(_, Cursor, Db) -> Db:close(Cursor). From ca50626f79d17de51dffe5cf6ff4f935b5fcb66d Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 1 Oct 2014 23:45:48 +0000 Subject: [PATCH 154/251] fix complex variant selecting, break hand variants selecting --- include/erlog_core.hrl | 13 ++------- src/core/erlog_errors.erl | 14 ++-------- src/core/logic/ec_core.erl | 33 ++++++++++++++++------ src/libs/external/db/erlog_db.erl | 44 ++++++++++++++--------------- src/storage/erlog_dict.erl | 44 ++++++++++++----------------- src/storage/erlog_ets.erl | 41 ++++++++++++--------------- src/storage/erlog_memory.erl | 46 ++++++++++--------------------- 7 files changed, 101 insertions(+), 134 deletions(-) diff --git a/include/erlog_core.hrl b/include/erlog_core.hrl index 8814343..a47bd41 100644 --- a/include/erlog_core.hrl +++ b/include/erlog_core.hrl @@ -41,7 +41,8 @@ database, event_man, f_consulter, - debugger + debugger, + cursor }). -define(ERLOG_CORE, @@ -89,12 +90,4 @@ {to_integer, 2}, {to_string, 2} ] -). - --record(cursor, -{ - type :: core | external, %type of cursor. Ordinary cursor, or external cursor for db_library - function :: atom(), %function, which used cursor last - functor :: tuple(), %functor, which was searched through cursor last - data :: atom() | pid() %cursor initial data, pid of database cursor's connection or smth else -}). \ No newline at end of file +). \ No newline at end of file diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 31955e9..d033971 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -45,8 +45,6 @@ erlog_error(E) -> throw({erlog_error, E}). %% backwards over choice points until matching cut. fail(Param = #param{choice = [#cp{type = goal_clauses} = Cp | Cps]}) -> fail_goal_clauses(Cp, Param#param{choice = Cps}); -fail(Param = #param{choice = [#cp{type = db_goal_clauses} = Cp | Cps]}) -> - fail_db_goal_clauses(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = Type} = Cp | Cps]}) when Type == disjunction; Type == if_then_else -> fail_disjunction(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = clause} = Cp | Cps]}) -> @@ -88,21 +86,13 @@ fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Para ec_logic:prove_predicates(Pi, Fs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private -fail_goal_clauses(#cp{data = {G, Db, C}, next = Next, bs = Bs, vn = Vn}, Param) -> - NextClause = case erlog_memory:next(Db) of +fail_goal_clauses(#cp{data = {G, Db, C, Cursor}, next = Next, bs = Bs, vn = Vn}, Param) -> + NextClause = case erlog_memory:next(Db, Cursor) of [] -> [{next, C}]; N -> N end, ec_core:prove_goal_clauses(NextClause, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn}). -%% @private -fail_db_goal_clauses(#cp{data = {G, Db, C}, next = Next, bs = Bs, vn = Vn}, Param) -> - NextClause = case erlog_memory:db_next(Db) of - [] -> [C]; - N -> N - end, - ec_core:prove_goal_clauses(NextClause, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn}). - fail_findall(#cp{next = Next, data = {Tag, Bag}, bs = Bs, vn = Vn0}, Param = #param{database = Db}) -> Data = erlog_memory:raw_fetch(Db, Tag), erlog_memory:raw_erase(Db, Tag), %Clear special entry diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index c423d9d..73ff6f1 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -75,12 +75,9 @@ prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bi prove_goal(Param = #param{goal = G, database = Db}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of - {built_in, Mod} -> Mod:prove_goal(Param); %kernel space - {code, {Mod, Func}} -> Mod:Func(Param); %library space - {clauses, []} -> erlog_errors:fail(Param); - {clauses, Cs} -> prove_goal_clauses(Cs, Param); %user space - undefined -> erlog_errors:fail(Param); - {erlog_error, E} -> erlog_errors:erlog_error(E, Db) %Fill in more error data + {cursor, Cursor, result, Result} -> + run_n_close(Result, Param#param{cursor = Cursor}); + Result -> check_result(Result, Param) end. %% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> @@ -98,8 +95,8 @@ prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> %for cla false -> prove_goal_clause(C, Params) end; -prove_goal_clauses(C, Params = #param{goal = G, next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps, database = Db}) -> - Cp = #cp{type = goal_clauses, label = Vn, data = {G, Db, C}, next = Next, bs = Bs, vn = Vn}, +prove_goal_clauses(C, Params = #param{goal = G, next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps, database = Db, cursor = Cursor}) -> + Cp = #cp{type = goal_clauses, label = Vn, data = {G, Db, C, Cursor}, next = Next, bs = Bs, vn = Vn}, prove_goal_clause(C, Params#param{choice = [Cp | Cps]}). prove_goal_clause([L], Param) -> prove_goal_clause(L, Param); @@ -110,4 +107,22 @@ prove_goal_clause({_Tag, H0, {B0, _}}, Param = #param{goal = G, next_goal = Next {B1, _Rs2, Vn2} = ec_body:body_instance(B0, Next, Rs0, Vn1, Label), ec_core:prove_body(Param#param{goal = B1, bindings = Bs1, var_num = Vn2}); fail -> erlog_errors:fail(Param) - end. \ No newline at end of file + end. + +run_n_close(Result, Param = #param{database = Db, cursor = Cursor}) -> + try + Res = check_result(Result, Param), + erlog_memory:close(Db, Cursor), + Res + catch + throw:E -> + erlog_memory:close(Db, Cursor), + throw(E) + end. + +check_result({built_in, Mod}, Param) -> Mod:prove_goal(Param); +check_result({code, {Mod, Func}}, Param) -> Mod:Func(Param); +check_result({clauses, []}, Param) -> erlog_errors:fail(Param); +check_result({clauses, Cs}, Param) -> prove_goal_clauses(Cs, Param); +check_result(undefined, Param) -> erlog_errors:fail(Param); +check_result({erlog_error, E}, #param{database = Db}) -> erlog_errors:erlog_error(E, Db). \ No newline at end of file diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 03ccaa4..85de28b 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -33,10 +33,9 @@ load(Db) -> db_call_2(Param = #param{goal = {db_call, _, _} = Goal, next_goal = Next0, bindings = Bs, database = Db}) -> {db_call, Table, G} = ec_support:dderef(Goal, Bs), case erlog_memory:db_findall(Db, Table, ec_support:functor(G)) of - [] -> erlog_errors:fail(Param); - {erlog_error, E} -> erlog_errors:erlog_error(E, Db); - {clauses, Cs} -> prove_call(G, Cs, Next0, Param); - Cs -> prove_call(G, Cs, Next0, Param) + {cursor, Cursor, result, Result} -> + run_n_close(Result, Param#param{cursor = Cursor}, G, Next0); + Result -> check_result(Result, Param, G, Next0) end. db_assert_2(Params = #param{goal = {db_assert, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> @@ -100,8 +99,8 @@ prove_call(G, Cs, Next0, Param = #param{bindings = Bs, choice = Cps, database = {[Next1 | _], true} -> %% Must increment Vn to avoid clashes!!! Cut = #cut{label = Vn}, - prove_goal_clauses(Cs, Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); - {[Next1 | _], false} -> prove_goal_clauses(Cs, Param#param{goal = Next1, var_num = Vn + 1}) + ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); + {[Next1 | _], false} -> ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, var_num = Vn + 1}) end. %% @private @@ -155,19 +154,20 @@ retract_clauses(Ch, Cb, [C | Cs], Param = #param{bindings = Bs0, var_num = Vn0}, fail_retract(#cp{data = {Ch, Cb, Cs, Table}, next = Next, bs = Bs, vn = Vn}, Param) -> retract_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}, Table). -%% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Try to prove Goal using Clauses which all have the same functor. -prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> - %% Must be smart here and test whether we need to add a cut point. - %% C has the structure {Tag,Head,{Body,BodyHasCut}}. - case element(2, element(3, C)) of - true -> - Cut = #cut{label = Vn}, - erlog_errors:fail(Params#param{choice = [Cut | Cps]}); - false -> - erlog_errors:fail(Params) - end; -prove_goal_clauses(C, Params = #param{goal = G, next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps, database = Db}) -> - Cp = #cp{type = db_goal_clauses, label = Vn, data = {G, Db, C}, next = Next, bs = Bs, vn = Vn}, - ec_core:prove_goal_clause(C, Params#param{choice = [Cp | Cps]}). \ No newline at end of file +%% @private +run_n_close(Result, Param = #param{database = Db, cursor = Cursor}, G, Next0) -> + try + Res = check_result(Result, Param#param{cursor = Cursor}, G, Next0), + erlog_memory:close(Db, Cursor), + Res + catch + throw:E -> + erlog_memory:close(Db, Cursor), + throw(E) + end. + +%% @private +check_result([], Param, _, _) -> erlog_errors:fail(Param); +check_result({clauses, Cs}, Param, G, Next) -> prove_call(G, Cs, Next, Param); +check_result({erlog_error, E}, #param{database = Db}, _, _) -> erlog_errors:erlog_error(E, Db); +check_result(Cs, Param, G, Next) -> prove_call(G, Cs, Next, Param). \ No newline at end of file diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index f0962ba..482f546 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -103,8 +103,8 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call error -> case dict:find(Functor, Dict) of %search userspace last {ok, Cs} -> - Cursor = #cursor{type = external, function = findall, functor = Functor, data = stub}, - {{Cursor, {clauses, form_clauses(Cs, Cursor)}}, Db}; + Cursor = form_cursor(), + {{cursor, Cursor, result, {clauses, form_clauses(Cs, Cursor)}}, Db}; error -> {[], Db} end end @@ -123,32 +123,26 @@ findall({StdLib, ExLib, Db}, {Functor}) -> %for bagof end end. -close(#cursor{data = undefined}) -> ok; -close(#cursor{functor = Functor}) -> - put(Functor, queue:new()). %save empty queue +close(undefined) -> ok; +close(Cursor) -> + put(Cursor, queue:new()). %save empty queue next(undefined) -> []; -next(#cursor{functor = Functor}) -> - Queue = get(Functor), %get clauses +next(Cursor) -> + Queue = get(Cursor), %get clauses case queue:out(Queue) of %take variant {{value, Val}, UQ} -> - put(Functor, UQ), %save others + put(Cursor, UQ), %save others Val; %return it {empty, _} -> [] %nothing to return end. get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> Dict = erlog_db_storage:get_db(dict, Collection), - case get_procedure({StdLib, ExLib, Dict}, {Functor, external}) of - {Cursor, {Res, Udict}} when is_record(Cursor, cursor) -> %return with cursor - erlog_db_storage:update_db(Collection, Udict), - {{Cursor, Res}, Db}; - {Res, Udict} -> - erlog_db_storage:update_db(Collection, Udict), - {Res, Db} %normal return - end; -get_procedure({StdLib, ExLib, Db}, Param) -> - {Functor, Type} = check_param(Param), + {Res, Udict} = get_procedure({StdLib, ExLib, Dict}, Functor), + erlog_db_storage:update_db(Collection, Udict), + {Res, Db}; +get_procedure({StdLib, ExLib, Db}, {Functor}) -> Res = case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> StFun; error -> @@ -157,8 +151,8 @@ get_procedure({StdLib, ExLib, Db}, Param) -> error -> case dict:find(Functor, Db) of %search userspace last {ok, Cs} -> - Cursor = #cursor{type = Type, function = get_procedure, functor = Functor, data = stub}, - {Cursor, {clauses, form_clauses(Cs, Cursor)}}; + Cursor = form_cursor(), + {cursor, Cursor, result, {clauses, form_clauses(Cs, Cursor)}}; error -> undefined end end @@ -236,12 +230,10 @@ check_immutable(Dict, Functor) -> %% @private form_clauses(Loaded, _) when length(Loaded) =< 1 -> Loaded; -form_clauses([First | Loaded], #cursor{functor = Functor}) -> +form_clauses([First | Loaded], Cursor) -> Queue = queue:from_list(Loaded), - put(Functor, Queue), + put(Cursor, Queue), First. -%% @private -%% Spike for imitation normal cursors, as separate processes -check_param({Functor}) -> {Functor, core}; -check_param({{Functor}, external}) -> {Functor, external}. \ No newline at end of file +form_cursor() -> + [random:uniform(X) || X <- lists:seq(1, 20)]. \ No newline at end of file diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 6a7780e..9a5df4e 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -98,8 +98,8 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call Cs when is_list(Cs) -> Cs; _ -> [] end, - Cursor = #cursor{type = external, function = findall, functor = Functor, data = stub}, - {{Cursor, {clauses, form_clauses(CS, Cursor)}}, Db} + Cursor = form_cursor(), + {{cursor, Cursor, result, {clauses, form_clauses(CS, Cursor)}}, Db} end end; findall({StdLib, ExLib, Db}, {Functor}) -> @@ -117,30 +117,24 @@ findall({StdLib, ExLib, Db}, {Functor}) -> end end. -close(#cursor{data = undefined}) -> ok; -close(#cursor{functor = Functor}) -> - put(Functor, queue:new()). %save empty queue +close(undefined) -> ok; +close(Cursor) -> + put(Cursor, queue:new()). %save empty queue next(undefined) -> []; -next(#cursor{functor = Functor}) -> - Queue = get(Functor), %get clauses +next(Cursor) -> + Queue = get(Cursor), %get clauses case queue:out(Queue) of %take variant {{value, Val}, UQ} -> - put(Functor, UQ), %save others + put(Cursor, UQ), %save others Val; %return it {empty, _} -> [] %nothing to return end. -get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> +get_procedure({StdLib, ExLib, _}, {Collection, Functor}) -> Ets = erlog_db_storage:get_db(ets, Collection), - case get_procedure({StdLib, ExLib, Ets}, {{Functor}, external}) of - {external, {Res, _}} -> %return with cursor - {{external, Res}, Db}; - {Res, _} -> - {Res, Db} %normal return - end; -get_procedure({StdLib, ExLib, Db}, Param) -> - {Functor, Type} = check_param(Param), + get_procedure({StdLib, ExLib, Ets}, {Functor}); +get_procedure({StdLib, ExLib, Db}, {Functor}) -> Res = case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> StFun; error -> @@ -149,8 +143,8 @@ get_procedure({StdLib, ExLib, Db}, Param) -> error -> case catch ets:lookup_element(Db, Functor, 2) of %search userspace last Cs when is_list(Cs) -> - Cursor = #cursor{type = Type, function = get_procedure, functor = Functor, data = stub}, - {Cursor, {clauses, form_clauses(Cs, Cursor)}}; + Cursor = form_cursor(), + {cursor, Cursor, result, {clauses, form_clauses(Cs, Cursor)}}; _ -> undefined end end @@ -232,11 +226,10 @@ check_immutable(Dict, Functor) -> %TODO may be move me to erlog_memory? %% @private form_clauses(Loaded, _) when length(Loaded) =< 1 -> Loaded; -form_clauses([First | Loaded], #cursor{functor = Functor}) -> +form_clauses([First | Loaded], Cursor) -> Queue = queue:from_list(Loaded), - put(Functor, Queue), + put(Cursor, Queue), First. -%% @private -check_param({Functor}) -> {Functor, core}; -check_param({{Functor}, external}) -> {Functor, external}. \ No newline at end of file +form_cursor() -> + [random:uniform(X) || X <- lists:seq(1, 20)]. \ No newline at end of file diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 15b79b1..5555d3d 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -32,7 +32,8 @@ raw_append/3, raw_erase/2, listing/2, - next/1]). + next/2, + close/2]). -export([db_assertz_clause/3, db_assertz_clause/4, @@ -42,8 +43,7 @@ db_abolish_clauses/3, get_db_procedure/3, db_findall/3, - db_listing/3, - db_next/1]). + db_listing/3]). -export([load_kernel_space/3]). @@ -63,9 +63,7 @@ exlib :: dict, %library-space memory database :: atom(), % callback module for user-space memory in_mem :: dict, %integrated memory for findall operations - state :: term(), % callback state - core_cursor = #cursor{} :: #cursor{}, %cursors for db and normal operations - external_cursor = #cursor{} :: #cursor{} + state :: term() % callback state }). %%%=================================================================== @@ -99,8 +97,7 @@ db_asserta_clause(Database, Collection, Head, Body) -> db_findall(Database, Collection, Fun) -> gen_server:call(Database, {findall, {Collection, Fun}}). finadll(Database, Fun) -> gen_server:call(Database, {findall, {Fun}}). -db_next(Database) -> gen_server:call(Database, db_next). -next(Database) -> gen_server:call(Database, next). +next(Database, Cursor) -> gen_server:call(Database, {next, Cursor}). retract_clause(Database, F, Ct) -> gen_server:call(Database, {retract_clause, {F, Ct}}). db_retract_clause(Database, Collection, F, Ct) -> @@ -129,6 +126,8 @@ listing(Database, Args) -> gen_server:call(Database, {listing, {Args}}). db_listing(Database, Collection, Args) -> gen_server:call(Database, {listing, {Collection, Args}}). +close(Database, Cursor) -> gen_server:call(Database, {close, Cursor}). + %%-------------------------------------------------------------------- %% @doc %% Starts the server @@ -223,15 +222,16 @@ handle_call({abolish_clauses, {_, Func} = Params}, _From, State = #state{state = catch throw:E -> {reply, E, State} end; -handle_call(next, _From, State = #state{database = Db, core_cursor = Core}) -> %get next result by cursor - Res = Db:next(Core), +handle_call({next, Cursor}, _From, State = #state{database = Db}) -> %get next result by cursor + Res = Db:next(Cursor), {reply, Res, State}; -handle_call(db_next, _From, State = #state{database = Db, external_cursor = External}) -> %get next result by cursor - Res = Db:next(External), +handle_call({close, Cursor}, _From, State = #state{database = Db}) -> %get next result by cursor + Res = Db:close(Cursor), {reply, Res, State}; handle_call({Fun, Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module try - check_result(Db:Fun({StdLib, ExLib, DbState}, Params), State) + {Res, UState} = Db:Fun({StdLib, ExLib, DbState}, Params), + {reply, Res, State#state{state = UState}} catch throw:E -> {reply, E, State} end; @@ -256,9 +256,7 @@ handle_call(_Request, _From, State) -> {noreply, NewState :: #state{}} | {noreply, NewState :: #state{}, timeout() | hibernate} | {stop, Reason :: term(), NewState :: #state{}}). -handle_cast(halt, State = #state{core_cursor = Core, external_cursor = External, database = Db}) -> - Db:close(Core), - Db:close(External), +handle_cast(halt, State) -> {stop, normal, State}; handle_cast(_Request, State) -> {noreply, State}. @@ -339,18 +337,4 @@ check_abolish(Func, StdLib, ExLib, Db, DbState, Params) -> {ExLib, NewState, Res}; UExlib -> %dict changed -> was deleted {UExlib, DbState, ok} - end. - -%% @private -%% Update cursor, if we got it -check_result({{Cursor = #cursor{type = external}, Res}, UState}, State = #state{external_cursor = Old, database = Db}) -> - close_cursor(Cursor, Old, Db), - {reply, Res, State#state{state = UState, external_cursor = Cursor}}; -check_result({{Cursor = #cursor{type = core}, Res}, UState}, State = #state{core_cursor = Old, database = Db}) -> - close_cursor(Cursor, Old, Db), - {reply, Res, State#state{state = UState, core_cursor = Cursor}}; -check_result({Res, UState}, State) -> - {reply, Res, State#state{state = UState}}. - -close_cursor(Same, Same, _) -> ok; -close_cursor(_, Cursor, Db) -> Db:close(Cursor). + end. \ No newline at end of file From 1cc59654f14a3d7ea8f89c76066884ee18b0e566 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 2 Oct 2014 21:08:30 +0000 Subject: [PATCH 155/251] fix clause and empty cursor next --- src/storage/erlog_dict.erl | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 482f546..5a585ab 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -129,17 +129,19 @@ close(Cursor) -> next(undefined) -> []; next(Cursor) -> - Queue = get(Cursor), %get clauses - case queue:out(Queue) of %take variant - {{value, Val}, UQ} -> - put(Cursor, UQ), %save others - Val; %return it - {empty, _} -> [] %nothing to return + case get(Cursor) of %get clauses + undefined -> []; %empty cursor + Queue -> case queue:out(Queue) of %take variant + {{value, Val}, UQ} -> + put(Cursor, UQ), %save others + Val; %return it + {empty, _} -> [] %nothing to return + end end. get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> Dict = erlog_db_storage:get_db(dict, Collection), - {Res, Udict} = get_procedure({StdLib, ExLib, Dict}, Functor), + {Res, Udict} = get_procedure({StdLib, ExLib, Dict}, {Functor}), erlog_db_storage:update_db(Collection, Udict), {Res, Db}; get_procedure({StdLib, ExLib, Db}, {Functor}) -> From 86e261e6fee547cbc6f0a36962dd1e469ffc9150 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 2 Oct 2014 23:52:23 +0000 Subject: [PATCH 156/251] fix retractall & db_retractall & db_call --- src/core/logic/ec_core.erl | 32 ++- src/libs/external/db/erlog_db.erl | 61 +++-- src/libs/standard/core/logic/ec_logic.erl | 287 +++++++++++----------- 3 files changed, 197 insertions(+), 183 deletions(-) diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index 73ff6f1..26236d2 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -12,7 +12,7 @@ -include("erlog_core.hrl"). %% API --export([prove_body/1, prove_goal/1, prove_goal/5, prove_goal_clauses/2, prove_goal_clause/2]). +-export([prove_body/1, prove_goal/1, prove_goal/5, prove_goal_clauses/2, run_n_close/2]). %% prove_goal(Goal, Database) -> Succeed | Fail. %% This is the main entry point into the interpreter. Check that @@ -76,7 +76,8 @@ prove_goal(Param = #param{goal = G, database = Db}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of {cursor, Cursor, result, Result} -> - run_n_close(Result, Param#param{cursor = Cursor}); + Fun = fun() -> check_result(Result, Param) end, + run_n_close(Fun, Param#param{cursor = Cursor}); Result -> check_result(Result, Param) end. @@ -99,6 +100,21 @@ prove_goal_clauses(C, Params = #param{goal = G, next_goal = Next, var_num = Vn, Cp = #cp{type = goal_clauses, label = Vn, data = {G, Db, C, Cursor}, next = Next, bs = Bs, vn = Vn}, prove_goal_clause(C, Params#param{choice = [Cp | Cps]}). +%% Run function and close cursor after that. +-spec run_n_close(Fun :: fun(), #param{}) -> any(). +run_n_close(Fun, #param{database = Db, cursor = Cursor}) -> + try + Res = Fun(), + erlog_memory:close(Db, Cursor), + Res + catch + throw:E -> + erlog_memory:close(Db, Cursor), + throw(E) + end. + +%% @private +prove_goal_clause([], Param) -> erlog_errors:fail(Param); prove_goal_clause([L], Param) -> prove_goal_clause(L, Param); prove_goal_clause({_Tag, H0, {B0, _}}, Param = #param{goal = G, next_goal = Next, bindings = Bs0, var_num = Vn0}) -> Label = Vn0, @@ -109,17 +125,7 @@ prove_goal_clause({_Tag, H0, {B0, _}}, Param = #param{goal = G, next_goal = Next fail -> erlog_errors:fail(Param) end. -run_n_close(Result, Param = #param{database = Db, cursor = Cursor}) -> - try - Res = check_result(Result, Param), - erlog_memory:close(Db, Cursor), - Res - catch - throw:E -> - erlog_memory:close(Db, Cursor), - throw(E) - end. - +%% @private check_result({built_in, Mod}, Param) -> Mod:prove_goal(Param); check_result({code, {Mod, Func}}, Param) -> Mod:Func(Param); check_result({clauses, []}, Param) -> erlog_errors:fail(Param); diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 85de28b..fa35db4 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -34,8 +34,9 @@ db_call_2(Param = #param{goal = {db_call, _, _} = Goal, next_goal = Next0, bindi {db_call, Table, G} = ec_support:dderef(Goal, Bs), case erlog_memory:db_findall(Db, Table, ec_support:functor(G)) of {cursor, Cursor, result, Result} -> - run_n_close(Result, Param#param{cursor = Cursor}, G, Next0); - Result -> check_result(Result, Param, G, Next0) + Fun = fun() -> check_call_result(Result, Param#param{cursor = Cursor}, G, Next0) end, + ec_core:run_n_close(Fun, Param#param{cursor = Cursor}); + Result -> check_call_result(Result, Param, G, Next0) end. db_assert_2(Params = #param{goal = {db_assert, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> @@ -112,24 +113,13 @@ prove_retract(H, B, Table, Params = #param{database = Db}) -> end. %% @private -prove_retractall(H, B, Table, Params = #param{next_goal = Next, bindings = Bs0, var_num = Vn0, database = Db}) -> +prove_retractall(H, B, Table, Params = #param{database = Db}) -> Functor = ec_support:functor(H), case erlog_memory:get_db_procedure(Db, Table, Functor) of - {clauses, Cs} -> - lists:foreach( - fun(Clause) -> - case ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of - {succeed, _, _} -> - erlog_memory:db_retract_clause(Db, Table, ec_support:functor(H), element(1, Clause)); - fail -> ok - end - end, Cs), - ec_core:prove_body(Params#param{goal = Next}); - {code, _} -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); - built_in -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); - undefined -> ec_core:prove_body(Params#param{goal = Next}) + {cursor, Cursor, result, Res} -> + check_retractall_result(Res, H, B, Functor, Table, Params#param{cursor = Cursor}); + Res -> + check_retractall_result(Res, H, B, Functor, Table, Params) end. %% @private @@ -155,19 +145,28 @@ fail_retract(#cp{data = {Ch, Cb, Cs, Table}, next = Next, bs = Bs, vn = Vn}, Par retract_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}, Table). %% @private -run_n_close(Result, Param = #param{database = Db, cursor = Cursor}, G, Next0) -> - try - Res = check_result(Result, Param#param{cursor = Cursor}, G, Next0), - erlog_memory:close(Db, Cursor), - Res - catch - throw:E -> - erlog_memory:close(Db, Cursor), - throw(E) +check_call_result([], Param, _, _) -> erlog_errors:fail(Param); +check_call_result({clauses, Cs}, Param, G, Next) -> prove_call(G, Cs, Next, Param); +check_call_result({erlog_error, E}, #param{database = Db}, _, _) -> erlog_errors:erlog_error(E, Db); +check_call_result(Cs, Param, G, Next) -> prove_call(G, Cs, Next, Param). + +retractall_clauses(_, [], _, _, Params = #param{next_goal = Next}) -> ec_core:prove_body(Params#param{goal = Next}); +retractall_clauses(Table, Clause, H, B, Params = #param{bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}) -> + case ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of + {succeed, _, _} -> + erlog_memory:db_retract_clause(Db, Table, ec_support:functor(H), element(1, Clause)), + retractall_clauses(Table, erlog_memory:next(Db, Cursor), H, B, Params); + fail -> ok end. %% @private -check_result([], Param, _, _) -> erlog_errors:fail(Param); -check_result({clauses, Cs}, Param, G, Next) -> prove_call(G, Cs, Next, Param); -check_result({erlog_error, E}, #param{database = Db}, _, _) -> erlog_errors:erlog_error(E, Db); -check_result(Cs, Param, G, Next) -> prove_call(G, Cs, Next, Param). \ No newline at end of file +check_retractall_result({built_in, _}, _, _, Functor, _, _) -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); +check_retractall_result({code, _}, _, _, Functor, _, _) -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); +check_retractall_result({clauses, Cs}, H, B, _, Table, Params = #param{cursor = Cursor}) -> + Fun = fun() -> retractall_clauses(Table, Cs, H, B, Params) end, + ec_core:run_n_close(Fun, Params#param{cursor = Cursor}); +check_retractall_result(undefined, _, _, _, _, Params = #param{next_goal = Next}) -> + ec_core:prove_body(Params#param{goal = Next}); +check_retractall_result({erlog_error, E}, _, _, _, _, #param{database = Db}) -> erlog_errors:erlog_error(E, Db). \ No newline at end of file diff --git a/src/libs/standard/core/logic/ec_logic.erl b/src/libs/standard/core/logic/ec_logic.erl index 9c26ebf..f9830b2 100644 --- a/src/libs/standard/core/logic/ec_logic.erl +++ b/src/libs/standard/core/logic/ec_logic.erl @@ -13,15 +13,15 @@ %% API -export([initial_goal/1, - check_goal/6, - prove_findall/4, - prove_ecall/3, - prove_clause/3, - prove_current_predicate/2, - prove_predicates/3, - prove_retract/2, - prove_retractall/2, - retract_clauses/4, parse_int/1, to_string/1]). + check_goal/6, + prove_findall/4, + prove_ecall/3, + prove_clause/3, + prove_current_predicate/2, + prove_predicates/3, + prove_retract/2, + prove_retractall/2, + retract_clauses/4, parse_int/1, to_string/1]). %% prove_findall(Term, Goal, Bag, Param) %% Do findall on Goal and return list of each Term in Bag. We are @@ -31,147 +31,147 @@ %% fail_findall which cleans up by removing special database entry %% and unifying Bag. prove_findall(T, G, B0, Param = #param{bindings = Bs, choice = Cps, next_goal = Next, var_num = Vn, database = Db}) -> - Label = Vn, - Tag = Vn + 1, %Increment to avoid clashes - {Next1, _} = ec_logic:check_goal(G, [{findall, Tag, T}], Bs, Db, false, Label), - B1 = partial_list(B0, Bs), - Cp = #cp{type = findall, data = {Tag, B1}, next = Next, bs = Bs, vn = Vn}, - erlog_memory:raw_store(Db, Tag, []), %Initialise collection - %% Catch case where an erlog error occurs when cleanup database. - try - ec_core:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], bindings = Bs, var_num = Vn + 1}) - catch - throw:{erlog_error, E, Dba} -> - Dbb = erlog_memory:raw_erase(Dba, Tag), %Clear special entry - erlog_errors:erlog_error(E, Dbb) - end. + Label = Vn, + Tag = Vn + 1, %Increment to avoid clashes + {Next1, _} = ec_logic:check_goal(G, [{findall, Tag, T}], Bs, Db, false, Label), + B1 = partial_list(B0, Bs), + Cp = #cp{type = findall, data = {Tag, B1}, next = Next, bs = Bs, vn = Vn}, + erlog_memory:raw_store(Db, Tag, []), %Initialise collection + %% Catch case where an erlog error occurs when cleanup database. + try + ec_core:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], bindings = Bs, var_num = Vn + 1}) + catch + throw:{erlog_error, E, Dba} -> + Dbb = erlog_memory:raw_erase(Dba, Tag), %Clear special entry + erlog_errors:erlog_error(E, Dbb) + end. %% prove_ecall(Generator, Value, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Call an external (Erlang) generator and handle return value, either %% succeed or fail. prove_ecall(Efun, Val, Param = #param{next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> - case Efun() of - {succeed, Ret, Cont} -> %Succeed and more choices - Cp = #cp{type = ecall, data = {Cont, Val}, next = Next, bs = Bs, vn = Vn}, - ec_body:unify_prove_body(Val, Ret, Param#param{choice = [Cp | Cps]}); - {succeed_last, Ret} -> %Succeed but last choice - ec_body:unify_prove_body(Val, Ret, Param); - fail -> erlog_errors:fail(Param) %No more - end. + case Efun() of + {succeed, Ret, Cont} -> %Succeed and more choices + Cp = #cp{type = ecall, data = {Cont, Val}, next = Next, bs = Bs, vn = Vn}, + ec_body:unify_prove_body(Val, Ret, Param#param{choice = [Cp | Cps]}); + {succeed_last, Ret} -> %Succeed but last choice + ec_body:unify_prove_body(Val, Ret, Param); + fail -> erlog_errors:fail(Param) %No more + end. %% prove_clause(Head, Body, Next, ChoicePoints, Bindings, VarNum, DataBase) -> %% void. %% Unify clauses matching with functor from Head with both Head and Body. prove_clause(H, B, Param = #param{database = Db}) -> - Functor = ec_support:functor(H), - case erlog_memory:get_procedure(Db, Functor) of - {clauses, Cs} -> ec_unify:unify_clauses(H, B, Cs, Param); - {code, _} -> - erlog_errors:permission_error(access, private_procedure, ec_support:pred_ind(Functor)); - built_in -> - erlog_errors:permission_error(access, private_procedure, ec_support:pred_ind(Functor)); - undefined -> erlog_errors:fail(Param) - end. + Functor = ec_support:functor(H), + case erlog_memory:get_procedure(Db, Functor) of + {clauses, Cs} -> ec_unify:unify_clauses(H, B, Cs, Param); + {code, _} -> + erlog_errors:permission_error(access, private_procedure, ec_support:pred_ind(Functor)); + built_in -> + erlog_errors:permission_error(access, private_procedure, ec_support:pred_ind(Functor)); + undefined -> erlog_errors:fail(Param) + end. %% prove_current_predicate(PredInd, Next, ChoicePoints, Bindings, VarNum, DataBase) -> %% void. %% Match functors of existing user (interpreted) predicate with PredInd. prove_current_predicate(Pi, Param = #param{database = Db}) -> - case Pi of - {'/', _, _} -> ok; - {_} -> ok; - Other -> erlog_errors:type_error(predicate_indicator, Other) - end, - Fs = erlog_memory:get_interp_functors(Db), - prove_predicates(Pi, Fs, Param). + case Pi of + {'/', _, _} -> ok; + {_} -> ok; + Other -> erlog_errors:type_error(predicate_indicator, Other) + end, + Fs = erlog_memory:get_interp_functors(Db), + prove_predicates(Pi, Fs, Param). prove_predicates(Pi, [F | Fs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> - Cp = #cp{type = current_predicate, data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, - ec_body:unify_prove_body(Pi, ec_support:pred_ind(F), Param#param{choice = [Cp | Cps]}); + Cp = #cp{type = current_predicate, data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, + ec_body:unify_prove_body(Pi, ec_support:pred_ind(F), Param#param{choice = [Cp | Cps]}); prove_predicates(_Pi, [], Param) -> erlog_errors:fail(Param). %% prove_retract(Clause, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Retract clauses in database matching Clause. prove_retract({':-', H, B}, Params) -> - prove_retract(H, B, Params); + prove_retract(H, B, Params); prove_retract(H, Params) -> - prove_retract(H, true, Params). + prove_retract(H, true, Params). prove_retractall({':-', H, B}, Params) -> - prove_retractall(H, B, Params); + prove_retractall(H, B, Params); prove_retractall(H, Params) -> - prove_retractall(H, true, Params). + prove_retractall(H, true, Params). %% check_goal(Goal, Next, Bindings, Database, CutAfter, CutLabel) -> %% {WellFormedBody,HasCut}. %% Check to see that Goal is bound and ensure that it is well-formed. check_goal(G0, Next, Bs, Db, Cut, Label) -> - case ec_support:dderef(G0, Bs) of - {_} -> erlog_errors:instantiation_error(Db); %Must have something to call - G1 -> - case catch {ok, well_form_goal(G1, Next, Cut, Label)} of - {erlog_error, E} -> erlog_errors:erlog_error(E, Db); - {ok, GC} -> GC %Body and cut - end - end. + case ec_support:dderef(G0, Bs) of + {_} -> erlog_errors:instantiation_error(Db); %Must have something to call + G1 -> + case catch {ok, well_form_goal(G1, Next, Cut, Label)} of + {erlog_error, E} -> erlog_errors:erlog_error(E, Db); + {ok, GC} -> GC %Body and cut + end + end. %% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to retract Head and Body using Clauses which all have the same functor. retract_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param); retract_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}) -> %TODO foreach vs handmade recursion? - case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of - {succeed, Bs1, Vn1} -> - %% We have found a right clause so now retract it. - erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), - Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, - ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); - fail -> retract_clauses(Ch, Cb, Cs, Param) - end. + case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of + {succeed, Bs1, Vn1} -> + %% We have found a right clause so now retract it. + erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), + Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, + ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); + fail -> retract_clauses(Ch, Cb, Cs, Param) + end. %% well_form_goal(Goal, Tail, HasCutAfter, CutLabel) -> {Body,HasCut}. %% Check that Goal is well-formed, flatten conjunctions, fix cuts and %% add explicit call to top-level variables. well_form_goal({',', L, R}, Tail0, Cut0, Label) -> - {Tail1, Cut1} = well_form_goal(R, Tail0, Cut0, Label), - well_form_goal(L, Tail1, Cut1, Label); + {Tail1, Cut1} = well_form_goal(R, Tail0, Cut0, Label), + well_form_goal(L, Tail1, Cut1, Label); well_form_goal({';', {'->', C0, T0}, E0}, Tail, Cut0, Label) -> - {T1, Tc} = well_form_goal(T0, Tail, Cut0, Label), - {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), - {E1, Ec} = well_form_goal(E0, Tail, Cut0, Label), - {[{{if_then_else}, E1, Label} | C1], Tc or Ec}; + {T1, Tc} = well_form_goal(T0, Tail, Cut0, Label), + {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), + {E1, Ec} = well_form_goal(E0, Tail, Cut0, Label), + {[{{if_then_else}, E1, Label} | C1], Tc or Ec}; well_form_goal({';', L0, R0}, Tail, Cut0, Label) -> - {L1, Lc} = well_form_goal(L0, Tail, Cut0, Label), - {R1, Rc} = well_form_goal(R0, Tail, Cut0, Label), - {[{{disj}, R1} | L1], Lc or Rc}; + {L1, Lc} = well_form_goal(L0, Tail, Cut0, Label), + {R1, Rc} = well_form_goal(R0, Tail, Cut0, Label), + {[{{disj}, R1} | L1], Lc or Rc}; well_form_goal({'->', C0, T0}, Tail, Cut0, Label) -> - {T1, Cut1} = well_form_goal(T0, Tail, Cut0, Label), - %% N.B. an extra cut will be added at run-time! - {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), - {[{{if_then}, Label} | C1], Cut1}; + {T1, Cut1} = well_form_goal(T0, Tail, Cut0, Label), + %% N.B. an extra cut will be added at run-time! + {C1, _} = well_form_goal(C0, [{{cut}, Label, true} | T1], true, Label), + {[{{if_then}, Label} | C1], Cut1}; well_form_goal({once, G}, Tail, Cut, Label) -> - {G1, _} = well_form_goal(G, [{{cut}, Label, true} | Tail], true, Label), - {[{{once}, Label} | G1], Cut}; + {G1, _} = well_form_goal(G, [{{cut}, Label, true} | Tail], true, Label), + {[{{once}, Label} | G1], Cut}; well_form_goal({V}, Tail, Cut, _Label) -> - {[{call, {V}} | Tail], Cut}; + {[{call, {V}} | Tail], Cut}; well_form_goal(true, Tail, Cut, _Label) -> {Tail, Cut}; %No-op well_form_goal(fail, _Tail, _Cut, _Label) -> {[fail], false}; %No further well_form_goal('!', Tail, Cut, Label) -> - {[{{cut}, Label, not Cut} | Tail], true}; + {[{{cut}, Label, not Cut} | Tail], true}; well_form_goal(Goal, Tail, Cut, _Label) -> - ec_support:functor(Goal), %Check goal - {[Goal | Tail], Cut}. + ec_support:functor(Goal), %Check goal + {[Goal | Tail], Cut}. parse_int(Float) when is_float(Float) -> round(Float); parse_int(String) when is_list(String) -> - case string:to_integer(String) of - {error, E} -> throw(E); - {Res, _} -> Res - end; + case string:to_integer(String) of + {error, E} -> throw(E); + {Res, _} -> Res + end; parse_int(Atom) when is_atom(Atom) -> - parse_int(atom_to_list(Atom)). + parse_int(atom_to_list(Atom)). to_string(Int) when is_integer(Int) -> integer_to_list(Int); to_string(Value) -> lists:flatten(io_lib:format("~p", [Value])). @@ -187,21 +187,21 @@ initial_goal(Goal) -> initial_goal(Goal, ec_support:new_bindings(), 0). %% @private initial_goal({'_'}, Bs, Vn) -> {{Vn}, Bs, Vn + 1}; %Anonymous variable initial_goal({Name} = Var0, Bs, Vn) when is_atom(Name) -> - case ec_support:get_binding(Var0, Bs) of - {ok, Var1} -> {Var1, Bs, Vn}; - error -> - Var1 = {Vn}, - {Var1, ec_support:add_binding(Var0, Var1, Bs), Vn + 1} - end; + case ec_support:get_binding(Var0, Bs) of + {ok, Var1} -> {Var1, Bs, Vn}; + error -> + Var1 = {Vn}, + {Var1, ec_support:add_binding(Var0, Var1, Bs), Vn + 1} + end; initial_goal([H0 | T0], Bs0, Vn0) -> - {H1, Bs1, Vn1} = initial_goal(H0, Bs0, Vn0), - {T1, Bs2, Vn2} = initial_goal(T0, Bs1, Vn1), - {[H1 | T1], Bs2, Vn2}; + {H1, Bs1, Vn1} = initial_goal(H0, Bs0, Vn0), + {T1, Bs2, Vn2} = initial_goal(T0, Bs1, Vn1), + {[H1 | T1], Bs2, Vn2}; initial_goal([], Bs, Vn) -> {[], Bs, Vn}; initial_goal(S, Bs0, Vn0) when ?IS_FUNCTOR(S) -> - As0 = tl(tuple_to_list(S)), - {As1, Bs1, Vn1} = initial_goal(As0, Bs0, Vn0), - {list_to_tuple([element(1, S) | As1]), Bs1, Vn1}; + As0 = tl(tuple_to_list(S)), + {As1, Bs1, Vn1} = initial_goal(As0, Bs0, Vn0), + {list_to_tuple([element(1, S) | As1]), Bs1, Vn1}; initial_goal(T, Bs, Vn) when ?IS_ATOMIC(T) -> {T, Bs, Vn}; initial_goal(T, _Bs, _Vn) -> erlog_errors:type_error(callable, T). @@ -210,44 +210,53 @@ initial_goal(T, _Bs, _Vn) -> erlog_errors:type_error(callable, T). %% Dereference all variables and check if partial list. partial_list([], _) -> []; partial_list([H | T0], Bs) -> - T1 = partial_list(T0, Bs), - [H | T1]; + T1 = partial_list(T0, Bs), + [H | T1]; partial_list({V} = Var, Bs) -> - case ?BIND:find(V, Bs) of - {ok, T} -> partial_list(T, Bs); - error -> Var - end; + case ?BIND:find(V, Bs) of + {ok, T} -> partial_list(T, Bs); + error -> Var + end; partial_list(Other, _) -> erlog_errors:type_error(list, Other). %% @private prove_retract(H, B, Params = #param{database = Db}) -> - Functor = ec_support:functor(H), - case erlog_memory:get_procedure(Db, Functor) of - {clauses, Cs} -> retract_clauses(H, B, Cs, Params); - {code, _} -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); - built_in -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); - undefined -> erlog_errors:fail(Params) - end. + Functor = ec_support:functor(H), + case erlog_memory:get_procedure(Db, Functor) of + {clauses, Cs} -> retract_clauses(H, B, Cs, Params); + {code, _} -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); + built_in -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); + undefined -> erlog_errors:fail(Params) + end. %% @private -prove_retractall(H, B, Params = #param{next_goal = Next, bindings = Bs0, var_num = Vn0, database = Db}) -> - Functor = ec_support:functor(H), - case erlog_memory:get_procedure(Db, Functor) of - {clauses, Cs} -> - lists:foreach( - fun(Clause) -> - case ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of - {succeed, _, _} -> - erlog_memory:retract_clause(Db, ec_support:functor(H), element(1, Clause)); - fail -> ok - end - end, Cs), - ec_core:prove_body(Params#param{goal = Next}); - {code, _} -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); - built_in -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); - undefined -> ec_core:prove_body(Params#param{goal = Next}) - end. +prove_retractall(H, B, Params = #param{database = Db}) -> + Functor = ec_support:functor(H), + case erlog_memory:get_procedure(Db, Functor) of + {cursor, Cursor, result, Result} -> + check_result(Result, H, B, Functor, Params#param{cursor = Cursor}); + Result -> + check_result(Result, H, B, Functor, Params) + end. + +retractall_clauses([], _, _, Params = #param{next_goal = Next}) -> ec_core:prove_body(Params#param{goal = Next}); +retractall_clauses(Clause, H, B, Params = #param{bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}) -> + case ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of + {succeed, _, _} -> + erlog_memory:retract_clause(Db, ec_support:functor(H), element(1, Clause)), + retractall_clauses(erlog_memory:next(Db, Cursor), H, B, Params); + fail -> ok + end. + +%% @private +check_result({built_in, _}, _, _, Functor, _) -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); +check_result({code, _}, _, _, Functor, _) -> + erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); +check_result({clauses, Cs}, H, B, _, Params = #param{cursor = Cursor}) -> + Fun = fun() -> retractall_clauses(Cs, H, B, Params) end, + ec_core:run_n_close(Fun, Params#param{cursor = Cursor}); +check_result(undefined, _, _, _, Params = #param{next_goal = Next}) -> ec_core:prove_body(Params#param{goal = Next}); +check_result({erlog_error, E}, _, _, _, #param{database = Db}) -> erlog_errors:erlog_error(E, Db). \ No newline at end of file From d11e4f8ff0debe462345f3ea388dba2c60c10c36 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 3 Oct 2014 00:09:17 +0000 Subject: [PATCH 157/251] add spy to debugger --- .../debugger/erlog_simple_debugger.erl | 20 +++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl index cdbf4e5..7ba1371 100644 --- a/src/interface/debugger/erlog_simple_debugger.erl +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -28,7 +28,11 @@ { policy = listing %default policy of debugger is listing. }). -%% policy can be step - make N commands and +%% policy can be: +%% next N - make N commands and stop +%% stop Pred - stop when predicate Pred will be executing +%% listing - do not stop - just print every function result +%% spy Pred - do not stop, pring only predicate Pred result %%%=================================================================== %%% API @@ -100,6 +104,12 @@ handle_call({_, Functor, Vars}, _From, State = #state{policy = {next, N}}) when io:fwrite("Erlog debugger stopped execution on command ~p with memory: ~p.~n", [Functor, process_reply(Vars)]), Policy = process_action(), {reply, ok, State#state{policy = Policy}}; +handle_call({_, Functor, Vars}, _From, State = #state{policy = {spy, Pred}}) -> %spying for predicate + case lists:flatten(io_lib:format("~p", [Functor])) of + Pred -> io:format("Execute ~p, memory: ~p~n", [Functor, process_reply(Vars)]); + _ -> ok + end, + {reply, ok, State}; handle_call({_, Functor, _}, _From, State = #state{policy = {next, N}}) -> %counting steps io:fwrite("Skip ~p~n", [Functor]), {reply, ok, State#state{policy = {next, N - 1}}}; @@ -207,10 +217,12 @@ process_action() -> Listing = lists:prefix("listing", Order), Next = lists:prefix("next", Order), Stop = lists:prefix("stop", Order), + Spy = lists:prefix("spy", Order), if Listing -> listing; Next -> process_next(Order); Stop -> process_stop(Order); + Spy -> process_spy(Order); true -> io:format("Wrong action!~n"), process_action() @@ -224,4 +236,8 @@ process_next(Next) -> %% @private process_stop(Stop) -> - {stop, Stop -- "stop \n"}. \ No newline at end of file + {stop, Stop -- "stop \n"}. + +%% @private +process_spy(Spy) -> + {spy, Spy -- "spy \n"}. \ No newline at end of file From ded718aea9ff3a0c7f4c3d60bff79ee9e48a564e Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 3 Oct 2014 00:30:24 +0000 Subject: [PATCH 158/251] fix mistake with cursor passing --- src/core/logic/ec_core.erl | 6 +++--- src/libs/external/db/erlog_db.erl | 4 ++-- src/libs/standard/core/logic/ec_logic.erl | 2 +- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index 26236d2..6592817 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -76,7 +76,7 @@ prove_goal(Param = #param{goal = G, database = Db}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of {cursor, Cursor, result, Result} -> - Fun = fun() -> check_result(Result, Param) end, + Fun = fun(Params) -> check_result(Result, Params) end, run_n_close(Fun, Param#param{cursor = Cursor}); Result -> check_result(Result, Param) end. @@ -102,9 +102,9 @@ prove_goal_clauses(C, Params = #param{goal = G, next_goal = Next, var_num = Vn, %% Run function and close cursor after that. -spec run_n_close(Fun :: fun(), #param{}) -> any(). -run_n_close(Fun, #param{database = Db, cursor = Cursor}) -> +run_n_close(Fun, Params = #param{database = Db, cursor = Cursor}) -> try - Res = Fun(), + Res = Fun(Params), erlog_memory:close(Db, Cursor), Res catch diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index fa35db4..1e80edb 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -34,7 +34,7 @@ db_call_2(Param = #param{goal = {db_call, _, _} = Goal, next_goal = Next0, bindi {db_call, Table, G} = ec_support:dderef(Goal, Bs), case erlog_memory:db_findall(Db, Table, ec_support:functor(G)) of {cursor, Cursor, result, Result} -> - Fun = fun() -> check_call_result(Result, Param#param{cursor = Cursor}, G, Next0) end, + Fun = fun(Params) -> check_call_result(Result, Params, G, Next0) end, ec_core:run_n_close(Fun, Param#param{cursor = Cursor}); Result -> check_call_result(Result, Param, G, Next0) end. @@ -165,7 +165,7 @@ check_retractall_result({built_in, _}, _, _, Functor, _, _) -> check_retractall_result({code, _}, _, _, Functor, _, _) -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); check_retractall_result({clauses, Cs}, H, B, _, Table, Params = #param{cursor = Cursor}) -> - Fun = fun() -> retractall_clauses(Table, Cs, H, B, Params) end, + Fun = fun(Param) -> retractall_clauses(Table, Cs, H, B, Param) end, ec_core:run_n_close(Fun, Params#param{cursor = Cursor}); check_retractall_result(undefined, _, _, _, _, Params = #param{next_goal = Next}) -> ec_core:prove_body(Params#param{goal = Next}); diff --git a/src/libs/standard/core/logic/ec_logic.erl b/src/libs/standard/core/logic/ec_logic.erl index f9830b2..ec7148b 100644 --- a/src/libs/standard/core/logic/ec_logic.erl +++ b/src/libs/standard/core/logic/ec_logic.erl @@ -256,7 +256,7 @@ check_result({built_in, _}, _, _, Functor, _) -> check_result({code, _}, _, _, Functor, _) -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); check_result({clauses, Cs}, H, B, _, Params = #param{cursor = Cursor}) -> - Fun = fun() -> retractall_clauses(Cs, H, B, Params) end, + Fun = fun(Param) -> retractall_clauses(Cs, H, B, Param) end, ec_core:run_n_close(Fun, Params#param{cursor = Cursor}); check_result(undefined, _, _, _, Params = #param{next_goal = Next}) -> ec_core:prove_body(Params#param{goal = Next}); check_result({erlog_error, E}, _, _, _, #param{database = Db}) -> erlog_errors:erlog_error(E, Db). \ No newline at end of file From ad302e628142a963ef082d2c673d0beb2f9be262 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 3 Oct 2014 00:50:42 +0000 Subject: [PATCH 159/251] fix ets next --- src/storage/erlog_ets.erl | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 9a5df4e..0130dea 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -123,12 +123,14 @@ close(Cursor) -> next(undefined) -> []; next(Cursor) -> - Queue = get(Cursor), %get clauses - case queue:out(Queue) of %take variant - {{value, Val}, UQ} -> - put(Cursor, UQ), %save others - Val; %return it - {empty, _} -> [] %nothing to return + case get(Cursor) of %get clauses + undefined -> []; %empty cursor + Queue -> case queue:out(Queue) of %take variant + {{value, Val}, UQ} -> + put(Cursor, UQ), %save others + Val; %return it + {empty, _} -> [] %nothing to return + end end. get_procedure({StdLib, ExLib, _}, {Collection, Functor}) -> From 1d2d41d81c1fec0ce9927ac896a9a4ae6a539034 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 3 Oct 2014 22:46:27 +0000 Subject: [PATCH 160/251] fix multiple clauses issue --- src/core/erlog_errors.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index d033971..868ad26 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -91,7 +91,7 @@ fail_goal_clauses(#cp{data = {G, Db, C, Cursor}, next = Next, bs = Bs, vn = Vn}, [] -> [{next, C}]; N -> N end, - ec_core:prove_goal_clauses(NextClause, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn}). + ec_core:prove_goal_clauses(NextClause, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn, cursor = Cursor}). fail_findall(#cp{next = Next, data = {Tag, Bag}, bs = Bs, vn = Vn0}, Param = #param{database = Db}) -> Data = erlog_memory:raw_fetch(Db, Tag), From 55ec1fe773f58f6604df464df3ae5f1d521f9a3a Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 6 Oct 2014 11:57:56 +0000 Subject: [PATCH 161/251] add memory documentation --- doc/memory.md | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) create mode 100644 doc/memory.md diff --git a/doc/memory.md b/doc/memory.md new file mode 100644 index 0000000..c6c1fae --- /dev/null +++ b/doc/memory.md @@ -0,0 +1,35 @@ +### Erlog memory +#### Memory structure +All prolog predicates, that operate with memory - call `erlog_memory` gen_server for data. But `erlog_memory` does not +operate with data itself. It calls memory implementations, which behavior is described in `erlog_storage`. +Erlog memory is divided into three layers - __core__, __extended__ and __userspace__. +__Core__ memory contains all core library predicates. They are loaded there when erlog starts. It is implemented in dict, +which is stored in `erlog_memory` state. +__Extended__ memory contains all extended library predicates. They are loaded there on demand, using `use` keyword or +library autoload (see [docs](https://github.com/comtihon/erlog/blob/master/doc/libraries.md "libraries")) They are also +implemented in dict and stored in `erlog_memory` state. +__Userspace__ memory contains all facts and predicates - user loads himself. Its behavior is described in `erlog_storage`. +Module, which implements this behavior is stored in `erlog_memory`. By default `erlog_dict` is used, but you can select +`erlog_ets` or use your own. +`Erlog_memory` saves module, which implements memory, and its state. State is returned in `new` function and in functions, +which can probably modify it. See `erlog_storage` specification for details. State is passed to storage implementation on +every call. + +#### Using cursors +When prolog code is working - it often comes to a situation - where clauses for fact are found. Sometimes clauses number is +very big and multilayer. That is for cursors are used. When you use `erlog_storage` implementation with database - you can +fetch first clause from database and return cursor with result as `{cursor, Cursor, result, Result}`. Cursor will be saved +is erlog gen_server state and will fetch next clause from database if needed. If clause succeeded - cursor will be closed. +__Note__: prefer using cursors to fetching all clauses. + +#### Writing your own implementation +To write your own memory implementation, based on your favourite database, or cache, or something else - implement +`erlog_storage` behavior and pass your module name in arguments, when you start erlog (as mentioned in Readme). +`new/1` is called automatically - when erlog starts. New should be used for initialisation of the database. New takes +list as param which was sent in erlog arguments for database module. +`close/1` is called automatically - when erlog deside to close the cursor. +`next/1` is called automatically to fetch next clause value from database. +`get_procedure/2` is called automatically - when erlog is looking for a predicate to execute. First it search stdlib, then +extended lib and then userspace. It is main erlog predicate. Note, that it is called on every execution and can be the main +reason of loading the database. +Other functions are called manually, when different prolog predicates, depending on them, are called. \ No newline at end of file From 1d359b6daecf964568e6b0e4700aac5b66f9265e Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 6 Oct 2014 14:59:04 +0000 Subject: [PATCH 162/251] improve debugger and documentation --- doc/debugger.md | 32 +++++-- .../debugger/erlog_simple_debugger.erl | 89 ++++++++++++++----- 2 files changed, 93 insertions(+), 28 deletions(-) diff --git a/doc/debugger.md b/doc/debugger.md index 0dc6492..d76dc6d 100644 --- a/doc/debugger.md +++ b/doc/debugger.md @@ -4,7 +4,8 @@ more efficient usage - stop points can be added. #### Stopping with counter To stop commands execution after N executed commands - configure debugger with `next N`, where N is a positive integer. -After N goals code execution will be stopped and you will be asked again to configure debugger. +When N goals is skipped - you will be asked again. You can configure the action by hitting C, or skipping next N goals +by pressing `enter`. Example: 1> {ok, Pid} = erlog_simple_debugger:start_link(). @@ -25,19 +26,21 @@ Example: Skip {writeln,"hello"} Skip {retract,{foo,a,c}} Erlog debugger stopped execution on command {assert,{foo,a,b}} with memory: []. + [C_]:C Select action #### Stopping with goal -To stop commands execution after special command (breakpoint) - configure debugger with `stop G`, where G is a prolog term. -When such goal will be executed - debugger will stop code execution and ask you for next configuration. If you want to skip -all code up to an end - just use `listing`. +To stop commands execution after special command (breakpoint) - configure debugger with `stop G`, where G is a goal. Goal +can be set direct - with params, f.e. `foo(a,b)` - it will react only on this goal, or indirect - by arity `foo/2` - it +will react on every foo with arity 2. When such goal will be executed - debugger will stop code execution and ask you for +next configuration. If you want to skip all code up to an end - just use `listing`. Example: 1> {ok, Pid} = erlog_simple_debugger:start_link(). {ok,<0.34.0>} 2> erlog_simple_debugger:configure(Pid). Select action - | ?- stop {assert,{foo,a,b}} + | ?- stop assert(foo(a,b)) ok 3> erlog_local_shell:start(Pid). Erlog Shell V6.1 with debugger (abort with ^G) @@ -51,4 +54,21 @@ Example: Skip {writeln,"hello"} Skip {retract,{foo,a,c}} Erlog debugger stopped execution on command {assert,{foo,a,b}} with memory: []. - Select action \ No newline at end of file + Select action + +#### Spying for goals +To debug only for selected goal - use `spy G`, where G is a goal. Goal can be set by arity or direct, same as in stop +section. When goal matches - debugger will print execution, otherwise it will be silent. + + 1> {ok, Pid} = erlog_simple_debugger:start_link(). + {ok,<0.34.0>} + 2> erlog_simple_debugger:configure(Pid). + Select action + | ?- spy foo/2 + ok + 3> erlog_local_shell:start(Pid). + Erlog Shell V6.1 with debugger (abort with ^G) + | ?- assert(foo(a,b)), assert(foo(a,c)), foo(a,b), assert(foo(a,c)), foo(a,c), assert(foo(a,d)),foo(a,d), assert(foo(a,b)). + Execute {foo,a,b}, memory: [] + true + \ No newline at end of file diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl index 7ba1371..8725c0a 100644 --- a/src/interface/debugger/erlog_simple_debugger.erl +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -90,30 +90,37 @@ init([]) -> handle_call(conf, _From, State) -> Policy = process_action(), {reply, ok, State#state{policy = Policy}}; -handle_call({_, Functor, Vars}, _From, State = #state{policy = {stop, Pred}}) -> %stopping - Polisy = case lists:flatten(io_lib:format("~p", [Functor])) of - Pred -> - io:fwrite("Erlog debugger stopped execution on command ~s with memory: ~p.~n", [Pred, process_reply(Vars)]), - process_action(); - Other -> - io:format("Skip ~s~n", [Other]), - {stop, Pred} +handle_call({_, Functor, Vars}, _From, State = #state{policy = {stop, Rule} = Old}) -> %stopping + Fun = + fun() -> + io:fwrite("Erlog debugger stopped execution on command ~p with memory: ~p.~n", [Functor, process_reply(Vars)]), + process_action() + end, + Polisy = case process_match(Functor, Fun, Rule) of + false -> + io:format("Skip ~p~n", [Functor]), + Old; %use old policy + NewPolicy -> NewPolicy %update policy end, {reply, ok, State#state{policy = Polisy}}; -handle_call({_, Functor, Vars}, _From, State = #state{policy = {next, N}}) when N =< 1 -> %counting steps ending +handle_call({_, Functor, Vars}, _From, State = #state{policy = {next, N, M}}) when N =< 1 -> %counting steps ending io:fwrite("Erlog debugger stopped execution on command ~p with memory: ~p.~n", [Functor, process_reply(Vars)]), - Policy = process_action(), + Policy = case select_next() of + skip -> {next, M, M}; %use old policy - update steps num + NewPolicy -> NewPolicy %update policy + end, {reply, ok, State#state{policy = Policy}}; -handle_call({_, Functor, Vars}, _From, State = #state{policy = {spy, Pred}}) -> %spying for predicate - case lists:flatten(io_lib:format("~p", [Functor])) of - Pred -> io:format("Execute ~p, memory: ~p~n", [Functor, process_reply(Vars)]); - _ -> ok - end, +handle_call({_, Functor, Vars}, _From, State = #state{policy = {spy, Rule}}) -> %spying for predicate + Fun = + fun() -> + io:format("Execute ~p, memory: ~p~n", [Functor, process_reply(Vars)]) + end, + process_match(Functor, Fun, Rule), {reply, ok, State}; -handle_call({_, Functor, _}, _From, State = #state{policy = {next, N}}) -> %counting steps - io:fwrite("Skip ~p~n", [Functor]), - {reply, ok, State#state{policy = {next, N - 1}}}; -handle_call({_Res, Functor, Vars}, _From, State) -> %listing +handle_call({_, Functor, _}, _From, State = #state{policy = {next, N, M}}) -> %next = counting steps + io:format("Skip ~p~n", [Functor]), + {reply, ok, State#state{policy = {next, N - 1, M}}}; +handle_call({_Res, Functor, Vars}, _From, State = #state{policy = listing}) -> %listing io:format("Execute ~p, memory: ~p~n", [Functor, process_reply(Vars)]), {reply, ok, State}; handle_call(_Request, _From, State) -> @@ -183,6 +190,16 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== %%% Internal functions %%%=================================================================== +process_match(Functor, Execute, {detailed, Functor}) -> + Execute(); +process_match(_, _, {detailed, _}) -> + false; +process_match(Functor, Execute, {arity, Pred}) -> + case ec_support:functor(Functor) of + Pred -> Execute(); + _ -> false + end. + %% @private process_reply(Dict) -> case dict:size(Dict) of @@ -228,16 +245,44 @@ process_action() -> process_action() end. +select_next() -> + case io:get_line('[C\_]:') of + "C\n" -> process_action(); + _ -> skip + end. + %% @private process_next(Next) -> N = Next -- "next ", {Num, _Rest} = string:to_integer(N), - {next, Num}. + {next, Num, Num}. + +%% @private +process_pred(Pred) -> + case string:str(Pred, "/") of + 0 -> {detailed, get_detailed(Pred)}; %process detailed predicate + N -> {arity, get_arity(Pred, N)} %process pred/arity predicate + end. + +%% @private +%% Get prolog predicate from string functor(...) +-spec get_detailed(Pred :: string()) -> tuple(). +get_detailed(Pred) -> + {done, Res, _} = erlog_scan:tokens([], Pred ++ ".\n", 1), + {ok, Predicate} = erlog_parse:parse_prolog_term(Res), + Predicate. + +%% @private +%% Get tuple {Functor, Arity} from functor(...) +-spec get_arity(Pred :: string(), N :: integer()) -> tuple(). +get_arity(Pred, N) -> + {Fun, Arity} = lists:split(N, Pred), + {list_to_atom(Fun -- "/"), list_to_integer(Arity)}. %% @private process_stop(Stop) -> - {stop, Stop -- "stop \n"}. + {stop, process_pred(Stop -- "stop \n")}. %% @private process_spy(Spy) -> - {spy, Spy -- "spy \n"}. \ No newline at end of file + {spy, process_pred(Spy -- "spy \n")}. \ No newline at end of file From 364abff3b0be005d199d83d9bc2e5f2e835c77d8 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 7 Oct 2014 18:54:28 +0000 Subject: [PATCH 163/251] fix debugger fall on support functions --- src/interface/debugger/erlog_simple_debugger.erl | 1 + 1 file changed, 1 insertion(+) diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl index 8725c0a..c9e4227 100644 --- a/src/interface/debugger/erlog_simple_debugger.erl +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -190,6 +190,7 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== %%% Internal functions %%%=================================================================== +process_match({{_},_,_}, _, _) -> false; %skip support functors process_match(Functor, Execute, {detailed, Functor}) -> Execute(); process_match(_, _, {detailed, _}) -> From 89d0c3e12ebf5555796d345e456f3265a137ad4f Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 7 Oct 2014 19:10:52 +0000 Subject: [PATCH 164/251] fix db_retract --- src/core/logic/ec_core.erl | 10 +++------- src/libs/external/db/erlog_db.erl | 6 ++++++ 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index 6592817..bd4b21c 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -104,13 +104,9 @@ prove_goal_clauses(C, Params = #param{goal = G, next_goal = Next, var_num = Vn, -spec run_n_close(Fun :: fun(), #param{}) -> any(). run_n_close(Fun, Params = #param{database = Db, cursor = Cursor}) -> try - Res = Fun(Params), - erlog_memory:close(Db, Cursor), - Res - catch - throw:E -> - erlog_memory:close(Db, Cursor), - throw(E) + Fun(Params) + after + erlog_memory:close(Db, Cursor) end. %% @private diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 1e80edb..5742b91 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -108,6 +108,12 @@ prove_call(G, Cs, Next0, Param = #param{bindings = Bs, choice = Cps, database = prove_retract(H, B, Table, Params = #param{database = Db}) -> Functor = ec_support:functor(H), case erlog_memory:get_db_procedure(Db, Table, Functor) of + {cursor, Cursor, result, {clauses, Cs}} -> + try + retract_clauses(H, B, Cs, Params, Table) + after + erlog_memory:close(Db, Cursor) + end; {clauses, Cs} -> retract_clauses(H, B, Cs, Params, Table); undefined -> erlog_errors:fail(Params) end. From 2a4c797d062c3947d4b5d30d509962c20d662168 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 8 Oct 2014 00:41:21 +0000 Subject: [PATCH 165/251] fix retractall & db_retractall & unify clauses --- src/core/erlog_errors.erl | 16 +-- src/core/logic/ec_core.erl | 5 +- src/core/logic/ec_unify.erl | 138 ++++++++++------------ src/libs/external/db/erlog_db.erl | 26 ++-- src/libs/standard/core/logic/ec_logic.erl | 26 ++-- 5 files changed, 98 insertions(+), 113 deletions(-) diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 868ad26..96463be 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -74,24 +74,20 @@ fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Param) -> ec_logic:prove_ecall(Efun, Val, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private -fail_clause(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> - ec_unify:unify_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). +fail_clause(#cp{data = {Ch, Cb, Db, Cursor}, next = Next, bs = Bs, vn = Vn}, Param) -> + ec_unify:unify_clauses(Ch, Cb, erlog_memory:next(Db, Cursor), Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private -fail_retract(#cp{data = {Ch, Cb, Cs}, next = Next, bs = Bs, vn = Vn}, Param) -> - ec_logic:retract_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). +fail_retract(#cp{data = {Ch, Cb, {Db, Cursor}}, next = Next, bs = Bs, vn = Vn}, Param) -> + ec_logic:retract_clauses(Ch, Cb, erlog_memory:next(Db, Cursor), Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Param) -> ec_logic:prove_predicates(Pi, Fs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private -fail_goal_clauses(#cp{data = {G, Db, C, Cursor}, next = Next, bs = Bs, vn = Vn}, Param) -> - NextClause = case erlog_memory:next(Db, Cursor) of - [] -> [{next, C}]; - N -> N - end, - ec_core:prove_goal_clauses(NextClause, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn, cursor = Cursor}). +fail_goal_clauses(#cp{data = {G, Db, Cursor}, next = Next, bs = Bs, vn = Vn}, Param) -> + ec_core:prove_goal_clauses(erlog_memory:next(Db, Cursor), Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn, cursor = Cursor}). fail_findall(#cp{next = Next, data = {Tag, Bag}, bs = Bs, vn = Vn0}, Param = #param{database = Db}) -> Data = erlog_memory:raw_fetch(Db, Tag), diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index bd4b21c..e95e028 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -84,7 +84,7 @@ prove_goal(Param = #param{goal = G, database = Db}) -> %% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to prove Goal using Clauses which all have the same functor. -prove_goal_clauses([{next, _}], Params) -> %end of checking clauses +prove_goal_clauses([], Params) -> %end of checking clauses erlog_errors:fail(Params); prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> %for clauses with body %% Must be smart here and test whether we need to add a cut point. @@ -97,7 +97,7 @@ prove_goal_clauses([C], Params = #param{choice = Cps, var_num = Vn}) -> %for cla prove_goal_clause(C, Params) end; prove_goal_clauses(C, Params = #param{goal = G, next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps, database = Db, cursor = Cursor}) -> - Cp = #cp{type = goal_clauses, label = Vn, data = {G, Db, C, Cursor}, next = Next, bs = Bs, vn = Vn}, + Cp = #cp{type = goal_clauses, label = Vn, data = {G, Db, Cursor}, next = Next, bs = Bs, vn = Vn}, prove_goal_clause(C, Params#param{choice = [Cp | Cps]}). %% Run function and close cursor after that. @@ -124,7 +124,6 @@ prove_goal_clause({_Tag, H0, {B0, _}}, Param = #param{goal = G, next_goal = Next %% @private check_result({built_in, Mod}, Param) -> Mod:prove_goal(Param); check_result({code, {Mod, Func}}, Param) -> Mod:Func(Param); -check_result({clauses, []}, Param) -> erlog_errors:fail(Param); check_result({clauses, Cs}, Param) -> prove_goal_clauses(Cs, Param); check_result(undefined, Param) -> erlog_errors:fail(Param); check_result({erlog_error, E}, #param{database = Db}) -> erlog_errors:erlog_error(E, Db). \ No newline at end of file diff --git a/src/core/logic/ec_unify.erl b/src/core/logic/ec_unify.erl index 7651195..36bb69b 100644 --- a/src/core/logic/ec_unify.erl +++ b/src/core/logic/ec_unify.erl @@ -17,53 +17,45 @@ %% unify(Term, Term, Bindings) -> {succeed,NewBindings} | fail. %% Unify two terms with a set of bindings. unify(T10, T20, Bs0) -> - case {ec_support:deref(T10, Bs0), ec_support:deref(T20, Bs0)} of - {T1, T2} when ?IS_CONSTANT(T1), T1 == T2 -> - {succeed, Bs0}; - {{V}, {V}} -> {succeed, Bs0}; - {{_} = Var, T2} -> {succeed, ec_support:add_binding(Var, T2, Bs0)}; - {T1, {_} = Var} -> {succeed, ec_support:add_binding(Var, T1, Bs0)}; - {[H1 | T1], [H2 | T2]} -> - case unify(H1, H2, Bs0) of - {succeed, Bs1} -> unify(T1, T2, Bs1); - fail -> fail - end; - {[], []} -> {succeed, Bs0}; - {T1, T2} when tuple_size(T1) == tuple_size(T2), - element(1, T1) == element(1, T2) -> - unify_args(T1, T2, Bs0, 2, tuple_size(T1)); - _Other -> fail - end. + case {ec_support:deref(T10, Bs0), ec_support:deref(T20, Bs0)} of + {T1, T2} when ?IS_CONSTANT(T1), T1 == T2 -> + {succeed, Bs0}; + {{V}, {V}} -> {succeed, Bs0}; + {{_} = Var, T2} -> {succeed, ec_support:add_binding(Var, T2, Bs0)}; + {T1, {_} = Var} -> {succeed, ec_support:add_binding(Var, T1, Bs0)}; + {[H1 | T1], [H2 | T2]} -> + case unify(H1, H2, Bs0) of + {succeed, Bs1} -> unify(T1, T2, Bs1); + fail -> fail + end; + {[], []} -> {succeed, Bs0}; + {T1, T2} when tuple_size(T1) == tuple_size(T2), + element(1, T1) == element(1, T2) -> + unify_args(T1, T2, Bs0, 2, tuple_size(T1)); + _Other -> fail + end. -%% unify_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. %% Try to unify Head and Body using Clauses which all have the same functor. -unify_clauses(Ch, Cb, [C], Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0}) -> - %% No choice point on last clause - case unify_clause(Ch, Cb, C, Bs0, Vn0) of - {succeed, Bs1, Vn1} -> ec_core:prove_body(Param#param{goal = Next, bindings = Bs1, var_num = Vn1}); - fail -> erlog_errors:fail(Param) - end; -unify_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0, choice = Cps}) -> - case unify_clause(Ch, Cb, C, Bs0, Vn0) of - {succeed, Bs1, Vn1} -> - Cp = #cp{type = clause, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, - ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); - fail -> unify_clauses(Ch, Cb, Cs, Param) - end; -unify_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param). +unify_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param); %no more clauses to try +unify_clauses(Ch, Cb, C, Param = #param{next_goal = Next, bindings = Bs0, var_num = Vn0, choice = Cps, database = Db, cursor = Cursor}) -> + case unify_clause(Ch, Cb, C, Bs0, Vn0) of + {succeed, Bs1, Vn1} -> + Cp = #cp{type = clause, data = {Ch, Cb, Db, Cursor}, next = Next, bs = Bs0, vn = Vn0}, + ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); + fail -> unify_clauses(Ch, Cb, erlog_memory:next(Db, Cursor), Param) + end. unify_clause(Ch, Cb, {_Tag, H0, {B0, _}}, Bs0, Vn0) -> - {H1, Rs1, Vn1} = ec_term:term_instance(H0, Vn0), %Unique vars on head first - case unify(Ch, H1, Bs0) of - {succeed, Bs1} -> - {B1, _Rs2, Vn2} = ec_body:body_term(B0, Rs1, Vn1), %Now we need the rest - case unify(Cb, B1, Bs1) of - {succeed, Bs2} -> {succeed, Bs2, Vn2}; - fail -> fail - end; - fail -> fail - end. + {H1, Rs1, Vn1} = ec_term:term_instance(H0, Vn0), %Unique vars on head first + case unify(Ch, H1, Bs0) of + {succeed, Bs1} -> + {B1, _Rs2, Vn2} = ec_body:body_term(B0, Rs1, Vn1), %Now we need the rest + case unify(Cb, B1, Bs1) of + {succeed, Bs2} -> {succeed, Bs2, Vn2}; + fail -> fail + end; + fail -> fail + end. %% unify_head(Goal, Head, Bindings, VarNum) -> %% {succeed,Repls,NewBindings,NewVarNum} | fail @@ -71,48 +63,48 @@ unify_clause(Ch, Cb, {_Tag, H0, {B0, _}}, Bs0, Vn0) -> %% head. This saves us creating many variables which are local to the %% clause and saves many variable bindings. unify_head(Goal, Head, Bs, Vn) -> - unify_head(ec_support:deref(Goal, Bs), Head, orddict:new(), Bs, Vn). + unify_head(ec_support:deref(Goal, Bs), Head, orddict:new(), Bs, Vn). unify_head(G, H, Rs, Bs, Vn) when ?IS_CONSTANT(G), G == H -> - {succeed, Rs, Bs, Vn}; + {succeed, Rs, Bs, Vn}; unify_head(_T, {'_'}, Rs, Bs, Vn) -> {succeed, Rs, Bs, Vn}; unify_head(T, {V0}, Rs, Bs0, Vn) -> - %% Now for the tricky bit! - case orddict:find(V0, Rs) of - {ok, V1} -> %Already have a replacement - case unify(T, V1, Bs0) of - {succeed, Bs1} -> {succeed, Rs, Bs1, Vn}; - fail -> fail - end; - error -> %Add a replacement - {succeed, orddict:store(V0, T, Rs), Bs0, Vn} - end; + %% Now for the tricky bit! + case orddict:find(V0, Rs) of + {ok, V1} -> %Already have a replacement + case unify(T, V1, Bs0) of + {succeed, Bs1} -> {succeed, Rs, Bs1, Vn}; + fail -> fail + end; + error -> %Add a replacement + {succeed, orddict:store(V0, T, Rs), Bs0, Vn} + end; unify_head({_} = Var, H0, Rs0, Bs, Vn0) -> - %% Must have an instance here. - {H1, Rs1, Vn1} = ec_term:term_instance(H0, Rs0, Vn0), - {succeed, Rs1, ec_support:add_binding(Var, H1, Bs), Vn1}; + %% Must have an instance here. + {H1, Rs1, Vn1} = ec_term:term_instance(H0, Rs0, Vn0), + {succeed, Rs1, ec_support:add_binding(Var, H1, Bs), Vn1}; unify_head([GH | GT], [HH | HT], Rs0, Bs0, Vn0) -> - case unify_head(ec_support:deref(GH, Bs0), HH, Rs0, Bs0, Vn0) of - {succeed, Rs1, Bs1, Vn1} -> unify_head(ec_support:deref(GT, Bs1), HT, Rs1, Bs1, Vn1); - fail -> fail - end; + case unify_head(ec_support:deref(GH, Bs0), HH, Rs0, Bs0, Vn0) of + {succeed, Rs1, Bs1, Vn1} -> unify_head(ec_support:deref(GT, Bs1), HT, Rs1, Bs1, Vn1); + fail -> fail + end; unify_head([], [], Rs, Bs, Vn) -> {succeed, Rs, Bs, Vn}; unify_head(G, H, Rs, Bs, Vn) when tuple_size(G) == tuple_size(H), - element(1, G) == element(1, H) -> - unify_head_args(G, H, Rs, Bs, Vn, 2, tuple_size(G)); + element(1, G) == element(1, H) -> + unify_head_args(G, H, Rs, Bs, Vn, 2, tuple_size(G)); unify_head(_G, _H, _Rs, _Bs, _Vn) -> fail. unify_head_args(_G, _H, Rs, Bs, Vn, I, S) when I > S -> - {succeed, Rs, Bs, Vn}; + {succeed, Rs, Bs, Vn}; unify_head_args(G, H, Rs0, Bs0, Vn0, I, S) -> - case unify_head(ec_support:deref(element(I, G), Bs0), element(I, H), Rs0, Bs0, Vn0) of - {succeed, Rs1, Bs1, Vn1} -> unify_head_args(G, H, Rs1, Bs1, Vn1, I + 1, S); - fail -> fail - end. + case unify_head(ec_support:deref(element(I, G), Bs0), element(I, H), Rs0, Bs0, Vn0) of + {succeed, Rs1, Bs1, Vn1} -> unify_head_args(G, H, Rs1, Bs1, Vn1, I + 1, S); + fail -> fail + end. unify_args(_, _, Bs, I, S) when I > S -> {succeed, Bs}; unify_args(S1, S2, Bs0, I, S) -> - case unify(element(I, S1), element(I, S2), Bs0) of - {succeed, Bs1} -> unify_args(S1, S2, Bs1, I + 1, S); - fail -> fail - end. \ No newline at end of file + case unify(element(I, S1), element(I, S2), Bs0) of + {succeed, Bs1} -> unify_args(S1, S2, Bs1, I + 1, S); + fail -> fail + end. \ No newline at end of file diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 5742b91..a7c4490 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -109,13 +109,9 @@ prove_retract(H, B, Table, Params = #param{database = Db}) -> Functor = ec_support:functor(H), case erlog_memory:get_db_procedure(Db, Table, Functor) of {cursor, Cursor, result, {clauses, Cs}} -> - try - retract_clauses(H, B, Cs, Params, Table) - after - erlog_memory:close(Db, Cursor) - end; - {clauses, Cs} -> retract_clauses(H, B, Cs, Params, Table); - undefined -> erlog_errors:fail(Params) + ec_core:run_n_close(fun(Param) -> retract_clauses(H, B, Cs, Param, Table) end, Params#param{cursor = Cursor}); + undefined -> erlog_errors:fail(Params); + _ -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)) end. %% @private @@ -129,9 +125,9 @@ prove_retractall(H, B, Table, Params = #param{database = Db}) -> end. %% @private -retract(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1, Table) -> +retract(Ch, Cb, C, Cursor, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1, Table) -> erlog_memory:db_retract_clause(Db, Table, ec_support:functor(Ch), element(1, C)), - Cp = #cp{type = db_retract, data = {Ch, Cb, Cs, Table}, next = Next, bs = Bs0, vn = Vn0}, + Cp = #cp{type = db_retract, data = {Ch, Cb, {Db, Cursor}, Table}, next = Next, bs = Bs0, vn = Vn0}, ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). %% @private @@ -139,16 +135,16 @@ retract(Ch, Cb, C, Cs, Param = #param{next_goal = Next, choice = Cps, bindings = %% void. %% Try to retract Head and Body using Clauses which all have the same functor. retract_clauses(_Ch, _Cb, [], Param, _) -> erlog_errors:fail(Param); -retract_clauses(Ch, Cb, [C | Cs], Param = #param{bindings = Bs0, var_num = Vn0}, Table) -> %TODO foreach vs handmade recursion? +retract_clauses(Ch, Cb, C, Param = #param{bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}, Table) -> case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> %% We have found a right clause so now retract it. - retract(Ch, Cb, C, Cs, Param, Bs1, Vn1, Table); - fail -> retract_clauses(Ch, Cb, Cs, Param, Table) + retract(Ch, Cb, C, Cursor, Param, Bs1, Vn1, Table); + fail -> retract_clauses(Ch, Cb, erlog_memory:next(Db, Cursor), Param, Table) end. -fail_retract(#cp{data = {Ch, Cb, Cs, Table}, next = Next, bs = Bs, vn = Vn}, Param) -> - retract_clauses(Ch, Cb, Cs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}, Table). +fail_retract(#cp{data = {Ch, Cb, {Db, Cursor}, Table}, next = Next, bs = Bs, vn = Vn}, Param) -> + retract_clauses(Ch, Cb, erlog_memory:next(Db, Cursor), Param#param{next_goal = Next, bindings = Bs, var_num = Vn}, Table). %% @private check_call_result([], Param, _, _) -> erlog_errors:fail(Param); @@ -162,7 +158,7 @@ retractall_clauses(Table, Clause, H, B, Params = #param{bindings = Bs0, var_num {succeed, _, _} -> erlog_memory:db_retract_clause(Db, Table, ec_support:functor(H), element(1, Clause)), retractall_clauses(Table, erlog_memory:next(Db, Cursor), H, B, Params); - fail -> ok + fail -> retractall_clauses(Table, [], H, B, Params) end. %% @private diff --git a/src/libs/standard/core/logic/ec_logic.erl b/src/libs/standard/core/logic/ec_logic.erl index ec7148b..508a93e 100644 --- a/src/libs/standard/core/logic/ec_logic.erl +++ b/src/libs/standard/core/logic/ec_logic.erl @@ -63,15 +63,16 @@ prove_ecall(Efun, Val, Param = #param{next_goal = Next, choice = Cps, bindings = %% prove_clause(Head, Body, Next, ChoicePoints, Bindings, VarNum, DataBase) -> %% void. %% Unify clauses matching with functor from Head with both Head and Body. -prove_clause(H, B, Param = #param{database = Db}) -> +prove_clause(H, B, Params = #param{database = Db}) -> Functor = ec_support:functor(H), case erlog_memory:get_procedure(Db, Functor) of - {clauses, Cs} -> ec_unify:unify_clauses(H, B, Cs, Param); + {cursor, Cursor, result, {clauses, Cs}} -> + ec_core:run_n_close(fun(Param) -> ec_unify:unify_clauses(H, B, Cs, Param) end, Params#param{cursor = Cursor}); {code, _} -> erlog_errors:permission_error(access, private_procedure, ec_support:pred_ind(Functor)); built_in -> erlog_errors:permission_error(access, private_procedure, ec_support:pred_ind(Functor)); - undefined -> erlog_errors:fail(Param) + undefined -> erlog_errors:fail(Params) end. %% prove_current_predicate(PredInd, Next, ChoicePoints, Bindings, VarNum, DataBase) -> @@ -121,14 +122,14 @@ check_goal(G0, Next, Bs, Db, Cut, Label) -> %% void. %% Try to retract Head and Body using Clauses which all have the same functor. retract_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param); -retract_clauses(Ch, Cb, [C | Cs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}) -> %TODO foreach vs handmade recursion? +retract_clauses(Ch, Cb, C, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}) -> %TODO foreach vs handmade recursion? case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> %% We have found a right clause so now retract it. erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), - Cp = #cp{type = retract, data = {Ch, Cb, Cs}, next = Next, bs = Bs0, vn = Vn0}, + Cp = #cp{type = retract, data = {Ch, Cb, {Db, Cursor}}, next = Next, bs = Bs0, vn = Vn0}, ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); - fail -> retract_clauses(Ch, Cb, Cs, Param) + fail -> retract_clauses(Ch, Cb, erlog_memory:next(Db, Cursor), Param) end. %% well_form_goal(Goal, Tail, HasCutAfter, CutLabel) -> {Body,HasCut}. @@ -223,7 +224,8 @@ partial_list(Other, _) -> erlog_errors:type_error(list, Other). prove_retract(H, B, Params = #param{database = Db}) -> Functor = ec_support:functor(H), case erlog_memory:get_procedure(Db, Functor) of - {clauses, Cs} -> retract_clauses(H, B, Cs, Params); + {cursor, Cursor, result, {clauses, Cs}} -> + ec_core:run_n_close(fun(Param) -> retract_clauses(H, B, Cs, Param) end, Params#param{cursor = Cursor}); {code, _} -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); built_in -> @@ -236,7 +238,8 @@ prove_retractall(H, B, Params = #param{database = Db}) -> Functor = ec_support:functor(H), case erlog_memory:get_procedure(Db, Functor) of {cursor, Cursor, result, Result} -> - check_result(Result, H, B, Functor, Params#param{cursor = Cursor}); + Fun = fun(Param) -> check_result(Result, H, B, Functor, Param) end, + ec_core:run_n_close(Fun, Params#param{cursor = Cursor}); Result -> check_result(Result, H, B, Functor, Params) end. @@ -247,7 +250,7 @@ retractall_clauses(Clause, H, B, Params = #param{bindings = Bs0, var_num = Vn0, {succeed, _, _} -> erlog_memory:retract_clause(Db, ec_support:functor(H), element(1, Clause)), retractall_clauses(erlog_memory:next(Db, Cursor), H, B, Params); - fail -> ok + fail -> retractall_clauses([], H, B, Params) end. %% @private @@ -255,8 +258,7 @@ check_result({built_in, _}, _, _, Functor, _) -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); check_result({code, _}, _, _, Functor, _) -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); -check_result({clauses, Cs}, H, B, _, Params = #param{cursor = Cursor}) -> - Fun = fun(Param) -> retractall_clauses(Cs, H, B, Param) end, - ec_core:run_n_close(Fun, Params#param{cursor = Cursor}); +check_result({clauses, Cs}, H, B, _, Params) -> + retractall_clauses(Cs, H, B, Params); check_result(undefined, _, _, _, Params = #param{next_goal = Next}) -> ec_core:prove_body(Params#param{goal = Next}); check_result({erlog_error, E}, _, _, _, #param{database = Db}) -> erlog_errors:erlog_error(E, Db). \ No newline at end of file From fde31aab274a56939370503f95fd2b5e4d7ed95f Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 8 Oct 2014 02:09:27 +0000 Subject: [PATCH 166/251] fix retract clauses --- src/core/logic/ec_unify.erl | 1 + src/libs/external/db/erlog_db.erl | 7 +++++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/core/logic/ec_unify.erl b/src/core/logic/ec_unify.erl index 36bb69b..19d1494 100644 --- a/src/core/logic/ec_unify.erl +++ b/src/core/logic/ec_unify.erl @@ -45,6 +45,7 @@ unify_clauses(Ch, Cb, C, Param = #param{next_goal = Next, bindings = Bs0, var_nu fail -> unify_clauses(Ch, Cb, erlog_memory:next(Db, Cursor), Param) end. +unify_clause(Ch, Cb, [C], Bs0, Vn0) -> unify_clause(Ch, Cb, C, Bs0, Vn0); unify_clause(Ch, Cb, {_Tag, H0, {B0, _}}, Bs0, Vn0) -> {H1, Rs1, Vn1} = ec_term:term_instance(H0, Vn0), %Unique vars on head first case unify(Ch, H1, Bs0) of diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index a7c4490..f8e5f99 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -134,7 +134,8 @@ retract(Ch, Cb, C, Cursor, Param = #param{next_goal = Next, choice = Cps, bindin %% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to retract Head and Body using Clauses which all have the same functor. -retract_clauses(_Ch, _Cb, [], Param, _) -> erlog_errors:fail(Param); +retract_clauses(_, _, [], Param, _) -> erlog_errors:fail(Param); +retract_clauses(Ch, Cb, [C], Param, Table) -> retract_clauses(Ch, Cb, C, Param, Table); retract_clauses(Ch, Cb, C, Param = #param{bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}, Table) -> case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> @@ -153,12 +154,14 @@ check_call_result({erlog_error, E}, #param{database = Db}, _, _) -> erlog_errors check_call_result(Cs, Param, G, Next) -> prove_call(G, Cs, Next, Param). retractall_clauses(_, [], _, _, Params = #param{next_goal = Next}) -> ec_core:prove_body(Params#param{goal = Next}); +retractall_clauses(Table, [Clause], H, B, Params) -> retractall_clauses(Table, Clause, H, B, Params); retractall_clauses(Table, Clause, H, B, Params = #param{bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}) -> case ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of {succeed, _, _} -> erlog_memory:db_retract_clause(Db, Table, ec_support:functor(H), element(1, Clause)), retractall_clauses(Table, erlog_memory:next(Db, Cursor), H, B, Params); - fail -> retractall_clauses(Table, [], H, B, Params) + fail -> + retractall_clauses(Table, [], H, B, Params) end. %% @private From 98df6392c517b6b86f348e575ddb7decd405f96d Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 8 Oct 2014 02:41:02 +0000 Subject: [PATCH 167/251] add breakpoint support in debugger --- doc/debugger.md | 33 +++++++++++++++++++ src/core/logic/ec_core.erl | 3 ++ .../debugger/erlog_simple_debugger.erl | 6 +++- 3 files changed, 41 insertions(+), 1 deletion(-) diff --git a/doc/debugger.md b/doc/debugger.md index d76dc6d..0815e30 100644 --- a/doc/debugger.md +++ b/doc/debugger.md @@ -71,4 +71,37 @@ section. When goal matches - debugger will print execution, otherwise it will be | ?- assert(foo(a,b)), assert(foo(a,c)), foo(a,b), assert(foo(a,c)), foo(a,c), assert(foo(a,d)),foo(a,d), assert(foo(a,b)). Execute {foo,a,b}, memory: [] true + +#### Stopping with break poing +To stop execution somewhere in your code before specific functor - place breakpoint on this line. To place breakpoint in +code use `'??'` special functor. +Example code with one breakpoint: + + test:- + writeln("before breakpoint"), + '??'(writeln("stop me")), + writeln("after breakpoint"). +Output: + + 1> {ok, Pid} = erlog_simple_debugger:start_link(). + {ok,<0.34.0>} + 2> erlog_local_shell:start(Pid). + Erlog Shell V6.1 with debugger (abort with ^G) + | ?- consult('/home/prolog/test_debug.pl'). + Execute {call,{consult,'/home/prolog/test_debug.pl'}}, memory: [] + Execute {consult,'/home/prolog/test_debug.pl'}, memory: [] + true + | ?- test. + Execute {call,test}, memory: [] + Execute test, memory: [] + Execute {writeln,"before breakpoint"}, memory: [] + erlog_simple_printer: "before breakpoint" + Execute {'??',{writeln,"stop me"}, memory: [] + Erlog debugger stopped execution on command {writeln,"stop me"} with memory: []. + Select action + | ?- listing + erlog_simple_printer: "stop me" + Execute {writeln,"after breakpoint"}, memory: [] + erlog_simple_printer: "after breakpoint" + true \ No newline at end of file diff --git a/src/core/logic/ec_core.erl b/src/core/logic/ec_core.erl index e95e028..548cac6 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/ec_core.erl @@ -50,6 +50,9 @@ prove_goal(Param = #param{goal = {{once}, Label}, next_goal = Next, choice = Cps %% There is no ( G, ! ) here, it has already been prepended to Next. Cut = #cut{label = Label}, prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); +prove_goal(Param = #param{goal = {'??', Next}, bindings = Bs, debugger = Deb}) -> %debug stop point + Deb(stop, ec_support:dderef(Next, Bs), Bs), + prove_goal(Param#param{goal = Next}); prove_goal(Param = #param{goal = {{if_then_else}, Else, Label}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> %% Need to push a choicepoint to fail back to inside Cond and a cut %% to cut back to before Then when Cond succeeds. #cp{type=if_then_else} diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl index c9e4227..48dd549 100644 --- a/src/interface/debugger/erlog_simple_debugger.erl +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -90,6 +90,10 @@ init([]) -> handle_call(conf, _From, State) -> Policy = process_action(), {reply, ok, State#state{policy = Policy}}; +handle_call({stop, Functor, Vars}, _From, State) -> + io:fwrite("Erlog debugger stopped execution on command ~p with memory: ~p.~n", [Functor, process_reply(Vars)]), + Policy = process_action(), + {reply, ok, State#state{policy = Policy}}; handle_call({_, Functor, Vars}, _From, State = #state{policy = {stop, Rule} = Old}) -> %stopping Fun = fun() -> @@ -190,7 +194,7 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== %%% Internal functions %%%=================================================================== -process_match({{_},_,_}, _, _) -> false; %skip support functors +process_match({{_}, _, _}, _, _) -> false; %skip support functors process_match(Functor, Execute, {detailed, Functor}) -> Execute(); process_match(_, _, {detailed, _}) -> From fbe5cac3283c82003661b3bcad992f70a3190c4a Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 8 Oct 2014 02:41:31 +0000 Subject: [PATCH 168/251] fix readme --- doc/debugger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/debugger.md b/doc/debugger.md index 0815e30..0ee07a0 100644 --- a/doc/debugger.md +++ b/doc/debugger.md @@ -72,7 +72,7 @@ section. When goal matches - debugger will print execution, otherwise it will be Execute {foo,a,b}, memory: [] true -#### Stopping with break poing +#### Stopping with breakpoint To stop execution somewhere in your code before specific functor - place breakpoint on this line. To place breakpoint in code use `'??'` special functor. Example code with one breakpoint: From b382738c28b7acd2b8c8f80a590a20539203121e Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 13 Oct 2014 21:08:30 +0000 Subject: [PATCH 169/251] add state passing to close & next --- src/storage/erlog_dict.erl | 19 +++++++++--------- src/storage/erlog_ets.erl | 19 +++++++++--------- src/storage/erlog_memory.erl | 12 ++++++------ src/storage/erlog_storage.erl | 36 ++++++++++++++++++++++------------- 4 files changed, 49 insertions(+), 37 deletions(-) diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 5a585ab..a45e404 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -24,8 +24,8 @@ get_interp_functors/1, findall/2, listing/2, - close/1, - next/1]). + close/2, + next/2]). new() -> {ok, dict:new()}. @@ -123,19 +123,20 @@ findall({StdLib, ExLib, Db}, {Functor}) -> %for bagof end end. -close(undefined) -> ok; -close(Cursor) -> - put(Cursor, queue:new()). %save empty queue +close(Db, undefined) -> {ok, Db}; +close(Db, Cursor) -> + put(Cursor, queue:new()), + {ok, Db}. %save empty queue -next(undefined) -> []; -next(Cursor) -> +next(Db, undefined) -> {[], Db}; +next(Db, Cursor) -> case get(Cursor) of %get clauses undefined -> []; %empty cursor Queue -> case queue:out(Queue) of %take variant {{value, Val}, UQ} -> put(Cursor, UQ), %save others - Val; %return it - {empty, _} -> [] %nothing to return + {Val, Db}; %return it + {empty, _} -> {[], Db} %nothing to return end end. diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 0130dea..992c5c1 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -24,8 +24,8 @@ get_interp_functors/1, findall/2, listing/2, - close/1, - next/1]). + close/2, + next/2]). new() -> {ok, ets:new(eets, [bag, private])}. @@ -117,19 +117,20 @@ findall({StdLib, ExLib, Db}, {Functor}) -> end end. -close(undefined) -> ok; -close(Cursor) -> - put(Cursor, queue:new()). %save empty queue +close(Ets, undefined) -> {ok, Ets}; +close(Ets, Cursor) -> + put(Cursor, queue:new()), %save empty queue + {ok, Ets}. -next(undefined) -> []; -next(Cursor) -> +next(Ets, undefined) -> {[], Ets}; +next(Ets, Cursor) -> case get(Cursor) of %get clauses - undefined -> []; %empty cursor + undefined -> {[], Ets}; %empty cursor Queue -> case queue:out(Queue) of %take variant {{value, Val}, UQ} -> put(Cursor, UQ), %save others Val; %return it - {empty, _} -> [] %nothing to return + {empty, _} -> {[], Ets} %nothing to return end end. diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 5555d3d..bd51266 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -222,12 +222,12 @@ handle_call({abolish_clauses, {_, Func} = Params}, _From, State = #state{state = catch throw:E -> {reply, E, State} end; -handle_call({next, Cursor}, _From, State = #state{database = Db}) -> %get next result by cursor - Res = Db:next(Cursor), - {reply, Res, State}; -handle_call({close, Cursor}, _From, State = #state{database = Db}) -> %get next result by cursor - Res = Db:close(Cursor), - {reply, Res, State}; +handle_call({next, Cursor}, _From, State = #state{state = DbState, database = Db}) -> %get next result by cursor + {Res, UState} = Db:next(DbState, Cursor), + {reply, Res, State#state{state = UState}}; +handle_call({close, Cursor}, _From, State = #state{state = DbState, database = Db}) -> %get next result by cursor + {Res, UState} = Db:close(DbState, Cursor), + {reply, Res, State#state{state = UState}}; handle_call({Fun, Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module try {Res, UState} = Db:Fun({StdLib, ExLib, DbState}, Params), diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl index bc17bef..6f5ecb3 100644 --- a/src/storage/erlog_storage.erl +++ b/src/storage/erlog_storage.erl @@ -9,28 +9,38 @@ -module(erlog_storage). -author("tihon"). --callback new() -> {ok, State :: term()}. +%% ------- Prolog ------- +%% add value right +-callback assertz_clause({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Param :: term()) -> {ok, NewState :: any()}. --callback new(Params :: list()) -> {ok, State :: term()}. +%% add value left +-callback asserta_clause({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Param :: term()) -> {ok, NewState :: any()}. --callback close(Pid :: pid()) -> ok. +%% find all values +-callback findall({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Functor :: tuple()) -> {Res :: list(), NewState :: any()}. --callback next(Pid :: pid()) -> ok. +%% get all values in memory by search criteria +-callback listing({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Param :: term()) -> {Res :: list(), NewState :: any()}. --callback assertz_clause({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Param :: term()) -> {ok, NewState :: term()}. +%% remove selected functor +-callback retract_clause({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Param :: term()) -> {ok, NewState :: any()}. --callback asserta_clause({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Param :: term()) -> {ok, NewState :: term()}. +%% remove all matching functors +-callback abolish_clauses({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Func :: term()) -> {ok, NewState :: any()}. --callback findall({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Functor :: tuple()) -> {Res :: list(), NewState :: term()}. +%% ------- System ------- +-callback new() -> {ok, State :: any()}. --callback listing({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Param :: term()) -> {Res :: list(), NewState :: term()}. +-callback new(Params :: list()) -> {ok, State :: any()}. --callback retract_clause({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Param :: term()) -> {ok, NewState :: term()}. +%% close cursor +-callback close(State :: any(), Pid :: pid()) -> {ok, NewState :: any()}. --callback abolish_clauses({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Func :: term()) -> {ok, NewState :: term()}. +%% get next result by cursor +-callback next(State :: any(), Pid :: any()) -> {[] | any(), NewState :: any()}. --callback get_procedure({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Func :: term()) -> {atom, NewState :: term()} | {term(), NewState :: term()}. +-callback get_procedure({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Func :: term()) -> {atom, NewState :: any()} | {term(), NewState :: any()}. --callback get_procedure_type({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}, Func :: term()) -> {atom(), NewState :: term()}. +-callback get_procedure_type({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Func :: term()) -> {atom(), NewState :: any()}. --callback get_interp_functors({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: term()}) -> {list(), NewState :: term()}. \ No newline at end of file +-callback get_interp_functors({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}) -> {list(), NewState :: any()}. \ No newline at end of file From 12c57d00cf68fb8fbf54cf458fe38e3e1acb8972 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 13 Oct 2014 21:31:57 +0000 Subject: [PATCH 170/251] partly made updating cursors --- src/core/erlog_errors.erl | 9 ++++++--- src/core/logic/ec_unify.erl | 4 +++- src/libs/external/db/erlog_db.erl | 10 +++++++--- src/libs/standard/core/logic/ec_logic.erl | 7 +++++-- src/storage/erlog_dict.erl | 4 ++-- src/storage/erlog_ets.erl | 4 ++-- src/storage/erlog_memory.erl | 7 ++++++- 7 files changed, 31 insertions(+), 14 deletions(-) diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 96463be..4036133 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -75,11 +75,13 @@ fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Param) -> %% @private fail_clause(#cp{data = {Ch, Cb, Db, Cursor}, next = Next, bs = Bs, vn = Vn}, Param) -> - ec_unify:unify_clauses(Ch, Cb, erlog_memory:next(Db, Cursor), Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + {UCursor, Res} = erlog_memory:next(Db, Cursor), + ec_unify:unify_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}). %% @private fail_retract(#cp{data = {Ch, Cb, {Db, Cursor}}, next = Next, bs = Bs, vn = Vn}, Param) -> - ec_logic:retract_clauses(Ch, Cb, erlog_memory:next(Db, Cursor), Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + {UCursor, Res} = erlog_memory:next(Db, Cursor), + ec_logic:retract_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}). %% @private fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Param) -> @@ -87,7 +89,8 @@ fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Para %% @private fail_goal_clauses(#cp{data = {G, Db, Cursor}, next = Next, bs = Bs, vn = Vn}, Param) -> - ec_core:prove_goal_clauses(erlog_memory:next(Db, Cursor), Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn, cursor = Cursor}). + {UCursor, Res} = erlog_memory:next(Db, Cursor), + ec_core:prove_goal_clauses(Res, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}). fail_findall(#cp{next = Next, data = {Tag, Bag}, bs = Bs, vn = Vn0}, Param = #param{database = Db}) -> Data = erlog_memory:raw_fetch(Db, Tag), diff --git a/src/core/logic/ec_unify.erl b/src/core/logic/ec_unify.erl index 19d1494..24dae1f 100644 --- a/src/core/logic/ec_unify.erl +++ b/src/core/logic/ec_unify.erl @@ -42,7 +42,9 @@ unify_clauses(Ch, Cb, C, Param = #param{next_goal = Next, bindings = Bs0, var_nu {succeed, Bs1, Vn1} -> Cp = #cp{type = clause, data = {Ch, Cb, Db, Cursor}, next = Next, bs = Bs0, vn = Vn0}, ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); - fail -> unify_clauses(Ch, Cb, erlog_memory:next(Db, Cursor), Param) + fail -> + {UCursor, Res} = erlog_memory:next(Db, Cursor), + unify_clauses(Ch, Cb, Res, Param#param{cursor = UCursor}) end. unify_clause(Ch, Cb, [C], Bs0, Vn0) -> unify_clause(Ch, Cb, C, Bs0, Vn0); diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index f8e5f99..9f2f1d4 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -141,11 +141,14 @@ retract_clauses(Ch, Cb, C, Param = #param{bindings = Bs0, var_num = Vn0, databas {succeed, Bs1, Vn1} -> %% We have found a right clause so now retract it. retract(Ch, Cb, C, Cursor, Param, Bs1, Vn1, Table); - fail -> retract_clauses(Ch, Cb, erlog_memory:next(Db, Cursor), Param, Table) + fail -> + {UCursor, Res} = erlog_memory:next(Db, Cursor), + retract_clauses(Ch, Cb, Res, Param#param{cursor = UCursor}, Table) end. fail_retract(#cp{data = {Ch, Cb, {Db, Cursor}, Table}, next = Next, bs = Bs, vn = Vn}, Param) -> - retract_clauses(Ch, Cb, erlog_memory:next(Db, Cursor), Param#param{next_goal = Next, bindings = Bs, var_num = Vn}, Table). + {UCursor, Res} = erlog_memory:next(Db, Cursor), + retract_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}, Table). %% @private check_call_result([], Param, _, _) -> erlog_errors:fail(Param); @@ -159,7 +162,8 @@ retractall_clauses(Table, Clause, H, B, Params = #param{bindings = Bs0, var_num case ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of {succeed, _, _} -> erlog_memory:db_retract_clause(Db, Table, ec_support:functor(H), element(1, Clause)), - retractall_clauses(Table, erlog_memory:next(Db, Cursor), H, B, Params); + {UCursor, Res} = erlog_memory:next(Db, Cursor), + retractall_clauses(Table, Res, H, B, Params#param{cursor = UCursor}); fail -> retractall_clauses(Table, [], H, B, Params) end. diff --git a/src/libs/standard/core/logic/ec_logic.erl b/src/libs/standard/core/logic/ec_logic.erl index 508a93e..ea24c21 100644 --- a/src/libs/standard/core/logic/ec_logic.erl +++ b/src/libs/standard/core/logic/ec_logic.erl @@ -129,7 +129,9 @@ retract_clauses(Ch, Cb, C, Param = #param{next_goal = Next, choice = Cps, bindin erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), Cp = #cp{type = retract, data = {Ch, Cb, {Db, Cursor}}, next = Next, bs = Bs0, vn = Vn0}, ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); - fail -> retract_clauses(Ch, Cb, erlog_memory:next(Db, Cursor), Param) + fail -> + {UCursor, Res} = erlog_memory:next(Db, Cursor), + retract_clauses(Ch, Cb, Res, Param#param{cursor = UCursor}) end. %% well_form_goal(Goal, Tail, HasCutAfter, CutLabel) -> {Body,HasCut}. @@ -249,7 +251,8 @@ retractall_clauses(Clause, H, B, Params = #param{bindings = Bs0, var_num = Vn0, case ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of {succeed, _, _} -> erlog_memory:retract_clause(Db, ec_support:functor(H), element(1, Clause)), - retractall_clauses(erlog_memory:next(Db, Cursor), H, B, Params); + {UCursor, Res} = erlog_memory:next(Db, Cursor), + retractall_clauses(Res, H, B, Params#param{cursor = UCursor}); fail -> retractall_clauses([], H, B, Params) end. diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index a45e404..b0cc9db 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -135,8 +135,8 @@ next(Db, Cursor) -> Queue -> case queue:out(Queue) of %take variant {{value, Val}, UQ} -> put(Cursor, UQ), %save others - {Val, Db}; %return it - {empty, _} -> {[], Db} %nothing to return + {{cursor, Cursor, result, Val}, Db}; %return it + {empty, _} -> {cursor, Cursor, result, [], Db} %nothing to return end end. diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 992c5c1..a700f29 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -129,8 +129,8 @@ next(Ets, Cursor) -> Queue -> case queue:out(Queue) of %take variant {{value, Val}, UQ} -> put(Cursor, UQ), %save others - Val; %return it - {empty, _} -> {[], Ets} %nothing to return + {{cursor, Cursor, result, Val}, Ets}; %return it + {empty, _} -> {cursor, Cursor, result, [], Ets} %nothing to return end end. diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index bd51266..2c52753 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -224,7 +224,12 @@ handle_call({abolish_clauses, {_, Func} = Params}, _From, State = #state{state = end; handle_call({next, Cursor}, _From, State = #state{state = DbState, database = Db}) -> %get next result by cursor {Res, UState} = Db:next(DbState, Cursor), - {reply, Res, State#state{state = UState}}; + Ans = case Res of + {cursor, After, result, Result} -> {After, Result}; %got new (or same cursor) and result. Form and return + [] -> {Cursor, []} %no result got - return old cursor and empty result + end, + io:format("next res is ~p~n", [Ans]), + {reply, Ans, State#state{state = UState}}; handle_call({close, Cursor}, _From, State = #state{state = DbState, database = Db}) -> %get next result by cursor {Res, UState} = Db:close(DbState, Cursor), {reply, Res, State#state{state = UState}}; From 7ec6e7de20587a522a5d6c41aa7ca8dafaaf5444 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 13 Oct 2014 21:41:27 +0000 Subject: [PATCH 171/251] fix retract clauses & mistakes in next --- src/libs/standard/core/logic/ec_logic.erl | 3 ++- src/storage/erlog_dict.erl | 4 ++-- src/storage/erlog_ets.erl | 2 +- src/storage/erlog_memory.erl | 1 - 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/libs/standard/core/logic/ec_logic.erl b/src/libs/standard/core/logic/ec_logic.erl index ea24c21..39d23e0 100644 --- a/src/libs/standard/core/logic/ec_logic.erl +++ b/src/libs/standard/core/logic/ec_logic.erl @@ -121,7 +121,8 @@ check_goal(G0, Next, Bs, Db, Cut, Label) -> %% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Try to retract Head and Body using Clauses which all have the same functor. -retract_clauses(_Ch, _Cb, [], Param) -> erlog_errors:fail(Param); +retract_clauses(_, _, [], Param) -> erlog_errors:fail(Param); +retract_clauses(Ch, Cb, [C], Param) -> retract_clauses(Ch, Cb, C, Param); retract_clauses(Ch, Cb, C, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}) -> %TODO foreach vs handmade recursion? case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index b0cc9db..65d050e 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -131,12 +131,12 @@ close(Db, Cursor) -> next(Db, undefined) -> {[], Db}; next(Db, Cursor) -> case get(Cursor) of %get clauses - undefined -> []; %empty cursor + undefined -> {[], Db}; %empty cursor Queue -> case queue:out(Queue) of %take variant {{value, Val}, UQ} -> put(Cursor, UQ), %save others {{cursor, Cursor, result, Val}, Db}; %return it - {empty, _} -> {cursor, Cursor, result, [], Db} %nothing to return + {empty, _} -> {{cursor, Cursor, result, []}, Db} %nothing to return end end. diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index a700f29..44042ba 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -130,7 +130,7 @@ next(Ets, Cursor) -> {{value, Val}, UQ} -> put(Cursor, UQ), %save others {{cursor, Cursor, result, Val}, Ets}; %return it - {empty, _} -> {cursor, Cursor, result, [], Ets} %nothing to return + {empty, _} -> {{cursor, Cursor, result, []}, Ets} %nothing to return end end. diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 2c52753..7c9cf34 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -228,7 +228,6 @@ handle_call({next, Cursor}, _From, State = #state{state = DbState, database = Db {cursor, After, result, Result} -> {After, Result}; %got new (or same cursor) and result. Form and return [] -> {Cursor, []} %no result got - return old cursor and empty result end, - io:format("next res is ~p~n", [Ans]), {reply, Ans, State#state{state = UState}}; handle_call({close, Cursor}, _From, State = #state{state = DbState, database = Db}) -> %get next result by cursor {Res, UState} = Db:close(DbState, Cursor), From 01aa2785276d82d731a216d9802b851df8a37533 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 13 Oct 2014 21:58:05 +0000 Subject: [PATCH 172/251] update doc, remove proc dict cursor impl --- doc/memory.md | 7 ++++--- src/storage/erlog_dict.erl | 37 +++++++++++++------------------------ src/storage/erlog_ets.erl | 32 ++++++++++++-------------------- 3 files changed, 29 insertions(+), 47 deletions(-) diff --git a/doc/memory.md b/doc/memory.md index c6c1fae..fc43113 100644 --- a/doc/memory.md +++ b/doc/memory.md @@ -26,9 +26,10 @@ __Note__: prefer using cursors to fetching all clauses. To write your own memory implementation, based on your favourite database, or cache, or something else - implement `erlog_storage` behavior and pass your module name in arguments, when you start erlog (as mentioned in Readme). `new/1` is called automatically - when erlog starts. New should be used for initialisation of the database. New takes -list as param which was sent in erlog arguments for database module. -`close/1` is called automatically - when erlog deside to close the cursor. -`next/1` is called automatically to fetch next clause value from database. +list as param which was sent in erlog arguments for database module. +`close/2` is called automatically - when erlog deside to close the cursor, database state can be updated there. +`next/2` is called automatically to fetch next clause value from database, database state can be updated there. Also, you +can update your cursor, if you hame some complex logic. `get_procedure/2` is called automatically - when erlog is looking for a predicate to execute. First it search stdlib, then extended lib and then userspace. It is main erlog predicate. Note, that it is called on every execution and can be the main reason of loading the database. diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 65d050e..5376fda 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -103,8 +103,8 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call error -> case dict:find(Functor, Dict) of %search userspace last {ok, Cs} -> - Cursor = form_cursor(), - {{cursor, Cursor, result, {clauses, form_clauses(Cs, Cursor)}}, Db}; + {First, Cursor} = form_clauses(Cs), %TODO fix bagof, possibly broken by return format + {{cursor, Cursor, result, {clauses, First}}, Db}; error -> {[], Db} end end @@ -123,21 +123,14 @@ findall({StdLib, ExLib, Db}, {Functor}) -> %for bagof end end. -close(Db, undefined) -> {ok, Db}; -close(Db, Cursor) -> - put(Cursor, queue:new()), - {ok, Db}. %save empty queue +close(Db, _) -> {ok, Db}. next(Db, undefined) -> {[], Db}; -next(Db, Cursor) -> - case get(Cursor) of %get clauses - undefined -> {[], Db}; %empty cursor - Queue -> case queue:out(Queue) of %take variant - {{value, Val}, UQ} -> - put(Cursor, UQ), %save others - {{cursor, Cursor, result, Val}, Db}; %return it - {empty, _} -> {{cursor, Cursor, result, []}, Db} %nothing to return - end +next(Db, Queue) -> + case queue:out(Queue) of %take variant + {{value, Val}, UQ} -> + {{cursor, UQ, result, Val}, Db}; %return it + {empty, UQ} -> {{cursor, UQ, result, []}, Db} %nothing to return end. get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> @@ -154,8 +147,8 @@ get_procedure({StdLib, ExLib, Db}, {Functor}) -> error -> case dict:find(Functor, Db) of %search userspace last {ok, Cs} -> - Cursor = form_cursor(), - {cursor, Cursor, result, {clauses, form_clauses(Cs, Cursor)}}; + {First, Cursor} = form_clauses(Cs), + {cursor, Cursor, result, {clauses, First}}; error -> undefined end end @@ -232,11 +225,7 @@ check_immutable(Dict, Functor) -> end. %% @private -form_clauses(Loaded, _) when length(Loaded) =< 1 -> Loaded; -form_clauses([First | Loaded], Cursor) -> +form_clauses([]) -> {[], queue:new()}; +form_clauses([First | Loaded]) -> Queue = queue:from_list(Loaded), - put(Cursor, Queue), - First. - -form_cursor() -> - [random:uniform(X) || X <- lists:seq(1, 20)]. \ No newline at end of file + {First, Queue}. \ No newline at end of file diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 44042ba..050fa82 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -98,8 +98,8 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call Cs when is_list(Cs) -> Cs; _ -> [] end, - Cursor = form_cursor(), - {{cursor, Cursor, result, {clauses, form_clauses(CS, Cursor)}}, Db} + {First, Cursor} = form_clauses(CS), + {{cursor, Cursor, result, {clauses, First}}, Db} end end; findall({StdLib, ExLib, Db}, {Functor}) -> @@ -123,15 +123,11 @@ close(Ets, Cursor) -> {ok, Ets}. next(Ets, undefined) -> {[], Ets}; -next(Ets, Cursor) -> - case get(Cursor) of %get clauses - undefined -> {[], Ets}; %empty cursor - Queue -> case queue:out(Queue) of %take variant - {{value, Val}, UQ} -> - put(Cursor, UQ), %save others - {{cursor, Cursor, result, Val}, Ets}; %return it - {empty, _} -> {{cursor, Cursor, result, []}, Ets} %nothing to return - end +next(Ets, Queue) -> + case queue:out(Queue) of %take variant + {{value, Val}, UQ} -> + {{cursor, UQ, result, Val}, Ets}; %return it + {empty, UQ} -> {{cursor, UQ, result, []}, Ets} %nothing to return end. get_procedure({StdLib, ExLib, _}, {Collection, Functor}) -> @@ -146,8 +142,8 @@ get_procedure({StdLib, ExLib, Db}, {Functor}) -> error -> case catch ets:lookup_element(Db, Functor, 2) of %search userspace last Cs when is_list(Cs) -> - Cursor = form_cursor(), - {cursor, Cursor, result, {clauses, form_clauses(Cs, Cursor)}}; + {First, Cursor} = form_clauses(Cs), + {{cursor, Cursor, result, {clauses, First}}, Db}; _ -> undefined end end @@ -228,11 +224,7 @@ check_immutable(Dict, Functor) -> %TODO may be move me to erlog_memory? end. %% @private -form_clauses(Loaded, _) when length(Loaded) =< 1 -> Loaded; -form_clauses([First | Loaded], Cursor) -> +form_clauses([]) -> {[], queue:new()}; +form_clauses([First | Loaded]) -> Queue = queue:from_list(Loaded), - put(Cursor, Queue), - First. - -form_cursor() -> - [random:uniform(X) || X <- lists:seq(1, 20)]. \ No newline at end of file + {First, Queue}. \ No newline at end of file From ca23be673d6c63742b6487096eb35f0dbd0e25e3 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 14 Oct 2014 23:24:12 +0000 Subject: [PATCH 173/251] added important todo thought --- src/storage/erlog_memory.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 7c9cf34..404f35d 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -11,7 +11,7 @@ -include("erlog_core.hrl"). --behaviour(gen_server). +-behaviour(gen_server). %TODO do we really need gen_server here? %% API -export([start_link/1, From a51589e64e2422f26d597233ea69094ca2cf9902 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 17 Oct 2014 02:19:39 +0000 Subject: [PATCH 174/251] rename short named files in case of conflicts with other project's deps --- src/core/erlog.erl | 2 +- src/core/erlog_errors.erl | 16 +-- src/core/erlog_logic.erl | 2 +- .../logic/{ec_body.erl => erlog_ec_body.erl} | 14 +-- .../logic/{ec_core.erl => erlog_ec_core.erl} | 20 ++-- .../{ec_support.erl => erlog_ec_support.erl} | 16 +-- .../logic/{ec_term.erl => erlog_ec_term.erl} | 2 +- .../{ec_unify.erl => erlog_ec_unify.erl} | 26 ++--- .../debugger/erlog_simple_debugger.erl | 2 +- src/io/erlog_file.erl | 8 +- src/libs/external/cache/erlog_cache.erl | 16 +-- src/libs/external/db/erlog_db.erl | 74 ++++++------- .../{eb_logic.erl => erlog_eb_logic.erl} | 100 ++++++++--------- src/libs/standard/bips/main/erlog_bips.erl | 86 +++++++-------- .../{ec_logic.erl => erlog_ec_logic.erl} | 60 +++++----- src/libs/standard/core/main/erlog_core.erl | 104 +++++++++--------- .../{ed_logic.erl => erlog_ed_logic.erl} | 8 +- src/libs/standard/dcg/main/erlog_dcg.erl | 10 +- .../{el_logic.erl => erlog_el_logic.erl} | 30 ++--- src/libs/standard/lists/main/erlog_lists.erl | 34 +++--- .../{et_logic.erl => erlog_et_logic.erl} | 6 +- src/libs/standard/time/main/erlog_time.erl | 60 +++++----- src/storage/erlog_dict.erl | 4 +- src/storage/erlog_ets.erl | 4 +- src/storage/erlog_memory.erl | 2 +- 25 files changed, 353 insertions(+), 353 deletions(-) rename src/core/logic/{ec_body.erl => erlog_ec_body.erl} (94%) rename src/core/logic/{ec_core.erl => erlog_ec_core.erl} (91%) rename src/core/logic/{ec_support.erl => erlog_ec_support.erl} (90%) rename src/core/logic/{ec_term.erl => erlog_ec_term.erl} (98%) rename src/core/logic/{ec_unify.erl => erlog_ec_unify.erl} (77%) rename src/libs/standard/bips/logic/{eb_logic.erl => erlog_eb_logic.erl} (62%) rename src/libs/standard/core/logic/{ec_logic.erl => erlog_ec_logic.erl} (81%) rename src/libs/standard/dcg/logic/{ed_logic.erl => erlog_ed_logic.erl} (94%) rename src/libs/standard/lists/logic/{el_logic.erl => erlog_el_logic.erl} (73%) rename src/libs/standard/time/logic/{et_logic.erl => erlog_et_logic.erl} (93%) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index b1ad3d0..b84ca63 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -207,7 +207,7 @@ prove_goal(Goal0, State = #state{db = Db, f_consulter = Fcon, e_man = Event, deb Goal1 = erlog_logic:unlistify(Goal0), %% Must use 'catch' here as 'try' does not do last-call %% optimisation. - case erlog_logic:prove_result(catch ec_core:prove_goal(Goal1, Db, Fcon, Event, Deb), Vs) of + case erlog_logic:prove_result(catch erlog_ec_core:prove_goal(Goal1, Db, Fcon, Event, Deb), Vs) of {succeed, Res, Args} -> {{succeed, Res}, State#state{state = Args}}; OtherRes -> {OtherRes, State} end. diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 4036133..d1c1d3a 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -67,36 +67,36 @@ fail(#param{choice = [], database = Db}) -> {fail, Db}. %% @private fail_disjunction(#cp{next = Next, bs = Bs, vn = Vn}, Param) -> - ec_core:prove_body(Param#param{goal = Next, bindings = Bs, var_num = Vn}). + erlog_ec_core:prove_body(Param#param{goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Param) -> - ec_logic:prove_ecall(Efun, Val, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + erlog_ec_logic:prove_ecall(Efun, Val, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_clause(#cp{data = {Ch, Cb, Db, Cursor}, next = Next, bs = Bs, vn = Vn}, Param) -> {UCursor, Res} = erlog_memory:next(Db, Cursor), - ec_unify:unify_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}). + erlog_ec_unify:unify_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}). %% @private fail_retract(#cp{data = {Ch, Cb, {Db, Cursor}}, next = Next, bs = Bs, vn = Vn}, Param) -> {UCursor, Res} = erlog_memory:next(Db, Cursor), - ec_logic:retract_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}). + erlog_ec_logic:retract_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}). %% @private fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Param) -> - ec_logic:prove_predicates(Pi, Fs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). + erlog_ec_logic:prove_predicates(Pi, Fs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private fail_goal_clauses(#cp{data = {G, Db, Cursor}, next = Next, bs = Bs, vn = Vn}, Param) -> {UCursor, Res} = erlog_memory:next(Db, Cursor), - ec_core:prove_goal_clauses(Res, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}). + erlog_ec_core:prove_goal_clauses(Res, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}). fail_findall(#cp{next = Next, data = {Tag, Bag}, bs = Bs, vn = Vn0}, Param = #param{database = Db}) -> Data = erlog_memory:raw_fetch(Db, Tag), erlog_memory:raw_erase(Db, Tag), %Clear special entry {Bs1, Vn1} = lists:mapfoldl(fun(B0, V0) -> %Create proper instances - {B1, _, V1} = ec_term:term_instance(ec_support:dderef(B0, Bs), V0), + {B1, _, V1} = erlog_ec_term:term_instance(erlog_ec_support:dderef(B0, Bs), V0), {B1, V1} end, Vn0, Data), - ec_body:unify_prove_body(Bag, Bs1, Param#param{next_goal = Next, var_num = Vn1}). \ No newline at end of file + erlog_ec_body:unify_prove_body(Bag, Bs1, Param#param{next_goal = Next, var_num = Vn1}). \ No newline at end of file diff --git a/src/core/erlog_logic.erl b/src/core/erlog_logic.erl index 3a8c2aa..5ea6611 100644 --- a/src/core/erlog_logic.erl +++ b/src/core/erlog_logic.erl @@ -28,7 +28,7 @@ unlistify([]) -> true; unlistify(G) -> G. %In case it wasn't a list. prove_result({succeed, Cps, Bs, _Vn, _Db1}, Vs) -> - {succeed, ec_support:dderef(Vs, Bs), [Vs, Cps]}; + {succeed, erlog_ec_support:dderef(Vs, Bs), [Vs, Cps]}; prove_result({fail, _Db1}, _Vs) -> fail; prove_result({erlog_error, Error, _Db1}, _Vs) -> diff --git a/src/core/logic/ec_body.erl b/src/core/logic/erlog_ec_body.erl similarity index 94% rename from src/core/logic/ec_body.erl rename to src/core/logic/erlog_ec_body.erl index 21403b2..e4f2070 100644 --- a/src/core/logic/ec_body.erl +++ b/src/core/logic/erlog_ec_body.erl @@ -6,7 +6,7 @@ %%% @end %%% Created : 15. Июль 2014 16:06 %%%------------------------------------------------------------------- --module(ec_body). +-module(erlog_ec_body). -author("tihon"). -include("erlog_core.hrl"). @@ -18,8 +18,8 @@ %% void. %% Unify Term1 = Term2, on success prove body Next else fail. unify_prove_body(T1, T2, Params = #param{next_goal = Next, bindings = Bs0}) -> - case ec_unify:unify(T1, T2, Bs0) of - {succeed, Bs1} -> ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); + case erlog_ec_unify:unify(T1, T2, Bs0) of + {succeed, Bs1} -> erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); fail -> erlog_errors:fail(Params) end. @@ -27,7 +27,7 @@ unify_prove_body(T1, T2, Params = #param{next_goal = Next, bindings = Bs0}) -> %% void. %% Unify A1 = B1, A2 = B2, on success prove body Next else fail. unify_prove_body(A1, B1, A2, B2, Params = #param{bindings = Bs0}) -> - case ec_unify:unify(A1, B1, Bs0) of + case erlog_ec_unify:unify(A1, B1, Bs0) of {succeed, Bs1} -> unify_prove_body(A2, B2, Params#param{bindings = Bs1}); fail -> erlog_errors:fail(Params) end. @@ -67,7 +67,7 @@ body_instance([{{once} = Once, G0, _} | Gs0], Tail, Rs0, Vn0, Label) -> {[{Once, Label} | G1], Rs2, Vn2}; body_instance([G0 | Gs0], Tail, Rs0, Vn0, Label) -> {Gs1, Rs1, Vn1} = body_instance(Gs0, Tail, Rs0, Vn0, Label), - {G1, Rs2, Vn2} = ec_term:term_instance(G0, Rs1, Vn1), + {G1, Rs2, Vn2} = erlog_ec_term:term_instance(G0, Rs1, Vn1), {[G1 | Gs1], Rs2, Vn2}; body_instance([], Tail, Rs, Vn, _Label) -> {Tail, Rs, Vn}. @@ -106,7 +106,7 @@ well_form_body(fail, _Tail, _Cut, _Label) -> {[fail], false}; %No further well_form_body('!', Tail, Cut, Label) -> {[{{cut}, Label, not Cut} | Tail], true}; well_form_body(Goal, Tail, Cut, _Label) -> - ec_support:functor(Goal), %Check goal + erlog_ec_support:functor(Goal), %Check goal {[Goal | Tail], Cut}. %% body_term(Body, Repls, VarNum) -> {Term,NewRepls,NewVarNum}. @@ -141,7 +141,7 @@ body_term([{{once}, G0, _} | Gs0], Rs0, Vn0) -> {body_conj({once, G1}, Gs1), Rs2, Vn2}; body_term([G0 | Gs0], Rs0, Vn0) -> {Gs1, Rs1, Vn1} = body_term(Gs0, Rs0, Vn0), - {G1, Rs2, Vn2} = ec_term:term_instance(G0, Rs1, Vn1), + {G1, Rs2, Vn2} = erlog_ec_term:term_instance(G0, Rs1, Vn1), {body_conj(G1, Gs1), Rs2, Vn2}; body_term([], Rs, Vn) -> {true, Rs, Vn}. diff --git a/src/core/logic/ec_core.erl b/src/core/logic/erlog_ec_core.erl similarity index 91% rename from src/core/logic/ec_core.erl rename to src/core/logic/erlog_ec_core.erl index 548cac6..fd71c95 100644 --- a/src/core/logic/ec_core.erl +++ b/src/core/logic/erlog_ec_core.erl @@ -6,7 +6,7 @@ %%% @end %%% Created : 12. Авг. 2014 16:47 %%%------------------------------------------------------------------- --module(ec_core). +-module(erlog_ec_core). -author("tihon"). -include("erlog_core.hrl"). @@ -23,10 +23,10 @@ prove_goal(Goal0, Db, Fcon, Event, Deb) -> %% put(erlog_cps, orddict:new()), %% put(erlog_var, orddict:new()), %% Check term and build new instance of term with bindings. - {Goal1, Bs, Vn} = ec_logic:initial_goal(Goal0), + {Goal1, Bs, Vn} = erlog_ec_logic:initial_goal(Goal0), Params = #param{goal = [{call, Goal1}], choice = [], bindings = Bs, var_num = Vn, event_man = Event, database = Db, f_consulter = Fcon, debugger = Deb}, - ec_core:prove_body(Params). %TODO use lists:foldr instead! + erlog_ec_core:prove_body(Params). %TODO use lists:foldr instead! %% prove_body(Body, ChoicePoints, Bindings, VarNum, Database) -> %% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase}. @@ -35,7 +35,7 @@ prove_goal(Goal0, Db, Fcon, Event, Deb) -> %% goal/body succeeds. prove_body(Params = #param{goal = [G | Gs], debugger = Deb, bindings = Bs}) -> %TODO use lists:foldr instead! %%io:fwrite("PB: ~p\n", [{G,Gs,Cps}]), - Deb(ok, ec_support:dderef(G, Bs), Bs), + Deb(ok, erlog_ec_support:dderef(G, Bs), Bs), prove_goal(Params#param{goal = G, next_goal = Gs}); prove_body(#param{goal = [], choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> %%io:fwrite("Cps: ~p\nCut: ~p\nVar: ~p\nVar: ~p\n", @@ -51,7 +51,7 @@ prove_goal(Param = #param{goal = {{once}, Label}, next_goal = Next, choice = Cps Cut = #cut{label = Label}, prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); prove_goal(Param = #param{goal = {'??', Next}, bindings = Bs, debugger = Deb}) -> %debug stop point - Deb(stop, ec_support:dderef(Next, Bs), Bs), + Deb(stop, erlog_ec_support:dderef(Next, Bs), Bs), prove_goal(Param#param{goal = Next}); prove_goal(Param = #param{goal = {{if_then_else}, Else, Label}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> %% Need to push a choicepoint to fail back to inside Cond and a cut @@ -70,14 +70,14 @@ prove_goal(Param = #param{goal = {{if_then}, Label}, next_goal = Next, choice = prove_body(Param#param{goal = Next, choice = [Cut | Cps]}); prove_goal(Param = #param{goal = {{cut}, Label, Last}}) -> %% Cut succeeds and trims back to cut ancestor. - ec_support:cut(Label, Last, Param); + erlog_ec_support:cut(Label, Last, Param); prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> %% There is no L here, it has already been prepended to Next. Cp = #cp{type = disjunction, next = R, bs = Bs, vn = Vn}, prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); prove_goal(Param = #param{goal = G, database = Db}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), - case catch erlog_memory:get_procedure(Db, ec_support:functor(G)) of + case catch erlog_memory:get_procedure(Db, erlog_ec_support:functor(G)) of {cursor, Cursor, result, Result} -> Fun = fun(Params) -> check_result(Result, Params) end, run_n_close(Fun, Param#param{cursor = Cursor}); @@ -117,10 +117,10 @@ prove_goal_clause([], Param) -> erlog_errors:fail(Param); prove_goal_clause([L], Param) -> prove_goal_clause(L, Param); prove_goal_clause({_Tag, H0, {B0, _}}, Param = #param{goal = G, next_goal = Next, bindings = Bs0, var_num = Vn0}) -> Label = Vn0, - case ec_unify:unify_head(G, H0, Bs0, Vn0 + 1) of + case erlog_ec_unify:unify_head(G, H0, Bs0, Vn0 + 1) of {succeed, Rs0, Bs1, Vn1} -> - {B1, _Rs2, Vn2} = ec_body:body_instance(B0, Next, Rs0, Vn1, Label), - ec_core:prove_body(Param#param{goal = B1, bindings = Bs1, var_num = Vn2}); + {B1, _Rs2, Vn2} = erlog_ec_body:body_instance(B0, Next, Rs0, Vn1, Label), + erlog_ec_core:prove_body(Param#param{goal = B1, bindings = Bs1, var_num = Vn2}); fail -> erlog_errors:fail(Param) end. diff --git a/src/core/logic/ec_support.erl b/src/core/logic/erlog_ec_support.erl similarity index 90% rename from src/core/logic/ec_support.erl rename to src/core/logic/erlog_ec_support.erl index ed90143..96959a8 100644 --- a/src/core/logic/ec_support.erl +++ b/src/core/logic/erlog_ec_support.erl @@ -6,7 +6,7 @@ %%% @end %%% Created : 15. Июль 2014 16:09 %%%------------------------------------------------------------------- --module(ec_support). +-module(erlog_ec_support). -author("tihon"). -include("erlog_core.hrl"). @@ -133,19 +133,19 @@ remove_nth(List, N) -> write(Res, Bs) when is_list(Res) -> case io_lib:printable_list(Res) of true -> Res; - false -> ec_support:dderef(Res, Bs) + false -> erlog_ec_support:dderef(Res, Bs) end; write(Res, Bs) -> write([Res], Bs). cut(Label, Last, Param = #param{next_goal = Next, choice = [#cut{label = Label} | Cps] = Cps0}) -> - if Last -> ec_core:prove_body(Param#param{goal = Next, choice = Cps}); - true -> ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) + if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); + true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) end; cut(Label, Last, Param = #param{next_goal = Next, choice = [#cp{type = if_then_else, label = Label} | Cps] = Cps0}) -> - if Last -> ec_core:prove_body(Param#param{goal = Next, choice = Cps}); - true -> ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) + if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); + true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) end; cut(Label, Last, Param = #param{choice = [#cp{type = goal_clauses, label = Label} = Cp | Cps]}) -> cut_goal_clauses(Last, Cp, Param#param{choice = Cps}); @@ -155,8 +155,8 @@ cut(Label, Last, Param = #param{choice = [_Cp | Cps]}) -> %% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db). cut_goal_clauses(true, #cp{label = _}, Param = #param{next_goal = Next}) -> %% Just remove the choice point completely and continue. - ec_core:prove_body(Param#param{goal = Next}); + erlog_ec_core:prove_body(Param#param{goal = Next}); cut_goal_clauses(false, #cp{label = L}, Param = #param{next_goal = Next, choice = Cps}) -> %% Replace choice point with cut point then continue. Cut = #cut{label = L}, - ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). \ No newline at end of file + erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). \ No newline at end of file diff --git a/src/core/logic/ec_term.erl b/src/core/logic/erlog_ec_term.erl similarity index 98% rename from src/core/logic/ec_term.erl rename to src/core/logic/erlog_ec_term.erl index e57516d..49d44a1 100644 --- a/src/core/logic/ec_term.erl +++ b/src/core/logic/erlog_ec_term.erl @@ -6,7 +6,7 @@ %%% @end %%% Created : 15. Июль 2014 16:29 %%%------------------------------------------------------------------- --module(ec_term). +-module(erlog_ec_term). -author("tihon"). %% API diff --git a/src/core/logic/ec_unify.erl b/src/core/logic/erlog_ec_unify.erl similarity index 77% rename from src/core/logic/ec_unify.erl rename to src/core/logic/erlog_ec_unify.erl index 24dae1f..e35a41f 100644 --- a/src/core/logic/ec_unify.erl +++ b/src/core/logic/erlog_ec_unify.erl @@ -6,7 +6,7 @@ %%% @end %%% Created : 15. Июль 2014 16:26 %%%------------------------------------------------------------------- --module(ec_unify). +-module(erlog_ec_unify). -author("tihon"). -include("erlog_core.hrl"). @@ -17,12 +17,12 @@ %% unify(Term, Term, Bindings) -> {succeed,NewBindings} | fail. %% Unify two terms with a set of bindings. unify(T10, T20, Bs0) -> - case {ec_support:deref(T10, Bs0), ec_support:deref(T20, Bs0)} of + case {erlog_ec_support:deref(T10, Bs0), erlog_ec_support:deref(T20, Bs0)} of {T1, T2} when ?IS_CONSTANT(T1), T1 == T2 -> {succeed, Bs0}; {{V}, {V}} -> {succeed, Bs0}; - {{_} = Var, T2} -> {succeed, ec_support:add_binding(Var, T2, Bs0)}; - {T1, {_} = Var} -> {succeed, ec_support:add_binding(Var, T1, Bs0)}; + {{_} = Var, T2} -> {succeed, erlog_ec_support:add_binding(Var, T2, Bs0)}; + {T1, {_} = Var} -> {succeed, erlog_ec_support:add_binding(Var, T1, Bs0)}; {[H1 | T1], [H2 | T2]} -> case unify(H1, H2, Bs0) of {succeed, Bs1} -> unify(T1, T2, Bs1); @@ -41,7 +41,7 @@ unify_clauses(Ch, Cb, C, Param = #param{next_goal = Next, bindings = Bs0, var_nu case unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> Cp = #cp{type = clause, data = {Ch, Cb, Db, Cursor}, next = Next, bs = Bs0, vn = Vn0}, - ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); + erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); fail -> {UCursor, Res} = erlog_memory:next(Db, Cursor), unify_clauses(Ch, Cb, Res, Param#param{cursor = UCursor}) @@ -49,10 +49,10 @@ unify_clauses(Ch, Cb, C, Param = #param{next_goal = Next, bindings = Bs0, var_nu unify_clause(Ch, Cb, [C], Bs0, Vn0) -> unify_clause(Ch, Cb, C, Bs0, Vn0); unify_clause(Ch, Cb, {_Tag, H0, {B0, _}}, Bs0, Vn0) -> - {H1, Rs1, Vn1} = ec_term:term_instance(H0, Vn0), %Unique vars on head first + {H1, Rs1, Vn1} = erlog_ec_term:term_instance(H0, Vn0), %Unique vars on head first case unify(Ch, H1, Bs0) of {succeed, Bs1} -> - {B1, _Rs2, Vn2} = ec_body:body_term(B0, Rs1, Vn1), %Now we need the rest + {B1, _Rs2, Vn2} = erlog_ec_body:body_term(B0, Rs1, Vn1), %Now we need the rest case unify(Cb, B1, Bs1) of {succeed, Bs2} -> {succeed, Bs2, Vn2}; fail -> fail @@ -66,7 +66,7 @@ unify_clause(Ch, Cb, {_Tag, H0, {B0, _}}, Bs0, Vn0) -> %% head. This saves us creating many variables which are local to the %% clause and saves many variable bindings. unify_head(Goal, Head, Bs, Vn) -> - unify_head(ec_support:deref(Goal, Bs), Head, orddict:new(), Bs, Vn). + unify_head(erlog_ec_support:deref(Goal, Bs), Head, orddict:new(), Bs, Vn). unify_head(G, H, Rs, Bs, Vn) when ?IS_CONSTANT(G), G == H -> {succeed, Rs, Bs, Vn}; @@ -84,11 +84,11 @@ unify_head(T, {V0}, Rs, Bs0, Vn) -> end; unify_head({_} = Var, H0, Rs0, Bs, Vn0) -> %% Must have an instance here. - {H1, Rs1, Vn1} = ec_term:term_instance(H0, Rs0, Vn0), - {succeed, Rs1, ec_support:add_binding(Var, H1, Bs), Vn1}; + {H1, Rs1, Vn1} = erlog_ec_term:term_instance(H0, Rs0, Vn0), + {succeed, Rs1, erlog_ec_support:add_binding(Var, H1, Bs), Vn1}; unify_head([GH | GT], [HH | HT], Rs0, Bs0, Vn0) -> - case unify_head(ec_support:deref(GH, Bs0), HH, Rs0, Bs0, Vn0) of - {succeed, Rs1, Bs1, Vn1} -> unify_head(ec_support:deref(GT, Bs1), HT, Rs1, Bs1, Vn1); + case unify_head(erlog_ec_support:deref(GH, Bs0), HH, Rs0, Bs0, Vn0) of + {succeed, Rs1, Bs1, Vn1} -> unify_head(erlog_ec_support:deref(GT, Bs1), HT, Rs1, Bs1, Vn1); fail -> fail end; unify_head([], [], Rs, Bs, Vn) -> {succeed, Rs, Bs, Vn}; @@ -100,7 +100,7 @@ unify_head(_G, _H, _Rs, _Bs, _Vn) -> fail. unify_head_args(_G, _H, Rs, Bs, Vn, I, S) when I > S -> {succeed, Rs, Bs, Vn}; unify_head_args(G, H, Rs0, Bs0, Vn0, I, S) -> - case unify_head(ec_support:deref(element(I, G), Bs0), element(I, H), Rs0, Bs0, Vn0) of + case unify_head(erlog_ec_support:deref(element(I, G), Bs0), element(I, H), Rs0, Bs0, Vn0) of {succeed, Rs1, Bs1, Vn1} -> unify_head_args(G, H, Rs1, Bs1, Vn1, I + 1, S); fail -> fail end. diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl index 48dd549..0c20203 100644 --- a/src/interface/debugger/erlog_simple_debugger.erl +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -200,7 +200,7 @@ process_match(Functor, Execute, {detailed, Functor}) -> process_match(_, _, {detailed, _}) -> false; process_match(Functor, Execute, {arity, Pred}) -> - case ec_support:functor(Functor) of + case erlog_ec_support:functor(Functor) of Pred -> Execute(); _ -> false end. diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index 1b977ed..bb67387 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -48,14 +48,14 @@ reconsult(Fun, File, Db) -> %% @private -spec consult_assert(Term0 :: term(), Db :: pid()) -> {ok, Db :: pid()}. consult_assert(Term0, Db) -> - Term1 = ed_logic:expand_term(Term0), + Term1 = erlog_ed_logic:expand_term(Term0), check_assert(Db, Term1), {ok, Db}. %TODO refactor consult_terms not to pass DB everywhere! %% @private -spec reconsult_assert(Term0 :: term(), {Db :: pid(), Seen :: list()}) -> {ok, {Db :: pid(), list()}}. reconsult_assert(Term0, {Db, Seen}) -> - Term1 = ed_logic:expand_term(Term0), + Term1 = erlog_ed_logic:expand_term(Term0), Func = functor(Term1), case lists:member(Func, Seen) of true -> @@ -86,8 +86,8 @@ consult_terms(Ifun, Params, [Term | Ts]) -> consult_terms(_, _, []) -> ok. %% @private -functor({':-', H, _B}) -> ec_support:functor(H); -functor(T) -> ec_support:functor(T). +functor({':-', H, _B}) -> erlog_ec_support:functor(H); +functor(T) -> erlog_ec_support:functor(T). %% @private check_assert(Db, Term) -> diff --git a/src/libs/external/cache/erlog_cache.erl b/src/libs/external/cache/erlog_cache.erl index 3b05772..dd8276e 100644 --- a/src/libs/external/cache/erlog_cache.erl +++ b/src/libs/external/cache/erlog_cache.erl @@ -30,19 +30,19 @@ load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_CACHE). put_2(Params = #param{goal = {put, _, _} = Goal, next_goal = Next, bindings = Bs}) -> - {put, Key, Value} = ec_support:dderef(Goal, Bs), - case ec_support:is_bound(Value) of %Value must exists + {put, Key, Value} = erlog_ec_support:dderef(Goal, Bs), + case erlog_ec_support:is_bound(Value) of %Value must exists true -> case get(erlog_cache) of undefined -> erlog_errors:fail(Params); Ets -> ets:insert(Ets, {Key, Value}), - ec_core:prove_body(Params#param{goal = Next}) + erlog_ec_core:prove_body(Params#param{goal = Next}) end; false -> erlog_errors:fail(Params) end. get_2(Params = #param{goal = {get, _, _} = Goal, bindings = Bs}) -> - {get, Key, Result} = ec_support:dderef(Goal, Bs), + {get, Key, Result} = erlog_ec_support:dderef(Goal, Bs), case get(erlog_cache) of undefined -> erlog_errors:fail(Params); Ets -> check_value(ets:lookup(Ets, Key), Result, Params) @@ -52,13 +52,13 @@ get_2(Params = #param{goal = {get, _, _} = Goal, bindings = Bs}) -> %% @private check_value([], _, Params) -> erlog_errors:fail(Params); check_value([{_, Value}], Result, Params = #param{next_goal = Next, bindings = Bs0}) -> - case ec_support:is_bound(Result) of + case erlog_ec_support:is_bound(Result) of true -> %compare value from cache with result - if Result == Value -> ec_core:prove_body(Params#param{goal = Next}); + if Result == Value -> erlog_ec_core:prove_body(Params#param{goal = Next}); true -> erlog_errors:fail(Params) end; false -> %save value from cache to result - Bs = ec_support:add_binding(Result, Value, Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) + Bs = erlog_ec_support:add_binding(Result, Value, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) end. diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 9f2f1d4..dd4e0b7 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -31,58 +31,58 @@ load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_DB). db_call_2(Param = #param{goal = {db_call, _, _} = Goal, next_goal = Next0, bindings = Bs, database = Db}) -> - {db_call, Table, G} = ec_support:dderef(Goal, Bs), - case erlog_memory:db_findall(Db, Table, ec_support:functor(G)) of + {db_call, Table, G} = erlog_ec_support:dderef(Goal, Bs), + case erlog_memory:db_findall(Db, Table, erlog_ec_support:functor(G)) of {cursor, Cursor, result, Result} -> Fun = fun(Params) -> check_call_result(Result, Params, G, Next0) end, - ec_core:run_n_close(Fun, Param#param{cursor = Cursor}); + erlog_ec_core:run_n_close(Fun, Param#param{cursor = Cursor}); Result -> check_call_result(Result, Param, G, Next0) end. db_assert_2(Params = #param{goal = {db_assert, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> - {db_assert, Table, Fact} = ec_support:dderef(Goal, Bs), + {db_assert, Table, Fact} = erlog_ec_support:dderef(Goal, Bs), erlog_memory:db_assertz_clause(Db, Table, Fact), - ec_core:prove_body(Params#param{goal = Next}). + erlog_ec_core:prove_body(Params#param{goal = Next}). db_asserta_2(Params = #param{goal = {db_asserta, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> - {db_asserta, Table, Fact} = ec_support:dderef(Goal, Bs), + {db_asserta, Table, Fact} = erlog_ec_support:dderef(Goal, Bs), erlog_memory:db_asserta_clause(Db, Table, Fact), - ec_core:prove_body(Params#param{goal = Next}). + erlog_ec_core:prove_body(Params#param{goal = Next}). db_abolish_2(Params = #param{goal = {db_abolish, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> - {db_abolish, Table, Fact} = ec_support:dderef(Goal, Bs), + {db_abolish, Table, Fact} = erlog_ec_support:dderef(Goal, Bs), case Fact of {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> erlog_memory:db_abolish_clauses(Db, Table, {N, A}), - ec_core:prove_body(Params#param{goal = Next}); + erlog_ec_core:prove_body(Params#param{goal = Next}); Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) end. db_retract_2(Params = #param{goal = {db_retract, _, _} = Goal, bindings = Bs}) -> - {db_retract, Table, Fact} = ec_support:dderef(Goal, Bs), + {db_retract, Table, Fact} = erlog_ec_support:dderef(Goal, Bs), prove_retract(Fact, Table, Params). db_retractall_2(Params = #param{goal = {db_retractall, _, _} = Goal, bindings = Bs}) -> - {db_retractall, Table, Fact} = ec_support:dderef(Goal, Bs), + {db_retractall, Table, Fact} = erlog_ec_support:dderef(Goal, Bs), prove_retractall(Fact, Table, Params). db_listing_2(Params = #param{goal = {db_listing, _, _} = Goal, next_goal = Next, bindings = Bs0, database = Db}) -> - {db_listing, Table, Res} = ec_support:dderef(Goal, Bs0), + {db_listing, Table, Res} = erlog_ec_support:dderef(Goal, Bs0), Content = erlog_memory:db_listing(Db, Table, []), - Bs = ec_support:add_binding(Res, Content, Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). + Bs = erlog_ec_support:add_binding(Res, Content, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). db_listing_3(Params = #param{goal = {db_listing, _, _, _} = Goal, next_goal = Next, bindings = Bs0, database = Db}) -> - {db_listing, Table, Functor, Res} = ec_support:dderef(Goal, Bs0), + {db_listing, Table, Functor, Res} = erlog_ec_support:dderef(Goal, Bs0), Content = erlog_memory:db_listing(Db, Table, [Functor]), - Bs = ec_support:add_binding(Res, Content, Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). + Bs = erlog_ec_support:add_binding(Res, Content, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). db_listing_4(Params = #param{goal = {db_listing, _, _, _, _} = Goal, next_goal = Next, bindings = Bs0, database = Db}) -> - {db_listing, Table, Functor, Arity, Res} = ec_support:dderef(Goal, Bs0), + {db_listing, Table, Functor, Arity, Res} = erlog_ec_support:dderef(Goal, Bs0), Content = erlog_memory:db_listing(Db, Table, [Functor, Arity]), - Bs = ec_support:add_binding(Res, Content, Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). + Bs = erlog_ec_support:add_binding(Res, Content, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). prove_retract({':-', H, B}, Table, Params) -> prove_retract(H, B, Table, Params); @@ -96,27 +96,27 @@ prove_retractall(H, Table, Params) -> %% @private prove_call(G, Cs, Next0, Param = #param{bindings = Bs, choice = Cps, database = Db, var_num = Vn}) -> - case ec_logic:check_goal(G, Next0, Bs, Db, false, Vn) of + case erlog_ec_logic:check_goal(G, Next0, Bs, Db, false, Vn) of {[Next1 | _], true} -> %% Must increment Vn to avoid clashes!!! Cut = #cut{label = Vn}, - ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); - {[Next1 | _], false} -> ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, var_num = Vn + 1}) + erlog_ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); + {[Next1 | _], false} -> erlog_ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, var_num = Vn + 1}) end. %% @private prove_retract(H, B, Table, Params = #param{database = Db}) -> - Functor = ec_support:functor(H), + Functor = erlog_ec_support:functor(H), case erlog_memory:get_db_procedure(Db, Table, Functor) of {cursor, Cursor, result, {clauses, Cs}} -> - ec_core:run_n_close(fun(Param) -> retract_clauses(H, B, Cs, Param, Table) end, Params#param{cursor = Cursor}); + erlog_ec_core:run_n_close(fun(Param) -> retract_clauses(H, B, Cs, Param, Table) end, Params#param{cursor = Cursor}); undefined -> erlog_errors:fail(Params); - _ -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)) + _ -> erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)) end. %% @private prove_retractall(H, B, Table, Params = #param{database = Db}) -> - Functor = ec_support:functor(H), + Functor = erlog_ec_support:functor(H), case erlog_memory:get_db_procedure(Db, Table, Functor) of {cursor, Cursor, result, Res} -> check_retractall_result(Res, H, B, Functor, Table, Params#param{cursor = Cursor}); @@ -126,9 +126,9 @@ prove_retractall(H, B, Table, Params = #param{database = Db}) -> %% @private retract(Ch, Cb, C, Cursor, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1, Table) -> - erlog_memory:db_retract_clause(Db, Table, ec_support:functor(Ch), element(1, C)), + erlog_memory:db_retract_clause(Db, Table, erlog_ec_support:functor(Ch), element(1, C)), Cp = #cp{type = db_retract, data = {Ch, Cb, {Db, Cursor}, Table}, next = Next, bs = Bs0, vn = Vn0}, - ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). + erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). %% @private %% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> @@ -137,7 +137,7 @@ retract(Ch, Cb, C, Cursor, Param = #param{next_goal = Next, choice = Cps, bindin retract_clauses(_, _, [], Param, _) -> erlog_errors:fail(Param); retract_clauses(Ch, Cb, [C], Param, Table) -> retract_clauses(Ch, Cb, C, Param, Table); retract_clauses(Ch, Cb, C, Param = #param{bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}, Table) -> - case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of + case erlog_ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> %% We have found a right clause so now retract it. retract(Ch, Cb, C, Cursor, Param, Bs1, Vn1, Table); @@ -156,12 +156,12 @@ check_call_result({clauses, Cs}, Param, G, Next) -> prove_call(G, Cs, Next, Para check_call_result({erlog_error, E}, #param{database = Db}, _, _) -> erlog_errors:erlog_error(E, Db); check_call_result(Cs, Param, G, Next) -> prove_call(G, Cs, Next, Param). -retractall_clauses(_, [], _, _, Params = #param{next_goal = Next}) -> ec_core:prove_body(Params#param{goal = Next}); +retractall_clauses(_, [], _, _, Params = #param{next_goal = Next}) -> erlog_ec_core:prove_body(Params#param{goal = Next}); retractall_clauses(Table, [Clause], H, B, Params) -> retractall_clauses(Table, Clause, H, B, Params); retractall_clauses(Table, Clause, H, B, Params = #param{bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}) -> - case ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of + case erlog_ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of {succeed, _, _} -> - erlog_memory:db_retract_clause(Db, Table, ec_support:functor(H), element(1, Clause)), + erlog_memory:db_retract_clause(Db, Table, erlog_ec_support:functor(H), element(1, Clause)), {UCursor, Res} = erlog_memory:next(Db, Cursor), retractall_clauses(Table, Res, H, B, Params#param{cursor = UCursor}); fail -> @@ -170,12 +170,12 @@ retractall_clauses(Table, Clause, H, B, Params = #param{bindings = Bs0, var_num %% @private check_retractall_result({built_in, _}, _, _, Functor, _, _) -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); + erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)); check_retractall_result({code, _}, _, _, Functor, _, _) -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); + erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)); check_retractall_result({clauses, Cs}, H, B, _, Table, Params = #param{cursor = Cursor}) -> Fun = fun(Param) -> retractall_clauses(Table, Cs, H, B, Param) end, - ec_core:run_n_close(Fun, Params#param{cursor = Cursor}); + erlog_ec_core:run_n_close(Fun, Params#param{cursor = Cursor}); check_retractall_result(undefined, _, _, _, _, Params = #param{next_goal = Next}) -> - ec_core:prove_body(Params#param{goal = Next}); + erlog_ec_core:prove_body(Params#param{goal = Next}); check_retractall_result({erlog_error, E}, _, _, _, _, #param{database = Db}) -> erlog_errors:erlog_error(E, Db). \ No newline at end of file diff --git a/src/libs/standard/bips/logic/eb_logic.erl b/src/libs/standard/bips/logic/erlog_eb_logic.erl similarity index 62% rename from src/libs/standard/bips/logic/eb_logic.erl rename to src/libs/standard/bips/logic/erlog_eb_logic.erl index 3345758..e97115f 100644 --- a/src/libs/standard/bips/logic/eb_logic.erl +++ b/src/libs/standard/bips/logic/erlog_eb_logic.erl @@ -6,7 +6,7 @@ %%% @end %%% Created : 12. Авг. 2014 17:24 %%%------------------------------------------------------------------- --module(eb_logic). +-module(erlog_eb_logic). -author("tihon"). -include("erlog_core.hrl"). @@ -22,8 +22,8 @@ %% term_test_prove_body(Test, Left, Right, Next, ChoicePoints, Bindings, Varnum, Database) -> %% void. term_test_prove_body(Test, L, R, Params = #param{next_goal = Next, bindings = Bs}) -> - case erlang:Test(ec_support:dderef(L, Bs), ec_support:dderef(R, Bs)) of - true -> ec_core:prove_body(Params#param{goal = Next}); + case erlang:Test(erlog_ec_support:dderef(L, Bs), erlog_ec_support:dderef(R, Bs)) of + true -> erlog_ec_core:prove_body(Params#param{goal = Next}); false -> erlog_errors:fail(Params) end. @@ -31,14 +31,14 @@ term_test_prove_body(Test, L, R, Params = #param{next_goal = Next, bindings = Bs %% Prove the goal arg(I, Ct, Arg), Index and Term have been dereferenced. prove_arg(I, [H | T], A, Param = #param{database = Db}) when is_integer(I) -> if - I == 1 -> ec_body:unify_prove_body(H, A, Param); - I == 2 -> ec_body:unify_prove_body(T, A, Param); + I == 1 -> erlog_ec_body:unify_prove_body(H, A, Param); + I == 2 -> erlog_ec_body:unify_prove_body(T, A, Param); true -> {fail, Db} end; prove_arg(I, Ct, A, Param = #param{database = Db}) when is_integer(I), tuple_size(Ct) >= 2 -> if I > 1, I + 1 =< tuple_size(Ct) -> - ec_body:unify_prove_body(element(I + 1, Ct), A, Param); + erlog_ec_body:unify_prove_body(element(I + 1, Ct), A, Param); true -> {fail, Db} end; prove_arg(I, Ct, _, #param{database = Db}) -> @@ -50,24 +50,24 @@ prove_arg(I, Ct, _, #param{database = Db}) -> %% prove_functor(Term, Functor, Arity, Next, ChoicePoints, Bindings, VarNum, Database) -> void. %% Prove the call functor(T, F, A), Term has been dereferenced. prove_functor(T, F, A, Params) when tuple_size(T) >= 2 -> - ec_body:unify_prove_body(F, element(1, T), A, tuple_size(T) - 1, Params); + erlog_ec_body:unify_prove_body(F, element(1, T), A, tuple_size(T) - 1, Params); prove_functor(T, F, A, Params) when ?IS_ATOMIC(T) -> - ec_body:unify_prove_body(F, T, A, 0, Params); + erlog_ec_body:unify_prove_body(F, T, A, 0, Params); prove_functor([_ | _], F, A, Params) -> %% Just the top level here. - ec_body:unify_prove_body(F, '.', A, 2, Params); + erlog_ec_body:unify_prove_body(F, '.', A, 2, Params); prove_functor({_} = Var, F0, A0, Params = #param{next_goal = Next, bindings = Bs0, var_num = Vn0, database = Db}) -> - case {ec_support:dderef(F0, Bs0), ec_support:dderef(A0, Bs0)} of + case {erlog_ec_support:dderef(F0, Bs0), erlog_ec_support:dderef(A0, Bs0)} of {'.', 2} -> %He, he, he! - Bs1 = ec_support:add_binding(Var, [{Vn0} | {Vn0 + 1}], Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs1, var_num = Vn0 + 2}); + Bs1 = erlog_ec_support:add_binding(Var, [{Vn0} | {Vn0 + 1}], Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1, var_num = Vn0 + 2}); {F1, 0} when ?IS_ATOMIC(F1) -> - Bs1 = ec_support:add_binding(Var, F1, Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); + Bs1 = erlog_ec_support:add_binding(Var, F1, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); {F1, A1} when is_atom(F1), is_integer(A1), A1 > 0 -> - As = ec_support:make_vars(A1, Vn0), - Bs1 = ec_support:add_binding(Var, list_to_tuple([F1 | As]), Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs1, var_num = Vn0 + A1}); %!!! + As = erlog_ec_support:make_vars(A1, Vn0), + Bs1 = erlog_ec_support:add_binding(Var, list_to_tuple([F1 | As]), Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1, var_num = Vn0 + A1}); %!!! %% Now the error cases. {{_}, _} -> erlog_errors:instantiation_error(Db); {F1, A1} when is_atom(F1) -> erlog_errors:type_error(integer, A1, Db); @@ -78,39 +78,39 @@ prove_functor({_} = Var, F0, A0, Params = #param{next_goal = Next, bindings = Bs %% Prove the goal Term =.. List, Term has already been dereferenced. prove_univ(T, L, Params) when tuple_size(T) >= 2 -> Es = tuple_to_list(T), - ec_body:unify_prove_body(Es, L, Params); + erlog_ec_body:unify_prove_body(Es, L, Params); prove_univ(T, L, Params) when ?IS_ATOMIC(T) -> - ec_body:unify_prove_body([T], L, Params); + erlog_ec_body:unify_prove_body([T], L, Params); prove_univ([Lh | Lt], L, Params) -> - ec_body:unify_prove_body(['.', Lh, Lt], L, Params); + erlog_ec_body:unify_prove_body(['.', Lh, Lt], L, Params); prove_univ({_} = Var, L, Params = #param{next_goal = Next, bindings = Bs0, database = Db}) -> - Bs1 = case ec_support:dderef(L, Bs0) of + Bs1 = case erlog_ec_support:dderef(L, Bs0) of ['.', Lh, Lt] -> %He, he, he! - ec_support:add_binding(Var, [Lh | Lt], Bs0); + erlog_ec_support:add_binding(Var, [Lh | Lt], Bs0); [A] when ?IS_ATOMIC(A) -> - ec_support:add_binding(Var, A, Bs0); + erlog_ec_support:add_binding(Var, A, Bs0); [F | As] when is_atom(F), length(As) > 0 -> - ec_support:add_binding(Var, list_to_tuple([F | As]), Bs0); + erlog_ec_support:add_binding(Var, list_to_tuple([F | As]), Bs0); %% Now the error cases. They end with throw -> no return there [{_} | _] -> erlog_errors:instantiation_error(Db); {_} -> erlog_errors:instantiation_error(Db); Other -> erlog_errors:type_error(list, Other, Db) end, - ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}). + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}). %% prove_atom_chars(Atom, List, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. %% Prove the atom_chars(Atom, List). prove_atom_chars(A, L, Params = #param{bindings = Bs, database = Db}) -> %% After a suggestion by Sean Cribbs. - case ec_support:dderef(A, Bs) of + case erlog_ec_support:dderef(A, Bs) of Atom when is_atom(Atom) -> AtomList = [list_to_atom([C]) || C <- atom_to_list(Atom)], - ec_body:unify_prove_body(L, AtomList, Params); + erlog_ec_body:unify_prove_body(L, AtomList, Params); {_} = Var -> %% Error #3: List is neither a list nor a partial list. %% Handled in dderef_list/2. - List = ec_support:dderef_list(L, Bs), + List = erlog_ec_support:dderef_list(L, Bs), %% Error #1, #4: List is a list or partial list with an %% element which is a variable or not one char atom. Fun = fun({_}) -> erlog_errors:instantiation_error(Db); @@ -122,7 +122,7 @@ prove_atom_chars(A, L, Params = #param{bindings = Bs, database = Db}) -> end, Chars = lists:map(Fun, List), Atom = list_to_atom(Chars), - ec_body:unify_prove_body(Var, Atom, Params); + erlog_ec_body:unify_prove_body(Var, Atom, Params); Other -> %% Error #2: Atom is neither a variable nor an atom erlog_errors:type_error(atom, Other, Db) @@ -131,9 +131,9 @@ prove_atom_chars(A, L, Params = #param{bindings = Bs, database = Db}) -> %% arith_test_prove_body(Test, Left, Right, Next, ChoicePoints, Bindings, VarNum, Database) -> %% void. arith_test_prove_body(Test, L, R, Params = #param{next_goal = Next, bindings = Bs, database = Db}) -> - case erlang:Test(eval_arith(ec_support:deref(L, Bs), Bs, Db), - eval_arith(ec_support:deref(R, Bs), Bs, Db)) of - true -> ec_core:prove_body(Params#param{goal = Next}); + case erlang:Test(eval_arith(erlog_ec_support:deref(L, Bs), Bs, Db), + eval_arith(erlog_ec_support:deref(R, Bs), Bs, Db)) of + true -> erlog_ec_core:prove_body(Params#param{goal = Next}); false -> erlog_errors:fail(Params) end. @@ -142,40 +142,40 @@ arith_test_prove_body(Test, L, R, Params = #param{next_goal = Next, bindings = B %% errors. Dereference each level as we go, might fail so save some %% work. Must be called deferenced. eval_arith({'+', A, B}, Bs, Db) -> - eval_arith(ec_support:deref(A, Bs), Bs, Db) + eval_arith(ec_support:deref(B, Bs), Bs, Db); + eval_arith(erlog_ec_support:deref(A, Bs), Bs, Db) + eval_arith(erlog_ec_support:deref(B, Bs), Bs, Db); eval_arith({'-', A, B}, Bs, Db) -> - eval_arith(ec_support:deref(A, Bs), Bs, Db) - eval_arith(ec_support:deref(B, Bs), Bs, Db); + eval_arith(erlog_ec_support:deref(A, Bs), Bs, Db) - eval_arith(erlog_ec_support:deref(B, Bs), Bs, Db); eval_arith({'*', A, B}, Bs, Db) -> - eval_arith(ec_support:deref(A, Bs), Bs, Db) * eval_arith(ec_support:deref(B, Bs), Bs, Db); + eval_arith(erlog_ec_support:deref(A, Bs), Bs, Db) * eval_arith(erlog_ec_support:deref(B, Bs), Bs, Db); eval_arith({'/', A, B}, Bs, Db) -> - eval_arith(ec_support:deref(A, Bs), Bs, Db) / eval_arith(ec_support:deref(B, Bs), Bs, Db); + eval_arith(erlog_ec_support:deref(A, Bs), Bs, Db) / eval_arith(erlog_ec_support:deref(B, Bs), Bs, Db); eval_arith({'**', A, B}, Bs, Db) -> - math:pow(eval_arith(ec_support:deref(A, Bs), Bs, Db), - eval_arith(ec_support:deref(B, Bs), Bs, Db)); + math:pow(eval_arith(erlog_ec_support:deref(A, Bs), Bs, Db), + eval_arith(erlog_ec_support:deref(B, Bs), Bs, Db)); eval_arith({'//', A, B}, Bs, Db) -> - eval_int(ec_support:deref(A, Bs), Bs, Db) div eval_int(ec_support:deref(B, Bs), Bs, Db); + eval_int(erlog_ec_support:deref(A, Bs), Bs, Db) div eval_int(erlog_ec_support:deref(B, Bs), Bs, Db); eval_arith({'mod', A, B}, Bs, Db) -> - eval_int(ec_support:deref(A, Bs), Bs, Db) rem eval_int(ec_support:deref(B, Bs), Bs, Db); + eval_int(erlog_ec_support:deref(A, Bs), Bs, Db) rem eval_int(erlog_ec_support:deref(B, Bs), Bs, Db); eval_arith({'/\\', A, B}, Bs, Db) -> - eval_int(ec_support:deref(A, Bs), Bs, Db) band eval_int(ec_support:deref(B, Bs), Bs, Db); + eval_int(erlog_ec_support:deref(A, Bs), Bs, Db) band eval_int(erlog_ec_support:deref(B, Bs), Bs, Db); eval_arith({'\\/', A, B}, Bs, Db) -> - eval_int(ec_support:deref(A, Bs), Bs, Db) bor eval_int(ec_support:deref(B, Bs), Bs, Db); + eval_int(erlog_ec_support:deref(A, Bs), Bs, Db) bor eval_int(erlog_ec_support:deref(B, Bs), Bs, Db); eval_arith({'<<', A, B}, Bs, Db) -> - eval_int(ec_support:deref(A, Bs), Bs, Db) bsl eval_int(ec_support:deref(B, Bs), Bs, Db); + eval_int(erlog_ec_support:deref(A, Bs), Bs, Db) bsl eval_int(erlog_ec_support:deref(B, Bs), Bs, Db); eval_arith({'>>', A, B}, Bs, Db) -> - eval_int(ec_support:deref(A, Bs), Bs, Db) bsr eval_int(ec_support:deref(B, Bs), Bs, Db); + eval_int(erlog_ec_support:deref(A, Bs), Bs, Db) bsr eval_int(erlog_ec_support:deref(B, Bs), Bs, Db); eval_arith({'\\', A}, Bs, Db) -> - bnot eval_int(ec_support:deref(A, Bs), Bs, Db); + bnot eval_int(erlog_ec_support:deref(A, Bs), Bs, Db); eval_arith({'+', A}, Bs, Db) -> - + eval_arith(ec_support:deref(A, Bs), Bs, Db); + + eval_arith(erlog_ec_support:deref(A, Bs), Bs, Db); eval_arith({'-', A}, Bs, Db) -> - - eval_arith(ec_support:deref(A, Bs), Bs, Db); + - eval_arith(erlog_ec_support:deref(A, Bs), Bs, Db); eval_arith({'abs', A}, Bs, Db) -> - abs(eval_arith(ec_support:deref(A, Bs), Bs, Db)); + abs(eval_arith(erlog_ec_support:deref(A, Bs), Bs, Db)); eval_arith({'float', A}, Bs, Db) -> - float(eval_arith(ec_support:deref(A, Bs), Bs, Db)); + float(eval_arith(erlog_ec_support:deref(A, Bs), Bs, Db)); eval_arith({'truncate', A}, Bs, Db) -> - trunc(eval_arith(ec_support:deref(A, Bs), Bs, Db)); + trunc(eval_arith(erlog_ec_support:deref(A, Bs), Bs, Db)); eval_arith(N, _Bs, _Db) when is_number(N) -> N; %Just a number %% Error cases. eval_arith({_}, _Bs, Db) -> erlog_errors:instantiation_error(Db); diff --git a/src/libs/standard/bips/main/erlog_bips.erl b/src/libs/standard/bips/main/erlog_bips.erl index d22c3d2..d101650 100644 --- a/src/libs/standard/bips/main/erlog_bips.erl +++ b/src/libs/standard/bips/main/erlog_bips.erl @@ -43,88 +43,88 @@ load(Db) -> %% Term unification and comparison prove_goal(Params = #param{goal = {'=', L, R}}) -> - ec_body:unify_prove_body(L, R, Params); + erlog_ec_body:unify_prove_body(L, R, Params); prove_goal(Params = #param{goal = {'\\=', L, R}, next_goal = Next, bindings = Bs0}) -> - case ec_unify:unify(L, R, Bs0) of + case erlog_ec_unify:unify(L, R, Bs0) of {succeed, _Bs1} -> erlog_errors:fail(Params); - fail -> ec_core:prove_body(Params#param{goal = Next}) + fail -> erlog_ec_core:prove_body(Params#param{goal = Next}) end; prove_goal(Params = #param{goal = {'@>', L, R}}) -> - eb_logic:term_test_prove_body('>', L, R, Params); + erlog_eb_logic:term_test_prove_body('>', L, R, Params); prove_goal(Params = #param{goal = {'@>=', L, R}}) -> - eb_logic:term_test_prove_body('>=', L, R, Params); + erlog_eb_logic:term_test_prove_body('>=', L, R, Params); prove_goal(Params = #param{goal = {'==', L, R}}) -> - eb_logic:term_test_prove_body('==', L, R, Params); + erlog_eb_logic:term_test_prove_body('==', L, R, Params); prove_goal(Params = #param{goal = {'\\==', L, R}}) -> - eb_logic:term_test_prove_body('/=', L, R, Params); + erlog_eb_logic:term_test_prove_body('/=', L, R, Params); prove_goal(Params = #param{goal = {'@<', L, R}}) -> - eb_logic:term_test_prove_body('<', L, R, Params); + erlog_eb_logic:term_test_prove_body('<', L, R, Params); prove_goal(Params = #param{goal = {'@=<', L, R}}) -> - eb_logic:term_test_prove_body('=<', L, R, Params); + erlog_eb_logic:term_test_prove_body('=<', L, R, Params); %% Term creation and decomposition. prove_goal(Params = #param{goal = {arg, I, Ct, A}, bindings = Bs}) -> - eb_logic:prove_arg(ec_support:deref(I, Bs), ec_support:deref(Ct, Bs), A, Params); + erlog_eb_logic:prove_arg(erlog_ec_support:deref(I, Bs), erlog_ec_support:deref(Ct, Bs), A, Params); prove_goal(Params = #param{goal = {copy_term, T0, C}, bindings = Bs, var_num = Vn0}) -> %% Use term_instance to create the copy, can ignore orddict it creates. - {T, _Nbs, Vn1} = ec_term:term_instance(ec_support:dderef(T0, Bs), Vn0), - ec_body:unify_prove_body(T, C, Params#param{var_num = Vn1}); + {T, _Nbs, Vn1} = erlog_ec_term:term_instance(erlog_ec_support:dderef(T0, Bs), Vn0), + erlog_ec_body:unify_prove_body(T, C, Params#param{var_num = Vn1}); prove_goal(Params = #param{goal = {functor, T, F, A}, bindings = Bs}) -> - eb_logic:prove_functor(ec_support:dderef(T, Bs), F, A, Params); + erlog_eb_logic:prove_functor(erlog_ec_support:dderef(T, Bs), F, A, Params); prove_goal(Params = #param{goal = {'=..', T, L}, bindings = Bs}) -> - eb_logic:prove_univ(ec_support:dderef(T, Bs), L, Params); + erlog_eb_logic:prove_univ(erlog_ec_support:dderef(T, Bs), L, Params); %% Type testing. prove_goal(Params = #param{goal = {atom, T0}, next_goal = Next, bindings = Bs}) -> - case ec_support:deref(T0, Bs) of - T when is_atom(T) -> ec_core:prove_body(Params#param{goal = Next}); + case erlog_ec_support:deref(T0, Bs) of + T when is_atom(T) -> erlog_ec_core:prove_body(Params#param{goal = Next}); _Other -> erlog_errors:fail(Params) end; prove_goal(Params = #param{goal = {atomic, T0}, next_goal = Next, bindings = Bs}) -> - case ec_support:deref(T0, Bs) of - T when ?IS_ATOMIC(T) -> ec_core:prove_body(Params#param{goal = Next}); + case erlog_ec_support:deref(T0, Bs) of + T when ?IS_ATOMIC(T) -> erlog_ec_core:prove_body(Params#param{goal = Next}); _Other -> erlog_errors:fail(Params) end; prove_goal(Params = #param{goal = {compound, T0}, next_goal = Next, bindings = Bs}) -> - case ec_support:deref(T0, Bs) of + case erlog_ec_support:deref(T0, Bs) of T when ?IS_ATOMIC(T) -> erlog_errors:fail(Params); - _Other -> ec_core:prove_body(Params#param{goal = Next}) + _Other -> erlog_ec_core:prove_body(Params#param{goal = Next}) end; prove_goal(Params = #param{goal = {integer, T0}, next_goal = Next, bindings = Bs}) -> - case ec_support:deref(T0, Bs) of - T when is_integer(T) -> ec_core:prove_body(Params#param{goal = Next}); + case erlog_ec_support:deref(T0, Bs) of + T when is_integer(T) -> erlog_ec_core:prove_body(Params#param{goal = Next}); _Other -> erlog_errors:fail(Params) end; prove_goal(Params = #param{goal = {float, T0}, next_goal = Next, bindings = Bs}) -> - case ec_support:deref(T0, Bs) of - T when is_float(T) -> ec_core:prove_body(Params#param{goal = Next}); + case erlog_ec_support:deref(T0, Bs) of + T when is_float(T) -> erlog_ec_core:prove_body(Params#param{goal = Next}); _Other -> erlog_errors:fail(Params) end; prove_goal(Params = #param{goal = {number, T0}, next_goal = Next, bindings = Bs}) -> - case ec_support:deref(T0, Bs) of - T when is_number(T) -> ec_core:prove_body(Params#param{goal = Next}); + case erlog_ec_support:deref(T0, Bs) of + T when is_number(T) -> erlog_ec_core:prove_body(Params#param{goal = Next}); _Other -> erlog_errors:fail(Params) end; prove_goal(Params = #param{goal = {nonvar, T0}, next_goal = Next, bindings = Bs}) -> - case ec_support:deref(T0, Bs) of + case erlog_ec_support:deref(T0, Bs) of {_} -> erlog_errors:fail(Params); - _Other -> ec_core:prove_body(Params#param{goal = Next}) + _Other -> erlog_ec_core:prove_body(Params#param{goal = Next}) end; prove_goal(Params = #param{goal = {var, T0}, next_goal = Next, bindings = Bs}) -> - case ec_support:deref(T0, Bs) of - {_} -> ec_core:prove_body(Params#param{goal = Next}); + case erlog_ec_support:deref(T0, Bs) of + {_} -> erlog_ec_core:prove_body(Params#param{goal = Next}); _Other -> erlog_errors:fail(Params) end; %% Atom processing. prove_goal(Params = #param{goal = {atom_chars, A, L}}) -> - eb_logic:prove_atom_chars(A, L, Params); + erlog_eb_logic:prove_atom_chars(A, L, Params); prove_goal(Params = #param{goal = {atom_length, A0, L0}, bindings = Bs, database = Db}) -> - case ec_support:dderef(A0, Bs) of + case erlog_ec_support:dderef(A0, Bs) of A when is_atom(A) -> Alen = length(atom_to_list(A)), %No of chars in atom - case ec_support:dderef(L0, Bs) of + case erlog_ec_support:dderef(L0, Bs) of L when is_integer(L) -> - ec_body:unify_prove_body(Alen, L, Params); + erlog_ec_body:unify_prove_body(Alen, L, Params); {_} = Var -> - ec_body:unify_prove_body(Alen, Var, Params); + erlog_ec_body:unify_prove_body(Alen, Var, Params); Other -> erlog_errors:type_error(integer, Other, Db) end; {_} -> erlog_errors:instantiation_error(Db); @@ -132,17 +132,17 @@ prove_goal(Params = #param{goal = {atom_length, A0, L0}, bindings = Bs, database end; %% Arithmetic evalution and comparison. prove_goal(Params = #param{goal = {is, N, E0}, bindings = Bs, database = Db}) -> - E = eb_logic:eval_arith(ec_support:deref(E0, Bs), Bs, Db), - ec_body:unify_prove_body(N, E, Params); + E = erlog_eb_logic:eval_arith(erlog_ec_support:deref(E0, Bs), Bs, Db), + erlog_ec_body:unify_prove_body(N, E, Params); prove_goal(Params = #param{goal = {'>', L, R}}) -> - eb_logic:arith_test_prove_body('>', L, R, Params); + erlog_eb_logic:arith_test_prove_body('>', L, R, Params); prove_goal(Params = #param{goal = {'>=', L, R}}) -> - eb_logic:arith_test_prove_body('>=', L, R, Params); + erlog_eb_logic:arith_test_prove_body('>=', L, R, Params); prove_goal(Params = #param{goal = {'=:=', L, R}}) -> - eb_logic:arith_test_prove_body('==', L, R, Params); + erlog_eb_logic:arith_test_prove_body('==', L, R, Params); prove_goal(Params = #param{goal = {'=\\=', L, R}}) -> - eb_logic:arith_test_prove_body('/=', L, R, Params); + erlog_eb_logic:arith_test_prove_body('/=', L, R, Params); prove_goal(Params = #param{goal = {'<', L, R}}) -> - eb_logic:arith_test_prove_body('<', L, R, Params); + erlog_eb_logic:arith_test_prove_body('<', L, R, Params); prove_goal(Params = #param{goal = {'=<', L, R}}) -> - eb_logic:arith_test_prove_body('=<', L, R, Params). \ No newline at end of file + erlog_eb_logic:arith_test_prove_body('=<', L, R, Params). \ No newline at end of file diff --git a/src/libs/standard/core/logic/ec_logic.erl b/src/libs/standard/core/logic/erlog_ec_logic.erl similarity index 81% rename from src/libs/standard/core/logic/ec_logic.erl rename to src/libs/standard/core/logic/erlog_ec_logic.erl index 39d23e0..f638fef 100644 --- a/src/libs/standard/core/logic/ec_logic.erl +++ b/src/libs/standard/core/logic/erlog_ec_logic.erl @@ -6,7 +6,7 @@ %%% @end %%% Created : 15. Июль 2014 16:02 %%%------------------------------------------------------------------- --module(ec_logic). +-module(erlog_ec_logic). -author("tihon"). -include("erlog_core.hrl"). @@ -33,13 +33,13 @@ prove_findall(T, G, B0, Param = #param{bindings = Bs, choice = Cps, next_goal = Next, var_num = Vn, database = Db}) -> Label = Vn, Tag = Vn + 1, %Increment to avoid clashes - {Next1, _} = ec_logic:check_goal(G, [{findall, Tag, T}], Bs, Db, false, Label), + {Next1, _} = erlog_ec_logic:check_goal(G, [{findall, Tag, T}], Bs, Db, false, Label), B1 = partial_list(B0, Bs), Cp = #cp{type = findall, data = {Tag, B1}, next = Next, bs = Bs, vn = Vn}, erlog_memory:raw_store(Db, Tag, []), %Initialise collection %% Catch case where an erlog error occurs when cleanup database. try - ec_core:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], bindings = Bs, var_num = Vn + 1}) + erlog_ec_core:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], bindings = Bs, var_num = Vn + 1}) catch throw:{erlog_error, E, Dba} -> Dbb = erlog_memory:raw_erase(Dba, Tag), %Clear special entry @@ -54,9 +54,9 @@ prove_ecall(Efun, Val, Param = #param{next_goal = Next, choice = Cps, bindings = case Efun() of {succeed, Ret, Cont} -> %Succeed and more choices Cp = #cp{type = ecall, data = {Cont, Val}, next = Next, bs = Bs, vn = Vn}, - ec_body:unify_prove_body(Val, Ret, Param#param{choice = [Cp | Cps]}); + erlog_ec_body:unify_prove_body(Val, Ret, Param#param{choice = [Cp | Cps]}); {succeed_last, Ret} -> %Succeed but last choice - ec_body:unify_prove_body(Val, Ret, Param); + erlog_ec_body:unify_prove_body(Val, Ret, Param); fail -> erlog_errors:fail(Param) %No more end. @@ -64,14 +64,14 @@ prove_ecall(Efun, Val, Param = #param{next_goal = Next, choice = Cps, bindings = %% void. %% Unify clauses matching with functor from Head with both Head and Body. prove_clause(H, B, Params = #param{database = Db}) -> - Functor = ec_support:functor(H), + Functor = erlog_ec_support:functor(H), case erlog_memory:get_procedure(Db, Functor) of {cursor, Cursor, result, {clauses, Cs}} -> - ec_core:run_n_close(fun(Param) -> ec_unify:unify_clauses(H, B, Cs, Param) end, Params#param{cursor = Cursor}); + erlog_ec_core:run_n_close(fun(Param) -> erlog_ec_unify:unify_clauses(H, B, Cs, Param) end, Params#param{cursor = Cursor}); {code, _} -> - erlog_errors:permission_error(access, private_procedure, ec_support:pred_ind(Functor)); + erlog_errors:permission_error(access, private_procedure, erlog_ec_support:pred_ind(Functor)); built_in -> - erlog_errors:permission_error(access, private_procedure, ec_support:pred_ind(Functor)); + erlog_errors:permission_error(access, private_procedure, erlog_ec_support:pred_ind(Functor)); undefined -> erlog_errors:fail(Params) end. @@ -89,7 +89,7 @@ prove_current_predicate(Pi, Param = #param{database = Db}) -> prove_predicates(Pi, [F | Fs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> Cp = #cp{type = current_predicate, data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, - ec_body:unify_prove_body(Pi, ec_support:pred_ind(F), Param#param{choice = [Cp | Cps]}); + erlog_ec_body:unify_prove_body(Pi, erlog_ec_support:pred_ind(F), Param#param{choice = [Cp | Cps]}); prove_predicates(_Pi, [], Param) -> erlog_errors:fail(Param). %% prove_retract(Clause, Next, ChoicePoints, Bindings, VarNum, Database) -> @@ -109,7 +109,7 @@ prove_retractall(H, Params) -> %% {WellFormedBody,HasCut}. %% Check to see that Goal is bound and ensure that it is well-formed. check_goal(G0, Next, Bs, Db, Cut, Label) -> - case ec_support:dderef(G0, Bs) of + case erlog_ec_support:dderef(G0, Bs) of {_} -> erlog_errors:instantiation_error(Db); %Must have something to call G1 -> case catch {ok, well_form_goal(G1, Next, Cut, Label)} of @@ -124,12 +124,12 @@ check_goal(G0, Next, Bs, Db, Cut, Label) -> retract_clauses(_, _, [], Param) -> erlog_errors:fail(Param); retract_clauses(Ch, Cb, [C], Param) -> retract_clauses(Ch, Cb, C, Param); retract_clauses(Ch, Cb, C, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}) -> %TODO foreach vs handmade recursion? - case ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of + case erlog_ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> %% We have found a right clause so now retract it. - erlog_memory:retract_clause(Db, ec_support:functor(Ch), element(1, C)), + erlog_memory:retract_clause(Db, erlog_ec_support:functor(Ch), element(1, C)), Cp = #cp{type = retract, data = {Ch, Cb, {Db, Cursor}}, next = Next, bs = Bs0, vn = Vn0}, - ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); + erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); fail -> {UCursor, Res} = erlog_memory:next(Db, Cursor), retract_clauses(Ch, Cb, Res, Param#param{cursor = UCursor}) @@ -165,7 +165,7 @@ well_form_goal(fail, _Tail, _Cut, _Label) -> {[fail], false}; %No further well_form_goal('!', Tail, Cut, Label) -> {[{{cut}, Label, not Cut} | Tail], true}; well_form_goal(Goal, Tail, Cut, _Label) -> - ec_support:functor(Goal), %Check goal + erlog_ec_support:functor(Goal), %Check goal {[Goal | Tail], Cut}. parse_int(Float) when is_float(Float) -> round(Float); @@ -185,17 +185,17 @@ to_string(Value) -> lists:flatten(io_lib:format("~p", [Value])). %% Check term for well-formedness as an Erlog term and replace '_' %% variables with unique numbered variables. Error on non-well-formed %% goals. -initial_goal(Goal) -> initial_goal(Goal, ec_support:new_bindings(), 0). +initial_goal(Goal) -> initial_goal(Goal, erlog_ec_support:new_bindings(), 0). %% @private initial_goal({'_'}, Bs, Vn) -> {{Vn}, Bs, Vn + 1}; %Anonymous variable initial_goal({Name} = Var0, Bs, Vn) when is_atom(Name) -> - case ec_support:get_binding(Var0, Bs) of + case erlog_ec_support:get_binding(Var0, Bs) of {ok, Var1} -> {Var1, Bs, Vn}; error -> Var1 = {Vn}, - {Var1, ec_support:add_binding(Var0, Var1, Bs), Vn + 1} + {Var1, erlog_ec_support:add_binding(Var0, Var1, Bs), Vn + 1} end; initial_goal([H0 | T0], Bs0, Vn0) -> {H1, Bs1, Vn1} = initial_goal(H0, Bs0, Vn0), @@ -225,33 +225,33 @@ partial_list(Other, _) -> erlog_errors:type_error(list, Other). %% @private prove_retract(H, B, Params = #param{database = Db}) -> - Functor = ec_support:functor(H), + Functor = erlog_ec_support:functor(H), case erlog_memory:get_procedure(Db, Functor) of {cursor, Cursor, result, {clauses, Cs}} -> - ec_core:run_n_close(fun(Param) -> retract_clauses(H, B, Cs, Param) end, Params#param{cursor = Cursor}); + erlog_ec_core:run_n_close(fun(Param) -> retract_clauses(H, B, Cs, Param) end, Params#param{cursor = Cursor}); {code, _} -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); + erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)); built_in -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); + erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)); undefined -> erlog_errors:fail(Params) end. %% @private prove_retractall(H, B, Params = #param{database = Db}) -> - Functor = ec_support:functor(H), + Functor = erlog_ec_support:functor(H), case erlog_memory:get_procedure(Db, Functor) of {cursor, Cursor, result, Result} -> Fun = fun(Param) -> check_result(Result, H, B, Functor, Param) end, - ec_core:run_n_close(Fun, Params#param{cursor = Cursor}); + erlog_ec_core:run_n_close(Fun, Params#param{cursor = Cursor}); Result -> check_result(Result, H, B, Functor, Params) end. -retractall_clauses([], _, _, Params = #param{next_goal = Next}) -> ec_core:prove_body(Params#param{goal = Next}); +retractall_clauses([], _, _, Params = #param{next_goal = Next}) -> erlog_ec_core:prove_body(Params#param{goal = Next}); retractall_clauses(Clause, H, B, Params = #param{bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}) -> - case ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of + case erlog_ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of {succeed, _, _} -> - erlog_memory:retract_clause(Db, ec_support:functor(H), element(1, Clause)), + erlog_memory:retract_clause(Db, erlog_ec_support:functor(H), element(1, Clause)), {UCursor, Res} = erlog_memory:next(Db, Cursor), retractall_clauses(Res, H, B, Params#param{cursor = UCursor}); fail -> retractall_clauses([], H, B, Params) @@ -259,10 +259,10 @@ retractall_clauses(Clause, H, B, Params = #param{bindings = Bs0, var_num = Vn0, %% @private check_result({built_in, _}, _, _, Functor, _) -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); + erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)); check_result({code, _}, _, _, Functor, _) -> - erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)); + erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)); check_result({clauses, Cs}, H, B, _, Params) -> retractall_clauses(Cs, H, B, Params); -check_result(undefined, _, _, _, Params = #param{next_goal = Next}) -> ec_core:prove_body(Params#param{goal = Next}); +check_result(undefined, _, _, _, Params = #param{next_goal = Next}) -> erlog_ec_core:prove_body(Params#param{goal = Next}); check_result({erlog_error, E}, _, _, _, #param{database = Db}) -> erlog_errors:erlog_error(E, Db). \ No newline at end of file diff --git a/src/libs/standard/core/main/erlog_core.erl b/src/libs/standard/core/main/erlog_core.erl index 0b846f1..d09cce3 100644 --- a/src/libs/standard/core/main/erlog_core.erl +++ b/src/libs/standard/core/main/erlog_core.erl @@ -49,61 +49,61 @@ prove_goal(Param = #param{goal = {call, G}, next_goal = Next0, choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> %% Only add cut CP to Cps if goal contains a cut. Label = Vn, - case ec_logic:check_goal(G, Next0, Bs, Db, false, Label) of + case erlog_ec_logic:check_goal(G, Next0, Bs, Db, false, Label) of {Next1, true} -> %% Must increment Vn to avoid clashes!!! Cut = #cut{label = Label}, - ec_core:prove_body(Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); - {Next1, false} -> ec_core:prove_body(Param#param{goal = Next1, var_num = Vn + 1}) + erlog_ec_core:prove_body(Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); + {Next1, false} -> erlog_ec_core:prove_body(Param#param{goal = Next1, var_num = Vn + 1}) end; prove_goal(Params = #param{goal = fail}) -> erlog_errors:fail(Params); prove_goal(Param = #param{goal = {'\\+', G}, next_goal = Next0, choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> %% We effectively implementing \+ G with ( G -> fail ; true ). Label = Vn, - {Next1, _} = ec_logic:check_goal(G, [{{cut}, Label, true}, fail], Bs, Db, true, Label), + {Next1, _} = erlog_ec_logic:check_goal(G, [{{cut}, Label, true}, fail], Bs, Db, true, Label), Cp = #cp{type = if_then_else, label = Label, next = Next0, bs = Bs, vn = Vn}, %%io:fwrite("PG(\\+): ~p\n", [{G1,[Cp|Cps]]), %% Must increment Vn to avoid clashes!!! - ec_core:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], var_num = Vn + 1}); + erlog_ec_core:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], var_num = Vn + 1}); prove_goal(Param = #param{goal = repeat, next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> Cp = #cp{type = disjunction, next = [repeat | Next], bs = Bs, vn = Vn}, - ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); + erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); %% Clause creation and destruction. prove_goal(Param = #param{goal = {abolish, Pi0}, next_goal = Next, bindings = Bs, database = Db}) -> - case ec_support:dderef(Pi0, Bs) of + case erlog_ec_support:dderef(Pi0, Bs) of {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> erlog_memory:abolish_clauses(Db, {N, A}), - ec_core:prove_body(Param#param{goal = Next}); + erlog_ec_core:prove_body(Param#param{goal = Next}); Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) end; prove_goal(Param = #param{goal = {Assert, C0}, next_goal = Next, bindings = Bs, database = Db}) when Assert == assert; Assert == assertz -> - C = ec_support:dderef(C0, Bs), + C = erlog_ec_support:dderef(C0, Bs), erlog_memory:assertz_clause(Db, C), - ec_core:prove_body(Param#param{goal = Next}); + erlog_ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {asserta, C0}, next_goal = Next, bindings = Bs, database = Db}) -> - C = ec_support:dderef(C0, Bs), + C = erlog_ec_support:dderef(C0, Bs), erlog_memory:asserta_clause(Db, C), - ec_core:prove_body(Param#param{goal = Next}); + erlog_ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {retract, C0}, bindings = Bs}) -> - C = ec_support:dderef(C0, Bs), - ec_logic:prove_retract(C, Param); + C = erlog_ec_support:dderef(C0, Bs), + erlog_ec_logic:prove_retract(C, Param); prove_goal(Param = #param{goal = {retractall, C0}, bindings = Bs}) -> - C = ec_support:dderef(C0, Bs), - ec_logic:prove_retractall(C, Param); + C = erlog_ec_support:dderef(C0, Bs), + erlog_ec_logic:prove_retractall(C, Param); %% Clause retrieval and information prove_goal(Param = #param{goal = {clause, H0, B}, bindings = Bs}) -> - H1 = ec_support:dderef(H0, Bs), - ec_logic:prove_clause(H1, B, Param); + H1 = erlog_ec_support:dderef(H0, Bs), + erlog_ec_logic:prove_clause(H1, B, Param); prove_goal(Param = #param{goal = {current_predicate, Pi0}, bindings = Bs}) -> - Pi = ec_support:dderef(Pi0, Bs), - ec_logic:prove_current_predicate(Pi, Param); + Pi = erlog_ec_support:dderef(Pi0, Bs), + erlog_ec_logic:prove_current_predicate(Pi, Param); prove_goal(Param = #param{goal = {predicate_property, H0, P}, bindings = Bs, database = Db}) -> - H = ec_support:dderef(H0, Bs), - case catch erlog_memory:get_procedure_type(Db, ec_support:functor(H)) of - built_in -> ec_body:unify_prove_body(P, built_in, Param); - compiled -> ec_body:unify_prove_body(P, compiled, Param); - interpreted -> ec_body:unify_prove_body(P, interpreted, Param); + H = erlog_ec_support:dderef(H0, Bs), + case catch erlog_memory:get_procedure_type(Db, erlog_ec_support:functor(H)) of + built_in -> erlog_ec_body:unify_prove_body(P, built_in, Param); + compiled -> erlog_ec_body:unify_prove_body(P, compiled, Param); + interpreted -> erlog_ec_body:unify_prove_body(P, interpreted, Param); undefined -> erlog_errors:fail(Param); {erlog_error, E} -> erlog_errors:erlog_error(E, Db) end; @@ -111,7 +111,7 @@ prove_goal(Param = #param{goal = {predicate_property, H0, P}, bindings = Bs, dat prove_goal(Param = #param{goal = {ecall, C0, Val}, bindings = Bs, database = Db}) -> %% Build the initial call. %%io:fwrite("PG(ecall): ~p\n ~p\n ~p\n", [dderef(C0, Bs),Next,Cps]), - Efun = case ec_support:dderef(C0, Bs) of + Efun = case erlog_ec_support:dderef(C0, Bs) of {':', M, F} when is_atom(M), is_atom(F) -> fun() -> M:F() end; {':', M, {F, A}} when is_atom(M), is_atom(F) -> @@ -124,74 +124,74 @@ prove_goal(Param = #param{goal = {ecall, C0, Val}, bindings = Bs, database = Db} Fun when is_function(Fun) -> Fun; Other -> erlog_errors:type_error(callable, Other, Db) end, - ec_logic:prove_ecall(Efun, Val, Param); + erlog_ec_logic:prove_ecall(Efun, Val, Param); %% Non-standard but useful. prove_goal(Param = #param{goal = {writeln, T}, next_goal = Next, bindings = Bs, event_man = Evman}) -> %% Display procedure. - Res = ec_support:write(T, Bs), + Res = erlog_ec_support:write(T, Bs), gen_event:notify(Evman, Res), - ec_core:prove_body(Param#param{goal = Next}); + erlog_ec_core:prove_body(Param#param{goal = Next}); %% File utils prove_goal(Param = #param{goal = {consult, Name}, next_goal = Next, bindings = Bs, f_consulter = Fcon, database = Db}) -> - case erlog_file:consult(Fcon, ec_support:dderef(Name, Bs), Db) of + case erlog_file:consult(Fcon, erlog_ec_support:dderef(Name, Bs), Db) of ok -> ok; {Err, Error} when Err == erlog_error; Err == error -> erlog_errors:erlog_error(Error, Db) end, - ec_core:prove_body(Param#param{goal = Next}); + erlog_ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {reconsult, Name}, next_goal = Next, f_consulter = Fcon, database = Db}) -> case erlog_file:reconsult(Fcon, Name, Db) of ok -> ok; {Err, Error} when Err == erlog_error; Err == error -> erlog_errors:erlog_error(Error, Db) end, - ec_core:prove_body(Param#param{goal = Next}); + erlog_ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db}) -> try Library:load(Db) catch _:Error -> erlog_errors:erlog_error(Error, Db) end, - ec_core:prove_body(Param#param{goal = Next}); + erlog_ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {listing, Res}, next_goal = Next, bindings = Bs0, database = Db}) -> Content = erlog_memory:listing(Db, []), - Bs = ec_support:add_binding(Res, Content, Bs0), - ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); + Bs = erlog_ec_support:add_binding(Res, Content, Bs0), + erlog_ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); prove_goal(Param = #param{goal = {listing, Pred, Res}, next_goal = Next, bindings = Bs0, database = Db}) -> Content = erlog_memory:listing(Db, [Pred]), - Bs = ec_support:add_binding(Res, Content, Bs0), - ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); + Bs = erlog_ec_support:add_binding(Res, Content, Bs0), + erlog_ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); prove_goal(Param = #param{goal = {listing, Pred, Arity, Res}, next_goal = Next, bindings = Bs0, database = Db}) -> Content = erlog_memory:listing(Db, [Pred, Arity]), - Bs = ec_support:add_binding(Res, Content, Bs0), - ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); + Bs = erlog_ec_support:add_binding(Res, Content, Bs0), + erlog_ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); prove_goal(Param = #param{goal = {findall, T, G, B}}) -> %findall start - ec_logic:prove_findall(T, G, B, Param); + erlog_ec_logic:prove_findall(T, G, B, Param); prove_goal(Param = #param{goal = {findall, Tag, T0}, bindings = Bs, database = Db}) -> %findall finish - T1 = ec_support:dderef(T0, Bs), + T1 = erlog_ec_support:dderef(T0, Bs), erlog_memory:raw_append(Db, Tag, T1), %Append to saved list erlog_errors:fail(Param); prove_goal(Param = #param{goal = {bagof, Goal, Fun, Res}, choice = Cs0, bindings = Bs0, next_goal = Next, var_num = Vn, database = Db}) -> Predicates = erlog_memory:finadll(Db, Fun), FunList = tuple_to_list(Fun), - ResultDict = ec_support:collect_alternatives(Goal, FunList, Predicates), + ResultDict = erlog_ec_support:collect_alternatives(Goal, FunList, Predicates), Collected = dict:fetch_keys(ResultDict), [UBs | Choises] = lists:foldr( fun(Key, Acc) -> - UpdBs0 = ec_support:update_result(Key, ResultDict, Res, Bs0), - UpdBs1 = ec_support:update_vars(Goal, FunList, Key, UpdBs0), + UpdBs0 = erlog_ec_support:update_result(Key, ResultDict, Res, Bs0), + UpdBs1 = erlog_ec_support:update_vars(Goal, FunList, Key, UpdBs0), [#cp{type = disjunction, label = Fun, next = Next, bs = UpdBs1, vn = Vn} | Acc] end, Cs0, Collected), - ec_core:prove_body(Param#param{goal = Next, bindings = UBs#cp.bs, choice = Choises, var_num = Vn + length(Choises)}); + erlog_ec_core:prove_body(Param#param{goal = Next, bindings = UBs#cp.bs, choice = Choises, var_num = Vn + length(Choises)}); prove_goal(Param = #param{goal = {to_integer, NumV, Res}, next_goal = Next, bindings = Bs0}) -> - Num = ec_support:dderef(NumV, Bs0), - case catch (ec_logic:parse_int(Num)) of + Num = erlog_ec_support:dderef(NumV, Bs0), + case catch (erlog_ec_logic:parse_int(Num)) of Int when is_integer(Int) -> - Bs = ec_support:add_binding(Res, Int, Bs0), - ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); + Bs = erlog_ec_support:add_binding(Res, Int, Bs0), + erlog_ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); _ -> erlog_errors:fail(Param) end; prove_goal(Param = #param{goal = {to_string, VarV, Res}, next_goal = Next, bindings = Bs0}) -> - Var = ec_support:dderef(VarV, Bs0), - Bs = ec_support:add_binding(Res, ec_logic:to_string(Var), Bs0), - ec_core:prove_body(Param#param{goal = Next, bindings = Bs}). + Var = erlog_ec_support:dderef(VarV, Bs0), + Bs = erlog_ec_support:add_binding(Res, erlog_ec_logic:to_string(Var), Bs0), + erlog_ec_core:prove_body(Param#param{goal = Next, bindings = Bs}). diff --git a/src/libs/standard/dcg/logic/ed_logic.erl b/src/libs/standard/dcg/logic/erlog_ed_logic.erl similarity index 94% rename from src/libs/standard/dcg/logic/ed_logic.erl rename to src/libs/standard/dcg/logic/erlog_ed_logic.erl index 38ebff9..f4bcc3e 100644 --- a/src/libs/standard/dcg/logic/ed_logic.erl +++ b/src/libs/standard/dcg/logic/erlog_ed_logic.erl @@ -6,7 +6,7 @@ %%% @end %%% Created : 12. Авг. 2014 17:48 %%%------------------------------------------------------------------- --module(ed_logic). +-module(erlog_ed_logic). -author("tihon"). -include("erlog_core.hrl"). @@ -26,11 +26,11 @@ expand_term({'-->', _, _} = Term, Vn) -> expand_term(Term, Vn) -> {Term, Vn}. phrase(Params = #param{goal = Goal, next_goal = Next0, bindings = Bs, var_num = Vn0}) -> - {phrase, GRBody, S0, S} = ec_support:dderef(Goal, Bs), - {Body, Vn1} = ed_logic:dcg_body(GRBody, S0, S, Vn0), + {phrase, GRBody, S0, S} = erlog_ec_support:dderef(Goal, Bs), + {Body, Vn1} = erlog_ed_logic:dcg_body(GRBody, S0, S, Vn0), %% io:format("~p\n", [Body]), Next1 = [{call, Body} | Next0], %Evaluate body - ec_core:prove_body(Params#param{goal = Next1, var_num = Vn1}). + erlog_ec_core:prove_body(Params#param{goal = Next1, var_num = Vn1}). %% dcg_rule(Term, VarNum) -> {ExpTerm,NewVarNum}. %% dcg_rule(DCGRule, VarIn, VarOout, VarNum) -> {ExpTerm,NewVarNum}. diff --git a/src/libs/standard/dcg/main/erlog_dcg.erl b/src/libs/standard/dcg/main/erlog_dcg.erl index 9023c8a..b80444a 100644 --- a/src/libs/standard/dcg/main/erlog_dcg.erl +++ b/src/libs/standard/dcg/main/erlog_dcg.erl @@ -30,10 +30,10 @@ load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:load_kernel_space(Db, ?MODULE, Proc) end, ?ERLOG_DCG). prove_goal(Params = #param{goal = {expand_term, _, _} = Goal, bindings = Bs, var_num = Vn0}) -> - {expand_term, DCGRule, A2} = ec_support:dderef(Goal, Bs), - {Exp, Vn1} = ed_logic:expand_term(DCGRule, Vn0), - ec_body:unify_prove_body(A2, Exp, Params#param{var_num = Vn1}); + {expand_term, DCGRule, A2} = erlog_ec_support:dderef(Goal, Bs), + {Exp, Vn1} = erlog_ed_logic:expand_term(DCGRule, Vn0), + erlog_ec_body:unify_prove_body(A2, Exp, Params#param{var_num = Vn1}); prove_goal(Params = #param{goal = {phrase, A, B}}) -> - ed_logic:phrase(Params#param{goal = {phrase, A, B, []}}); + erlog_ed_logic:phrase(Params#param{goal = {phrase, A, B, []}}); prove_goal(Params = #param{goal = {phrase, _, _, _}}) -> - ed_logic:phrase(Params). \ No newline at end of file + erlog_ed_logic:phrase(Params). \ No newline at end of file diff --git a/src/libs/standard/lists/logic/el_logic.erl b/src/libs/standard/lists/logic/erlog_el_logic.erl similarity index 73% rename from src/libs/standard/lists/logic/el_logic.erl rename to src/libs/standard/lists/logic/erlog_el_logic.erl index eefaa6d..0fe5530 100644 --- a/src/libs/standard/lists/logic/el_logic.erl +++ b/src/libs/standard/lists/logic/erlog_el_logic.erl @@ -6,7 +6,7 @@ %%% @end %%% Created : 12. Авг. 2014 18:01 %%%------------------------------------------------------------------- --module(el_logic). +-module(erlog_el_logic). -author("tihon"). -include("erlog_core.hrl"). @@ -21,18 +21,18 @@ insert(Params = #param{goal = {insert, A1, A2, A3}, next_goal = Next, bindings = Bs, choice = Cps, var_num = Vn, f_consulter = Fcon}) -> FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed - el_logic:fail_insert(LCp, Params#param{choice = LCps, database = LDb, f_consulter = Fcon}, A1, A2, A3) + erlog_el_logic:fail_insert(LCp, Params#param{choice = LCps, database = LDb, f_consulter = Fcon}, A1, A2, A3) end, Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, - ec_body:unify_prove_body(A3, [A2 | A1], Params#param{choice = [Cp | Cps]}). + erlog_ec_body:unify_prove_body(A3, [A2 | A1], Params#param{choice = [Cp | Cps]}). fail_append(#cp{next = Next0, bs = Bs0, vn = Vn}, Params, A1, L, A3) -> H = {Vn}, T = {Vn + 1}, L1 = {Vn + 2}, - Bs1 = ec_support:add_binding(A1, [H | T], Bs0), %A1 always a variable here. + Bs1 = erlog_ec_support:add_binding(A1, [H | T], Bs0), %A1 always a variable here. Next1 = [{append, T, L, L1} | Next0], - ec_body:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs1, + erlog_ec_body:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs1, var_num = Vn + 3}). fail_insert(#cp{next = Next0, bs = Bs, vn = Vn}, Params, A1, X, A3) -> @@ -40,13 +40,13 @@ fail_insert(#cp{next = Next0, bs = Bs, vn = Vn}, Params, A1, X, A3) -> L = {Vn + 1}, L1 = {Vn + 2}, Next1 = [{insert, L, X, L1} | Next0], - ec_body:unify_prove_body(A1, [H | L], A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 3}). + erlog_ec_body:unify_prove_body(A1, [H | L], A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 3}). fail_member(#cp{next = Next0, bs = Bs, vn = Vn}, Params, A1, A2) -> H = {Vn}, T = {Vn + 1}, Next1 = [{member, A1, T} | Next0], - ec_body:unify_prove_body(A2, [H | T], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 2}). + erlog_ec_body:unify_prove_body(A2, [H | T], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 2}). %% memberchk_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% memberchk(X, [X|_]) :- !. @@ -54,11 +54,11 @@ fail_member(#cp{next = Next0, bs = Bs, vn = Vn}, Params, A1, A2) -> %% We don't build the list and we never backtrack so we can be smart %% and match directly. Should we give a type error? memberchk({memberchk, A1, A2}, Params = #param{next_goal = Next, bindings = Bs0}) -> - case ec_support:deref(A2, Bs0) of + case erlog_ec_support:deref(A2, Bs0) of [H | T] -> - case ec_unify:unify(A1, H, Bs0) of + case erlog_ec_unify:unify(A1, H, Bs0) of {succeed, Bs1} -> - ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); fail -> memberchk({memberchk, A1, T}, Params) end; @@ -71,9 +71,9 @@ memberchk({memberchk, A1, A2}, Params = #param{next_goal = Next, bindings = Bs0} %% reverse([H|L1], L) :- reverse(L1, L2), append(L2, [H], L). %% Here we attempt to compile indexing in the first argument. reverse({reverse, A1, A2}, Params = #param{next_goal = Next0, bindings = Bs0, choice = Cps, var_num = Vn}) -> - case ec_support:deref(A1, Bs0) of + case erlog_ec_support:deref(A1, Bs0) of [] -> - ec_body:unify_prove_body(A2, [], Params); + erlog_ec_body:unify_prove_body(A2, [], Params); [H | T] -> L = {Vn}, L1 = A2, @@ -88,8 +88,8 @@ reverse({reverse, A1, A2}, Params = #param{next_goal = Next0, bindings = Bs0, ch fail_reverse(LCp, Params#param{choice = LCps, database = LDb}, Var, A2) end, Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, - Bs1 = ec_support:add_binding(Var, [], Bs0), - ec_body:unify_prove_body(A2, [], Params#param{choice = [Cp | Cps], bindings = Bs1}); + Bs1 = erlog_ec_support:add_binding(Var, [], Bs0), + erlog_ec_body:unify_prove_body(A2, [], Params#param{choice = [Cp | Cps], bindings = Bs1}); _ -> erlog_errors:fail(Params) %Will fail here! end. @@ -99,7 +99,7 @@ fail_reverse(#cp{next = Next, bs = Bs0, vn = Vn}, Params, A1, A2) -> T = {Vn + 1}, L1 = A2, L = {Vn + 2}, - Bs1 = ec_support:add_binding(A1, [H | T], Bs0), + Bs1 = erlog_ec_support:add_binding(A1, [H | T], Bs0), %%Next1 = [{reverse,T,L},{apperse,L,[H],L1}|Next], %%prove_body(Next1, Cps, Bs1, Vn+3, Db). Next1 = [{append, L, [H], L1} | Next], diff --git a/src/libs/standard/lists/main/erlog_lists.erl b/src/libs/standard/lists/main/erlog_lists.erl index 1a61fd1..b11f45c 100644 --- a/src/libs/standard/lists/main/erlog_lists.erl +++ b/src/libs/standard/lists/main/erlog_lists.erl @@ -46,49 +46,49 @@ load(Db) -> ]). prove_goal(Params = #param{goal = {length, ListVar, Len}, next_goal = Next, bindings = Bs0}) -> - case ec_support:deref(ListVar, Bs0) of + case erlog_ec_support:deref(ListVar, Bs0) of List when is_list(List) -> - Bs1 = ec_support:add_binding(Len, length(List), Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); + Bs1 = erlog_ec_support:add_binding(Len, length(List), Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); _ -> erlog_errors:fail(Params) end; prove_goal(Params = #param{goal = {append, A1, L, A3}, next_goal = Next0, bindings = Bs0, choice = Cps, var_num = Vn, f_consulter = Fcon}) -> - case ec_support:deref(A1, Bs0) of + case erlog_ec_support:deref(A1, Bs0) of [] -> %Cannot backtrack - ec_body:unify_prove_body(L, A3, Params); + erlog_ec_body:unify_prove_body(L, A3, Params); [H | T] -> %Cannot backtrack L1 = {Vn}, Next1 = [{append, T, L, L1} | Next0], - ec_body:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, var_num = Vn + 1}); + erlog_ec_body:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, var_num = Vn + 1}); {_} = Var -> %This can backtrack FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed - el_logic:fail_append(LCp, Params#param{choice = LCps, database = LDb, f_consulter = Fcon}, Var, L, A3) + erlog_el_logic:fail_append(LCp, Params#param{choice = LCps, database = LDb, f_consulter = Fcon}, Var, L, A3) end, Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, - Bs1 = ec_support:add_binding(Var, [], Bs0), - ec_body:unify_prove_body(L, A3, Params#param{choice = [Cp | Cps], bindings = Bs1}); + Bs1 = erlog_ec_support:add_binding(Var, [], Bs0), + erlog_ec_body:unify_prove_body(L, A3, Params#param{choice = [Cp | Cps], bindings = Bs1}); _ -> erlog_errors:fail(Params) %Will fail here! end; prove_goal(Params = #param{goal = {insert, _, _, _}}) -> - el_logic:insert(Params); + erlog_el_logic:insert(Params); prove_goal(Params = #param{goal = {delete, A, B, C}}) -> - el_logic:insert(Params#param{goal = {insert, C, B, A}}); + erlog_el_logic:insert(Params#param{goal = {insert, C, B, A}}); prove_goal(Params = #param{goal = {member, A1, A2}, next_goal = Next, bindings = Bs, choice = Cps, var_num = Vn}) -> FailFun = fun(LCp, LCps, LDb) -> - el_logic:fail_member(LCp, Params#param{choice = LCps, database = LDb}, A1, A2) + erlog_el_logic:fail_member(LCp, Params#param{choice = LCps, database = LDb}, A1, A2) end, Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, T = {Vn}, - ec_body:unify_prove_body(A2, [A1 | T], Params#param{choice = [Cp | Cps], var_num = Vn + 1}); + erlog_ec_body:unify_prove_body(A2, [A1 | T], Params#param{choice = [Cp | Cps], var_num = Vn + 1}); prove_goal(Params = #param{goal = {memberchk, A1, A2}}) -> - el_logic:memberchk({memberchk, A1, A2}, Params); + erlog_el_logic:memberchk({memberchk, A1, A2}, Params); prove_goal(Params = #param{goal = {sort, L0, S}, bindings = Bs}) -> %% This may throw an erlog error, we don't catch it here. - L1 = lists:usort(ec_support:dderef_list(L0, Bs)), - ec_body:unify_prove_body(S, L1, Params); + L1 = lists:usort(erlog_ec_support:dderef_list(L0, Bs)), + erlog_ec_body:unify_prove_body(S, L1, Params); %% reverse([], []). %% reverse([H|L1], L) :- reverse(L1, L2), append(L2, [H], L). %% Here we attempt to compile indexing in the first argument. prove_goal(Params = #param{goal = {reverse, A1, A2}}) -> - el_logic:reverse({reverse, A1, A2}, Params). \ No newline at end of file + erlog_el_logic:reverse({reverse, A1, A2}, Params). \ No newline at end of file diff --git a/src/libs/standard/time/logic/et_logic.erl b/src/libs/standard/time/logic/erlog_et_logic.erl similarity index 93% rename from src/libs/standard/time/logic/et_logic.erl rename to src/libs/standard/time/logic/erlog_et_logic.erl index 10e3aad..9152dc1 100644 --- a/src/libs/standard/time/logic/et_logic.erl +++ b/src/libs/standard/time/logic/erlog_et_logic.erl @@ -6,7 +6,7 @@ %%% @end %%% Created : 12. Авг. 2014 18:10 %%%------------------------------------------------------------------- --module(et_logic). +-module(erlog_et_logic). -author("tihon"). -include("erlog_time.hrl"). @@ -32,7 +32,7 @@ date_to_seconds(Time, sec) -> Time. -spec date_string_to_data(string()) -> tuple(). date_string_to_data(DataStr) -> [MStr, DStr, YStr, HStr, MnStr, SStr] = string:tokens(DataStr, " :"), - Month = ec_support:index_of(MStr, tuple_to_list(?MONTHS)), + Month = erlog_ec_support:index_of(MStr, tuple_to_list(?MONTHS)), {{list_to_integer(YStr), Month, list_to_integer(DStr)}, {list_to_integer(HStr), list_to_integer(MnStr), list_to_integer(SStr)}}. @@ -65,5 +65,5 @@ check_var({'-', Var}, Bs) -> Res when is_integer(Res) -> -1 * Res; Res -> Res end; -check_var({Var}, Bs) -> check_var(ec_support:deref({Var}, Bs), Bs); +check_var({Var}, Bs) -> check_var(erlog_ec_support:deref({Var}, Bs), Bs); check_var(Var, _) -> Var. \ No newline at end of file diff --git a/src/libs/standard/time/main/erlog_time.erl b/src/libs/standard/time/main/erlog_time.erl index 2fb54ad..1e93900 100644 --- a/src/libs/standard/time/main/erlog_time.erl +++ b/src/libs/standard/time/main/erlog_time.erl @@ -24,50 +24,50 @@ load(Db) -> %% Returns current timestamp. prove_goal(Params = #param{goal = {localtime, Var}, next_goal = Next, bindings = Bs0}) -> {M, S, _} = os:timestamp(), - Bs = ec_support:add_binding(Var, et_logic:date_to_ts({M, S}), Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + Bs = erlog_ec_support:add_binding(Var, erlog_et_logic:date_to_ts({M, S}), Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Returns timestamp for data, ignoring time prove_goal(Params = #param{goal = {date, DateString, Res}, next_goal = Next, bindings = Bs0}) -> - {{Y, M, D}, _} = et_logic:date_string_to_data(et_logic:check_var(DateString, Bs0)), - DataTS = et_logic:data_to_ts({{Y, M, D}, {0, 0, 0}}), - Bs = ec_support:add_binding(Res, DataTS, Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + {{Y, M, D}, _} = erlog_et_logic:date_string_to_data(erlog_et_logic:check_var(DateString, Bs0)), + DataTS = erlog_et_logic:data_to_ts({{Y, M, D}, {0, 0, 0}}), + Bs = erlog_ec_support:add_binding(Res, DataTS, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Returns timestamp for data, ignoring time prove_goal(Params = #param{goal = {date, D, M, Y, Res}, next_goal = Next, bindings = Bs0}) -> - DataTS = et_logic:data_to_ts({{et_logic:check_var(Y, Bs0), et_logic:check_var(M, Bs0), et_logic:check_var(D, Bs0)}, {0, 0, 0}}), - Bs = ec_support:add_binding(Res, DataTS, Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + DataTS = erlog_et_logic:data_to_ts({{erlog_et_logic:check_var(Y, Bs0), erlog_et_logic:check_var(M, Bs0), erlog_et_logic:check_var(D, Bs0)}, {0, 0, 0}}), + Bs = erlog_ec_support:add_binding(Res, DataTS, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Returns timestamp for data, ignoring data. prove_goal(Params = #param{goal = {time, TimeString, Res}, next_goal = Next, bindings = Bs0}) -> - {_, {H, M, S}} = et_logic:date_string_to_data(et_logic:check_var(TimeString, Bs0)), %cut YMD - TS = S * et_logic:date_to_seconds(M, minute) * et_logic:date_to_seconds(H, hour), - Bs = ec_support:add_binding(Res, TS, Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + {_, {H, M, S}} = erlog_et_logic:date_string_to_data(erlog_et_logic:check_var(TimeString, Bs0)), %cut YMD + TS = S * erlog_et_logic:date_to_seconds(M, minute) * erlog_et_logic:date_to_seconds(H, hour), + Bs = erlog_ec_support:add_binding(Res, TS, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Returns timestamp for data, ignoring data. prove_goal(Params = #param{goal = {time, H, M, S, Res}, next_goal = Next, bindings = Bs0}) -> - TS = et_logic:check_var(S, Bs0) - * et_logic:date_to_seconds(et_logic:check_var(M, Bs0), minute) - * et_logic:date_to_seconds(et_logic:check_var(H, Bs0), hour), - Bs = ec_support:add_binding(Res, TS, Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + TS = erlog_et_logic:check_var(S, Bs0) + * erlog_et_logic:date_to_seconds(erlog_et_logic:check_var(M, Bs0), minute) + * erlog_et_logic:date_to_seconds(erlog_et_logic:check_var(H, Bs0), hour), + Bs = erlog_ec_support:add_binding(Res, TS, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Calculates differense between two timestamps. Returns the result in specifyed format prove_goal(Params = #param{goal = {date_diff, TS1, TS2, Format, Res}, next_goal = Next, bindings = Bs0}) -> - Diff = timer:now_diff(et_logic:ts_to_date(et_logic:check_var(TS1, Bs0)), et_logic:ts_to_date(et_logic:check_var(TS2, Bs0))) / 1000000, - Bs = ec_support:add_binding(Res, et_logic:seconds_to_date(Diff, et_logic:check_var(Format, Bs0)), Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + Diff = timer:now_diff(erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS1, Bs0)), erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS2, Bs0))) / 1000000, + Bs = erlog_ec_support:add_binding(Res, erlog_et_logic:seconds_to_date(Diff, erlog_et_logic:check_var(Format, Bs0)), Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Adds number of seconds T2 in Type format to Time1. Returns timestamp prove_goal(Params = #param{goal = {add_time, Time1, Type, T2, Res}, next_goal = Next, bindings = Bs0}) -> - Diff = et_logic:check_var(Time1, Bs0) + et_logic:date_to_seconds(et_logic:check_var(T2, Bs0), et_logic:check_var(Type, Bs0)), - Bs = ec_support:add_binding(Res, Diff, Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + Diff = erlog_et_logic:check_var(Time1, Bs0) + erlog_et_logic:date_to_seconds(erlog_et_logic:check_var(T2, Bs0), erlog_et_logic:check_var(Type, Bs0)), + Bs = erlog_ec_support:add_binding(Res, Diff, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Converts timestamp to human readable format prove_goal(Params = #param{goal = {date_print, TS1, Res}, next_goal = Next, bindings = Bs0}) -> - {{Year, Month, Day}, {Hour, Minute, Second}} = et_logic:date_to_data(et_logic:ts_to_date(et_logic:check_var(TS1, Bs0))), + {{Year, Month, Day}, {Hour, Minute, Second}} = erlog_et_logic:date_to_data(erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS1, Bs0))), DateStr = lists:flatten(io_lib:format("~s ~2w ~4w ~2w:~2..0w:~2..0w", [?MONTH(Month), Day, Year, Hour, Minute, Second])), - Bs = ec_support:add_binding(Res, DateStr, Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + Bs = erlog_ec_support:add_binding(Res, DateStr, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Parses date string and returns timestamp. prove_goal(Params = #param{goal = {date_parse, DataStr, Res}, next_goal = Next, bindings = Bs0}) -> - Data = et_logic:date_string_to_data(et_logic:check_var(DataStr, Bs0)), - Bs = ec_support:add_binding(Res, et_logic:data_to_ts(Data), Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). \ No newline at end of file + Data = erlog_et_logic:date_string_to_data(erlog_et_logic:check_var(DataStr, Bs0)), + Bs = erlog_ec_support:add_binding(Res, erlog_et_logic:data_to_ts(Data), Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). \ No newline at end of file diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 5376fda..2e964b1 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -197,7 +197,7 @@ listing({_, _, Db}, {[]}) -> %% @private clause(Head, Body0, {StdLib, ExLib, Db}, ClauseFun) -> - {Functor, Body} = case catch {ok, ec_support:functor(Head), ec_body:well_form_body(Body0, false, sture)} of + {Functor, Body} = case catch {ok, erlog_ec_support:functor(Head), erlog_ec_body:well_form_body(Body0, false, sture)} of {erlog_error, E} -> erlog_errors:erlog_error(E, Db); {ok, F, B} -> {F, B} end, @@ -221,7 +221,7 @@ check_duplicates(Cs, Head, Body) -> check_immutable(Dict, Functor) -> case dict:is_key(Functor, Dict) of false -> ok; - true -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)) + true -> erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)) end. %% @private diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 050fa82..1f06536 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -197,7 +197,7 @@ listing({_, _, Db}, {[]}) -> %% @private clause(Head, Body0, {StdLib, ExLib, Db}, ClauseFun) -> - {Functor, Body} = case catch {ok, ec_support:functor(Head), ec_body:well_form_body(Body0, false, sture)} of + {Functor, Body} = case catch {ok, erlog_ec_support:functor(Head), erlog_ec_body:well_form_body(Body0, false, sture)} of {erlog_error, E} -> erlog_errors:erlog_error(E, Db); {ok, F, B} -> {F, B} end, @@ -220,7 +220,7 @@ check_duplicates(Cs, Head, Body) -> check_immutable(Dict, Functor) -> %TODO may be move me to erlog_memory? case dict:is_key(Functor, Dict) of false -> ok; - true -> erlog_errors:permission_error(modify, static_procedure, ec_support:pred_ind(Functor)) + true -> erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)) end. %% @private diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 404f35d..b232cf6 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -191,7 +191,7 @@ handle_call({load_kernel_space, {Module, Functor}}, _From, State = #state{stdlib handle_call({load_library_space, {{Functor, M, F}}}, _From, State = #state{stdlib = StdLib, exlib = ExLib}) -> %load library space into memory case dict:is_key(Functor, StdLib) of true -> - {reply, {erlog_error, {modify, static_procedure, ec_support:pred_ind(Functor)}}, State}; + {reply, {erlog_error, {modify, static_procedure, erlog_ec_support:pred_ind(Functor)}}, State}; false -> {reply, ok, State#state{exlib = dict:store(Functor, {code, {M, F}}, ExLib)}} end; From 8d524fa1bc3ec37eed32a48eb40b20f4a66111a7 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 22 Oct 2014 23:29:13 +0000 Subject: [PATCH 175/251] add string library --- include/erlog_string.hrl | 17 +++++++ src/core/erlog.erl | 3 +- .../standard/string/main/erlog_string.erl | 46 +++++++++++++++++++ 3 files changed, 65 insertions(+), 1 deletion(-) create mode 100644 include/erlog_string.hrl create mode 100644 src/libs/standard/string/main/erlog_string.erl diff --git a/include/erlog_string.hrl b/include/erlog_string.hrl new file mode 100644 index 0000000..674ea7b --- /dev/null +++ b/include/erlog_string.hrl @@ -0,0 +1,17 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 22. Окт. 2014 20:56 +%%%------------------------------------------------------------------- +-author("tihon"). + +-define(ERLOG_STRING, + [ + {concat, 2}, + {substring, 4}, + {indexof, 3}, + {split, 3} + ]). \ No newline at end of file diff --git a/src/core/erlog.erl b/src/core/erlog.erl index b84ca63..4288039 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -145,7 +145,8 @@ load_built_in(Database) -> erlog_bips, %Built in predicates erlog_dcg, %DCG predicates erlog_lists, %Common lists library - erlog_time %Bindings for working with data and time + erlog_time, %Bindings for working with data and time + erlog_string %Bindings for working with strings ]). %% @private diff --git a/src/libs/standard/string/main/erlog_string.erl b/src/libs/standard/string/main/erlog_string.erl new file mode 100644 index 0000000..c2d1819 --- /dev/null +++ b/src/libs/standard/string/main/erlog_string.erl @@ -0,0 +1,46 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 22. Окт. 2014 20:54 +%%%------------------------------------------------------------------- +-module(erlog_string). +-author("tihon"). + +-include("erlog_string.hrl"). +-include("erlog_core.hrl"). + +-behaviour(erlog_stdlib). + +%% API +-export([load/1, prove_goal/1]). + +load(Db) -> + lists:foreach(fun(Proc) -> erlog_memory:load_kernel_space(Db, ?MODULE, Proc) end, ?ERLOG_STRING). + +prove_goal(Params = #param{goal = {concat, Strings, Res}, next_goal = Next, bindings = Bs0}) -> + case erlog_ec_support:deref(Strings, Bs0) of + List when is_list(List) -> + Bs1 = erlog_ec_support:add_binding(Res, lists:concat(List), Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); + _ -> erlog_errors:fail(Params) + end; +prove_goal(Params = #param{goal = {substring, _, _, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> + {substring, From, To, Str, Res} = erlog_ec_support:dderef(Goal, Bs0), + Bs1 = erlog_ec_support:add_binding(Res, lists:sublist(Str, From, To - From), Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); +prove_goal(Params = #param{goal = {indexof, _, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> + {indexof, Str1, Str2, Res} = erlog_ec_support:dderef(Goal, Bs0), + case string:str(Str1, Str2) of + 0 -> erlog_errors:fail(Params); + Num -> + Bs1 = erlog_ec_support:add_binding(Res, Num, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}) + end; +prove_goal(Params = #param{goal = {split, _, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> + {split, Str, Del, Res} = erlog_ec_support:dderef(Goal, Bs0), + List = string:tokens(Str, Del), + Bs1 = erlog_ec_support:add_binding(Res, List, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}). \ No newline at end of file From d27551e60d8a6c99e3af174033e10546158c3361 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 25 Oct 2014 01:18:40 +0000 Subject: [PATCH 176/251] add prolog library autoload --- include/erlog_core.hrl | 2 +- lib/autoload/lists.pl | 2 + src/core/erlog.erl | 31 +-- src/core/erlog_file_consulter.erl | 16 ++ src/core/erlog_logic.erl | 10 +- src/core/logic/erlog_ec_core.erl | 6 +- src/io/erlog_file.erl | 12 +- src/io/erlog_io.erl | 248 ++++-------------- src/libs/standard/core/main/erlog_core.erl | 8 +- .../standard/lists/logic/erlog_el_logic.erl | 136 +++++----- src/libs/standard/lists/main/erlog_lists.erl | 83 +++--- .../string/{main => }/erlog_string.erl | 0 12 files changed, 207 insertions(+), 347 deletions(-) create mode 100644 lib/autoload/lists.pl create mode 100644 src/core/erlog_file_consulter.erl rename src/libs/standard/string/{main => }/erlog_string.erl (100%) diff --git a/include/erlog_core.hrl b/include/erlog_core.hrl index a47bd41..b8dae65 100644 --- a/include/erlog_core.hrl +++ b/include/erlog_core.hrl @@ -40,7 +40,7 @@ var_num, database, event_man, - f_consulter, + f_consulter :: atom(), debugger, cursor }). diff --git a/lib/autoload/lists.pl b/lib/autoload/lists.pl new file mode 100644 index 0000000..037c6e1 --- /dev/null +++ b/lib/autoload/lists.pl @@ -0,0 +1,2 @@ +perm([], []). +perm([X|Xs], Ys1) :- perm(Xs, Ys), insert(Ys, X, Ys1). diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 4288039..33f5d1b 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -42,7 +42,7 @@ -record(state, { db :: atom(), %database - f_consulter :: fun(), %file consulter + f_consulter :: atom(), %file consulter debugger :: fun(), %debugger function e_man :: pid(), %event manager, used for debuging and other output (not for return) state = normal :: normal | list() %state for solution selecting. @@ -63,16 +63,11 @@ start_link() -> start_link(Params) -> gen_server:start_link(?MODULE, Params, []). -init([]) -> % use built in database - {ok, Db} = init_database([]), - F = init_consulter([]), - {ok, E} = gen_event:start_link(), - Debugger = init_debugger([]), - gen_event:add_handler(E, erlog_simple_printer, []), %set the default debug module - {ok, #state{db = Db, f_consulter = F, e_man = E, debugger = Debugger}}; init(Params) -> % use custom database implementation FileCon = init_consulter(Params), {ok, Db} = init_database(Params), + LibsDir = proplists:get_value(libs_dir, Params, "../lib"), %default assumes erlog is run from ebin + ok = load_prolog_libraries(FileCon, LibsDir, Db), ok = load_external_libraries(Params, Db), {ok, E} = gen_event:start_link(), Debugger = init_debugger(Params), @@ -131,7 +126,7 @@ init_database(Params) -> %% @private -spec init_consulter(Params :: proplists:proplist()) -> fun() | any(). init_consulter(Params) -> - proplists:get_value(f_consulter, Params, fun erlog_io:read_file/1). %get function from params or default + proplists:get_value(f_consulter, Params, erlog_io). %get consulter module from params or default init_debugger(Params) -> proplists:get_value(debugger, Params, fun(_, _, _) -> ok end). @@ -149,6 +144,12 @@ load_built_in(Database) -> erlog_string %Bindings for working with strings ]). +%% @private +load_prolog_libraries(Fcon, LibsDir, Db) -> + Autoload = Fcon:lookup(LibsDir ++ "/autoload"), + lists:foreach(fun(Lib) -> erlog_file:consult(Fcon, LibsDir ++ "/autoload/" ++ Lib, Db) end, Autoload), + ok. + %% @private load_external_libraries(Params, Database) -> case proplists:get_value(libraries, Params) of @@ -168,8 +169,8 @@ run_command(Command, State) -> %% @private %% Preprocess command -preprocess_command({ok, Command}, State = #state{f_consulter = Fun, db = Db}) when is_list(Command) -> %TODO may be remove me? - case erlog_logic:reconsult_files(Command, Db, Fun) of +preprocess_command({ok, Command}, State = #state{f_consulter = Consulter, db = Db}) when is_list(Command) -> %TODO may be remove me? + case erlog_logic:reconsult_files(Command, Db, Consulter) of ok -> {true, State}; {error, {L, Pm, Pe}} -> @@ -192,8 +193,8 @@ process_command({prove, Goal}, State) -> prove_goal(Goal, State); process_command(next, State = #state{state = normal}) -> % can't select solution, when not in select mode {fail, State}; -process_command(next, State = #state{state = [Vs, Cps], db = Db, f_consulter = Fcon}) -> - case erlog_logic:prove_result(catch erlog_errors:fail(#param{choice = Cps, database = Db, f_consulter = Fcon}), Vs) of +process_command(next, State = #state{state = [Vs, Cps], db = Db, f_consulter = Consulter}) -> + case erlog_logic:prove_result(catch erlog_errors:fail(#param{choice = Cps, database = Db, f_consulter = Consulter}), Vs) of {Atom, Res, Args} -> {{Atom, Res}, State#state{state = Args}}; Other -> {Other, State} end; @@ -202,13 +203,13 @@ process_command(halt, State) -> {ok, State}. %% @private -prove_goal(Goal0, State = #state{db = Db, f_consulter = Fcon, e_man = Event, debugger = Deb}) -> +prove_goal(Goal0, State = #state{db = Db, f_consulter = Consulter, e_man = Event, debugger = Deb}) -> Vs = erlog_logic:vars_in(Goal0), %% Goal may be a list of goals, ensure proper goal. Goal1 = erlog_logic:unlistify(Goal0), %% Must use 'catch' here as 'try' does not do last-call %% optimisation. - case erlog_logic:prove_result(catch erlog_ec_core:prove_goal(Goal1, Db, Fcon, Event, Deb), Vs) of + case erlog_logic:prove_result(catch erlog_ec_core:prove_goal(Goal1, Db, Consulter, Event, Deb), Vs) of {succeed, Res, Args} -> {{succeed, Res}, State#state{state = Args}}; OtherRes -> {OtherRes, State} end. diff --git a/src/core/erlog_file_consulter.erl b/src/core/erlog_file_consulter.erl new file mode 100644 index 0000000..e452a4e --- /dev/null +++ b/src/core/erlog_file_consulter.erl @@ -0,0 +1,16 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 25. Окт. 2014 0:22 +%%%------------------------------------------------------------------- +-module(erlog_file_consulter). +-author("tihon"). + +%% get list of files in directory +-callback lookup(Directory :: string()) -> Files :: list(). + +%% consult selected file +-callback load(FileLoc :: string()) -> ok. diff --git a/src/core/erlog_logic.erl b/src/core/erlog_logic.erl index 5ea6611..3875bf5 100644 --- a/src/core/erlog_logic.erl +++ b/src/core/erlog_logic.erl @@ -38,11 +38,11 @@ prove_result({erlog_error, Error}, _Vs) -> %No new database prove_result({'EXIT', Error}, _Vs) -> {'EXIT', Error}. --spec reconsult_files(list(), pid(), fun()) -> ok | tuple(). -reconsult_files([], _Db, _Fun) -> ok; %TODO lists:foldr instead! -reconsult_files([F | Fs], Db, Fun) -> - case erlog_file:reconsult(Fun, F, Db) of - ok -> reconsult_files(Fs, Db, Fun); +-spec reconsult_files(list(), pid(), atom()) -> ok | tuple(). +reconsult_files([], _, _) -> ok; %TODO lists:foldr instead! +reconsult_files([F | Fs], Db, Consulter) -> + case erlog_file:reconsult(Consulter, F, Db) of + ok -> reconsult_files(Fs, Db, Consulter); {erlog_error, Error} -> {erlog_error, Error}; {error, Error} -> {error, Error} end; diff --git a/src/core/logic/erlog_ec_core.erl b/src/core/logic/erlog_ec_core.erl index fd71c95..991d9fc 100644 --- a/src/core/logic/erlog_ec_core.erl +++ b/src/core/logic/erlog_ec_core.erl @@ -17,15 +17,15 @@ %% prove_goal(Goal, Database) -> Succeed | Fail. %% This is the main entry point into the interpreter. Check that %% everything is consistent then prove the goal as a call. --spec prove_goal(Goal0 :: term(), Db :: pid(), Fcon :: fun(), Event :: pid(), Deb :: fun()) -> term(). -prove_goal(Goal0, Db, Fcon, Event, Deb) -> +-spec prove_goal(Goal0 :: term(), Db :: pid(), Consuter :: atom(), Event :: pid(), Deb :: fun()) -> term(). +prove_goal(Goal0, Db, Consulter, Event, Deb) -> %% put(erlog_cut, orddict:new()), %% put(erlog_cps, orddict:new()), %% put(erlog_var, orddict:new()), %% Check term and build new instance of term with bindings. {Goal1, Bs, Vn} = erlog_ec_logic:initial_goal(Goal0), Params = #param{goal = [{call, Goal1}], choice = [], bindings = Bs, var_num = Vn, - event_man = Event, database = Db, f_consulter = Fcon, debugger = Deb}, + event_man = Event, database = Db, f_consulter = Consulter, debugger = Deb}, erlog_ec_core:prove_body(Params). %TODO use lists:foldr instead! %% prove_body(Body, ChoicePoints, Bindings, VarNum, Database) -> diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index bb67387..fccf9fa 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -27,16 +27,16 @@ %% {ok,NewDatabase} | {error,Error} | {erlog_error,Error}. %% Load/reload an Erlog file into the interpreter. Reloading will %% abolish old definitons of clauses. --spec consult(fun(), File :: string(), Db :: pid()) -> ok | tuple(). -consult(Fun, File, Db) -> - case Fun(File) of %default is erlog_io:read_file/1 +-spec consult(atom(), File :: string(), Db :: pid()) -> ok | tuple(). +consult(Consulter, File, Db) -> + case Consulter:load(File) of %call erlog_file_consulter implementation {ok, Terms} -> consult_terms(fun consult_assert/2, Db, Terms); Error -> Error end. --spec reconsult(fun(), File :: string(), Db :: pid()) -> ok | tuple(). -reconsult(Fun, File, Db) -> - case Fun(File) of %default is erlog_io:read_file/1 +-spec reconsult(atom(), File :: string(), Db :: pid()) -> ok | tuple(). +reconsult(Consulter, File, Db) -> + case Consulter:load(File) of %call erlog_file_consulter implementation {ok, Terms} -> case consult_terms(fun reconsult_assert/2, {Db, []}, Terms) of ok -> ok; diff --git a/src/io/erlog_io.erl b/src/io/erlog_io.erl index 73e8d04..893650e 100644 --- a/src/io/erlog_io.erl +++ b/src/io/erlog_io.erl @@ -28,210 +28,60 @@ -module(erlog_io). --export([scan_file/1, read_file/1, format_error/1, format_error/2]). --export([write/1, write/2, write1/1, writeq/1, writeq/2, writeq1/1, - write_canonical/1, write_canonical/2, write_canonical1/1]). +-behaviour(erlog_file_consulter). --record(ops, {op = false, q = true}). +-export([format_error/1, format_error/2, lookup/1, load/1]). -scan_file(File) -> - case file:open(File, [read]) of - {ok, Fd} -> - try - {ok, scan_stream(Fd, 1)} - catch - throw:Term -> Term; - error:Error -> {error, einval, Error}; - exit:Exit -> {exit, einval, Exit} - after - file:close(Fd) - end; - Error -> Error - end. +-spec lookup(Directory :: string()) -> list(). +lookup(Directory) -> + case file:list_dir(Directory) of + {ok, List} -> List; + {error, enoent} -> [] + end. -scan_stream(Fd, L0) -> - case scan_erlog_term(Fd, '', L0) of - {ok, Toks, L1} -> [Toks | scan_stream(Fd, L1)]; - {error, Error, _} -> throw({error, Error}); - {eof, _} = Eof -> Eof - end. - -%% read_file(FileName) -> {ok,[Term]} | {error,Error}. %% Read a file containing Prolog terms. This has been taken from 'io' %% but cleaned up using try. -read_file(File) -> - case file:open(File, [read]) of - {ok, Fd} -> - try - {ok, read_stream(Fd, 1)} - catch - throw:Term -> Term; - error:Error -> {error, einval, Error}; - exit:Exit -> {exit, einval, Exit} - after - file:close(Fd) - end; - Error -> Error - end. - -read_stream(Fd, L0) -> - case scan_erlog_term(Fd, '', L0) of - {ok, Toks, L1} -> - case erlog_parse:term(Toks, L0) of - {ok, end_of_file} -> []; %Prolog does this. - {ok, Term} -> [Term | read_stream(Fd, L1)]; %TODO recurstion is not tail! - {error, What} -> throw({error, What}) - end; - {error, Error, _} -> throw({error, Error}); - {eof, _} -> [] - end. - -scan_erlog_term(Io, Prompt, Line) -> - io:request(Io, {get_until, Prompt, erlog_scan, tokens, [Line]}). - -%% write([IoDevice], Term) -> ok. -%% writeq([IoDevice], Term) -> ok. -%% write_canonical([IoDevice], Term) -> ok. -%% A very simple write function. Does not pretty-print but can handle -%% operators. The xxx1 verions return an iolist of the characters. -write(T) -> write(standard_io, T). - -write(Io, T) -> io:put_chars(Io, write1(T)). - -write1(T) -> write1(T, 1200, #ops{op = true, q = false}). - -writeq(T) -> writeq(standard_io, T). - -writeq(Io, T) -> io:put_chars(Io, writeq1(T)). - -writeq1(T) -> write1(T, 1200, #ops{op = true, q = true}). - -write_canonical(T) -> write_canonical(standard_io, T). - -write_canonical(Io, T) -> io:put_chars(Io, write_canonical1(T)). - -write_canonical1(T) -> write1(T, 1200, #ops{op = false, q = true}). - -%% write1(Term, Precedence, Ops) -> iolist(). -%% The function which does the actual writing. -write1(T, Prec, Ops) when is_atom(T) -> write1_atom(T, Prec, Ops); -write1(T, _, _) when is_number(T) -> io_lib:write(T); -write1({V}, _, _) when is_integer(V) -> "_" ++ integer_to_list(V); -write1({V}, _, _) -> atom_to_list(V); %Variable -write1([H | T], _, Ops) -> - [$[, write1(H, 999, Ops), write1_tail(T, Ops), $]]; -write1([], _, _) -> "[]"; -write1({F, A}, Prec, #ops{op = true} = Ops) -> - case erlog_parse:prefix_op(F) of - {yes, OpP, ArgP} -> - Out = [write1(F, 1200, Ops), $\s, write1(A, ArgP, Ops)], - write1_prec(Out, OpP, Prec); - no -> - case erlog_parse:postfix_op(F) of - {yes, ArgP, OpP} -> - Out = [write1(A, ArgP, Ops), $\s, write1(F, 1200, Ops)], - write1_prec(Out, OpP, Prec); - no -> - [write1(F, 1200, Ops), $(, write1(A, 999, Ops), $)] - end - end; -write1({',', A1, A2}, Prec, #ops{op = true} = Ops) -> - %% Must special case , here. - Out = [write1(A1, 999, Ops), ", ", write1(A2, 1000, Ops)], - write1_prec(Out, 1000, Prec); -write1({F, A1, A2}, Prec, #ops{op = true} = Ops) -> - case erlog_parse:infix_op(F) of - {yes, Lp, OpP, Rp} -> - Out = [write1(A1, Lp, Ops), $\s, write1(F, 1200, Ops), - $\s, write1(A2, Rp, Ops)], - write1_prec(Out, OpP, Prec); - no -> - [write1(F, 1200, Ops), $(, write1(A1, 999, Ops), - $,, write1(A2, 999, Ops), $)] - end; -write1(T, _, Ops) when is_tuple(T) -> - [F, A1 | As] = tuple_to_list(T), - [write1(F, 1200, Ops), $(, write1(A1, 999, Ops), write1_tail(As, Ops), $)]; -write1(T, _, _) -> %Else use default Erlang. - io_lib:write(T). - -%% write1_prec(OutString, OpPrecedence, Precedence) -> iolist(). -%% Encase OutString with (..) if op precedence higher than -%% precedence. -write1_prec(Out, OpP, Prec) when OpP > Prec -> [$(, Out, $)]; -write1_prec(Out, _, _) -> Out. - -write1_tail([T | Ts], Ops) -> - [$,, write1(T, 999, Ops) | write1_tail(Ts, Ops)]; -write1_tail([], _) -> []; -write1_tail(T, Ops) -> [$|, write1(T, 999, Ops)]. - -write1_atom(A, Prec, #ops{q = false}) -> %No quoting - write1_atom_1(A, atom_to_list(A), Prec); -write1_atom(A, Prec, _) when A == '!'; A == ';' -> %Special atoms - write1_atom_1(A, atom_to_list(A), Prec); -write1_atom(A, Prec, _) -> - case atom_to_list(A) of - [C | Cs] = Acs -> - case (lower_case(C) andalso alpha_chars(Cs)) - orelse symbol_chars(Acs) of - true -> write1_atom_1(A, Acs, Prec); - false -> - Qcs = quote_atom(Acs), - write1_atom_1(A, Qcs, Prec) - end; - [] -> write1_atom_1(A, "''", Prec) - end. - -write1_atom_1(A, Acs, Prec) -> - case erlog_parse:prefix_op(A) of - {yes, OpP, _} when OpP > Prec -> [$(, Acs, $)]; - _ -> - case erlog_parse:postfix_op(A) of - {yes, _, OpP} when OpP > Prec -> [$(, Acs, $)]; - _ -> Acs - end - end. - -quote_atom(Acs) -> [$', Acs, $']. %Very naive as yet. - -symbol_chars(Cs) -> lists:all(fun symbol_char/1, Cs). - -symbol_char($-) -> true; -symbol_char($#) -> true; -symbol_char($$) -> true; -symbol_char($&) -> true; -symbol_char($*) -> true; -symbol_char($+) -> true; -symbol_char($.) -> true; -symbol_char($/) -> true; -symbol_char($\\) -> true; -symbol_char($:) -> true; -symbol_char($<) -> true; -symbol_char($=) -> true; -symbol_char($>) -> true; -symbol_char($?) -> true; -symbol_char($@) -> true; -symbol_char($^) -> true; -symbol_char($~) -> true; -symbol_char(_) -> false. - -lower_case(C) -> (C >= $a) and (C =< $z). - -alpha_chars(Cs) -> lists:all(fun alpha_char/1, Cs). - -alpha_char($_) -> true; -alpha_char(C) when C >= $A, C =< $Z -> true; -alpha_char(C) when C >= $0, C =< $9 -> true; -alpha_char(C) -> lower_case(C). +-spec load(File :: string()) -> {ok, [Term :: term()]} | {error, Error :: term()}. +load(File) -> + case file:open(File, [read]) of + {ok, Fd} -> + try + {ok, read_stream(Fd, 1)} + catch + throw:Term -> Term; + error:Error -> {error, einval, Error}; + exit:Exit -> {exit, einval, Exit} + after + file:close(Fd) + end; + Error -> Error + end. format_error(Params) -> format_error("Error", Params). format_error(Type, Params) -> - B = lists:foldr( - fun(Param, Acc) when is_list(Param) -> - [Param | Acc]; - (Param, Acc) -> - [io_lib:format("~p", [Param]) | Acc] - end, ["\n"], [Type | Params]), - S = string:join(B, ": "), - lists:flatten(S). + B = lists:foldr( + fun(Param, Acc) when is_list(Param) -> + [Param | Acc]; + (Param, Acc) -> + [io_lib:format("~p", [Param]) | Acc] + end, ["\n"], [Type | Params]), + S = string:join(B, ": "), + lists:flatten(S). + + +%% @private +read_stream(Fd, L0) -> + case scan_erlog_term(Fd, '', L0) of + {ok, Toks, L1} -> + case erlog_parse:term(Toks, L0) of + {ok, end_of_file} -> []; %Prolog does this. + {ok, Term} -> [Term | read_stream(Fd, L1)]; %TODO recurstion is not tail! + {error, What} -> throw({error, What}) + end; + {error, Error, _} -> throw({error, Error}); + {eof, _} -> [] + end. + +%% @private +scan_erlog_term(Io, Prompt, Line) -> + io:request(Io, {get_until, Prompt, erlog_scan, tokens, [Line]}). \ No newline at end of file diff --git a/src/libs/standard/core/main/erlog_core.erl b/src/libs/standard/core/main/erlog_core.erl index d09cce3..9b60d39 100644 --- a/src/libs/standard/core/main/erlog_core.erl +++ b/src/libs/standard/core/main/erlog_core.erl @@ -132,15 +132,15 @@ prove_goal(Param = #param{goal = {writeln, T}, next_goal = Next, bindings = Bs, gen_event:notify(Evman, Res), erlog_ec_core:prove_body(Param#param{goal = Next}); %% File utils -prove_goal(Param = #param{goal = {consult, Name}, next_goal = Next, bindings = Bs, f_consulter = Fcon, database = Db}) -> - case erlog_file:consult(Fcon, erlog_ec_support:dderef(Name, Bs), Db) of +prove_goal(Param = #param{goal = {consult, Name}, next_goal = Next, bindings = Bs, f_consulter = Consulter, database = Db}) -> + case erlog_file:consult(Consulter, erlog_ec_support:dderef(Name, Bs), Db) of ok -> ok; {Err, Error} when Err == erlog_error; Err == error -> erlog_errors:erlog_error(Error, Db) end, erlog_ec_core:prove_body(Param#param{goal = Next}); -prove_goal(Param = #param{goal = {reconsult, Name}, next_goal = Next, f_consulter = Fcon, database = Db}) -> - case erlog_file:reconsult(Fcon, Name, Db) of +prove_goal(Param = #param{goal = {reconsult, Name}, next_goal = Next, f_consulter = Consulter, database = Db}) -> + case erlog_file:reconsult(Consulter, Name, Db) of ok -> ok; {Err, Error} when Err == erlog_error; Err == error -> erlog_errors:erlog_error(Error, Db) diff --git a/src/libs/standard/lists/logic/erlog_el_logic.erl b/src/libs/standard/lists/logic/erlog_el_logic.erl index 0fe5530..49f326e 100644 --- a/src/libs/standard/lists/logic/erlog_el_logic.erl +++ b/src/libs/standard/lists/logic/erlog_el_logic.erl @@ -13,40 +13,40 @@ %% API -export([fail_append/5, - fail_insert/5, - fail_member/4, - memberchk/2, - insert/1, - reverse/2]). + fail_insert/5, + fail_member/4, + memberchk/2, + insert/1, + reverse/2]). -insert(Params = #param{goal = {insert, A1, A2, A3}, next_goal = Next, bindings = Bs, choice = Cps, var_num = Vn, f_consulter = Fcon}) -> - FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed - erlog_el_logic:fail_insert(LCp, Params#param{choice = LCps, database = LDb, f_consulter = Fcon}, A1, A2, A3) - end, - Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, - erlog_ec_body:unify_prove_body(A3, [A2 | A1], Params#param{choice = [Cp | Cps]}). +insert(Params = #param{goal = {insert, A1, A2, A3}, next_goal = Next, bindings = Bs, choice = Cps, var_num = Vn}) -> + FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed + erlog_el_logic:fail_insert(LCp, Params#param{choice = LCps, database = LDb}, A1, A2, A3) + end, + Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, + erlog_ec_body:unify_prove_body(A3, [A2 | A1], Params#param{choice = [Cp | Cps]}). fail_append(#cp{next = Next0, bs = Bs0, vn = Vn}, Params, A1, L, A3) -> - H = {Vn}, - T = {Vn + 1}, - L1 = {Vn + 2}, - Bs1 = erlog_ec_support:add_binding(A1, [H | T], Bs0), %A1 always a variable here. - Next1 = [{append, T, L, L1} | Next0], - erlog_ec_body:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs1, - var_num = Vn + 3}). + H = {Vn}, + T = {Vn + 1}, + L1 = {Vn + 2}, + Bs1 = erlog_ec_support:add_binding(A1, [H | T], Bs0), %A1 always a variable here. + Next1 = [{append, T, L, L1} | Next0], + erlog_ec_body:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs1, + var_num = Vn + 3}). fail_insert(#cp{next = Next0, bs = Bs, vn = Vn}, Params, A1, X, A3) -> - H = {Vn}, - L = {Vn + 1}, - L1 = {Vn + 2}, - Next1 = [{insert, L, X, L1} | Next0], - erlog_ec_body:unify_prove_body(A1, [H | L], A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 3}). + H = {Vn}, + L = {Vn + 1}, + L1 = {Vn + 2}, + Next1 = [{insert, L, X, L1} | Next0], + erlog_ec_body:unify_prove_body(A1, [H | L], A3, [H | L1], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 3}). fail_member(#cp{next = Next0, bs = Bs, vn = Vn}, Params, A1, A2) -> - H = {Vn}, - T = {Vn + 1}, - Next1 = [{member, A1, T} | Next0], - erlog_ec_body:unify_prove_body(A2, [H | T], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 2}). + H = {Vn}, + T = {Vn + 1}, + Next1 = [{member, A1, T} | Next0], + erlog_ec_body:unify_prove_body(A2, [H | T], Params#param{next_goal = Next1, bindings = Bs, var_num = Vn + 2}). %% memberchk_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% memberchk(X, [X|_]) :- !. @@ -54,53 +54,53 @@ fail_member(#cp{next = Next0, bs = Bs, vn = Vn}, Params, A1, A2) -> %% We don't build the list and we never backtrack so we can be smart %% and match directly. Should we give a type error? memberchk({memberchk, A1, A2}, Params = #param{next_goal = Next, bindings = Bs0}) -> - case erlog_ec_support:deref(A2, Bs0) of - [H | T] -> - case erlog_ec_unify:unify(A1, H, Bs0) of - {succeed, Bs1} -> - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); - fail -> - memberchk({memberchk, A1, T}, Params) - end; - {_} -> erlog_errors:instantiation_error(); - _ -> erlog_errors:fail(Params) - end. + case erlog_ec_support:deref(A2, Bs0) of + [H | T] -> + case erlog_ec_unify:unify(A1, H, Bs0) of + {succeed, Bs1} -> + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); + fail -> + memberchk({memberchk, A1, T}, Params) + end; + {_} -> erlog_errors:instantiation_error(); + _ -> erlog_errors:fail(Params) + end. %% reverse_2(Head, NextGoal, Choicepoints, Bindings, VarNum, Database) -> void. %% reverse([], []). %% reverse([H|L1], L) :- reverse(L1, L2), append(L2, [H], L). %% Here we attempt to compile indexing in the first argument. reverse({reverse, A1, A2}, Params = #param{next_goal = Next0, bindings = Bs0, choice = Cps, var_num = Vn}) -> - case erlog_ec_support:deref(A1, Bs0) of - [] -> - erlog_ec_body:unify_prove_body(A2, [], Params); - [H | T] -> - L = {Vn}, - L1 = A2, - %% Naive straight expansion of body. - %%Next1 = [{reverse,T,L},{append,L,[H],L1}|Next0], - %%prove_body(Next1, Cps, Bs0, Vn+1, Db); - %% Smarter direct calling of local function. - Next1 = [{append, L, [H], L1} | Next0], - reverse({reverse, T, L}, Params#param{next_goal = Next1, var_num = Vn + 1}); - {_} = Var -> - FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed - fail_reverse(LCp, Params#param{choice = LCps, database = LDb}, Var, A2) - end, - Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, - Bs1 = erlog_ec_support:add_binding(Var, [], Bs0), - erlog_ec_body:unify_prove_body(A2, [], Params#param{choice = [Cp | Cps], bindings = Bs1}); - _ -> erlog_errors:fail(Params) %Will fail here! - end. + case erlog_ec_support:deref(A1, Bs0) of + [] -> + erlog_ec_body:unify_prove_body(A2, [], Params); + [H | T] -> + L = {Vn}, + L1 = A2, + %% Naive straight expansion of body. + %%Next1 = [{reverse,T,L},{append,L,[H],L1}|Next0], + %%prove_body(Next1, Cps, Bs0, Vn+1, Db); + %% Smarter direct calling of local function. + Next1 = [{append, L, [H], L1} | Next0], + reverse({reverse, T, L}, Params#param{next_goal = Next1, var_num = Vn + 1}); + {_} = Var -> + FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed + fail_reverse(LCp, Params#param{choice = LCps, database = LDb}, Var, A2) + end, + Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, + Bs1 = erlog_ec_support:add_binding(Var, [], Bs0), + erlog_ec_body:unify_prove_body(A2, [], Params#param{choice = [Cp | Cps], bindings = Bs1}); + _ -> erlog_errors:fail(Params) %Will fail here! + end. %% @private fail_reverse(#cp{next = Next, bs = Bs0, vn = Vn}, Params, A1, A2) -> - H = {Vn}, - T = {Vn + 1}, - L1 = A2, - L = {Vn + 2}, - Bs1 = erlog_ec_support:add_binding(A1, [H | T], Bs0), - %%Next1 = [{reverse,T,L},{apperse,L,[H],L1}|Next], - %%prove_body(Next1, Cps, Bs1, Vn+3, Db). - Next1 = [{append, L, [H], L1} | Next], - reverse({reverse, T, L}, Params#param{next_goal = Next1, bindings = Bs1, var_num = Vn + 3}). \ No newline at end of file + H = {Vn}, + T = {Vn + 1}, + L1 = A2, + L = {Vn + 2}, + Bs1 = erlog_ec_support:add_binding(A1, [H | T], Bs0), + %%Next1 = [{reverse,T,L},{apperse,L,[H],L1}|Next], + %%prove_body(Next1, Cps, Bs1, Vn+3, Db). + Next1 = [{append, L, [H], L1} | Next], + reverse({reverse, T, L}, Params#param{next_goal = Next1, bindings = Bs1, var_num = Vn + 3}). \ No newline at end of file diff --git a/src/libs/standard/lists/main/erlog_lists.erl b/src/libs/standard/lists/main/erlog_lists.erl index b11f45c..4a2975e 100644 --- a/src/libs/standard/lists/main/erlog_lists.erl +++ b/src/libs/standard/lists/main/erlog_lists.erl @@ -35,60 +35,51 @@ %% load(Database) -> Database. %% Assert predicates into the database. load(Db) -> - lists:foreach(fun(Proc) -> erlog_memory:load_kernel_space(Db, ?MODULE, Proc) end, ?ERLOG_LISTS), - %% Finally interpreted common list library. - lists:foreach(fun(Clause) -> erlog_memory:assertz_clause(Db, Clause) end, %TODO change me to kernelspace - [ - %% perm([], []). - %% perm([X|Xs], Ys1) :- perm(Xs, Ys), insert(Ys, X, Ys1). - {perm, [], []}, - {':-', {perm, [{1} | {2}], {3}}, {',', {perm, {2}, {4}}, {insert, {4}, {1}, {3}}}} - ]). + lists:foreach(fun(Proc) -> erlog_memory:load_kernel_space(Db, ?MODULE, Proc) end, ?ERLOG_LISTS). prove_goal(Params = #param{goal = {length, ListVar, Len}, next_goal = Next, bindings = Bs0}) -> - case erlog_ec_support:deref(ListVar, Bs0) of - List when is_list(List) -> - Bs1 = erlog_ec_support:add_binding(Len, length(List), Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); - _ -> erlog_errors:fail(Params) - end; -prove_goal(Params = #param{goal = {append, A1, L, A3}, next_goal = Next0, bindings = Bs0, choice = Cps, - var_num = Vn, f_consulter = Fcon}) -> - case erlog_ec_support:deref(A1, Bs0) of - [] -> %Cannot backtrack - erlog_ec_body:unify_prove_body(L, A3, Params); - [H | T] -> %Cannot backtrack - L1 = {Vn}, - Next1 = [{append, T, L, L1} | Next0], - erlog_ec_body:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, var_num = Vn + 1}); - {_} = Var -> %This can backtrack - FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed - erlog_el_logic:fail_append(LCp, Params#param{choice = LCps, database = LDb, f_consulter = Fcon}, Var, L, A3) - end, - Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, - Bs1 = erlog_ec_support:add_binding(Var, [], Bs0), - erlog_ec_body:unify_prove_body(L, A3, Params#param{choice = [Cp | Cps], bindings = Bs1}); - _ -> erlog_errors:fail(Params) %Will fail here! - end; + case erlog_ec_support:deref(ListVar, Bs0) of + List when is_list(List) -> + Bs1 = erlog_ec_support:add_binding(Len, length(List), Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); + _ -> erlog_errors:fail(Params) + end; +prove_goal(Params = #param{goal = {append, A1, L, A3}, next_goal = Next0, bindings = Bs0, choice = Cps, var_num = Vn}) -> + case erlog_ec_support:deref(A1, Bs0) of + [] -> %Cannot backtrack + erlog_ec_body:unify_prove_body(L, A3, Params); + [H | T] -> %Cannot backtrack + L1 = {Vn}, + Next1 = [{append, T, L, L1} | Next0], + erlog_ec_body:unify_prove_body(A3, [H | L1], Params#param{next_goal = Next1, var_num = Vn + 1}); + {_} = Var -> %This can backtrack + FailFun = fun(LCp, LCps, LDb) -> %TODO db not needed + erlog_el_logic:fail_append(LCp, Params#param{choice = LCps, database = LDb}, Var, L, A3) + end, + Cp = #cp{type = compiled, data = FailFun, next = Next0, bs = Bs0, vn = Vn}, + Bs1 = erlog_ec_support:add_binding(Var, [], Bs0), + erlog_ec_body:unify_prove_body(L, A3, Params#param{choice = [Cp | Cps], bindings = Bs1}); + _ -> erlog_errors:fail(Params) %Will fail here! + end; prove_goal(Params = #param{goal = {insert, _, _, _}}) -> - erlog_el_logic:insert(Params); + erlog_el_logic:insert(Params); prove_goal(Params = #param{goal = {delete, A, B, C}}) -> - erlog_el_logic:insert(Params#param{goal = {insert, C, B, A}}); + erlog_el_logic:insert(Params#param{goal = {insert, C, B, A}}); prove_goal(Params = #param{goal = {member, A1, A2}, next_goal = Next, bindings = Bs, choice = Cps, var_num = Vn}) -> - FailFun = fun(LCp, LCps, LDb) -> - erlog_el_logic:fail_member(LCp, Params#param{choice = LCps, database = LDb}, A1, A2) - end, - Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, - T = {Vn}, - erlog_ec_body:unify_prove_body(A2, [A1 | T], Params#param{choice = [Cp | Cps], var_num = Vn + 1}); + FailFun = fun(LCp, LCps, LDb) -> + erlog_el_logic:fail_member(LCp, Params#param{choice = LCps, database = LDb}, A1, A2) + end, + Cp = #cp{type = compiled, data = FailFun, next = Next, bs = Bs, vn = Vn}, + T = {Vn}, + erlog_ec_body:unify_prove_body(A2, [A1 | T], Params#param{choice = [Cp | Cps], var_num = Vn + 1}); prove_goal(Params = #param{goal = {memberchk, A1, A2}}) -> - erlog_el_logic:memberchk({memberchk, A1, A2}, Params); + erlog_el_logic:memberchk({memberchk, A1, A2}, Params); prove_goal(Params = #param{goal = {sort, L0, S}, bindings = Bs}) -> - %% This may throw an erlog error, we don't catch it here. - L1 = lists:usort(erlog_ec_support:dderef_list(L0, Bs)), - erlog_ec_body:unify_prove_body(S, L1, Params); + %% This may throw an erlog error, we don't catch it here. + L1 = lists:usort(erlog_ec_support:dderef_list(L0, Bs)), + erlog_ec_body:unify_prove_body(S, L1, Params); %% reverse([], []). %% reverse([H|L1], L) :- reverse(L1, L2), append(L2, [H], L). %% Here we attempt to compile indexing in the first argument. prove_goal(Params = #param{goal = {reverse, A1, A2}}) -> - erlog_el_logic:reverse({reverse, A1, A2}, Params). \ No newline at end of file + erlog_el_logic:reverse({reverse, A1, A2}, Params). \ No newline at end of file diff --git a/src/libs/standard/string/main/erlog_string.erl b/src/libs/standard/string/erlog_string.erl similarity index 100% rename from src/libs/standard/string/main/erlog_string.erl rename to src/libs/standard/string/erlog_string.erl From 0fe5b99c4df7248b3260a5591bcd36d5246dddd3 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 25 Oct 2014 03:27:19 +0000 Subject: [PATCH 177/251] moved prolog libraries to userspace --- README.md | 37 ++++++++++---- doc/libraries.md | 8 ++- include/erlog_core.hrl | 3 +- src/core/erlog.erl | 22 ++++---- src/core/logic/erlog_ec_core.erl | 8 +-- src/io/erlog_file.erl | 26 +++++++++- src/libs/external/cache/erlog_cache.erl | 2 +- src/libs/external/db/erlog_db.erl | 2 +- src/libs/standard/core/main/erlog_core.erl | 7 ++- src/storage/erlog_dict.erl | 40 ++++++--------- src/storage/erlog_ets.erl | 37 +++++--------- src/storage/erlog_memory.erl | 59 +++++++++++++++++----- src/storage/erlog_storage.erl | 2 - 13 files changed, 158 insertions(+), 95 deletions(-) diff --git a/README.md b/README.md index 1f25ad4..c8abea3 100644 --- a/README.md +++ b/README.md @@ -89,27 +89,31 @@ Erlog also supports calling `consult/1` and `reconsult/1` from prolog code: __Remember!__ For proper consulting files with default consulter, files should end with empty line! #### Custom file consulter: -Basic file consulting takes `FileName` as argument and loads file from your filesystem. -But if your production-system needs to consult files from database, of shared filesystem, or something else - you can create -your own function for consulting files and pass it to erlog. -Just add your function to configuration list as __f_consulter__: - - F = fun(Filename) -> my_hadoop_server:get_file(Filename) end, - ConfList = [{f_consulter, F}], +File consulter is a module, used to operate with files. It's behaviour is described in `erlog_file_consulter`. It should +implement two functions: `lookup` and `load`. Lookup returns list of all prolog libraries from selected directory and load +reads selected file and parse it to prolog terms. +Default implementation use files and directories for libraries search and loading. If you implement your own file consulter, +f.e. if you use database filesystem or smth else - implement `erlog_file_consulter` behaviour in your module and pass its +name in erlog configuration as __f_consulter__: + + ConfList = [{f_consulter, my_hadoop_consulter}], erlog:start_link(ConfList). #### Custom debugger handler: If you wan't to use functions from debug library - you should define your own gen_event handler and pass it to erlog. All debug events from such debug functions as `writeln/1` will be passed there. -See `erlog_simple_printer` as a default implementation of console printer as an example, or `erlog_remote_eh`, which is intended to print debug to remote client. +See `erlog_simple_printer` as a default implementation of console printer as an example, or `erlog_remote_eh`, which is +intended to print debug to remote client. To configure your gen_event module - just pass module and arguments as __event_h__ in configuration: ConfList = [{event_h, {my_event_handler, Args}}], erlog:start_link(ConfList). #### Working with libraries: -Erlog is implemented in erlang modules, called libraries. They can be standard and external. -All predicates from standard functions are loaded to memory when you start erlog core. +Erlog supports two kinds of libraries: native (written in Erlang) and extended (written in Prolog). Native libraries can +be standard and external. +All predicates from standard libraries are loaded to memory when you start erlog core. +All prolog libraries from `lib/autoload` are also loaded to memory when you start erlog core. ##### Manual loading external libraries But to use predicates from external functions - you should manually load them to memory with the help of `use/1` command: @@ -131,4 +135,15 @@ remember, that two execution requests can be processed on different erlog instan In this example system erlog gen server is created one per one separate command (F.e. http request). Firstly - library `some_lib` is loaded. Than erlog server with loaded library is destroyed (as request is complete) and for another request `some_lib_fun(some_val)` another erlog server is created, but, without loaded library. -More in [docs](https://github.com/comtihon/erlog/blob/master/doc/libraries.md "libraries"). \ No newline at end of file +More in [docs](https://github.com/comtihon/erlog/blob/master/doc/libraries.md "libraries"). +##### Loading Prolog libraries +When configuring erlog you should set default library directory as __libs_dir__: + + ConfList = [{libs_dir, "/usr/share/prolog/lib/"}], + erlog:start_link(ConfList). +If you don't set this - erlog will use `../lib` directory, assuming it was run from `ebin`. +For manual loading prolog library - also try `use`, but instead of __atom__ name call it with __string__ library name: + + use(erlog_cache). %use extended native library + use("proc/cuda/driver.pl"). %use prolog library, from /usr/share/prolog/lib/proc/cuda/ +__Important!__ To avoid `erlog_parse,{operator_expected,'.'}` error - sure, that last character in your prolog file is `\n`. \ No newline at end of file diff --git a/doc/libraries.md b/doc/libraries.md index 02b9f66..77ce0a2 100644 --- a/doc/libraries.md +++ b/doc/libraries.md @@ -59,4 +59,10 @@ _File `erlog_uid.erl`_ id_1(Params = #param{goal = {id, Res}, next_goal = Next, bindings = Bs0}) -> Bs = ec_support:add_binding(Res, binary_to_list(uuid:generate()), Bs0), - ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). \ No newline at end of file + ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). + +### Prolog libraries +You can also write prolog libraries, which you can load manually of automatically. All this libraries will be loaded to +library space. For automatic loading libraries - move them to `lib/autoload` directory. +Note, that if you create a functor in prolog library and load this library - you won't create same functor in userspace with +the help of `assert`. Also - if you have same functors in different libraries - they will be rewritten by last loaded. \ No newline at end of file diff --git a/include/erlog_core.hrl b/include/erlog_core.hrl index b8dae65..4dcf51f 100644 --- a/include/erlog_core.hrl +++ b/include/erlog_core.hrl @@ -42,7 +42,8 @@ event_man, f_consulter :: atom(), debugger, - cursor + cursor, + libs_dir }). -define(ERLOG_CORE, diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 33f5d1b..dbaf524 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -45,7 +45,8 @@ f_consulter :: atom(), %file consulter debugger :: fun(), %debugger function e_man :: pid(), %event manager, used for debuging and other output (not for return) - state = normal :: normal | list() %state for solution selecting. + state = normal :: normal | list(), %state for solution selecting. + libs_dir :: string() %path for directory, where prolog libs are stored }). execute(Worker, Command, undefined) -> execute(Worker, Command); @@ -75,7 +76,7 @@ init(Params) -> % use custom database implementation undefined -> ok; {Module, Arguments} -> gen_event:add_handler(E, Module, Arguments) end, - {ok, #state{db = Db, f_consulter = FileCon, e_man = E, debugger = Debugger}}. + {ok, #state{db = Db, f_consulter = FileCon, e_man = E, debugger = Debugger, libs_dir = LibsDir}}. handle_call({execute, Command}, _From, State) -> %running prolog code in normal mode {Res, _} = Repl = case erlog_scan:tokens([], Command, 1) of @@ -114,12 +115,9 @@ change_state({_, State}) -> State#state{state = normal}. %% Configurates database with arguments, populates it and returns. -spec init_database(Params :: proplists:proplist()) -> {ok, Pid :: pid()}. init_database(Params) -> - {ok, DbPid} = case proplists:get_value(database, Params) of - undefined -> erlog_memory:start_link(erlog_dict); %default database is ets module - Module -> - Args = proplists:get_value(arguments, Params), - erlog_memory:start_link(Module, Args) - end, + Module = proplists:get_value(database, Params, erlog_dict), %default database is dict module + Args = proplists:get_value(arguments, Params, []), + {ok, DbPid} = erlog_memory:start_link(Module, Args), load_built_in(DbPid), {ok, DbPid}. @@ -193,8 +191,8 @@ process_command({prove, Goal}, State) -> prove_goal(Goal, State); process_command(next, State = #state{state = normal}) -> % can't select solution, when not in select mode {fail, State}; -process_command(next, State = #state{state = [Vs, Cps], db = Db, f_consulter = Consulter}) -> - case erlog_logic:prove_result(catch erlog_errors:fail(#param{choice = Cps, database = Db, f_consulter = Consulter}), Vs) of +process_command(next, State = #state{state = [Vs, Cps], db = Db, f_consulter = Consulter, libs_dir = LD}) -> + case erlog_logic:prove_result(catch erlog_errors:fail(#param{choice = Cps, database = Db, f_consulter = Consulter, libs_dir = LD}), Vs) of {Atom, Res, Args} -> {{Atom, Res}, State#state{state = Args}}; Other -> {Other, State} end; @@ -203,13 +201,13 @@ process_command(halt, State) -> {ok, State}. %% @private -prove_goal(Goal0, State = #state{db = Db, f_consulter = Consulter, e_man = Event, debugger = Deb}) -> +prove_goal(Goal0, State = #state{db = Db, f_consulter = Consulter, e_man = Event, debugger = Deb, libs_dir = LD}) -> Vs = erlog_logic:vars_in(Goal0), %% Goal may be a list of goals, ensure proper goal. Goal1 = erlog_logic:unlistify(Goal0), %% Must use 'catch' here as 'try' does not do last-call %% optimisation. - case erlog_logic:prove_result(catch erlog_ec_core:prove_goal(Goal1, Db, Consulter, Event, Deb), Vs) of + case erlog_logic:prove_result(catch erlog_ec_core:prove_goal(Goal1, Db, Consulter, Event, Deb, LD), Vs) of {succeed, Res, Args} -> {{succeed, Res}, State#state{state = Args}}; OtherRes -> {OtherRes, State} end. diff --git a/src/core/logic/erlog_ec_core.erl b/src/core/logic/erlog_ec_core.erl index 991d9fc..5521624 100644 --- a/src/core/logic/erlog_ec_core.erl +++ b/src/core/logic/erlog_ec_core.erl @@ -12,20 +12,20 @@ -include("erlog_core.hrl"). %% API --export([prove_body/1, prove_goal/1, prove_goal/5, prove_goal_clauses/2, run_n_close/2]). +-export([prove_body/1, prove_goal/1, prove_goal/6, prove_goal_clauses/2, run_n_close/2]). %% prove_goal(Goal, Database) -> Succeed | Fail. %% This is the main entry point into the interpreter. Check that %% everything is consistent then prove the goal as a call. --spec prove_goal(Goal0 :: term(), Db :: pid(), Consuter :: atom(), Event :: pid(), Deb :: fun()) -> term(). -prove_goal(Goal0, Db, Consulter, Event, Deb) -> +-spec prove_goal(Goal0 :: term(), Db :: pid(), Consuter :: atom(), Event :: pid(), Deb :: fun(), LibsDir :: string()) -> term(). +prove_goal(Goal0, Db, Consulter, Event, Deb, LibsDir) -> %% put(erlog_cut, orddict:new()), %% put(erlog_cps, orddict:new()), %% put(erlog_var, orddict:new()), %% Check term and build new instance of term with bindings. {Goal1, Bs, Vn} = erlog_ec_logic:initial_goal(Goal0), Params = #param{goal = [{call, Goal1}], choice = [], bindings = Bs, var_num = Vn, - event_man = Event, database = Db, f_consulter = Consulter, debugger = Deb}, + event_man = Event, database = Db, f_consulter = Consulter, debugger = Deb, libs_dir = LibsDir}, erlog_ec_core:prove_body(Params). %TODO use lists:foldr instead! %% prove_body(Body, ChoicePoints, Bindings, VarNum, Database) -> diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index fccf9fa..fbd297b 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -18,7 +18,7 @@ -module(erlog_file). --export([consult/3, reconsult/3]). +-export([consult/3, reconsult/3, load_library/3]). %% consult(File, Database) -> @@ -34,6 +34,14 @@ consult(Consulter, File, Db) -> Error -> Error end. +%% consult to library space +-spec load_library(atom(), File :: string(), Db :: pid()) -> ok | tuple(). +load_library(Consulter, File, Db) -> + case Consulter:load(File) of %call erlog_file_consulter implementation + {ok, Terms} -> consult_terms(fun consult_lib/2, Db, Terms); + Error -> Error + end. + -spec reconsult(atom(), File :: string(), Db :: pid()) -> ok | tuple(). reconsult(Consulter, File, Db) -> case Consulter:load(File) of %call erlog_file_consulter implementation @@ -52,6 +60,14 @@ consult_assert(Term0, Db) -> check_assert(Db, Term1), {ok, Db}. %TODO refactor consult_terms not to pass DB everywhere! +%% @private +-spec consult_lib(Term0 :: term(), Db :: pid()) -> {ok, Db :: pid()}. +consult_lib(Term0, Db) -> + Term1 = erlog_ed_logic:expand_term(Term0), + check_load(Db, Term1), + {ok, Db}. + + %% @private -spec reconsult_assert(Term0 :: term(), {Db :: pid(), Seen :: list()}) -> {ok, {Db :: pid(), list()}}. reconsult_assert(Term0, {Db, Seen}) -> @@ -96,6 +112,14 @@ check_assert(Db, Term) -> _ -> ok end. +%% @private +%% Same as check assert, but use library space +check_load(Db, Term) -> + case erlog_memory:load_extended_library(Db, Term) of + {erlog_error, E} -> erlog_errors:erlog_error(E); + _ -> ok + end. + %% @private check_abolish(Db, Term) -> case erlog_memory:abolish_clauses(Db, Term) of diff --git a/src/libs/external/cache/erlog_cache.erl b/src/libs/external/cache/erlog_cache.erl index dd8276e..97273da 100644 --- a/src/libs/external/cache/erlog_cache.erl +++ b/src/libs/external/cache/erlog_cache.erl @@ -27,7 +27,7 @@ load(Db) -> put(erlog_cache, Ets); _ -> ok end, - lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_CACHE). + lists:foreach(fun(Proc) -> erlog_memory:load_native_library(Db, Proc) end, ?ERLOG_CACHE). put_2(Params = #param{goal = {put, _, _} = Goal, next_goal = Next, bindings = Bs}) -> {put, Key, Value} = erlog_ec_support:dderef(Goal, Bs), diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index dd4e0b7..239bdeb 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -28,7 +28,7 @@ db_listing_4/1]). load(Db) -> - lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_DB). + lists:foreach(fun(Proc) -> erlog_memory:load_native_library(Db, Proc) end, ?ERLOG_DB). db_call_2(Param = #param{goal = {db_call, _, _} = Goal, next_goal = Next0, bindings = Bs, database = Db}) -> {db_call, Table, G} = erlog_ec_support:dderef(Goal, Bs), diff --git a/src/libs/standard/core/main/erlog_core.erl b/src/libs/standard/core/main/erlog_core.erl index 9b60d39..52b7f9d 100644 --- a/src/libs/standard/core/main/erlog_core.erl +++ b/src/libs/standard/core/main/erlog_core.erl @@ -146,13 +146,18 @@ prove_goal(Param = #param{goal = {reconsult, Name}, next_goal = Next, f_consulte erlog_errors:erlog_error(Error, Db) end, erlog_ec_core:prove_body(Param#param{goal = Next}); -prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db}) -> +prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db}) when is_atom(Library) -> try Library:load(Db) catch _:Error -> erlog_errors:erlog_error(Error, Db) end, erlog_ec_core:prove_body(Param#param{goal = Next}); +prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db, f_consulter = Consulter, libs_dir = LD}) when is_list(Library) -> + case erlog_file:load_library(Consulter, lists:concat([LD, "/", Library]), Db) of + ok -> erlog_ec_core:prove_body(Param#param{goal = Next}); + _ -> erlog_errors:fail(Param) + end; prove_goal(Param = #param{goal = {listing, Res}, next_goal = Next, bindings = Bs0, database = Db}) -> Content = erlog_memory:listing(Db, []), Bs = erlog_ec_support:add_binding(Res, Content, Bs0), diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 2e964b1..198d7e3 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -14,7 +14,7 @@ -behaviour(erlog_storage). %% erlog callbacks --export([new/0, new/1, +-export([new/1, assertz_clause/2, asserta_clause/2, retract_clause/2, @@ -27,8 +27,6 @@ close/2, next/2]). -new() -> {ok, dict:new()}. - new(_) -> {ok, dict:new()}. assertz_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> @@ -70,9 +68,7 @@ retract_clause({StdLib, ExLib, Db}, {Collection, Functor, Ct}) -> {Res, Udict} = retract_clause({StdLib, ExLib, Dict}, {Functor, Ct}), erlog_db_storage:update_db(Collection, Udict), {Res, Db}; -retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> - ok = check_immutable(StdLib, Functor), - ok = check_immutable(ExLib, Functor), +retract_clause({_, _, Db}, {Functor, Ct}) -> Udb = case dict:is_key(Functor, Db) of true -> dict:update(Functor, fun(Old) -> lists:keydelete(Ct, 1, Old) end, [], Db); @@ -85,8 +81,7 @@ abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> {Res, Udict} = abolish_clauses({StdLib, ExLib, Dict}, {Functor}), erlog_db_storage:update_db(Collection, Udict), {Res, Db}; -abolish_clauses({StdLib, _, Db}, {Functor}) -> - ok = check_immutable(StdLib, Functor), +abolish_clauses({_, _, Db}, {Functor}) -> Udb = case dict:is_key(Functor, Db) of true -> dict:erase(Functor, Db); false -> Db %Do nothing @@ -103,8 +98,8 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call error -> case dict:find(Functor, Dict) of %search userspace last {ok, Cs} -> - {First, Cursor} = form_clauses(Cs), %TODO fix bagof, possibly broken by return format - {{cursor, Cursor, result, {clauses, First}}, Db}; + Res = work_with_clauses(Cs), %TODO fix bagof, possibly broken by return format + {Res, Db}; error -> {[], Db} end end @@ -138,17 +133,18 @@ get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> {Res, Udict} = get_procedure({StdLib, ExLib, Dict}, {Functor}), erlog_db_storage:update_db(Collection, Udict), {Res, Db}; -get_procedure({StdLib, ExLib, Db}, {Functor}) -> +get_procedure({StdLib, ExLib, Db}, {Functor}) -> %TODO move all operations with stdlib and exlib to erlog_memory! Res = case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> StFun; error -> case dict:find(Functor, ExLib) of %search libraryspace then + {ok, Cs} when is_list(Cs) -> + work_with_clauses(Cs); {ok, ExFun} -> ExFun; error -> case dict:find(Functor, Db) of %search userspace last {ok, Cs} -> - {First, Cursor} = form_clauses(Cs), - {cursor, Cursor, result, {clauses, First}}; + work_with_clauses(Cs); error -> undefined end end @@ -196,13 +192,11 @@ listing({_, _, Db}, {[]}) -> {dict:fetch_keys(Db), Db}. %% @private -clause(Head, Body0, {StdLib, ExLib, Db}, ClauseFun) -> +clause(Head, Body0, {_, _, Db}, ClauseFun) -> {Functor, Body} = case catch {ok, erlog_ec_support:functor(Head), erlog_ec_body:well_form_body(Body0, false, sture)} of {erlog_error, E} -> erlog_errors:erlog_error(E, Db); {ok, F, B} -> {F, B} end, - ok = check_immutable(StdLib, Functor), %check built-in functions (read only) for clause - ok = check_immutable(ExLib, Functor), %check library functions (read only) for clauses case dict:find(Functor, Db) of {ok, Cs} -> ClauseFun(Functor, Cs, Body); error -> dict:append(Functor, {0, Head, Body}, Db) @@ -217,15 +211,13 @@ check_duplicates(Cs, Head, Body) -> (_, Acc) -> Acc end, false, Cs)). -%% @private -check_immutable(Dict, Functor) -> - case dict:is_key(Functor, Dict) of - false -> ok; - true -> erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)) - end. - %% @private form_clauses([]) -> {[], queue:new()}; form_clauses([First | Loaded]) -> Queue = queue:from_list(Loaded), - {First, Queue}. \ No newline at end of file + {First, Queue}. + +%% @private +work_with_clauses(Cs) -> + {First, Cursor} = form_clauses(Cs), + {cursor, Cursor, result, {clauses, First}}. \ No newline at end of file diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 1f06536..7829e90 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -14,7 +14,7 @@ -behaviour(erlog_storage). %% erlog callbacks --export([new/0, new/1, +-export([new/1, assertz_clause/2, asserta_clause/2, retract_clause/2, @@ -27,8 +27,6 @@ close/2, next/2]). -new() -> {ok, ets:new(eets, [bag, private])}. - new(_) -> {ok, ets:new(eets, [bag, private])}. assertz_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> @@ -66,9 +64,7 @@ retract_clause({StdLib, ExLib, Db}, {Collection, Functor, Ct}) -> Ets = erlog_db_storage:get_db(ets, Collection), {Res, _} = retract_clause({StdLib, ExLib, Ets}, {Functor, Ct}), {Res, Db}; -retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> - ok = check_immutable(StdLib, Functor), - ok = check_immutable(ExLib, Functor), +retract_clause({_, _, Db}, {Functor, Ct}) -> case catch ets:lookup_element(Db, Functor, 2) of Cs when is_list(Cs) -> Object = lists:keyfind(Ct, 1, Cs), @@ -81,8 +77,7 @@ abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> Ets = erlog_db_storage:get_db(ets, Collection), {Res, _} = abolish_clauses({StdLib, ExLib, Ets}, {Functor}), {Res, Db}; -abolish_clauses({StdLib, _, Db}, {Functor}) -> - ok = check_immutable(StdLib, Functor), +abolish_clauses({_, _, Db}, {Functor}) -> ets:delete(Db, Functor), {ok, Db}. @@ -98,8 +93,8 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call Cs when is_list(Cs) -> Cs; _ -> [] end, - {First, Cursor} = form_clauses(CS), - {{cursor, Cursor, result, {clauses, First}}, Db} + Res = work_with_clauses(CS), + {Res, Db} end end; findall({StdLib, ExLib, Db}, {Functor}) -> @@ -141,9 +136,7 @@ get_procedure({StdLib, ExLib, Db}, {Functor}) -> {ok, ExFun} -> ExFun; error -> case catch ets:lookup_element(Db, Functor, 2) of %search userspace last - Cs when is_list(Cs) -> - {First, Cursor} = form_clauses(Cs), - {{cursor, Cursor, result, {clauses, First}}, Db}; + Cs when is_list(Cs) -> work_with_clauses(Cs); _ -> undefined end end @@ -196,13 +189,11 @@ listing({_, _, Db}, {[]}) -> end, [], Db), Db}. %% @private -clause(Head, Body0, {StdLib, ExLib, Db}, ClauseFun) -> +clause(Head, Body0, {_, _, Db}, ClauseFun) -> {Functor, Body} = case catch {ok, erlog_ec_support:functor(Head), erlog_ec_body:well_form_body(Body0, false, sture)} of {erlog_error, E} -> erlog_errors:erlog_error(E, Db); {ok, F, B} -> {F, B} end, - ok = check_immutable(StdLib, Functor), %check built-in functions (read only) for clause - ok = check_immutable(ExLib, Functor), %check library functions (read only) for clauses case ets:lookup(Db, Functor) of [] -> ets:insert(Db, {Functor, {0, Head, Body}}); Cs -> ClauseFun(Functor, Cs, Body) @@ -216,15 +207,13 @@ check_duplicates(Cs, Head, Body) -> (_, Acc) -> Acc end, true, Cs). -%% @private -check_immutable(Dict, Functor) -> %TODO may be move me to erlog_memory? - case dict:is_key(Functor, Dict) of - false -> ok; - true -> erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)) - end. - %% @private form_clauses([]) -> {[], queue:new()}; form_clauses([First | Loaded]) -> Queue = queue:from_list(Loaded), - {First, Queue}. \ No newline at end of file + {First, Queue}. + +%% @private +work_with_clauses(Cs) -> + {First, Cursor} = form_clauses(Cs), + {cursor, Cursor, result, {clauses, First}}. \ No newline at end of file diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index b232cf6..8b18f1d 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -16,7 +16,9 @@ %% API -export([start_link/1, start_link/2, - load_library_space/2, + load_native_library/2, + load_extended_library/2, + load_extended_library/3, assertz_clause/3, asserta_clause/3, retract_clause/3, @@ -57,7 +59,7 @@ -define(SERVER, ?MODULE). --record(state, +-record(state, %TODO move to erlog, remove this process as separate { stdlib :: dict, %kernel-space memory exlib :: dict, %library-space memory @@ -73,7 +75,12 @@ load_kernel_space(Database, Module, Functor) -> gen_server:call(Database, {load_kernel_space, {Module, Functor}}). %% libraryspace predicate loading -load_library_space(Database, Proc) -> gen_server:call(Database, {load_library_space, {Proc}}). +load_native_library(Database, Proc) -> gen_server:call(Database, {load_native, Proc}). + +%% add prolog functor to libraryspace +load_extended_library(Database, {':-', Head, Body}) -> load_extended_library(Database, Head, Body); +load_extended_library(Database, Head) -> load_extended_library(Database, Head, true). +load_extended_library(Database, Head, Body) -> gen_server:call(Database, {load_extended, {Head, Body}}). %% userspace predicate loading assertz_clause(Database, {':-', Head, Body}) -> assertz_clause(Database, Head, Body); @@ -95,7 +102,7 @@ db_asserta_clause(Database, Collection, Head, Body) -> gen_server:call(Database, {asserta_clause, {Collection, Head, Body}}). db_findall(Database, Collection, Fun) -> gen_server:call(Database, {findall, {Collection, Fun}}). -finadll(Database, Fun) -> gen_server:call(Database, {findall, {Fun}}). +finadll(Database, Fun) -> gen_server:call(Database, {findall, {Fun}}). %TODO remove such encapsulation cases next(Database, Cursor) -> gen_server:call(Database, {next, Cursor}). @@ -177,7 +184,7 @@ init([Database, Params]) when is_atom(Database) -> %% %% @end %%-------------------------------------------------------------------- --spec(handle_call(Request :: term(), From :: {pid(), Tag :: term()}, +-spec(handle_call(Request :: term(), From :: {pid(), Tag :: term()}, %TODO refactor me, get rid of gen_server and its callbacks State :: #state{}) -> {reply, Reply :: term(), NewState :: #state{}} | {reply, Reply :: term(), NewState :: #state{}, timeout() | hibernate} | @@ -188,13 +195,13 @@ init([Database, Params]) when is_atom(Database) -> handle_call({load_kernel_space, {Module, Functor}}, _From, State = #state{stdlib = StdLib}) -> %load kernel space into memory UStdlib = dict:store(Functor, {built_in, Module}, StdLib), {reply, ok, State#state{stdlib = UStdlib}}; -handle_call({load_library_space, {{Functor, M, F}}}, _From, State = #state{stdlib = StdLib, exlib = ExLib}) -> %load library space into memory - case dict:is_key(Functor, StdLib) of - true -> - {reply, {erlog_error, {modify, static_procedure, erlog_ec_support:pred_ind(Functor)}}, State}; - false -> - {reply, ok, State#state{exlib = dict:store(Functor, {code, {M, F}}, ExLib)}} - end; +handle_call({load_native, {Functor, M, F}}, _From, State = #state{stdlib = StdLib, exlib = ExLib}) -> %load library space into memory + check_immutable(StdLib, Functor), + {reply, ok, State#state{exlib = dict:store(Functor, {code, {M, F}}, ExLib)}}; +handle_call({load_extended, {H, _} = F}, _From, State = #state{stdlib = StdLib, exlib = ExLib}) -> %load library space into memory + check_immutable(StdLib, erlog_ec_support:functor(H)), + {Res, UExLib} = erlog_dict:assertz_clause({StdLib, ExLib, ExLib}, F), %use erlog_dict module to assert library to exlib dict + {reply, Res, State#state{exlib = UExLib}}; handle_call({raw_store, {Key, Value}}, _From, State = #state{in_mem = InMem}) -> %findall store Umem = store(Key, Value, InMem), {reply, ok, State#state{in_mem = Umem}}; @@ -209,6 +216,7 @@ handle_call({raw_erase, {Key}}, _From, State = #state{in_mem = InMem}) -> %find Umem = dict:erase(Key, InMem), {reply, ok, State#state{in_mem = Umem}}; handle_call({abolish_clauses, {Func}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module + check_immutable(StdLib, Func), try {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, {Func}), {reply, Res, State#state{state = NewState, exlib = UpdExlib}} @@ -216,12 +224,31 @@ handle_call({abolish_clauses, {Func}}, _From, State = #state{state = DbState, da throw:E -> {reply, E, State} end; handle_call({abolish_clauses, {_, Func} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module + check_immutable(StdLib, Func), %abolishing fact from default memory need to be checked try {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, Params), {reply, Res, State#state{state = NewState, exlib = UpdExlib}} catch throw:E -> {reply, E, State} end; +handle_call({Fun, {F, _} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) + when Fun == asserta_clause; Fun == assertz_clause -> + check_immutable(StdLib, erlog_ec_support:functor(F)), %modifying fact in default memory need to be checked + check_immutable(ExLib, erlog_ec_support:functor(F)), + try + {Res, UState} = Db:Fun({StdLib, ExLib, DbState}, Params), + {reply, Res, State#state{state = UState}} + catch + throw:E -> {reply, E, State} + end;handle_call({retract_clause, {Func, _} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> + check_immutable(StdLib, Func), %modifying fact in default memory need to be checked + check_immutable(ExLib, Func), + try + {Res, UState} = Db:retract_clause({StdLib, ExLib, DbState}, Params), + {reply, Res, State#state{state = UState}} + catch + throw:E -> {reply, E, State} + end; handle_call({next, Cursor}, _From, State = #state{state = DbState, database = Db}) -> %get next result by cursor {Res, UState} = Db:next(DbState, Cursor), Ans = case Res of @@ -341,4 +368,12 @@ check_abolish(Func, StdLib, ExLib, Db, DbState, Params) -> {ExLib, NewState, Res}; UExlib -> %dict changed -> was deleted {UExlib, DbState, ok} + end. + +%% @private +check_immutable(Dict, Functor) -> + case dict:is_key(Functor, Dict) of + false -> ok; + true -> + erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)) %TODO will crash db process, but not erlog end. \ No newline at end of file diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl index 6f5ecb3..d748626 100644 --- a/src/storage/erlog_storage.erl +++ b/src/storage/erlog_storage.erl @@ -29,8 +29,6 @@ -callback abolish_clauses({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Func :: term()) -> {ok, NewState :: any()}. %% ------- System ------- --callback new() -> {ok, State :: any()}. - -callback new(Params :: list()) -> {ok, State :: any()}. %% close cursor From c057fb5117e94fac46cefb81a705e25f76537202 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 28 Oct 2014 00:47:04 +0000 Subject: [PATCH 178/251] make loading prolog libraries through standard loading interface --- README.md | 9 ++++++++- doc/libraries.md | 9 +++++++-- src/core/erlog.erl | 12 +++++++++--- src/io/erlog_file.erl | 2 +- 4 files changed, 25 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index c8abea3..191c968 100644 --- a/README.md +++ b/README.md @@ -134,7 +134,14 @@ remember, that two execution requests can be processed on different erlog instan some_lib_fun(some_val). %returns false In this example system erlog gen server is created one per one separate command (F.e. http request). Firstly - library `some_lib` is loaded. Than erlog server with loaded library is destroyed (as request is complete) and for another request -`some_lib_fun(some_val)` another erlog server is created, but, without loaded library. +`some_lib_fun(some_val)` another erlog server is created, but, without loaded library. +##### Automatic libraries loading +For convenient libraries usage you can load all libraries you need when creating a core. It will let you not to call `use/1` +everywhere in your code. Just add param `{libraries, [my_first_lib, my second_lib]}` in your params when starting a core: + + ConfList = [{libraries, [Lib1, Lib2]}], + erlog:start_link(ConfList). +All libraries from array will be loaded. More in [docs](https://github.com/comtihon/erlog/blob/master/doc/libraries.md "libraries"). ##### Loading Prolog libraries When configuring erlog you should set default library directory as __libs_dir__: diff --git a/doc/libraries.md b/doc/libraries.md index 77ce0a2..0b3376f 100644 --- a/doc/libraries.md +++ b/doc/libraries.md @@ -33,8 +33,13 @@ everywhere in your code. Just add param `{libraries, [my_first_lib, my second_li ConfList = [{libraries, [my_first_lib, my second_lib]}], erlog:start_link(ConfList). -All libraries from array will be loaded. +All libraries from array will be loaded. +You can load native libraries - just pass name of your module where library is implemented to ConfList as an atom. Or you +can load library, written in prolog. In that case you should pass full path to library as a string: + ConfList = [{libraries, [my_first_lib, my second_lib, "/home/user/testlib.pl"]}], + erlog:start_link(ConfList). + ### Writing your own libraries You can write your own external libraries. For doing so - just setup behaviour `erlog_exlib`. It has one callback function `load(Db)` for initialisation library. Then you should define your execution functions. See __External libraries__ for @@ -63,6 +68,6 @@ _File `erlog_uid.erl`_ ### Prolog libraries You can also write prolog libraries, which you can load manually of automatically. All this libraries will be loaded to -library space. For automatic loading libraries - move them to `lib/autoload` directory. +library space. For automatic loading libraries - move them to `lib/autoload` directory, or use library autoload standard method. Note, that if you create a functor in prolog library and load this library - you won't create same functor in userspace with the help of `assert`. Also - if you have same functors in different libraries - they will be rewritten by last loaded. \ No newline at end of file diff --git a/src/core/erlog.erl b/src/core/erlog.erl index dbaf524..d9c770d 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -69,7 +69,7 @@ init(Params) -> % use custom database implementation {ok, Db} = init_database(Params), LibsDir = proplists:get_value(libs_dir, Params, "../lib"), %default assumes erlog is run from ebin ok = load_prolog_libraries(FileCon, LibsDir, Db), - ok = load_external_libraries(Params, Db), + ok = load_external_libraries(Params, FileCon, Db), {ok, E} = gen_event:start_link(), Debugger = init_debugger(Params), case proplists:get_value(event_h, Params) of %register handler, if any @@ -149,10 +149,16 @@ load_prolog_libraries(Fcon, LibsDir, Db) -> ok. %% @private -load_external_libraries(Params, Database) -> +load_external_libraries(Params, FileCon, Database) -> case proplists:get_value(libraries, Params) of undefined -> ok; - Libraries -> lists:foreach(fun(Mod) -> Mod:load(Database) end, Libraries) + Libraries -> + lists:foreach( + fun(Mod) when is_atom(Mod) -> %autoload native library + Mod:load(Database); + (PrologLib) when is_list(PrologLib) -> %autoload external library + erlog_file:consult(FileCon, PrologLib, Database) + end, Libraries) end. %% @private diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index fbd297b..95485f1 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -30,7 +30,7 @@ -spec consult(atom(), File :: string(), Db :: pid()) -> ok | tuple(). consult(Consulter, File, Db) -> case Consulter:load(File) of %call erlog_file_consulter implementation - {ok, Terms} -> consult_terms(fun consult_assert/2, Db, Terms); + {ok, Terms} -> io:format("consult terms ~p~n", [Terms]), consult_terms(fun consult_assert/2, Db, Terms); Error -> Error end. From 2b713eae4fad04959d61197b1c476b57f8ac0c51 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 28 Oct 2014 02:46:29 +0000 Subject: [PATCH 179/251] update doc --- doc/libraries.md | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/doc/libraries.md b/doc/libraries.md index 0b3376f..6daede4 100644 --- a/doc/libraries.md +++ b/doc/libraries.md @@ -70,4 +70,16 @@ _File `erlog_uid.erl`_ You can also write prolog libraries, which you can load manually of automatically. All this libraries will be loaded to library space. For automatic loading libraries - move them to `lib/autoload` directory, or use library autoload standard method. Note, that if you create a functor in prolog library and load this library - you won't create same functor in userspace with -the help of `assert`. Also - if you have same functors in different libraries - they will be rewritten by last loaded. \ No newline at end of file +the help of `assert`. Also - if you have same functors in different libraries - they will be rewritten by last loaded. + +#### When prefer autoloading? +You may noticed, that `use/1` and `consult/1` share same functionality. The only difference is that `consult` loads predicates +to __userspace__, while `use` loads predicates to __library space__ (Extended). When is it optional to select each? +If you work locally, without your own storage implementation - it doesnt' matter, as default erlog storage model for userspace is +same as for library space - dict. But when you have your own memory implementation - you should understand: + +* library space is dict, stored in local memory. It can be faster, than your remote database. +* when your system has many users, who shares some code (library) - consulting this library leads to copying it to user's +tables/collections/namespaces, while using library will make copy only in memory of user's thread. +* if you store huge number of facts into library - dict implementation of library space can show worse performance, than +your database. From 3463b5278dcd84add8ba4312414d09f289becabe Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 28 Oct 2014 03:18:36 +0000 Subject: [PATCH 180/251] fix list defererence --- src/core/logic/erlog_ec_support.erl | 130 ++++++++++++++-------------- 1 file changed, 66 insertions(+), 64 deletions(-) diff --git a/src/core/logic/erlog_ec_support.erl b/src/core/logic/erlog_ec_support.erl index 96959a8..e4452e7 100644 --- a/src/core/logic/erlog_ec_support.erl +++ b/src/core/logic/erlog_ec_support.erl @@ -13,17 +13,19 @@ %% API -export([new_bindings/0, get_binding/2, add_binding/3, - functor/1, cut/3, collect_alternatives/3, - update_result/4, update_vars/4, deref/2, dderef_list/2, - make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3, write/2, is_bound/1]). + functor/1, cut/3, collect_alternatives/3, + update_result/4, update_vars/4, deref/2, dderef_list/2, + make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3, write/2, is_bound/1]). %% deref(Term, Bindings) -> Term. %% Dereference a variable, else just return the term. +deref(L, Bs) when is_list(L) -> + lists:foldl(fun(Var, Res) -> [deref(Var, Bs), Res] end, [], L); deref({V} = T0, Bs) -> - case ?BIND:find(V, Bs) of - {ok, T1} -> deref(T1, Bs); - error -> T0 - end; + case ?BIND:find(V, Bs) of + {ok, T1} -> deref(T1, Bs); + error -> T0 + end; deref(T, _) -> T. %Not a variable, return it. %% deref_list(List, Bindings) -> List. @@ -31,10 +33,10 @@ deref(T, _) -> T. %Not a variable, return it. deref_list([], _) -> []; %It already is a list %TODO where it is used? deref_list([_ | _] = L, _) -> L; deref_list({V}, Bs) -> - case dict:find(V, Bs) of - {ok, L} -> deref_list(L, Bs); - error -> erlog_errors:instantiation_error() - end; + case dict:find(V, Bs) of + {ok, L} -> deref_list(L, Bs); + error -> erlog_errors:instantiation_error() + end; deref_list(Other, _) -> erlog_errors:type_error(list, Other). %% dderef(Term, Bindings) -> Term. @@ -43,28 +45,28 @@ deref_list(Other, _) -> erlog_errors:type_error(list, Other). dderef(A, _) when ?IS_CONSTANT(A) -> A; dderef([], _) -> []; dderef([H0 | T0], Bs) -> - [dderef(H0, Bs) | dderef(T0, Bs)]; + [dderef(H0, Bs) | dderef(T0, Bs)]; dderef({V} = Var, Bs) -> - case ?BIND:find(V, Bs) of %TODO check, why dict instead erlog_storage - {ok, T} -> dderef(T, Bs); - error -> Var - end; + case ?BIND:find(V, Bs) of %TODO check, why dict instead erlog_storage + {ok, T} -> dderef(T, Bs); + error -> Var + end; dderef(T, Bs) when is_tuple(T) -> - Es0 = tuple_to_list(T), - Es1 = dderef(Es0, Bs), - list_to_tuple(Es1). + Es0 = tuple_to_list(T), + Es1 = dderef(Es0, Bs), + list_to_tuple(Es1). %% dderef_list(List, Bindings) -> List. %% Dereference all variables to any depth but check that the %% top-level is a list. dderef_list([], _Bs) -> []; dderef_list([H | T], Bs) -> - [dderef(H, Bs) | dderef_list(T, Bs)]; + [dderef(H, Bs) | dderef_list(T, Bs)]; dderef_list({V}, Bs) -> - case ?BIND:find(V, Bs) of - {ok, L} -> dderef_list(L, Bs); - error -> erlog_errors:instantiation_error() - end; + case ?BIND:find(V, Bs) of + {ok, L} -> dderef_list(L, Bs); + error -> erlog_errors:instantiation_error() + end; dderef_list(Other, _Bs) -> erlog_errors:type_error(list, Other). %% detects, whether variable is bound or not @@ -76,11 +78,11 @@ is_bound(_) -> true. %% Make a list of new variables starting at VarNum. make_vars(0, _) -> []; make_vars(I, Vn) -> - [{Vn} | make_vars(I - 1, Vn + 1)]. + [{Vn} | make_vars(I - 1, Vn + 1)]. %% functor(Goal) -> {Name,Arity}. functor(T) when ?IS_FUNCTOR(T) -> - {element(1, T), tuple_size(T) - 1}; + {element(1, T), tuple_size(T) - 1}; functor(T) when is_atom(T) -> {T, 0}; functor(T) -> erlog_errors:type_error(callable, T). @@ -93,32 +95,32 @@ pred_ind({N, A}) -> {'/', N, A}. new_bindings() -> ?BIND:new(). add_binding({V}, Val, Bs0) -> - ?BIND:store(V, Val, Bs0). + ?BIND:store(V, Val, Bs0). get_binding({V}, Bs) -> - ?BIND:find(V, Bs). + ?BIND:find(V, Bs). collect_alternatives(Goal, FunList, Predicates) -> - Element = index_of(Goal, FunList) - 1, - lists:foldr( - fun({_, Pred, _}, Dict) -> - [_ | ParamList] = tuple_to_list(Pred), - Keys = remove_nth(ParamList, Element), - dict:append(Keys, lists:nth(Element, ParamList), Dict) - end, dict:new(), Predicates). + Element = index_of(Goal, FunList) - 1, + lists:foldr( + fun({_, Pred, _}, Dict) -> + [_ | ParamList] = tuple_to_list(Pred), + Keys = remove_nth(ParamList, Element), + dict:append(Keys, lists:nth(Element, ParamList), Dict) + end, dict:new(), Predicates). update_result(Key, ResultDict, Res, Bs0) -> - case dict:find(Key, ResultDict) of - {ok, Value} -> add_binding(Res, Value, Bs0); - error -> Bs0 - end. + case dict:find(Key, ResultDict) of + {ok, Value} -> add_binding(Res, Value, Bs0); + error -> Bs0 + end. update_vars(Goal, FunList, Key, Bs) -> - Vars = tl(FunList) -- [Goal], - lists:foldl( - fun({N} = Var, UBs1) -> - add_binding(Var, lists:nth(N, Key), UBs1) - end, Bs, Vars). + Vars = tl(FunList) -- [Goal], + lists:foldl( + fun({N} = Var, UBs1) -> + add_binding(Var, lists:nth(N, Key), UBs1) + end, Bs, Vars). index_of(Item, List) -> index_of(Item, List, 1). @@ -127,36 +129,36 @@ index_of(Item, [Item | _], Index) -> Index; index_of(Item, [_ | Tl], Index) -> index_of(Item, Tl, Index + 1). remove_nth(List, N) -> - {A, B} = lists:split(N - 1, List), - A ++ tl(B). + {A, B} = lists:split(N - 1, List), + A ++ tl(B). write(Res, Bs) when is_list(Res) -> - case io_lib:printable_list(Res) of - true -> Res; - false -> erlog_ec_support:dderef(Res, Bs) - end; + case io_lib:printable_list(Res) of + true -> Res; + false -> erlog_ec_support:dderef(Res, Bs) + end; write(Res, Bs) -> - write([Res], Bs). + write([Res], Bs). cut(Label, Last, Param = #param{next_goal = Next, choice = [#cut{label = Label} | Cps] = Cps0}) -> - if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); - true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) - end; + if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); + true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) + end; cut(Label, Last, Param = #param{next_goal = Next, choice = [#cp{type = if_then_else, label = Label} | Cps] = Cps0}) -> - if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); - true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) - end; + if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); + true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) + end; cut(Label, Last, Param = #param{choice = [#cp{type = goal_clauses, label = Label} = Cp | Cps]}) -> - cut_goal_clauses(Last, Cp, Param#param{choice = Cps}); + cut_goal_clauses(Last, Cp, Param#param{choice = Cps}); cut(Label, Last, Param = #param{choice = [_Cp | Cps]}) -> - cut(Label, Last, Param#param{choice = Cps}). + cut(Label, Last, Param#param{choice = Cps}). %% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db). cut_goal_clauses(true, #cp{label = _}, Param = #param{next_goal = Next}) -> - %% Just remove the choice point completely and continue. - erlog_ec_core:prove_body(Param#param{goal = Next}); + %% Just remove the choice point completely and continue. + erlog_ec_core:prove_body(Param#param{goal = Next}); cut_goal_clauses(false, #cp{label = L}, Param = #param{next_goal = Next, choice = Cps}) -> - %% Replace choice point with cut point then continue. - Cut = #cut{label = L}, - erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). \ No newline at end of file + %% Replace choice point with cut point then continue. + Cut = #cut{label = L}, + erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). \ No newline at end of file From 420d276a53eb95775cb0c2ac4b3a4ccccabbf5ea Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 28 Oct 2014 03:18:36 +0000 Subject: [PATCH 181/251] fix list defererence --- src/core/logic/erlog_ec_support.erl | 130 ++++++++++++++-------------- 1 file changed, 66 insertions(+), 64 deletions(-) diff --git a/src/core/logic/erlog_ec_support.erl b/src/core/logic/erlog_ec_support.erl index 96959a8..e4452e7 100644 --- a/src/core/logic/erlog_ec_support.erl +++ b/src/core/logic/erlog_ec_support.erl @@ -13,17 +13,19 @@ %% API -export([new_bindings/0, get_binding/2, add_binding/3, - functor/1, cut/3, collect_alternatives/3, - update_result/4, update_vars/4, deref/2, dderef_list/2, - make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3, write/2, is_bound/1]). + functor/1, cut/3, collect_alternatives/3, + update_result/4, update_vars/4, deref/2, dderef_list/2, + make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3, write/2, is_bound/1]). %% deref(Term, Bindings) -> Term. %% Dereference a variable, else just return the term. +deref(L, Bs) when is_list(L) -> + lists:foldl(fun(Var, Res) -> [deref(Var, Bs), Res] end, [], L); deref({V} = T0, Bs) -> - case ?BIND:find(V, Bs) of - {ok, T1} -> deref(T1, Bs); - error -> T0 - end; + case ?BIND:find(V, Bs) of + {ok, T1} -> deref(T1, Bs); + error -> T0 + end; deref(T, _) -> T. %Not a variable, return it. %% deref_list(List, Bindings) -> List. @@ -31,10 +33,10 @@ deref(T, _) -> T. %Not a variable, return it. deref_list([], _) -> []; %It already is a list %TODO where it is used? deref_list([_ | _] = L, _) -> L; deref_list({V}, Bs) -> - case dict:find(V, Bs) of - {ok, L} -> deref_list(L, Bs); - error -> erlog_errors:instantiation_error() - end; + case dict:find(V, Bs) of + {ok, L} -> deref_list(L, Bs); + error -> erlog_errors:instantiation_error() + end; deref_list(Other, _) -> erlog_errors:type_error(list, Other). %% dderef(Term, Bindings) -> Term. @@ -43,28 +45,28 @@ deref_list(Other, _) -> erlog_errors:type_error(list, Other). dderef(A, _) when ?IS_CONSTANT(A) -> A; dderef([], _) -> []; dderef([H0 | T0], Bs) -> - [dderef(H0, Bs) | dderef(T0, Bs)]; + [dderef(H0, Bs) | dderef(T0, Bs)]; dderef({V} = Var, Bs) -> - case ?BIND:find(V, Bs) of %TODO check, why dict instead erlog_storage - {ok, T} -> dderef(T, Bs); - error -> Var - end; + case ?BIND:find(V, Bs) of %TODO check, why dict instead erlog_storage + {ok, T} -> dderef(T, Bs); + error -> Var + end; dderef(T, Bs) when is_tuple(T) -> - Es0 = tuple_to_list(T), - Es1 = dderef(Es0, Bs), - list_to_tuple(Es1). + Es0 = tuple_to_list(T), + Es1 = dderef(Es0, Bs), + list_to_tuple(Es1). %% dderef_list(List, Bindings) -> List. %% Dereference all variables to any depth but check that the %% top-level is a list. dderef_list([], _Bs) -> []; dderef_list([H | T], Bs) -> - [dderef(H, Bs) | dderef_list(T, Bs)]; + [dderef(H, Bs) | dderef_list(T, Bs)]; dderef_list({V}, Bs) -> - case ?BIND:find(V, Bs) of - {ok, L} -> dderef_list(L, Bs); - error -> erlog_errors:instantiation_error() - end; + case ?BIND:find(V, Bs) of + {ok, L} -> dderef_list(L, Bs); + error -> erlog_errors:instantiation_error() + end; dderef_list(Other, _Bs) -> erlog_errors:type_error(list, Other). %% detects, whether variable is bound or not @@ -76,11 +78,11 @@ is_bound(_) -> true. %% Make a list of new variables starting at VarNum. make_vars(0, _) -> []; make_vars(I, Vn) -> - [{Vn} | make_vars(I - 1, Vn + 1)]. + [{Vn} | make_vars(I - 1, Vn + 1)]. %% functor(Goal) -> {Name,Arity}. functor(T) when ?IS_FUNCTOR(T) -> - {element(1, T), tuple_size(T) - 1}; + {element(1, T), tuple_size(T) - 1}; functor(T) when is_atom(T) -> {T, 0}; functor(T) -> erlog_errors:type_error(callable, T). @@ -93,32 +95,32 @@ pred_ind({N, A}) -> {'/', N, A}. new_bindings() -> ?BIND:new(). add_binding({V}, Val, Bs0) -> - ?BIND:store(V, Val, Bs0). + ?BIND:store(V, Val, Bs0). get_binding({V}, Bs) -> - ?BIND:find(V, Bs). + ?BIND:find(V, Bs). collect_alternatives(Goal, FunList, Predicates) -> - Element = index_of(Goal, FunList) - 1, - lists:foldr( - fun({_, Pred, _}, Dict) -> - [_ | ParamList] = tuple_to_list(Pred), - Keys = remove_nth(ParamList, Element), - dict:append(Keys, lists:nth(Element, ParamList), Dict) - end, dict:new(), Predicates). + Element = index_of(Goal, FunList) - 1, + lists:foldr( + fun({_, Pred, _}, Dict) -> + [_ | ParamList] = tuple_to_list(Pred), + Keys = remove_nth(ParamList, Element), + dict:append(Keys, lists:nth(Element, ParamList), Dict) + end, dict:new(), Predicates). update_result(Key, ResultDict, Res, Bs0) -> - case dict:find(Key, ResultDict) of - {ok, Value} -> add_binding(Res, Value, Bs0); - error -> Bs0 - end. + case dict:find(Key, ResultDict) of + {ok, Value} -> add_binding(Res, Value, Bs0); + error -> Bs0 + end. update_vars(Goal, FunList, Key, Bs) -> - Vars = tl(FunList) -- [Goal], - lists:foldl( - fun({N} = Var, UBs1) -> - add_binding(Var, lists:nth(N, Key), UBs1) - end, Bs, Vars). + Vars = tl(FunList) -- [Goal], + lists:foldl( + fun({N} = Var, UBs1) -> + add_binding(Var, lists:nth(N, Key), UBs1) + end, Bs, Vars). index_of(Item, List) -> index_of(Item, List, 1). @@ -127,36 +129,36 @@ index_of(Item, [Item | _], Index) -> Index; index_of(Item, [_ | Tl], Index) -> index_of(Item, Tl, Index + 1). remove_nth(List, N) -> - {A, B} = lists:split(N - 1, List), - A ++ tl(B). + {A, B} = lists:split(N - 1, List), + A ++ tl(B). write(Res, Bs) when is_list(Res) -> - case io_lib:printable_list(Res) of - true -> Res; - false -> erlog_ec_support:dderef(Res, Bs) - end; + case io_lib:printable_list(Res) of + true -> Res; + false -> erlog_ec_support:dderef(Res, Bs) + end; write(Res, Bs) -> - write([Res], Bs). + write([Res], Bs). cut(Label, Last, Param = #param{next_goal = Next, choice = [#cut{label = Label} | Cps] = Cps0}) -> - if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); - true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) - end; + if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); + true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) + end; cut(Label, Last, Param = #param{next_goal = Next, choice = [#cp{type = if_then_else, label = Label} | Cps] = Cps0}) -> - if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); - true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) - end; + if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); + true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) + end; cut(Label, Last, Param = #param{choice = [#cp{type = goal_clauses, label = Label} = Cp | Cps]}) -> - cut_goal_clauses(Last, Cp, Param#param{choice = Cps}); + cut_goal_clauses(Last, Cp, Param#param{choice = Cps}); cut(Label, Last, Param = #param{choice = [_Cp | Cps]}) -> - cut(Label, Last, Param#param{choice = Cps}). + cut(Label, Last, Param#param{choice = Cps}). %% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db). cut_goal_clauses(true, #cp{label = _}, Param = #param{next_goal = Next}) -> - %% Just remove the choice point completely and continue. - erlog_ec_core:prove_body(Param#param{goal = Next}); + %% Just remove the choice point completely and continue. + erlog_ec_core:prove_body(Param#param{goal = Next}); cut_goal_clauses(false, #cp{label = L}, Param = #param{next_goal = Next, choice = Cps}) -> - %% Replace choice point with cut point then continue. - Cut = #cut{label = L}, - erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). \ No newline at end of file + %% Replace choice point with cut point then continue. + Cut = #cut{label = L}, + erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). \ No newline at end of file From 931caa5fe131f4ebfb61646ef48e14a46b258b2c Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 28 Oct 2014 03:31:25 +0000 Subject: [PATCH 182/251] Revert "fix list defererence" This reverts commit 420d276a53eb95775cb0c2ac4b3a4ccccabbf5ea. --- src/core/logic/erlog_ec_support.erl | 130 ++++++++++++++-------------- 1 file changed, 64 insertions(+), 66 deletions(-) diff --git a/src/core/logic/erlog_ec_support.erl b/src/core/logic/erlog_ec_support.erl index e4452e7..96959a8 100644 --- a/src/core/logic/erlog_ec_support.erl +++ b/src/core/logic/erlog_ec_support.erl @@ -13,19 +13,17 @@ %% API -export([new_bindings/0, get_binding/2, add_binding/3, - functor/1, cut/3, collect_alternatives/3, - update_result/4, update_vars/4, deref/2, dderef_list/2, - make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3, write/2, is_bound/1]). + functor/1, cut/3, collect_alternatives/3, + update_result/4, update_vars/4, deref/2, dderef_list/2, + make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3, write/2, is_bound/1]). %% deref(Term, Bindings) -> Term. %% Dereference a variable, else just return the term. -deref(L, Bs) when is_list(L) -> - lists:foldl(fun(Var, Res) -> [deref(Var, Bs), Res] end, [], L); deref({V} = T0, Bs) -> - case ?BIND:find(V, Bs) of - {ok, T1} -> deref(T1, Bs); - error -> T0 - end; + case ?BIND:find(V, Bs) of + {ok, T1} -> deref(T1, Bs); + error -> T0 + end; deref(T, _) -> T. %Not a variable, return it. %% deref_list(List, Bindings) -> List. @@ -33,10 +31,10 @@ deref(T, _) -> T. %Not a variable, return it. deref_list([], _) -> []; %It already is a list %TODO where it is used? deref_list([_ | _] = L, _) -> L; deref_list({V}, Bs) -> - case dict:find(V, Bs) of - {ok, L} -> deref_list(L, Bs); - error -> erlog_errors:instantiation_error() - end; + case dict:find(V, Bs) of + {ok, L} -> deref_list(L, Bs); + error -> erlog_errors:instantiation_error() + end; deref_list(Other, _) -> erlog_errors:type_error(list, Other). %% dderef(Term, Bindings) -> Term. @@ -45,28 +43,28 @@ deref_list(Other, _) -> erlog_errors:type_error(list, Other). dderef(A, _) when ?IS_CONSTANT(A) -> A; dderef([], _) -> []; dderef([H0 | T0], Bs) -> - [dderef(H0, Bs) | dderef(T0, Bs)]; + [dderef(H0, Bs) | dderef(T0, Bs)]; dderef({V} = Var, Bs) -> - case ?BIND:find(V, Bs) of %TODO check, why dict instead erlog_storage - {ok, T} -> dderef(T, Bs); - error -> Var - end; + case ?BIND:find(V, Bs) of %TODO check, why dict instead erlog_storage + {ok, T} -> dderef(T, Bs); + error -> Var + end; dderef(T, Bs) when is_tuple(T) -> - Es0 = tuple_to_list(T), - Es1 = dderef(Es0, Bs), - list_to_tuple(Es1). + Es0 = tuple_to_list(T), + Es1 = dderef(Es0, Bs), + list_to_tuple(Es1). %% dderef_list(List, Bindings) -> List. %% Dereference all variables to any depth but check that the %% top-level is a list. dderef_list([], _Bs) -> []; dderef_list([H | T], Bs) -> - [dderef(H, Bs) | dderef_list(T, Bs)]; + [dderef(H, Bs) | dderef_list(T, Bs)]; dderef_list({V}, Bs) -> - case ?BIND:find(V, Bs) of - {ok, L} -> dderef_list(L, Bs); - error -> erlog_errors:instantiation_error() - end; + case ?BIND:find(V, Bs) of + {ok, L} -> dderef_list(L, Bs); + error -> erlog_errors:instantiation_error() + end; dderef_list(Other, _Bs) -> erlog_errors:type_error(list, Other). %% detects, whether variable is bound or not @@ -78,11 +76,11 @@ is_bound(_) -> true. %% Make a list of new variables starting at VarNum. make_vars(0, _) -> []; make_vars(I, Vn) -> - [{Vn} | make_vars(I - 1, Vn + 1)]. + [{Vn} | make_vars(I - 1, Vn + 1)]. %% functor(Goal) -> {Name,Arity}. functor(T) when ?IS_FUNCTOR(T) -> - {element(1, T), tuple_size(T) - 1}; + {element(1, T), tuple_size(T) - 1}; functor(T) when is_atom(T) -> {T, 0}; functor(T) -> erlog_errors:type_error(callable, T). @@ -95,32 +93,32 @@ pred_ind({N, A}) -> {'/', N, A}. new_bindings() -> ?BIND:new(). add_binding({V}, Val, Bs0) -> - ?BIND:store(V, Val, Bs0). + ?BIND:store(V, Val, Bs0). get_binding({V}, Bs) -> - ?BIND:find(V, Bs). + ?BIND:find(V, Bs). collect_alternatives(Goal, FunList, Predicates) -> - Element = index_of(Goal, FunList) - 1, - lists:foldr( - fun({_, Pred, _}, Dict) -> - [_ | ParamList] = tuple_to_list(Pred), - Keys = remove_nth(ParamList, Element), - dict:append(Keys, lists:nth(Element, ParamList), Dict) - end, dict:new(), Predicates). + Element = index_of(Goal, FunList) - 1, + lists:foldr( + fun({_, Pred, _}, Dict) -> + [_ | ParamList] = tuple_to_list(Pred), + Keys = remove_nth(ParamList, Element), + dict:append(Keys, lists:nth(Element, ParamList), Dict) + end, dict:new(), Predicates). update_result(Key, ResultDict, Res, Bs0) -> - case dict:find(Key, ResultDict) of - {ok, Value} -> add_binding(Res, Value, Bs0); - error -> Bs0 - end. + case dict:find(Key, ResultDict) of + {ok, Value} -> add_binding(Res, Value, Bs0); + error -> Bs0 + end. update_vars(Goal, FunList, Key, Bs) -> - Vars = tl(FunList) -- [Goal], - lists:foldl( - fun({N} = Var, UBs1) -> - add_binding(Var, lists:nth(N, Key), UBs1) - end, Bs, Vars). + Vars = tl(FunList) -- [Goal], + lists:foldl( + fun({N} = Var, UBs1) -> + add_binding(Var, lists:nth(N, Key), UBs1) + end, Bs, Vars). index_of(Item, List) -> index_of(Item, List, 1). @@ -129,36 +127,36 @@ index_of(Item, [Item | _], Index) -> Index; index_of(Item, [_ | Tl], Index) -> index_of(Item, Tl, Index + 1). remove_nth(List, N) -> - {A, B} = lists:split(N - 1, List), - A ++ tl(B). + {A, B} = lists:split(N - 1, List), + A ++ tl(B). write(Res, Bs) when is_list(Res) -> - case io_lib:printable_list(Res) of - true -> Res; - false -> erlog_ec_support:dderef(Res, Bs) - end; + case io_lib:printable_list(Res) of + true -> Res; + false -> erlog_ec_support:dderef(Res, Bs) + end; write(Res, Bs) -> - write([Res], Bs). + write([Res], Bs). cut(Label, Last, Param = #param{next_goal = Next, choice = [#cut{label = Label} | Cps] = Cps0}) -> - if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); - true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) - end; + if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); + true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) + end; cut(Label, Last, Param = #param{next_goal = Next, choice = [#cp{type = if_then_else, label = Label} | Cps] = Cps0}) -> - if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); - true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) - end; + if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); + true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) + end; cut(Label, Last, Param = #param{choice = [#cp{type = goal_clauses, label = Label} = Cp | Cps]}) -> - cut_goal_clauses(Last, Cp, Param#param{choice = Cps}); + cut_goal_clauses(Last, Cp, Param#param{choice = Cps}); cut(Label, Last, Param = #param{choice = [_Cp | Cps]}) -> - cut(Label, Last, Param#param{choice = Cps}). + cut(Label, Last, Param#param{choice = Cps}). %% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db). cut_goal_clauses(true, #cp{label = _}, Param = #param{next_goal = Next}) -> - %% Just remove the choice point completely and continue. - erlog_ec_core:prove_body(Param#param{goal = Next}); + %% Just remove the choice point completely and continue. + erlog_ec_core:prove_body(Param#param{goal = Next}); cut_goal_clauses(false, #cp{label = L}, Param = #param{next_goal = Next, choice = Cps}) -> - %% Replace choice point with cut point then continue. - Cut = #cut{label = L}, - erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). \ No newline at end of file + %% Replace choice point with cut point then continue. + Cut = #cut{label = L}, + erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). \ No newline at end of file From 8f292b9f45d100b80d56c5ee148f58a05c6404c0 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 28 Oct 2014 03:39:37 +0000 Subject: [PATCH 183/251] fix string list dderef --- src/libs/standard/string/{main => }/erlog_string.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) rename src/libs/standard/string/{main => }/erlog_string.erl (97%) diff --git a/src/libs/standard/string/main/erlog_string.erl b/src/libs/standard/string/erlog_string.erl similarity index 97% rename from src/libs/standard/string/main/erlog_string.erl rename to src/libs/standard/string/erlog_string.erl index c2d1819..00a38b1 100644 --- a/src/libs/standard/string/main/erlog_string.erl +++ b/src/libs/standard/string/erlog_string.erl @@ -21,7 +21,7 @@ load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:load_kernel_space(Db, ?MODULE, Proc) end, ?ERLOG_STRING). prove_goal(Params = #param{goal = {concat, Strings, Res}, next_goal = Next, bindings = Bs0}) -> - case erlog_ec_support:deref(Strings, Bs0) of + case erlog_ec_support:dderef_list(Strings, Bs0) of List when is_list(List) -> Bs1 = erlog_ec_support:add_binding(Res, lists:concat(List), Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); From e97631acadd9c17a783de1f5acc04eb3ff29ce81 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 30 Oct 2014 23:53:28 +0000 Subject: [PATCH 184/251] remove debug --- src/io/erlog_file.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index 95485f1..fbd297b 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -30,7 +30,7 @@ -spec consult(atom(), File :: string(), Db :: pid()) -> ok | tuple(). consult(Consulter, File, Db) -> case Consulter:load(File) of %call erlog_file_consulter implementation - {ok, Terms} -> io:format("consult terms ~p~n", [Terms]), consult_terms(fun consult_assert/2, Db, Terms); + {ok, Terms} -> consult_terms(fun consult_assert/2, Db, Terms); Error -> Error end. From d6b3ba3059ff2f21952855f5e5f1d141a799e074 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 31 Oct 2014 19:40:57 +0000 Subject: [PATCH 185/251] improved localtime logic --- src/core/logic/erlog_ec_support.erl | 4 +- src/libs/standard/time/main/erlog_time.erl | 86 +++++++++++++--------- 2 files changed, 55 insertions(+), 35 deletions(-) diff --git a/src/core/logic/erlog_ec_support.erl b/src/core/logic/erlog_ec_support.erl index 96959a8..fed692f 100644 --- a/src/core/logic/erlog_ec_support.erl +++ b/src/core/logic/erlog_ec_support.erl @@ -28,7 +28,7 @@ deref(T, _) -> T. %Not a variable, return it. %% deref_list(List, Bindings) -> List. %% Dereference the top-level checking that it is a list. -deref_list([], _) -> []; %It already is a list %TODO where it is used? +deref_list([], _) -> []; %It already is a list deref_list([_ | _] = L, _) -> L; deref_list({V}, Bs) -> case dict:find(V, Bs) of @@ -45,7 +45,7 @@ dderef([], _) -> []; dderef([H0 | T0], Bs) -> [dderef(H0, Bs) | dderef(T0, Bs)]; dderef({V} = Var, Bs) -> - case ?BIND:find(V, Bs) of %TODO check, why dict instead erlog_storage + case ?BIND:find(V, Bs) of {ok, T} -> dderef(T, Bs); error -> Var end; diff --git a/src/libs/standard/time/main/erlog_time.erl b/src/libs/standard/time/main/erlog_time.erl index 1e93900..45170ed 100644 --- a/src/libs/standard/time/main/erlog_time.erl +++ b/src/libs/standard/time/main/erlog_time.erl @@ -19,55 +19,75 @@ -export([prove_goal/1]). load(Db) -> - lists:foreach(fun(Proc) -> erlog_memory:load_kernel_space(Db, ?MODULE, Proc) end, ?ERLOG_TIME). + lists:foreach(fun(Proc) -> erlog_memory:load_kernel_space(Db, ?MODULE, Proc) end, ?ERLOG_TIME). %% Returns current timestamp. prove_goal(Params = #param{goal = {localtime, Var}, next_goal = Next, bindings = Bs0}) -> - {M, S, _} = os:timestamp(), - Bs = erlog_ec_support:add_binding(Var, erlog_et_logic:date_to_ts({M, S}), Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + {M, S, _} = os:timestamp(), + Now = erlog_et_logic:date_to_ts({M, S}), + case erlog_ec_support:is_bound(Var) of + true -> %compare to now if set + Value = erlog_ec_support:deref(Var, Bs0), + try to_integer(Value) of + Now -> + erlog_ec_core:prove_body(Params#param{goal = Next}); + _ -> + erlog_errors:fail(Params) + catch + _:_ -> + erlog_errors:fail(Params) + end; + false -> %write now if unset + Bs = erlog_ec_support:add_binding(Var, Now, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) + end; %% Returns timestamp for data, ignoring time prove_goal(Params = #param{goal = {date, DateString, Res}, next_goal = Next, bindings = Bs0}) -> - {{Y, M, D}, _} = erlog_et_logic:date_string_to_data(erlog_et_logic:check_var(DateString, Bs0)), - DataTS = erlog_et_logic:data_to_ts({{Y, M, D}, {0, 0, 0}}), - Bs = erlog_ec_support:add_binding(Res, DataTS, Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + {{Y, M, D}, _} = erlog_et_logic:date_string_to_data(erlog_et_logic:check_var(DateString, Bs0)), + DataTS = erlog_et_logic:data_to_ts({{Y, M, D}, {0, 0, 0}}), + Bs = erlog_ec_support:add_binding(Res, DataTS, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Returns timestamp for data, ignoring time prove_goal(Params = #param{goal = {date, D, M, Y, Res}, next_goal = Next, bindings = Bs0}) -> - DataTS = erlog_et_logic:data_to_ts({{erlog_et_logic:check_var(Y, Bs0), erlog_et_logic:check_var(M, Bs0), erlog_et_logic:check_var(D, Bs0)}, {0, 0, 0}}), - Bs = erlog_ec_support:add_binding(Res, DataTS, Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + DataTS = erlog_et_logic:data_to_ts({{erlog_et_logic:check_var(Y, Bs0), erlog_et_logic:check_var(M, Bs0), erlog_et_logic:check_var(D, Bs0)}, {0, 0, 0}}), + Bs = erlog_ec_support:add_binding(Res, DataTS, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Returns timestamp for data, ignoring data. prove_goal(Params = #param{goal = {time, TimeString, Res}, next_goal = Next, bindings = Bs0}) -> - {_, {H, M, S}} = erlog_et_logic:date_string_to_data(erlog_et_logic:check_var(TimeString, Bs0)), %cut YMD - TS = S * erlog_et_logic:date_to_seconds(M, minute) * erlog_et_logic:date_to_seconds(H, hour), - Bs = erlog_ec_support:add_binding(Res, TS, Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + {_, {H, M, S}} = erlog_et_logic:date_string_to_data(erlog_et_logic:check_var(TimeString, Bs0)), %cut YMD + TS = S * erlog_et_logic:date_to_seconds(M, minute) * erlog_et_logic:date_to_seconds(H, hour), + Bs = erlog_ec_support:add_binding(Res, TS, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Returns timestamp for data, ignoring data. prove_goal(Params = #param{goal = {time, H, M, S, Res}, next_goal = Next, bindings = Bs0}) -> - TS = erlog_et_logic:check_var(S, Bs0) - * erlog_et_logic:date_to_seconds(erlog_et_logic:check_var(M, Bs0), minute) - * erlog_et_logic:date_to_seconds(erlog_et_logic:check_var(H, Bs0), hour), - Bs = erlog_ec_support:add_binding(Res, TS, Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + TS = erlog_et_logic:check_var(S, Bs0) + * erlog_et_logic:date_to_seconds(erlog_et_logic:check_var(M, Bs0), minute) + * erlog_et_logic:date_to_seconds(erlog_et_logic:check_var(H, Bs0), hour), + Bs = erlog_ec_support:add_binding(Res, TS, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Calculates differense between two timestamps. Returns the result in specifyed format prove_goal(Params = #param{goal = {date_diff, TS1, TS2, Format, Res}, next_goal = Next, bindings = Bs0}) -> - Diff = timer:now_diff(erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS1, Bs0)), erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS2, Bs0))) / 1000000, - Bs = erlog_ec_support:add_binding(Res, erlog_et_logic:seconds_to_date(Diff, erlog_et_logic:check_var(Format, Bs0)), Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + Diff = timer:now_diff(erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS1, Bs0)), erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS2, Bs0))) / 1000000, + Bs = erlog_ec_support:add_binding(Res, erlog_et_logic:seconds_to_date(Diff, erlog_et_logic:check_var(Format, Bs0)), Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Adds number of seconds T2 in Type format to Time1. Returns timestamp prove_goal(Params = #param{goal = {add_time, Time1, Type, T2, Res}, next_goal = Next, bindings = Bs0}) -> - Diff = erlog_et_logic:check_var(Time1, Bs0) + erlog_et_logic:date_to_seconds(erlog_et_logic:check_var(T2, Bs0), erlog_et_logic:check_var(Type, Bs0)), - Bs = erlog_ec_support:add_binding(Res, Diff, Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + Diff = erlog_et_logic:check_var(Time1, Bs0) + erlog_et_logic:date_to_seconds(erlog_et_logic:check_var(T2, Bs0), erlog_et_logic:check_var(Type, Bs0)), + Bs = erlog_ec_support:add_binding(Res, Diff, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Converts timestamp to human readable format prove_goal(Params = #param{goal = {date_print, TS1, Res}, next_goal = Next, bindings = Bs0}) -> - {{Year, Month, Day}, {Hour, Minute, Second}} = erlog_et_logic:date_to_data(erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS1, Bs0))), - DateStr = lists:flatten(io_lib:format("~s ~2w ~4w ~2w:~2..0w:~2..0w", [?MONTH(Month), Day, Year, Hour, Minute, Second])), - Bs = erlog_ec_support:add_binding(Res, DateStr, Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); + {{Year, Month, Day}, {Hour, Minute, Second}} = erlog_et_logic:date_to_data(erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS1, Bs0))), + DateStr = lists:flatten(io_lib:format("~s ~2w ~4w ~2w:~2..0w:~2..0w", [?MONTH(Month), Day, Year, Hour, Minute, Second])), + Bs = erlog_ec_support:add_binding(Res, DateStr, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Parses date string and returns timestamp. prove_goal(Params = #param{goal = {date_parse, DataStr, Res}, next_goal = Next, bindings = Bs0}) -> - Data = erlog_et_logic:date_string_to_data(erlog_et_logic:check_var(DataStr, Bs0)), - Bs = erlog_ec_support:add_binding(Res, erlog_et_logic:data_to_ts(Data), Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). \ No newline at end of file + Data = erlog_et_logic:date_string_to_data(erlog_et_logic:check_var(DataStr, Bs0)), + Bs = erlog_ec_support:add_binding(Res, erlog_et_logic:data_to_ts(Data), Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). + +%% @private +to_integer(V) when is_binary(V) -> binary_to_integer(V); +to_integer(V) when is_list(V) -> list_to_integer(V); +to_integer(V) -> V. \ No newline at end of file From d9a3960590ca3311898d1f6b3b50ce696df1217f Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 1 Nov 2014 01:05:02 +0000 Subject: [PATCH 186/251] add try_add --- src/core/logic/erlog_ec_support.erl | 140 +++++++++++---------- src/libs/standard/time/main/erlog_time.erl | 19 +-- 2 files changed, 80 insertions(+), 79 deletions(-) diff --git a/src/core/logic/erlog_ec_support.erl b/src/core/logic/erlog_ec_support.erl index fed692f..c042140 100644 --- a/src/core/logic/erlog_ec_support.erl +++ b/src/core/logic/erlog_ec_support.erl @@ -13,17 +13,17 @@ %% API -export([new_bindings/0, get_binding/2, add_binding/3, - functor/1, cut/3, collect_alternatives/3, - update_result/4, update_vars/4, deref/2, dderef_list/2, - make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3, write/2, is_bound/1]). + functor/1, cut/3, collect_alternatives/3, + update_result/4, update_vars/4, deref/2, dderef_list/2, + make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3, write/2, is_bound/1, try_add/3]). %% deref(Term, Bindings) -> Term. %% Dereference a variable, else just return the term. deref({V} = T0, Bs) -> - case ?BIND:find(V, Bs) of - {ok, T1} -> deref(T1, Bs); - error -> T0 - end; + case ?BIND:find(V, Bs) of + {ok, T1} -> deref(T1, Bs); + error -> T0 + end; deref(T, _) -> T. %Not a variable, return it. %% deref_list(List, Bindings) -> List. @@ -31,10 +31,10 @@ deref(T, _) -> T. %Not a variable, return it. deref_list([], _) -> []; %It already is a list deref_list([_ | _] = L, _) -> L; deref_list({V}, Bs) -> - case dict:find(V, Bs) of - {ok, L} -> deref_list(L, Bs); - error -> erlog_errors:instantiation_error() - end; + case dict:find(V, Bs) of + {ok, L} -> deref_list(L, Bs); + error -> erlog_errors:instantiation_error() + end; deref_list(Other, _) -> erlog_errors:type_error(list, Other). %% dderef(Term, Bindings) -> Term. @@ -43,28 +43,28 @@ deref_list(Other, _) -> erlog_errors:type_error(list, Other). dderef(A, _) when ?IS_CONSTANT(A) -> A; dderef([], _) -> []; dderef([H0 | T0], Bs) -> - [dderef(H0, Bs) | dderef(T0, Bs)]; + [dderef(H0, Bs) | dderef(T0, Bs)]; dderef({V} = Var, Bs) -> - case ?BIND:find(V, Bs) of - {ok, T} -> dderef(T, Bs); - error -> Var - end; + case ?BIND:find(V, Bs) of + {ok, T} -> dderef(T, Bs); + error -> Var + end; dderef(T, Bs) when is_tuple(T) -> - Es0 = tuple_to_list(T), - Es1 = dderef(Es0, Bs), - list_to_tuple(Es1). + Es0 = tuple_to_list(T), + Es1 = dderef(Es0, Bs), + list_to_tuple(Es1). %% dderef_list(List, Bindings) -> List. %% Dereference all variables to any depth but check that the %% top-level is a list. dderef_list([], _Bs) -> []; dderef_list([H | T], Bs) -> - [dderef(H, Bs) | dderef_list(T, Bs)]; + [dderef(H, Bs) | dderef_list(T, Bs)]; dderef_list({V}, Bs) -> - case ?BIND:find(V, Bs) of - {ok, L} -> dderef_list(L, Bs); - error -> erlog_errors:instantiation_error() - end; + case ?BIND:find(V, Bs) of + {ok, L} -> dderef_list(L, Bs); + error -> erlog_errors:instantiation_error() + end; dderef_list(Other, _Bs) -> erlog_errors:type_error(list, Other). %% detects, whether variable is bound or not @@ -76,11 +76,11 @@ is_bound(_) -> true. %% Make a list of new variables starting at VarNum. make_vars(0, _) -> []; make_vars(I, Vn) -> - [{Vn} | make_vars(I - 1, Vn + 1)]. + [{Vn} | make_vars(I - 1, Vn + 1)]. %% functor(Goal) -> {Name,Arity}. functor(T) when ?IS_FUNCTOR(T) -> - {element(1, T), tuple_size(T) - 1}; + {element(1, T), tuple_size(T) - 1}; functor(T) when is_atom(T) -> {T, 0}; functor(T) -> erlog_errors:type_error(callable, T). @@ -92,33 +92,45 @@ pred_ind({N, A}) -> {'/', N, A}. %% Bindings are kept in a dict where the key is the variable name. new_bindings() -> ?BIND:new(). +%% Add bindings if acc is not bound. If it is bound - match result. +try_add(Var, Res, Bs) -> + Value = deref(Res, Bs), + case is_bound(Value) of + false -> add_binding(Res, Var, Bs); %not bound - just add var + true -> + case Value of %is bound. Fail if not the same + Var -> Bs; + _ -> error + end + end. + add_binding({V}, Val, Bs0) -> - ?BIND:store(V, Val, Bs0). + ?BIND:store(V, Val, Bs0). get_binding({V}, Bs) -> - ?BIND:find(V, Bs). + ?BIND:find(V, Bs). collect_alternatives(Goal, FunList, Predicates) -> - Element = index_of(Goal, FunList) - 1, - lists:foldr( - fun({_, Pred, _}, Dict) -> - [_ | ParamList] = tuple_to_list(Pred), - Keys = remove_nth(ParamList, Element), - dict:append(Keys, lists:nth(Element, ParamList), Dict) - end, dict:new(), Predicates). + Element = index_of(Goal, FunList) - 1, + lists:foldr( + fun({_, Pred, _}, Dict) -> + [_ | ParamList] = tuple_to_list(Pred), + Keys = remove_nth(ParamList, Element), + dict:append(Keys, lists:nth(Element, ParamList), Dict) + end, dict:new(), Predicates). update_result(Key, ResultDict, Res, Bs0) -> - case dict:find(Key, ResultDict) of - {ok, Value} -> add_binding(Res, Value, Bs0); - error -> Bs0 - end. + case dict:find(Key, ResultDict) of + {ok, Value} -> add_binding(Res, Value, Bs0); + error -> Bs0 + end. update_vars(Goal, FunList, Key, Bs) -> - Vars = tl(FunList) -- [Goal], - lists:foldl( - fun({N} = Var, UBs1) -> - add_binding(Var, lists:nth(N, Key), UBs1) - end, Bs, Vars). + Vars = tl(FunList) -- [Goal], + lists:foldl( + fun({N} = Var, UBs1) -> + add_binding(Var, lists:nth(N, Key), UBs1) + end, Bs, Vars). index_of(Item, List) -> index_of(Item, List, 1). @@ -127,36 +139,36 @@ index_of(Item, [Item | _], Index) -> Index; index_of(Item, [_ | Tl], Index) -> index_of(Item, Tl, Index + 1). remove_nth(List, N) -> - {A, B} = lists:split(N - 1, List), - A ++ tl(B). + {A, B} = lists:split(N - 1, List), + A ++ tl(B). write(Res, Bs) when is_list(Res) -> - case io_lib:printable_list(Res) of - true -> Res; - false -> erlog_ec_support:dderef(Res, Bs) - end; + case io_lib:printable_list(Res) of + true -> Res; + false -> erlog_ec_support:dderef(Res, Bs) + end; write(Res, Bs) -> - write([Res], Bs). + write([Res], Bs). cut(Label, Last, Param = #param{next_goal = Next, choice = [#cut{label = Label} | Cps] = Cps0}) -> - if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); - true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) - end; + if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); + true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) + end; cut(Label, Last, Param = #param{next_goal = Next, choice = [#cp{type = if_then_else, label = Label} | Cps] = Cps0}) -> - if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); - true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) - end; + if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); + true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) + end; cut(Label, Last, Param = #param{choice = [#cp{type = goal_clauses, label = Label} = Cp | Cps]}) -> - cut_goal_clauses(Last, Cp, Param#param{choice = Cps}); + cut_goal_clauses(Last, Cp, Param#param{choice = Cps}); cut(Label, Last, Param = #param{choice = [_Cp | Cps]}) -> - cut(Label, Last, Param#param{choice = Cps}). + cut(Label, Last, Param#param{choice = Cps}). %% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db). cut_goal_clauses(true, #cp{label = _}, Param = #param{next_goal = Next}) -> - %% Just remove the choice point completely and continue. - erlog_ec_core:prove_body(Param#param{goal = Next}); + %% Just remove the choice point completely and continue. + erlog_ec_core:prove_body(Param#param{goal = Next}); cut_goal_clauses(false, #cp{label = L}, Param = #param{next_goal = Next, choice = Cps}) -> - %% Replace choice point with cut point then continue. - Cut = #cut{label = L}, - erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). \ No newline at end of file + %% Replace choice point with cut point then continue. + Cut = #cut{label = L}, + erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). \ No newline at end of file diff --git a/src/libs/standard/time/main/erlog_time.erl b/src/libs/standard/time/main/erlog_time.erl index 45170ed..3b72b50 100644 --- a/src/libs/standard/time/main/erlog_time.erl +++ b/src/libs/standard/time/main/erlog_time.erl @@ -25,21 +25,10 @@ load(Db) -> prove_goal(Params = #param{goal = {localtime, Var}, next_goal = Next, bindings = Bs0}) -> {M, S, _} = os:timestamp(), Now = erlog_et_logic:date_to_ts({M, S}), - case erlog_ec_support:is_bound(Var) of - true -> %compare to now if set - Value = erlog_ec_support:deref(Var, Bs0), - try to_integer(Value) of - Now -> - erlog_ec_core:prove_body(Params#param{goal = Next}); - _ -> - erlog_errors:fail(Params) - catch - _:_ -> - erlog_errors:fail(Params) - end; - false -> %write now if unset - Bs = erlog_ec_support:add_binding(Var, Now, Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) + Value = to_integer(erlog_ec_support:deref(Var, Bs0)), %convert to integer, as it can be string, or binary. + case erlog_ec_support:try_add(Now, Value, Bs0) of + error -> erlog_errors:fail(Params); + Bs -> erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) end; %% Returns timestamp for data, ignoring time prove_goal(Params = #param{goal = {date, DateString, Res}, next_goal = Next, bindings = Bs0}) -> From a9f6732a7d2fe49638f33460c088d5f27ce7879f Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 3 Nov 2014 23:11:18 +0000 Subject: [PATCH 187/251] partly refactored erlog_memory --- src/storage/erlog_dict.erl | 52 +++++++++++++++++---------- src/storage/erlog_ets.erl | 52 +++++++++++++++++---------- src/storage/erlog_memory.erl | 68 +++++++++++++++++------------------ src/storage/erlog_storage.erl | 14 ++++++++ 4 files changed, 115 insertions(+), 71 deletions(-) diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 2e964b1..1d7fc04 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -27,15 +27,25 @@ close/2, next/2]). +%% erlog db callbacks +-export([db_assertz_clause/2, + db_asserta_clause/2, + db_retract_clause/2, + db_abolish_clauses/2, + db_findall/2, + get_db_procedure/2, + db_listing/2]). + new() -> {ok, dict:new()}. new(_) -> {ok, dict:new()}. -assertz_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> +db_assertz_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> Dict = erlog_db_storage:get_db(dict, Collection), {Res, Udict} = assertz_clause({StdLib, ExLib, Dict}, {Head, Body0}), erlog_db_storage:update_db(Collection, Udict), - {Res, Db}; + {Res, Db}. + assertz_clause({_, _, Db} = Memory, {Head, Body0}) -> Udb = clause(Head, Body0, Memory, fun(Functor, Cs, Body) -> @@ -46,11 +56,12 @@ assertz_clause({_, _, Db} = Memory, {Head, Body0}) -> end), {ok, Udb}. -asserta_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> +db_asserta_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> Dict = erlog_db_storage:get_db(dict, Collection), {Res, Udict} = asserta_clause({StdLib, ExLib, Dict}, {Head, Body0}), erlog_db_storage:update_db(Collection, Udict), - {Res, Db}; + {Res, Db}. + asserta_clause({_, _, Db} = Memory, {Head, Body0}) -> Udb = clause(Head, Body0, Memory, fun(Functor, Cs, Body) -> @@ -65,11 +76,12 @@ asserta_clause({_, _, Db} = Memory, {Head, Body0}) -> end), {ok, Udb}. -retract_clause({StdLib, ExLib, Db}, {Collection, Functor, Ct}) -> +db_retract_clause({StdLib, ExLib, Db}, {Collection, Functor, Ct}) -> Dict = erlog_db_storage:get_db(dict, Collection), {Res, Udict} = retract_clause({StdLib, ExLib, Dict}, {Functor, Ct}), erlog_db_storage:update_db(Collection, Udict), - {Res, Db}; + {Res, Db}. + retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> ok = check_immutable(StdLib, Functor), ok = check_immutable(ExLib, Functor), @@ -80,12 +92,13 @@ retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> end, {ok, Udb}. -abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> +db_abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> Dict = erlog_db_storage:get_db(dict, Collection), {Res, Udict} = abolish_clauses({StdLib, ExLib, Dict}, {Functor}), erlog_db_storage:update_db(Collection, Udict), - {Res, Db}; -abolish_clauses({StdLib, _, Db}, {Functor}) -> + {Res, Db}. + +abolish_clauses({StdLib, _, Db}, Functor) -> ok = check_immutable(StdLib, Functor), Udb = case dict:is_key(Functor, Db) of true -> dict:erase(Functor, Db); @@ -93,7 +106,7 @@ abolish_clauses({StdLib, _, Db}, {Functor}) -> end, {ok, Udb}. -findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call +db_findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call Dict = erlog_db_storage:get_db(dict, Collection), case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> {StFun, Db}; @@ -108,8 +121,9 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call error -> {[], Db} end end - end; -findall({StdLib, ExLib, Db}, {Functor}) -> %for bagof + end. + +findall({StdLib, ExLib, Db}, Functor) -> %for bagof case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> {StFun, Db}; error -> @@ -133,12 +147,13 @@ next(Db, Queue) -> {empty, UQ} -> {{cursor, UQ, result, []}, Db} %nothing to return end. -get_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> +get_db_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> Dict = erlog_db_storage:get_db(dict, Collection), {Res, Udict} = get_procedure({StdLib, ExLib, Dict}, {Functor}), erlog_db_storage:update_db(Collection, Udict), - {Res, Db}; -get_procedure({StdLib, ExLib, Db}, {Functor}) -> + {Res, Db}. + +get_procedure({StdLib, ExLib, Db}, Functor) -> Res = case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> StFun; error -> @@ -155,7 +170,7 @@ get_procedure({StdLib, ExLib, Db}, {Functor}) -> end, {Res, Db}. -get_procedure_type({StdLib, ExLib, Db}, {Functor}) -> +get_procedure_type({StdLib, ExLib, Db}, Functor) -> Res = case dict:is_key(Functor, StdLib) of %search built-in first true -> built_in; false -> @@ -175,11 +190,12 @@ get_interp_functors({_, ExLib, Db}) -> UserSpace = dict:fetch_keys(Db), {lists:concat([Library, UserSpace]), Db}. -listing({StdLib, ExLib, Db}, {Collection, Params}) -> +db_listing({StdLib, ExLib, Db}, {Collection, Params}) -> Dict = erlog_db_storage:get_db(dict, Collection), {Res, Udict} = listing({StdLib, ExLib, Dict}, {Params}), erlog_db_storage:update_db(Collection, Udict), - {Res, Db}; + {Res, Db}. + listing({_, _, Db}, {[Functor, Arity]}) -> {dict:fold( fun({F, A} = Res, _, Acc) when F == Functor andalso A == Arity -> diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 1f06536..7fd2853 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -27,14 +27,24 @@ close/2, next/2]). +%% erlog db callbacks +-export([db_assertz_clause/2, + db_asserta_clause/2, + db_retract_clause/2, + db_abolish_clauses/2, + db_findall/2, + get_db_procedure/2, + db_listing/2]). + new() -> {ok, ets:new(eets, [bag, private])}. new(_) -> {ok, ets:new(eets, [bag, private])}. -assertz_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> +db_assertz_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> Ets = erlog_db_storage:get_db(ets, Collection), {Res, _} = assertz_clause({StdLib, ExLib, Ets}, {Head, Body0}), - {Res, Db}; + {Res, Db}. + assertz_clause({_, _, Db} = Memory, {Head, Body0}) -> clause(Head, Body0, Memory, fun(Functor, Cs, Body) -> @@ -45,10 +55,11 @@ assertz_clause({_, _, Db} = Memory, {Head, Body0}) -> end), {ok, Db}. -asserta_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> +db_asserta_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> Ets = erlog_db_storage:get_db(ets, Collection), {Res, _} = asserta_clause({StdLib, ExLib, Ets}, {Head, Body0}), - {Res, Db}; + {Res, Db}. + asserta_clause({_, _, Db} = Memory, {Head, Body0}) -> clause(Head, Body0, Memory, fun(Functor, Cs, Body) -> @@ -62,10 +73,11 @@ asserta_clause({_, _, Db} = Memory, {Head, Body0}) -> end), {ok, Db}. -retract_clause({StdLib, ExLib, Db}, {Collection, Functor, Ct}) -> +db_retract_clause({StdLib, ExLib, Db}, {Collection, Functor, Ct}) -> Ets = erlog_db_storage:get_db(ets, Collection), {Res, _} = retract_clause({StdLib, ExLib, Ets}, {Functor, Ct}), - {Res, Db}; + {Res, Db}. + retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> ok = check_immutable(StdLib, Functor), ok = check_immutable(ExLib, Functor), @@ -77,16 +89,17 @@ retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> end, {ok, Db}. -abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> +db_abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> Ets = erlog_db_storage:get_db(ets, Collection), {Res, _} = abolish_clauses({StdLib, ExLib, Ets}, {Functor}), - {Res, Db}; -abolish_clauses({StdLib, _, Db}, {Functor}) -> + {Res, Db}. + +abolish_clauses({StdLib, _, Db}, Functor) -> ok = check_immutable(StdLib, Functor), ets:delete(Db, Functor), {ok, Db}. -findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call +db_findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call Ets = erlog_db_storage:get_db(ets, Collection), case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> {StFun, Db}; @@ -101,8 +114,9 @@ findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call {First, Cursor} = form_clauses(CS), {{cursor, Cursor, result, {clauses, First}}, Db} end - end; -findall({StdLib, ExLib, Db}, {Functor}) -> + end. + +findall({StdLib, ExLib, Db}, Functor) -> case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> {StFun, Db}; error -> @@ -130,10 +144,11 @@ next(Ets, Queue) -> {empty, UQ} -> {{cursor, UQ, result, []}, Ets} %nothing to return end. -get_procedure({StdLib, ExLib, _}, {Collection, Functor}) -> +get_db_procedure({StdLib, ExLib, _}, {Collection, Functor}) -> Ets = erlog_db_storage:get_db(ets, Collection), - get_procedure({StdLib, ExLib, Ets}, {Functor}); -get_procedure({StdLib, ExLib, Db}, {Functor}) -> + get_procedure({StdLib, ExLib, Ets}, {Functor}). + +get_procedure({StdLib, ExLib, Db}, Functor) -> Res = case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> StFun; error -> @@ -150,7 +165,7 @@ get_procedure({StdLib, ExLib, Db}, {Functor}) -> end, {Res, Db}. -get_procedure_type({StdLib, ExLib, Db}, {Functor}) -> +get_procedure_type({StdLib, ExLib, Db}, Functor) -> Res = case dict:is_key(Functor, StdLib) of %search built-in first true -> built_in; false -> @@ -173,10 +188,11 @@ get_interp_functors({_, ExLib, Db}) -> end, Library, Db), {Res, Db}. -listing({StdLib, ExLib, Db}, {Collection, Params}) -> +db_listing({StdLib, ExLib, Db}, {Collection, Params}) -> Ets = erlog_db_storage:get_db(ets, Collection), {Res, _} = listing({StdLib, ExLib, Ets}, {Params}), - {Res, Db}; + {Res, Db}. + listing({_, _, Db}, {[Functor, Arity]}) -> {ets:foldl( fun({{F, A} = Res, _}, Acc) when F == Functor andalso A == Arity -> diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index b232cf6..2b3140f 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -73,7 +73,7 @@ load_kernel_space(Database, Module, Functor) -> gen_server:call(Database, {load_kernel_space, {Module, Functor}}). %% libraryspace predicate loading -load_library_space(Database, Proc) -> gen_server:call(Database, {load_library_space, {Proc}}). +load_library_space(Database, Proc) -> gen_server:call(Database, {load_library_space, Proc}). %% userspace predicate loading assertz_clause(Database, {':-', Head, Body}) -> assertz_clause(Database, Head, Body); @@ -83,7 +83,7 @@ assertz_clause(Database, Head, Body) -> gen_server:call(Database, {assertz_claus db_assertz_clause(Database, Collection, {':-', Head, Body}) -> db_assertz_clause(Database, Collection, Head, Body); db_assertz_clause(Database, Collection, Head) -> db_assertz_clause(Database, Collection, Head, true). db_assertz_clause(Database, Collection, Head, Body) -> - gen_server:call(Database, {assertz_clause, {Collection, Head, Body}}). + gen_server:call(Database, {db_assertz_clause, {Collection, Head, Body}}). asserta_clause(Database, {':-', H, B}) -> asserta_clause(Database, H, B); asserta_clause(Database, H) -> asserta_clause(Database, H, true). @@ -92,39 +92,38 @@ asserta_clause(Database, Head, Body) -> gen_server:call(Database, {asserta_claus db_asserta_clause(Database, Collection, {':-', H, B}) -> db_asserta_clause(Database, Collection, H, B); db_asserta_clause(Database, Collection, H) -> db_asserta_clause(Database, Collection, H, true). db_asserta_clause(Database, Collection, Head, Body) -> - gen_server:call(Database, {asserta_clause, {Collection, Head, Body}}). + gen_server:call(Database, {db_asserta_clause, {Collection, Head, Body}}). -db_findall(Database, Collection, Fun) -> gen_server:call(Database, {findall, {Collection, Fun}}). -finadll(Database, Fun) -> gen_server:call(Database, {findall, {Fun}}). +db_findall(Database, Collection, Fun) -> gen_server:call(Database, {db_findall, {Collection, Fun}}). +finadll(Database, Fun) -> gen_server:call(Database, {findall, Fun}). next(Database, Cursor) -> gen_server:call(Database, {next, Cursor}). retract_clause(Database, F, Ct) -> gen_server:call(Database, {retract_clause, {F, Ct}}). db_retract_clause(Database, Collection, F, Ct) -> - gen_server:call(Database, {retract_clause, {Collection, F, Ct}}). + gen_server:call(Database, {db_retract_clause, {Collection, F, Ct}}). -abolish_clauses(Database, Func) -> gen_server:call(Database, {abolish_clauses, {Func}}). +abolish_clauses(Database, Func) -> gen_server:call(Database, {abolish_clauses, Func}). db_abolish_clauses(Database, Collection, Func) -> - gen_server:call(Database, {abolish_clauses, {Collection, Func}}). + gen_server:call(Database, {db_abolish_clauses, {Collection, Func}}). -get_procedure(Database, Func) -> gen_server:call(Database, {get_procedure, {Func}}). -get_db_procedure(Database, Collection, Func) -> gen_server:call(Database, {get_procedure, {Collection, Func}}). +get_procedure(Database, Func) -> gen_server:call(Database, {get_procedure, Func}). +get_db_procedure(Database, Collection, Func) -> gen_server:call(Database, {get_db_procedure, {Collection, Func}}). -get_procedure_type(Database, Func) -> gen_server:call(Database, {get_procedure_type, {Func}}). +get_procedure_type(Database, Func) -> gen_server:call(Database, {get_procedure_type, Func}). get_interp_functors(Database) -> gen_server:call(Database, get_interp_functors). raw_store(Database, Key, Value) -> gen_server:call(Database, {raw_store, {Key, Value}}). -raw_fetch(Database, Key) -> gen_server:call(Database, {raw_fetch, {Key}}). +raw_fetch(Database, Key) -> gen_server:call(Database, {raw_fetch, Key}). raw_append(Database, Key, Value) -> gen_server:call(Database, {raw_append, {Key, Value}}). -raw_erase(Database, Key) -> gen_server:call(Database, {raw_erase, {Key}}). +raw_erase(Database, Key) -> gen_server:call(Database, {raw_erase, Key}). -listing(Database, Args) -> gen_server:call(Database, {listing, {Args}}). - -db_listing(Database, Collection, Args) -> gen_server:call(Database, {listing, {Collection, Args}}). +listing(Database, Args) -> gen_server:call(Database, {listing, Args}). +db_listing(Database, Collection, Args) -> gen_server:call(Database, {db_listing, {Collection, Args}}). close(Database, Cursor) -> gen_server:call(Database, {close, Cursor}). @@ -188,7 +187,7 @@ init([Database, Params]) when is_atom(Database) -> handle_call({load_kernel_space, {Module, Functor}}, _From, State = #state{stdlib = StdLib}) -> %load kernel space into memory UStdlib = dict:store(Functor, {built_in, Module}, StdLib), {reply, ok, State#state{stdlib = UStdlib}}; -handle_call({load_library_space, {{Functor, M, F}}}, _From, State = #state{stdlib = StdLib, exlib = ExLib}) -> %load library space into memory +handle_call({load_library_space, {Functor, M, F}}, _From, State = #state{stdlib = StdLib, exlib = ExLib}) -> %load library space into memory case dict:is_key(Functor, StdLib) of true -> {reply, {erlog_error, {modify, static_procedure, erlog_ec_support:pred_ind(Functor)}}, State}; @@ -198,30 +197,20 @@ handle_call({load_library_space, {{Functor, M, F}}}, _From, State = #state{stdli handle_call({raw_store, {Key, Value}}, _From, State = #state{in_mem = InMem}) -> %findall store Umem = store(Key, Value, InMem), {reply, ok, State#state{in_mem = Umem}}; -handle_call({raw_fetch, {Key}}, _From, State = #state{in_mem = InMem}) -> %findall fetch +handle_call({raw_fetch, Key}, _From, State = #state{in_mem = InMem}) -> %findall fetch Res = fetch(Key, InMem), {reply, Res, State}; handle_call({raw_append, {Key, AppendValue}}, _From, State = #state{in_mem = InMem}) -> %findall append Value = fetch(Key, InMem), Umem = store(Key, lists:concat([Value, [AppendValue]]), InMem), {reply, ok, State#state{in_mem = Umem}}; -handle_call({raw_erase, {Key}}, _From, State = #state{in_mem = InMem}) -> %findall erase +handle_call({raw_erase, Key}, _From, State = #state{in_mem = InMem}) -> %findall erase Umem = dict:erase(Key, InMem), {reply, ok, State#state{in_mem = Umem}}; -handle_call({abolish_clauses, {Func}}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module - try - {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, {Func}), - {reply, Res, State#state{state = NewState, exlib = UpdExlib}} - catch - throw:E -> {reply, E, State} - end; -handle_call({abolish_clauses, {_, Func} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module - try - {UpdExlib, NewState, Res} = check_abolish(Func, StdLib, ExLib, Db, DbState, Params), - {reply, Res, State#state{state = NewState, exlib = UpdExlib}} - catch - throw:E -> {reply, E, State} - end; +handle_call({abolish_clauses, Func}, _From, State) -> %call third-party db module + do_abolish(abolish_clauses, Func, Func, State); +handle_call({db_abolish_clauses, {_, Func} = Params}, _From, State) -> %call third-party db module + do_abolish(db_abolish_clauses, Func, Params, State); handle_call({next, Cursor}, _From, State = #state{state = DbState, database = Db}) -> %get next result by cursor {Res, UState} = Db:next(DbState, Cursor), Ans = case Res of @@ -334,10 +323,19 @@ store(Key, Value, Memory) -> dict:store(Key, Value, Memory). %% @private -check_abolish(Func, StdLib, ExLib, Db, DbState, Params) -> +do_abolish(F, Func, Params, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> + try + {UpdExlib, NewState, Res} = check_abolish(F, Func, StdLib, ExLib, Db, DbState, Params), + {reply, Res, State#state{state = NewState, exlib = UpdExlib}} + catch + throw:E -> {reply, E, State} + end. + +%% @private +check_abolish(F, Func, StdLib, ExLib, Db, DbState, Params) -> case dict:erase(Func, ExLib) of ExLib -> %dict not changed - was not deleted. Search userspace - {Res, NewState} = Db:abolish_clauses({StdLib, ExLib, DbState}, Params), + {Res, NewState} = Db:F({StdLib, ExLib, DbState}, Params), {ExLib, NewState, Res}; UExlib -> %dict changed -> was deleted {UExlib, DbState, ok} diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl index 6f5ecb3..4581140 100644 --- a/src/storage/erlog_storage.erl +++ b/src/storage/erlog_storage.erl @@ -12,21 +12,33 @@ %% ------- Prolog ------- %% add value right -callback assertz_clause({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Param :: term()) -> {ok, NewState :: any()}. +%% same as assertz_clause, but work with specified database +-callback db_assertz_clause({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Param :: term()) -> {ok, NewState :: any()}. %% add value left -callback asserta_clause({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Param :: term()) -> {ok, NewState :: any()}. +%% same as asserta_clause, but work with specified database +-callback db_asserta_clause({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Param :: term()) -> {ok, NewState :: any()}. %% find all values -callback findall({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Functor :: tuple()) -> {Res :: list(), NewState :: any()}. +%% same as retract_clause, but work with specified database +-callback db_findall({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Functor :: tuple()) -> {Res :: list(), NewState :: any()}. %% get all values in memory by search criteria -callback listing({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Param :: term()) -> {Res :: list(), NewState :: any()}. +%% same as retract_clause, but work with specified database +-callback db_listing({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Param :: term()) -> {Res :: list(), NewState :: any()}. %% remove selected functor -callback retract_clause({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Param :: term()) -> {ok, NewState :: any()}. +%% same as retract_clause, but work with specified database +-callback db_retract_clause({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Param :: term()) -> {ok, NewState :: any()}. %% remove all matching functors -callback abolish_clauses({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Func :: term()) -> {ok, NewState :: any()}. +%% same as abolish_clauses, but work with specified database +-callback db_abolish_clauses({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Func :: term()) -> {ok, NewState :: any()}. %% ------- System ------- -callback new() -> {ok, State :: any()}. @@ -40,6 +52,8 @@ -callback next(State :: any(), Pid :: any()) -> {[] | any(), NewState :: any()}. -callback get_procedure({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Func :: term()) -> {atom, NewState :: any()} | {term(), NewState :: any()}. +%% same as get_procedure, but work with specified database +-callback get_db_procedure({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Func :: term()) -> {atom, NewState :: any()} | {term(), NewState :: any()}. -callback get_procedure_type({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Func :: term()) -> {atom(), NewState :: any()}. From 89e7ec3333451f611845e53270e0ee741241b347 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 3 Nov 2014 23:42:43 +0000 Subject: [PATCH 188/251] fix listing --- src/storage/erlog_dict.erl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 1d7fc04..551224c 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -192,23 +192,23 @@ get_interp_functors({_, ExLib, Db}) -> db_listing({StdLib, ExLib, Db}, {Collection, Params}) -> Dict = erlog_db_storage:get_db(dict, Collection), - {Res, Udict} = listing({StdLib, ExLib, Dict}, {Params}), + {Res, Udict} = listing({StdLib, ExLib, Dict}, Params), erlog_db_storage:update_db(Collection, Udict), {Res, Db}. -listing({_, _, Db}, {[Functor, Arity]}) -> +listing({_, _, Db}, [Functor, Arity]) -> {dict:fold( fun({F, A} = Res, _, Acc) when F == Functor andalso A == Arity -> [Res | Acc]; (_, _, Acc) -> Acc end, [], Db), Db}; -listing({_, _, Db}, {[Functor]}) -> +listing({_, _, Db}, [Functor]) -> {dict:fold( fun({F, Arity}, _, Acc) when F == Functor -> [{Functor, Arity} | Acc]; (_, _, Acc) -> Acc end, [], Db), Db}; -listing({_, _, Db}, {[]}) -> +listing({_, _, Db}, []) -> {dict:fetch_keys(Db), Db}. %% @private From 8171d32dd5a41a285eb7c6cbed62d87ef4921fa0 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 4 Nov 2014 05:24:40 +0000 Subject: [PATCH 189/251] move functor deeper from db_call to db_findall --- src/libs/external/db/erlog_db.erl | 2 +- src/storage/erlog_dict.erl | 3 ++- src/storage/erlog_ets.erl | 3 ++- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index dd4e0b7..16ded9b 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -32,7 +32,7 @@ load(Db) -> db_call_2(Param = #param{goal = {db_call, _, _} = Goal, next_goal = Next0, bindings = Bs, database = Db}) -> {db_call, Table, G} = erlog_ec_support:dderef(Goal, Bs), - case erlog_memory:db_findall(Db, Table, erlog_ec_support:functor(G)) of + case erlog_memory:db_findall(Db, Table, G) of {cursor, Cursor, result, Result} -> Fun = fun(Params) -> check_call_result(Result, Params, G, Next0) end, erlog_ec_core:run_n_close(Fun, Param#param{cursor = Cursor}); diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 551224c..60aa276 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -106,7 +106,8 @@ abolish_clauses({StdLib, _, Db}, Functor) -> end, {ok, Udb}. -db_findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call +db_findall({StdLib, ExLib, Db}, {Collection, Goal}) -> %for db_call + Functor = erlog_ec_support:functor(Goal), Dict = erlog_db_storage:get_db(dict, Collection), case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> {StFun, Db}; diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 7fd2853..f0e7572 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -99,7 +99,8 @@ abolish_clauses({StdLib, _, Db}, Functor) -> ets:delete(Db, Functor), {ok, Db}. -db_findall({StdLib, ExLib, Db}, {Collection, Functor}) -> %for db_call +db_findall({StdLib, ExLib, Db}, {Collection, Goal}) -> %for db_call + Functor = erlog_ec_support:functor(Goal), Ets = erlog_db_storage:get_db(ets, Collection), case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> {StFun, Db}; From 75679a0927326d30683775e3b43fb140866e93f0 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 4 Nov 2014 05:32:55 +0000 Subject: [PATCH 190/251] move functor of get_proc_type deeper --- src/libs/external/db/erlog_db.erl | 6 ++++-- src/libs/standard/core/main/erlog_core.erl | 2 +- src/storage/erlog_dict.erl | 3 ++- src/storage/erlog_ets.erl | 3 ++- 4 files changed, 9 insertions(+), 5 deletions(-) diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 16ded9b..6627c35 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -109,7 +109,8 @@ prove_retract(H, B, Table, Params = #param{database = Db}) -> Functor = erlog_ec_support:functor(H), case erlog_memory:get_db_procedure(Db, Table, Functor) of {cursor, Cursor, result, {clauses, Cs}} -> - erlog_ec_core:run_n_close(fun(Param) -> retract_clauses(H, B, Cs, Param, Table) end, Params#param{cursor = Cursor}); + erlog_ec_core:run_n_close(fun(Param) -> + retract_clauses(H, B, Cs, Param, Table) end, Params#param{cursor = Cursor}); undefined -> erlog_errors:fail(Params); _ -> erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)) end. @@ -156,7 +157,8 @@ check_call_result({clauses, Cs}, Param, G, Next) -> prove_call(G, Cs, Next, Para check_call_result({erlog_error, E}, #param{database = Db}, _, _) -> erlog_errors:erlog_error(E, Db); check_call_result(Cs, Param, G, Next) -> prove_call(G, Cs, Next, Param). -retractall_clauses(_, [], _, _, Params = #param{next_goal = Next}) -> erlog_ec_core:prove_body(Params#param{goal = Next}); +retractall_clauses(_, [], _, _, Params = #param{next_goal = Next}) -> + erlog_ec_core:prove_body(Params#param{goal = Next}); retractall_clauses(Table, [Clause], H, B, Params) -> retractall_clauses(Table, Clause, H, B, Params); retractall_clauses(Table, Clause, H, B, Params = #param{bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}) -> case erlog_ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of diff --git a/src/libs/standard/core/main/erlog_core.erl b/src/libs/standard/core/main/erlog_core.erl index d09cce3..9f40184 100644 --- a/src/libs/standard/core/main/erlog_core.erl +++ b/src/libs/standard/core/main/erlog_core.erl @@ -100,7 +100,7 @@ prove_goal(Param = #param{goal = {current_predicate, Pi0}, bindings = Bs}) -> erlog_ec_logic:prove_current_predicate(Pi, Param); prove_goal(Param = #param{goal = {predicate_property, H0, P}, bindings = Bs, database = Db}) -> H = erlog_ec_support:dderef(H0, Bs), - case catch erlog_memory:get_procedure_type(Db, erlog_ec_support:functor(H)) of + case catch erlog_memory:get_procedure_type(Db, H) of built_in -> erlog_ec_body:unify_prove_body(P, built_in, Param); compiled -> erlog_ec_body:unify_prove_body(P, compiled, Param); interpreted -> erlog_ec_body:unify_prove_body(P, interpreted, Param); diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 60aa276..0a267ef 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -171,7 +171,8 @@ get_procedure({StdLib, ExLib, Db}, Functor) -> end, {Res, Db}. -get_procedure_type({StdLib, ExLib, Db}, Functor) -> +get_procedure_type({StdLib, ExLib, Db}, Goal) -> + Functor = erlog_ec_support:functor(Goal), Res = case dict:is_key(Functor, StdLib) of %search built-in first true -> built_in; false -> diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index f0e7572..b8e032d 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -166,7 +166,8 @@ get_procedure({StdLib, ExLib, Db}, Functor) -> end, {Res, Db}. -get_procedure_type({StdLib, ExLib, Db}, Functor) -> +get_procedure_type({StdLib, ExLib, Db}, Goal) -> + Functor = erlog_ec_support:functor(Goal), Res = case dict:is_key(Functor, StdLib) of %search built-in first true -> built_in; false -> From 00bb4a4ebfe7cec132e6d10bfd12b2cc2020983c Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 4 Nov 2014 05:41:14 +0000 Subject: [PATCH 191/251] some fixes in db modules --- src/libs/external/db/erlog_db.erl | 9 +++++---- src/storage/erlog_dict.erl | 13 ++++++++----- src/storage/erlog_ets.erl | 13 ++++++++----- 3 files changed, 21 insertions(+), 14 deletions(-) diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 6627c35..f87b757 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -106,19 +106,20 @@ prove_call(G, Cs, Next0, Param = #param{bindings = Bs, choice = Cps, database = %% @private prove_retract(H, B, Table, Params = #param{database = Db}) -> - Functor = erlog_ec_support:functor(H), - case erlog_memory:get_db_procedure(Db, Table, Functor) of + case erlog_memory:get_db_procedure(Db, Table, H) of {cursor, Cursor, result, {clauses, Cs}} -> erlog_ec_core:run_n_close(fun(Param) -> retract_clauses(H, B, Cs, Param, Table) end, Params#param{cursor = Cursor}); undefined -> erlog_errors:fail(Params); - _ -> erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)) + _ -> + Functor = erlog_ec_support:functor(H), + erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)) end. %% @private prove_retractall(H, B, Table, Params = #param{database = Db}) -> Functor = erlog_ec_support:functor(H), - case erlog_memory:get_db_procedure(Db, Table, Functor) of + case erlog_memory:get_db_procedure(Db, Table, H) of {cursor, Cursor, result, Res} -> check_retractall_result(Res, H, B, Functor, Table, Params#param{cursor = Cursor}); Res -> diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 0a267ef..cc4552c 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -94,7 +94,7 @@ retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> db_abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> Dict = erlog_db_storage:get_db(dict, Collection), - {Res, Udict} = abolish_clauses({StdLib, ExLib, Dict}, {Functor}), + {Res, Udict} = abolish_clauses({StdLib, ExLib, Dict}, Functor), erlog_db_storage:update_db(Collection, Udict), {Res, Db}. @@ -124,7 +124,8 @@ db_findall({StdLib, ExLib, Db}, {Collection, Goal}) -> %for db_call end end. -findall({StdLib, ExLib, Db}, Functor) -> %for bagof +findall({StdLib, ExLib, Db}, Goal) -> %for bagof + Functor = erlog_ec_support:functor(Goal), case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> {StFun, Db}; error -> @@ -148,13 +149,15 @@ next(Db, Queue) -> {empty, UQ} -> {{cursor, UQ, result, []}, Db} %nothing to return end. -get_db_procedure({StdLib, ExLib, Db}, {Collection, Functor}) -> +get_db_procedure({StdLib, ExLib, Db}, {Collection, Goal}) -> + Functor = erlog_ec_support:functor(Goal), Dict = erlog_db_storage:get_db(dict, Collection), - {Res, Udict} = get_procedure({StdLib, ExLib, Dict}, {Functor}), + {Res, Udict} = get_procedure({StdLib, ExLib, Dict}, Functor), erlog_db_storage:update_db(Collection, Udict), {Res, Db}. -get_procedure({StdLib, ExLib, Db}, Functor) -> +get_procedure({StdLib, ExLib, Db}, Goal) -> + Functor = erlog_ec_support:functor(Goal), Res = case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> StFun; error -> diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index b8e032d..16395ec 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -91,7 +91,7 @@ retract_clause({StdLib, ExLib, Db}, {Functor, Ct}) -> db_abolish_clauses({StdLib, ExLib, Db}, {Collection, Functor}) -> Ets = erlog_db_storage:get_db(ets, Collection), - {Res, _} = abolish_clauses({StdLib, ExLib, Ets}, {Functor}), + {Res, _} = abolish_clauses({StdLib, ExLib, Ets}, Functor), {Res, Db}. abolish_clauses({StdLib, _, Db}, Functor) -> @@ -117,7 +117,8 @@ db_findall({StdLib, ExLib, Db}, {Collection, Goal}) -> %for db_call end end. -findall({StdLib, ExLib, Db}, Functor) -> +findall({StdLib, ExLib, Db}, Goal) -> + Functor = erlog_ec_support:functor(Goal), case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> {StFun, Db}; error -> @@ -145,11 +146,13 @@ next(Ets, Queue) -> {empty, UQ} -> {{cursor, UQ, result, []}, Ets} %nothing to return end. -get_db_procedure({StdLib, ExLib, _}, {Collection, Functor}) -> +get_db_procedure({StdLib, ExLib, _}, {Collection, Goal}) -> + Functor = erlog_ec_support:functor(Goal), Ets = erlog_db_storage:get_db(ets, Collection), - get_procedure({StdLib, ExLib, Ets}, {Functor}). + get_procedure({StdLib, ExLib, Ets}, Functor). -get_procedure({StdLib, ExLib, Db}, Functor) -> +get_procedure({StdLib, ExLib, Db}, Goal) -> + Functor = erlog_ec_support:functor(Goal), Res = case dict:find(Functor, StdLib) of %search built-in first {ok, StFun} -> StFun; error -> From 38e37c6baebc433d92bb0e3fbddcf4dd4c250815 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 4 Nov 2014 07:24:21 +0000 Subject: [PATCH 192/251] fix get procedure --- src/core/logic/erlog_ec_core.erl | 2 +- src/libs/standard/core/logic/erlog_ec_logic.erl | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/logic/erlog_ec_core.erl b/src/core/logic/erlog_ec_core.erl index fd71c95..4be91f9 100644 --- a/src/core/logic/erlog_ec_core.erl +++ b/src/core/logic/erlog_ec_core.erl @@ -77,7 +77,7 @@ prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bi prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); prove_goal(Param = #param{goal = G, database = Db}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), - case catch erlog_memory:get_procedure(Db, erlog_ec_support:functor(G)) of + case catch erlog_memory:get_procedure(Db, G) of {cursor, Cursor, result, Result} -> Fun = fun(Params) -> check_result(Result, Params) end, run_n_close(Fun, Param#param{cursor = Cursor}); diff --git a/src/libs/standard/core/logic/erlog_ec_logic.erl b/src/libs/standard/core/logic/erlog_ec_logic.erl index f638fef..5ab852b 100644 --- a/src/libs/standard/core/logic/erlog_ec_logic.erl +++ b/src/libs/standard/core/logic/erlog_ec_logic.erl @@ -65,7 +65,7 @@ prove_ecall(Efun, Val, Param = #param{next_goal = Next, choice = Cps, bindings = %% Unify clauses matching with functor from Head with both Head and Body. prove_clause(H, B, Params = #param{database = Db}) -> Functor = erlog_ec_support:functor(H), - case erlog_memory:get_procedure(Db, Functor) of + case erlog_memory:get_procedure(Db, H) of {cursor, Cursor, result, {clauses, Cs}} -> erlog_ec_core:run_n_close(fun(Param) -> erlog_ec_unify:unify_clauses(H, B, Cs, Param) end, Params#param{cursor = Cursor}); {code, _} -> @@ -226,7 +226,7 @@ partial_list(Other, _) -> erlog_errors:type_error(list, Other). %% @private prove_retract(H, B, Params = #param{database = Db}) -> Functor = erlog_ec_support:functor(H), - case erlog_memory:get_procedure(Db, Functor) of + case erlog_memory:get_procedure(Db, H) of {cursor, Cursor, result, {clauses, Cs}} -> erlog_ec_core:run_n_close(fun(Param) -> retract_clauses(H, B, Cs, Param) end, Params#param{cursor = Cursor}); {code, _} -> @@ -239,7 +239,7 @@ prove_retract(H, B, Params = #param{database = Db}) -> %% @private prove_retractall(H, B, Params = #param{database = Db}) -> Functor = erlog_ec_support:functor(H), - case erlog_memory:get_procedure(Db, Functor) of + case erlog_memory:get_procedure(Db, H) of {cursor, Cursor, result, Result} -> Fun = fun(Param) -> check_result(Result, H, B, Functor, Param) end, erlog_ec_core:run_n_close(Fun, Params#param{cursor = Cursor}); From 611269a089b81a8a05f0ce8ecf80952e15558d36 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 4 Nov 2014 09:36:37 +0000 Subject: [PATCH 193/251] add db_next --- src/libs/external/db/erlog_db.erl | 6 +++--- src/storage/erlog_dict.erl | 5 ++++- src/storage/erlog_ets.erl | 5 ++++- src/storage/erlog_memory.erl | 4 +++- src/storage/erlog_storage.erl | 1 + 5 files changed, 15 insertions(+), 6 deletions(-) diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index f87b757..4210824 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -144,12 +144,12 @@ retract_clauses(Ch, Cb, C, Param = #param{bindings = Bs0, var_num = Vn0, databas %% We have found a right clause so now retract it. retract(Ch, Cb, C, Cursor, Param, Bs1, Vn1, Table); fail -> - {UCursor, Res} = erlog_memory:next(Db, Cursor), + {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), retract_clauses(Ch, Cb, Res, Param#param{cursor = UCursor}, Table) end. fail_retract(#cp{data = {Ch, Cb, {Db, Cursor}, Table}, next = Next, bs = Bs, vn = Vn}, Param) -> - {UCursor, Res} = erlog_memory:next(Db, Cursor), + {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), retract_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}, Table). %% @private @@ -165,7 +165,7 @@ retractall_clauses(Table, Clause, H, B, Params = #param{bindings = Bs0, var_num case erlog_ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of {succeed, _, _} -> erlog_memory:db_retract_clause(Db, Table, erlog_ec_support:functor(H), element(1, Clause)), - {UCursor, Res} = erlog_memory:next(Db, Cursor), + {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), retractall_clauses(Table, Res, H, B, Params#param{cursor = UCursor}); fail -> retractall_clauses(Table, [], H, B, Params) diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index cc4552c..765916e 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -34,7 +34,8 @@ db_abolish_clauses/2, db_findall/2, get_db_procedure/2, - db_listing/2]). + db_listing/2, + db_next/3]). new() -> {ok, dict:new()}. @@ -149,6 +150,8 @@ next(Db, Queue) -> {empty, UQ} -> {{cursor, UQ, result, []}, Db} %nothing to return end. +db_next(Db, Queue, _Table) -> next(Db, Queue). + get_db_procedure({StdLib, ExLib, Db}, {Collection, Goal}) -> Functor = erlog_ec_support:functor(Goal), Dict = erlog_db_storage:get_db(dict, Collection), diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 16395ec..ae58603 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -34,7 +34,8 @@ db_abolish_clauses/2, db_findall/2, get_db_procedure/2, - db_listing/2]). + db_listing/2, + db_next/3]). new() -> {ok, ets:new(eets, [bag, private])}. @@ -146,6 +147,8 @@ next(Ets, Queue) -> {empty, UQ} -> {{cursor, UQ, result, []}, Ets} %nothing to return end. +db_next(Db, Queue, _Table) -> next(Db, Queue). + get_db_procedure({StdLib, ExLib, _}, {Collection, Goal}) -> Functor = erlog_ec_support:functor(Goal), Ets = erlog_db_storage:get_db(ets, Collection), diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 2b3140f..bb94cdf 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -43,7 +43,8 @@ db_abolish_clauses/3, get_db_procedure/3, db_findall/3, - db_listing/3]). + db_listing/3, + db_next/3]). -export([load_kernel_space/3]). @@ -98,6 +99,7 @@ db_findall(Database, Collection, Fun) -> gen_server:call(Database, {db_findall, finadll(Database, Fun) -> gen_server:call(Database, {findall, Fun}). next(Database, Cursor) -> gen_server:call(Database, {next, Cursor}). +db_next(Database, Cursor, Table) -> gen_server:call(Database, {db_next, Cursor, Table}). retract_clause(Database, F, Ct) -> gen_server:call(Database, {retract_clause, {F, Ct}}). db_retract_clause(Database, Collection, F, Ct) -> diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl index 4581140..37fcc2f 100644 --- a/src/storage/erlog_storage.erl +++ b/src/storage/erlog_storage.erl @@ -50,6 +50,7 @@ %% get next result by cursor -callback next(State :: any(), Pid :: any()) -> {[] | any(), NewState :: any()}. +-callback db_next(State :: any(), Pid :: any(), Table :: any()) -> {[] | any(), NewState :: any()}. -callback get_procedure({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Func :: term()) -> {atom, NewState :: any()} | {term(), NewState :: any()}. %% same as get_procedure, but work with specified database From 16b77002137a2a3af2d03cc29fdca03753b4b3c2 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 4 Nov 2014 09:42:03 +0000 Subject: [PATCH 194/251] fix apply --- src/storage/erlog_memory.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index bb94cdf..9449bbb 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -99,7 +99,7 @@ db_findall(Database, Collection, Fun) -> gen_server:call(Database, {db_findall, finadll(Database, Fun) -> gen_server:call(Database, {findall, Fun}). next(Database, Cursor) -> gen_server:call(Database, {next, Cursor}). -db_next(Database, Cursor, Table) -> gen_server:call(Database, {db_next, Cursor, Table}). +db_next(Database, Cursor, Table) -> gen_server:call(Database, {db_next, {Cursor, Table}}). retract_clause(Database, F, Ct) -> gen_server:call(Database, {retract_clause, {F, Ct}}). db_retract_clause(Database, Collection, F, Ct) -> From c50c2c0c96960c0367cdf665a62e34361757e018 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 4 Nov 2014 09:59:59 +0000 Subject: [PATCH 195/251] fix db_next --- src/storage/erlog_memory.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 9449bbb..c07e9be 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -213,8 +213,8 @@ handle_call({abolish_clauses, Func}, _From, State) -> %call third-party db modu do_abolish(abolish_clauses, Func, Func, State); handle_call({db_abolish_clauses, {_, Func} = Params}, _From, State) -> %call third-party db module do_abolish(db_abolish_clauses, Func, Params, State); -handle_call({next, Cursor}, _From, State = #state{state = DbState, database = Db}) -> %get next result by cursor - {Res, UState} = Db:next(DbState, Cursor), +handle_call({Fun, Cursor}, _From, State = #state{state = DbState, database = Db}) when Fun == next; Fun == db_next -> %get next result by cursor + {Res, UState} = Db:Fun(DbState, Cursor), Ans = case Res of {cursor, After, result, Result} -> {After, Result}; %got new (or same cursor) and result. Form and return [] -> {Cursor, []} %no result got - return old cursor and empty result From 842c15db55fde90cf08b9617b471c47893ab875c Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 4 Nov 2014 10:02:07 +0000 Subject: [PATCH 196/251] fix spec --- src/storage/erlog_storage.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/storage/erlog_storage.erl b/src/storage/erlog_storage.erl index 37fcc2f..01ce58c 100644 --- a/src/storage/erlog_storage.erl +++ b/src/storage/erlog_storage.erl @@ -50,7 +50,7 @@ %% get next result by cursor -callback next(State :: any(), Pid :: any()) -> {[] | any(), NewState :: any()}. --callback db_next(State :: any(), Pid :: any(), Table :: any()) -> {[] | any(), NewState :: any()}. +-callback db_next(State :: any(), Params :: tuple()) -> {[] | any(), NewState :: any()}. -callback get_procedure({Stdlib :: ets:tid(), ExLib :: ets:tid(), State :: any()}, Func :: term()) -> {atom, NewState :: any()} | {term(), NewState :: any()}. %% same as get_procedure, but work with specified database From b7a2b83ca8c338280c85be342a0d3ee8d38c9712 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 11 Nov 2014 03:05:56 +0000 Subject: [PATCH 197/251] fix db_next --- src/storage/erlog_dict.erl | 7 +++---- src/storage/erlog_ets.erl | 5 ++--- src/storage/erlog_memory.erl | 9 +++++++++ 3 files changed, 14 insertions(+), 7 deletions(-) diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 1b62c00..e315af5 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -47,7 +47,7 @@ db_assertz_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> assertz_clause({_, _, Db} = Memory, {Head, Body0}) -> Udb = clause(Head, Body0, Memory, - fun(Functor, Cs, Body) -> + fun(Functor, Cs, Body) -> case check_duplicates(Cs, Head, Body) of true -> Db; %found - do nothing _ -> dict:append(Functor, {length(Cs), Head, Body}, Db) %not found - insert new @@ -145,12 +145,11 @@ next(Db, Queue) -> {empty, UQ} -> {{cursor, UQ, result, []}, Db} %nothing to return end. -db_next(Db, Queue) -> next(Db, Queue). +db_next(Db, {Queue, _Table}) -> next(Db, Queue). get_db_procedure({StdLib, ExLib, Db}, {Collection, Goal}) -> - Functor = erlog_ec_support:functor(Goal), Dict = erlog_db_storage:get_db(dict, Collection), - {Res, Udict} = get_procedure({StdLib, ExLib, Dict}, Functor), + {Res, Udict} = get_procedure({StdLib, ExLib, Dict}, Goal), erlog_db_storage:update_db(Collection, Udict), {Res, Db}. diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index 083865f..f0bc9e8 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -141,12 +141,11 @@ next(Ets, Queue) -> {empty, UQ} -> {{cursor, UQ, result, []}, Ets} %nothing to return end. -db_next(Db, Queue) -> next(Db, Queue). +db_next(Db, {Queue, _Table}) -> next(Db, Queue). get_db_procedure({StdLib, ExLib, _}, {Collection, Goal}) -> - Functor = erlog_ec_support:functor(Goal), Ets = erlog_db_storage:get_db(ets, Collection), - get_procedure({StdLib, ExLib, Ets}, Functor). + get_procedure({StdLib, ExLib, Ets}, Goal). get_procedure({StdLib, ExLib, Db}, Goal) -> Functor = erlog_ec_support:functor(Goal), diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index c29f802..11b978b 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -227,10 +227,19 @@ handle_call({Fun, {F, _} = Params}, _From, State = #state{state = DbState, datab check_immutable(StdLib, erlog_ec_support:functor(F)), %modifying fact in default memory need to be checked check_immutable(ExLib, erlog_ec_support:functor(F)), do_action(Db, Fun, {StdLib, ExLib, DbState}, Params, State); +handle_call({Fun, {_, H, _} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) + when Fun == db_asserta_clause; Fun == db_assertz_clause -> + check_immutable(StdLib, erlog_ec_support:functor(H)), %modifying fact in default memory need to be checked + check_immutable(ExLib, erlog_ec_support:functor(H)), + do_action(Db, Fun, {StdLib, ExLib, DbState}, Params, State); handle_call({retract_clause, {Func, _} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> check_immutable(StdLib, Func), %modifying fact in default memory need to be checked check_immutable(ExLib, Func), do_action(Db, retract_clause, {StdLib, ExLib, DbState}, Params, State); +handle_call({db_retract_clause, {_, Func, _} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> + check_immutable(StdLib, Func), %modifying fact in default memory need to be checked + check_immutable(ExLib, Func), + do_action(Db, db_retract_clause, {StdLib, ExLib, DbState}, Params, State); handle_call({Fun, Cursor}, _From, State = #state{state = DbState, database = Db}) when Fun == next; Fun == db_next -> %get next result by cursor {Res, UState} = Db:Fun(DbState, Cursor), Ans = case Res of From a162b73e310cf8c70a9f2404b8ef2d8aaed613f5 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 11 Nov 2014 03:19:50 +0000 Subject: [PATCH 198/251] refactoring --- src/storage/erlog_memory.erl | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 11b978b..3c67aa6 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -222,15 +222,17 @@ handle_call({abolish_clauses, Func}, _From, State = #state{stdlib = StdLib}) -> handle_call({db_abolish_clauses, {_, Func} = Params}, _From, State = #state{stdlib = StdLib}) -> %call third-party db module check_immutable(StdLib, Func), %abolishing fact from default memory need to be checked check_abolish(db_abolish_clauses, Func, Params, State); -handle_call({Fun, {F, _} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) +handle_call({Fun, {H, _} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) when Fun == asserta_clause; Fun == assertz_clause -> - check_immutable(StdLib, erlog_ec_support:functor(F)), %modifying fact in default memory need to be checked - check_immutable(ExLib, erlog_ec_support:functor(F)), + F = erlog_ec_support:functor(H), + check_immutable(StdLib, F), %modifying fact in default memory need to be checked + check_immutable(ExLib, F), do_action(Db, Fun, {StdLib, ExLib, DbState}, Params, State); handle_call({Fun, {_, H, _} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) when Fun == db_asserta_clause; Fun == db_assertz_clause -> - check_immutable(StdLib, erlog_ec_support:functor(H)), %modifying fact in default memory need to be checked - check_immutable(ExLib, erlog_ec_support:functor(H)), + F = erlog_ec_support:functor(H), + check_immutable(StdLib, F), %modifying fact in default memory need to be checked + check_immutable(ExLib, F), do_action(Db, Fun, {StdLib, ExLib, DbState}, Params, State); handle_call({retract_clause, {Func, _} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> check_immutable(StdLib, Func), %modifying fact in default memory need to be checked From 4105a29eef6a378a57a4f473c6a3e633ee1d6096 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 12 Nov 2014 00:26:50 +0000 Subject: [PATCH 199/251] move check var to support --- src/core/logic/erlog_ec_support.erl | 11 +++++++++- .../standard/time/logic/erlog_et_logic.erl | 13 ++--------- src/libs/standard/time/main/erlog_time.erl | 22 +++++++++---------- 3 files changed, 23 insertions(+), 23 deletions(-) diff --git a/src/core/logic/erlog_ec_support.erl b/src/core/logic/erlog_ec_support.erl index c042140..04e383d 100644 --- a/src/core/logic/erlog_ec_support.erl +++ b/src/core/logic/erlog_ec_support.erl @@ -15,7 +15,7 @@ -export([new_bindings/0, get_binding/2, add_binding/3, functor/1, cut/3, collect_alternatives/3, update_result/4, update_vars/4, deref/2, dderef_list/2, - make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3, write/2, is_bound/1, try_add/3]). + make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3, write/2, is_bound/1, try_add/3, check_var/2]). %% deref(Term, Bindings) -> Term. %% Dereference a variable, else just return the term. @@ -84,6 +84,15 @@ functor(T) when ?IS_FUNCTOR(T) -> functor(T) when is_atom(T) -> {T, 0}; functor(T) -> erlog_errors:type_error(callable, T). +%% Checks - if var is normal, or binded, or < 0 (if int). Returns var's value. +check_var({'-', Var}, Bs) -> + case check_var(Var, Bs) of + Res when is_integer(Res) -> -1 * Res; + Res -> Res + end; +check_var({Var}, Bs) -> check_var(erlog_ec_support:deref({Var}, Bs), Bs); +check_var(Var, _) -> Var. + pred_ind({N, A}) -> {'/', N, A}. %% pred_ind(N, A) -> {'/',N,A}. diff --git a/src/libs/standard/time/logic/erlog_et_logic.erl b/src/libs/standard/time/logic/erlog_et_logic.erl index 9152dc1..3413b9e 100644 --- a/src/libs/standard/time/logic/erlog_et_logic.erl +++ b/src/libs/standard/time/logic/erlog_et_logic.erl @@ -12,7 +12,7 @@ -include("erlog_time.hrl"). %% API --export([date_to_ts/1, date_string_to_data/1, check_var/2, data_to_ts/1, date_to_seconds/2, seconds_to_date/2, date_to_data/1, ts_to_date/1]). +-export([date_to_ts/1, date_string_to_data/1, data_to_ts/1, date_to_seconds/2, seconds_to_date/2, date_to_data/1, ts_to_date/1]). %% Time in microseconds, atom for output format -spec seconds_to_date(Time :: integer(), atom()) -> integer(). @@ -57,13 +57,4 @@ date_to_ts({M1, S1}) -> ts_to_date(Timestamp) -> TSStr = integer_to_list(Timestamp), {M1, S1} = lists:split(4, TSStr), - {list_to_integer(M1), list_to_integer(S1), 0}. - -%% Checks - if var is normal, or binded, or < 0 (if int). Returns var's value. -check_var({'-', Var}, Bs) -> - case check_var(Var, Bs) of - Res when is_integer(Res) -> -1 * Res; - Res -> Res - end; -check_var({Var}, Bs) -> check_var(erlog_ec_support:deref({Var}, Bs), Bs); -check_var(Var, _) -> Var. \ No newline at end of file + {list_to_integer(M1), list_to_integer(S1), 0}. \ No newline at end of file diff --git a/src/libs/standard/time/main/erlog_time.erl b/src/libs/standard/time/main/erlog_time.erl index 3b72b50..51db270 100644 --- a/src/libs/standard/time/main/erlog_time.erl +++ b/src/libs/standard/time/main/erlog_time.erl @@ -32,47 +32,47 @@ prove_goal(Params = #param{goal = {localtime, Var}, next_goal = Next, bindings = end; %% Returns timestamp for data, ignoring time prove_goal(Params = #param{goal = {date, DateString, Res}, next_goal = Next, bindings = Bs0}) -> - {{Y, M, D}, _} = erlog_et_logic:date_string_to_data(erlog_et_logic:check_var(DateString, Bs0)), + {{Y, M, D}, _} = erlog_et_logic:date_string_to_data(erlog_ec_support:check_var(DateString, Bs0)), DataTS = erlog_et_logic:data_to_ts({{Y, M, D}, {0, 0, 0}}), Bs = erlog_ec_support:add_binding(Res, DataTS, Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Returns timestamp for data, ignoring time prove_goal(Params = #param{goal = {date, D, M, Y, Res}, next_goal = Next, bindings = Bs0}) -> - DataTS = erlog_et_logic:data_to_ts({{erlog_et_logic:check_var(Y, Bs0), erlog_et_logic:check_var(M, Bs0), erlog_et_logic:check_var(D, Bs0)}, {0, 0, 0}}), + DataTS = erlog_et_logic:data_to_ts({{erlog_ec_support:check_var(Y, Bs0), erlog_ec_support:check_var(M, Bs0), erlog_ec_support:check_var(D, Bs0)}, {0, 0, 0}}), Bs = erlog_ec_support:add_binding(Res, DataTS, Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Returns timestamp for data, ignoring data. prove_goal(Params = #param{goal = {time, TimeString, Res}, next_goal = Next, bindings = Bs0}) -> - {_, {H, M, S}} = erlog_et_logic:date_string_to_data(erlog_et_logic:check_var(TimeString, Bs0)), %cut YMD + {_, {H, M, S}} = erlog_et_logic:date_string_to_data(erlog_ec_support:check_var(TimeString, Bs0)), %cut YMD TS = S * erlog_et_logic:date_to_seconds(M, minute) * erlog_et_logic:date_to_seconds(H, hour), Bs = erlog_ec_support:add_binding(Res, TS, Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Returns timestamp for data, ignoring data. prove_goal(Params = #param{goal = {time, H, M, S, Res}, next_goal = Next, bindings = Bs0}) -> - TS = erlog_et_logic:check_var(S, Bs0) - * erlog_et_logic:date_to_seconds(erlog_et_logic:check_var(M, Bs0), minute) - * erlog_et_logic:date_to_seconds(erlog_et_logic:check_var(H, Bs0), hour), + TS = erlog_ec_support:check_var(S, Bs0) + * erlog_et_logic:date_to_seconds(erlog_ec_support:check_var(M, Bs0), minute) + * erlog_et_logic:date_to_seconds(erlog_ec_support:check_var(H, Bs0), hour), Bs = erlog_ec_support:add_binding(Res, TS, Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Calculates differense between two timestamps. Returns the result in specifyed format prove_goal(Params = #param{goal = {date_diff, TS1, TS2, Format, Res}, next_goal = Next, bindings = Bs0}) -> - Diff = timer:now_diff(erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS1, Bs0)), erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS2, Bs0))) / 1000000, - Bs = erlog_ec_support:add_binding(Res, erlog_et_logic:seconds_to_date(Diff, erlog_et_logic:check_var(Format, Bs0)), Bs0), + Diff = timer:now_diff(erlog_et_logic:ts_to_date(erlog_ec_support:check_var(TS1, Bs0)), erlog_et_logic:ts_to_date(erlog_ec_support:check_var(TS2, Bs0))) / 1000000, + Bs = erlog_ec_support:add_binding(Res, erlog_et_logic:seconds_to_date(Diff, erlog_ec_support:check_var(Format, Bs0)), Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Adds number of seconds T2 in Type format to Time1. Returns timestamp prove_goal(Params = #param{goal = {add_time, Time1, Type, T2, Res}, next_goal = Next, bindings = Bs0}) -> - Diff = erlog_et_logic:check_var(Time1, Bs0) + erlog_et_logic:date_to_seconds(erlog_et_logic:check_var(T2, Bs0), erlog_et_logic:check_var(Type, Bs0)), + Diff = erlog_ec_support:check_var(Time1, Bs0) + erlog_et_logic:date_to_seconds(erlog_ec_support:check_var(T2, Bs0), erlog_ec_support:check_var(Type, Bs0)), Bs = erlog_ec_support:add_binding(Res, Diff, Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Converts timestamp to human readable format prove_goal(Params = #param{goal = {date_print, TS1, Res}, next_goal = Next, bindings = Bs0}) -> - {{Year, Month, Day}, {Hour, Minute, Second}} = erlog_et_logic:date_to_data(erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS1, Bs0))), + {{Year, Month, Day}, {Hour, Minute, Second}} = erlog_et_logic:date_to_data(erlog_et_logic:ts_to_date(erlog_ec_support:check_var(TS1, Bs0))), DateStr = lists:flatten(io_lib:format("~s ~2w ~4w ~2w:~2..0w:~2..0w", [?MONTH(Month), Day, Year, Hour, Minute, Second])), Bs = erlog_ec_support:add_binding(Res, DateStr, Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Parses date string and returns timestamp. prove_goal(Params = #param{goal = {date_parse, DataStr, Res}, next_goal = Next, bindings = Bs0}) -> - Data = erlog_et_logic:date_string_to_data(erlog_et_logic:check_var(DataStr, Bs0)), + Data = erlog_et_logic:date_string_to_data(erlog_ec_support:check_var(DataStr, Bs0)), Bs = erlog_ec_support:add_binding(Res, erlog_et_logic:data_to_ts(Data), Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). From 7dbad315752a57cd3a942b77b6b44019de71b4ab Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 13 Nov 2014 22:29:19 +0000 Subject: [PATCH 200/251] add legasy branch --- src/libs/external/db/erlog_db.erl | 4 ++-- src/storage/erlog_dict.erl | 4 ++-- src/storage/erlog_ets.erl | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 4210824..2a9c17f 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -25,7 +25,7 @@ db_call_2/1, db_listing_2/1, db_listing_3/1, - db_listing_4/1]). + db_listing_4/1, prove_call/4]). load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:load_library_space(Db, Proc) end, ?ERLOG_DB). @@ -94,7 +94,6 @@ prove_retractall({':-', H, B}, Table, Params) -> prove_retractall(H, Table, Params) -> prove_retractall(H, true, Table, Params). -%% @private prove_call(G, Cs, Next0, Param = #param{bindings = Bs, choice = Cps, database = Db, var_num = Vn}) -> case erlog_ec_logic:check_goal(G, Next0, Bs, Db, false, Vn) of {[Next1 | _], true} -> @@ -104,6 +103,7 @@ prove_call(G, Cs, Next0, Param = #param{bindings = Bs, choice = Cps, database = {[Next1 | _], false} -> erlog_ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, var_num = Vn + 1}) end. + %% @private prove_retract(H, B, Table, Params = #param{database = Db}) -> case erlog_memory:get_db_procedure(Db, Table, H) of diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index 765916e..1ea795d 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -35,7 +35,7 @@ db_findall/2, get_db_procedure/2, db_listing/2, - db_next/3]). + db_next/2]). new() -> {ok, dict:new()}. @@ -150,7 +150,7 @@ next(Db, Queue) -> {empty, UQ} -> {{cursor, UQ, result, []}, Db} %nothing to return end. -db_next(Db, Queue, _Table) -> next(Db, Queue). +db_next(Db, {Queue, _Table}) -> next(Db, Queue). get_db_procedure({StdLib, ExLib, Db}, {Collection, Goal}) -> Functor = erlog_ec_support:functor(Goal), diff --git a/src/storage/erlog_ets.erl b/src/storage/erlog_ets.erl index ae58603..542fef8 100644 --- a/src/storage/erlog_ets.erl +++ b/src/storage/erlog_ets.erl @@ -35,7 +35,7 @@ db_findall/2, get_db_procedure/2, db_listing/2, - db_next/3]). + db_next/2]). new() -> {ok, ets:new(eets, [bag, private])}. @@ -147,7 +147,7 @@ next(Ets, Queue) -> {empty, UQ} -> {{cursor, UQ, result, []}, Ets} %nothing to return end. -db_next(Db, Queue, _Table) -> next(Db, Queue). +db_next(Db, {Queue, _Table}) -> next(Db, Queue). get_db_procedure({StdLib, ExLib, _}, {Collection, Goal}) -> Functor = erlog_ec_support:functor(Goal), From 6a322fafa052b9b05dc3fe800b23e5c7109a6a1e Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 13 Nov 2014 22:33:01 +0000 Subject: [PATCH 201/251] cherry pick prove_call export --- src/libs/external/db/erlog_db.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 4ed8e63..6199913 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -25,7 +25,7 @@ db_call_2/1, db_listing_2/1, db_listing_3/1, - db_listing_4/1]). + db_listing_4/1, prove_call/4]). load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:load_native_library(Db, Proc) end, ?ERLOG_DB). @@ -94,7 +94,6 @@ prove_retractall({':-', H, B}, Table, Params) -> prove_retractall(H, Table, Params) -> prove_retractall(H, true, Table, Params). -%% @private prove_call(G, Cs, Next0, Param = #param{bindings = Bs, choice = Cps, database = Db, var_num = Vn}) -> case erlog_ec_logic:check_goal(G, Next0, Bs, Db, false, Vn) of {[Next1 | _], true} -> @@ -104,6 +103,7 @@ prove_call(G, Cs, Next0, Param = #param{bindings = Bs, choice = Cps, database = {[Next1 | _], false} -> erlog_ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, var_num = Vn + 1}) end. + %% @private prove_retract(H, B, Table, Params = #param{database = Db}) -> case erlog_memory:get_db_procedure(Db, Table, H) of From 55b237a68a5ab2097f4ad91f95e3dc55c1c14a73 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 17 Nov 2014 23:57:47 +0000 Subject: [PATCH 202/251] improve date diff --- src/libs/standard/time/main/erlog_time.erl | 29 ++++++++++++++++++---- 1 file changed, 24 insertions(+), 5 deletions(-) diff --git a/src/libs/standard/time/main/erlog_time.erl b/src/libs/standard/time/main/erlog_time.erl index 3b72b50..038f0dc 100644 --- a/src/libs/standard/time/main/erlog_time.erl +++ b/src/libs/standard/time/main/erlog_time.erl @@ -55,10 +55,18 @@ prove_goal(Params = #param{goal = {time, H, M, S, Res}, next_goal = Next, bindin Bs = erlog_ec_support:add_binding(Res, TS, Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Calculates differense between two timestamps. Returns the result in specifyed format -prove_goal(Params = #param{goal = {date_diff, TS1, TS2, Format, Res}, next_goal = Next, bindings = Bs0}) -> - Diff = timer:now_diff(erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS1, Bs0)), erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS2, Bs0))) / 1000000, - Bs = erlog_ec_support:add_binding(Res, erlog_et_logic:seconds_to_date(Diff, erlog_et_logic:check_var(Format, Bs0)), Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); +prove_goal(Params = #param{goal = {date_diff, _, _, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> + {date_diff, TS1, TS2, Format, Res} = erlog_ec_support:deref(Goal, Bs0), + case check_bound([TS1, TS2, Format]) of + ok -> + Diff = timer:now_diff(erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS1, Bs0)), erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS2, Bs0))) / 1000000, + Time = erlog_et_logic:seconds_to_date(Diff, erlog_et_logic:check_var(Format, Bs0)), + case erlog_ec_support:try_add(Res, Time, Bs0) of + error -> erlog_errors:fail(Params); + Bs -> erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) + end; + no -> erlog_errors:fail(Params) + end; %% Adds number of seconds T2 in Type format to Time1. Returns timestamp prove_goal(Params = #param{goal = {add_time, Time1, Type, T2, Res}, next_goal = Next, bindings = Bs0}) -> Diff = erlog_et_logic:check_var(Time1, Bs0) + erlog_et_logic:date_to_seconds(erlog_et_logic:check_var(T2, Bs0), erlog_et_logic:check_var(Type, Bs0)), @@ -79,4 +87,15 @@ prove_goal(Params = #param{goal = {date_parse, DataStr, Res}, next_goal = Next, %% @private to_integer(V) when is_binary(V) -> binary_to_integer(V); to_integer(V) when is_list(V) -> list_to_integer(V); -to_integer(V) -> V. \ No newline at end of file +to_integer(V) -> V. + +%% @private +-spec check_bound(VarList :: list()) -> ok | no. +check_bound(VarList) -> + catch lists:foreach( + fun(Var) -> + case erlog_ec_support:is_bound(Var) of + true -> ok; + false -> throw(no) + end + end, VarList). \ No newline at end of file From 12f7e4b134967c2f60a1360f8b9cf02f485f376a Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 17 Nov 2014 23:57:47 +0000 Subject: [PATCH 203/251] merge --- src/libs/standard/time/main/erlog_time.erl | 29 ++++++++++++++++++---- 1 file changed, 24 insertions(+), 5 deletions(-) diff --git a/src/libs/standard/time/main/erlog_time.erl b/src/libs/standard/time/main/erlog_time.erl index 51db270..15f4c6b 100644 --- a/src/libs/standard/time/main/erlog_time.erl +++ b/src/libs/standard/time/main/erlog_time.erl @@ -55,10 +55,18 @@ prove_goal(Params = #param{goal = {time, H, M, S, Res}, next_goal = Next, bindin Bs = erlog_ec_support:add_binding(Res, TS, Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); %% Calculates differense between two timestamps. Returns the result in specifyed format -prove_goal(Params = #param{goal = {date_diff, TS1, TS2, Format, Res}, next_goal = Next, bindings = Bs0}) -> - Diff = timer:now_diff(erlog_et_logic:ts_to_date(erlog_ec_support:check_var(TS1, Bs0)), erlog_et_logic:ts_to_date(erlog_ec_support:check_var(TS2, Bs0))) / 1000000, - Bs = erlog_ec_support:add_binding(Res, erlog_et_logic:seconds_to_date(Diff, erlog_ec_support:check_var(Format, Bs0)), Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}); +prove_goal(Params = #param{goal = {date_diff, _, _, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> + {date_diff, TS1, TS2, Format, Res} = erlog_ec_support:deref(Goal, Bs0), + case check_bound([TS1, TS2, Format]) of + ok -> + Diff = timer:now_diff(erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS1, Bs0)), erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS2, Bs0))) / 1000000, + Time = erlog_et_logic:seconds_to_date(Diff, erlog_et_logic:check_var(Format, Bs0)), + case erlog_ec_support:try_add(Res, Time, Bs0) of + error -> erlog_errors:fail(Params); + Bs -> erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) + end; + no -> erlog_errors:fail(Params) + end; %% Adds number of seconds T2 in Type format to Time1. Returns timestamp prove_goal(Params = #param{goal = {add_time, Time1, Type, T2, Res}, next_goal = Next, bindings = Bs0}) -> Diff = erlog_ec_support:check_var(Time1, Bs0) + erlog_et_logic:date_to_seconds(erlog_ec_support:check_var(T2, Bs0), erlog_ec_support:check_var(Type, Bs0)), @@ -79,4 +87,15 @@ prove_goal(Params = #param{goal = {date_parse, DataStr, Res}, next_goal = Next, %% @private to_integer(V) when is_binary(V) -> binary_to_integer(V); to_integer(V) when is_list(V) -> list_to_integer(V); -to_integer(V) -> V. \ No newline at end of file +to_integer(V) -> V. + +%% @private +-spec check_bound(VarList :: list()) -> ok | no. +check_bound(VarList) -> + catch lists:foreach( + fun(Var) -> + case erlog_ec_support:is_bound(Var) of + true -> ok; + false -> throw(no) + end + end, VarList). \ No newline at end of file From 567ae398932b66e4ffde3bfb34a52023e5518583 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 18 Nov 2014 00:00:56 +0000 Subject: [PATCH 204/251] fix merge --- src/libs/standard/time/main/erlog_time.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/libs/standard/time/main/erlog_time.erl b/src/libs/standard/time/main/erlog_time.erl index 15f4c6b..6673d13 100644 --- a/src/libs/standard/time/main/erlog_time.erl +++ b/src/libs/standard/time/main/erlog_time.erl @@ -59,8 +59,8 @@ prove_goal(Params = #param{goal = {date_diff, _, _, _, _} = Goal, next_goal = Ne {date_diff, TS1, TS2, Format, Res} = erlog_ec_support:deref(Goal, Bs0), case check_bound([TS1, TS2, Format]) of ok -> - Diff = timer:now_diff(erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS1, Bs0)), erlog_et_logic:ts_to_date(erlog_et_logic:check_var(TS2, Bs0))) / 1000000, - Time = erlog_et_logic:seconds_to_date(Diff, erlog_et_logic:check_var(Format, Bs0)), + Diff = timer:now_diff(erlog_et_logic:ts_to_date(erlog_ec_support:check_var(TS1, Bs0)), erlog_et_logic:ts_to_date(erlog_ec_support:check_var(TS2, Bs0))) / 1000000, + Time = erlog_et_logic:seconds_to_date(Diff, erlog_ec_support:check_var(Format, Bs0)), case erlog_ec_support:try_add(Res, Time, Bs0) of error -> erlog_errors:fail(Params); Bs -> erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) From c1086a53eae56abadc53413fc0214049db8a7853 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 22 Nov 2014 01:22:14 +0000 Subject: [PATCH 205/251] fix loading libs in memory --- src/core/erlog.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index d9c770d..c22bce9 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -145,7 +145,7 @@ load_built_in(Database) -> %% @private load_prolog_libraries(Fcon, LibsDir, Db) -> Autoload = Fcon:lookup(LibsDir ++ "/autoload"), - lists:foreach(fun(Lib) -> erlog_file:consult(Fcon, LibsDir ++ "/autoload/" ++ Lib, Db) end, Autoload), + lists:foreach(fun(Lib) -> erlog_file:load_library(Fcon, LibsDir ++ "/autoload/" ++ Lib, Db) end, Autoload), ok. %% @private @@ -157,7 +157,7 @@ load_external_libraries(Params, FileCon, Database) -> fun(Mod) when is_atom(Mod) -> %autoload native library Mod:load(Database); (PrologLib) when is_list(PrologLib) -> %autoload external library - erlog_file:consult(FileCon, PrologLib, Database) + erlog_file:load_library(FileCon, PrologLib, Database) end, Libraries) end. From 2715dc3da1c6163cdcdeac838fcbd32530372915 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 22 Nov 2014 02:57:52 +0000 Subject: [PATCH 206/251] add deconsult --- include/erlog_core.hrl | 105 +++++++++++---------- src/io/erlog_file.erl | 49 +++++++--- src/libs/standard/core/main/erlog_core.erl | 7 ++ src/storage/erlog_dict.erl | 2 +- 4 files changed, 98 insertions(+), 65 deletions(-) diff --git a/include/erlog_core.hrl b/include/erlog_core.hrl index 4dcf51f..e37b9e0 100644 --- a/include/erlog_core.hrl +++ b/include/erlog_core.hrl @@ -33,62 +33,63 @@ %% record for passing arguments to erlog_core:prove_goal -record(param, { - goal, - next_goal, - choice, - bindings, - var_num, - database, - event_man, - f_consulter :: atom(), + goal, + next_goal, + choice, + bindings, + var_num, + database, + event_man, + f_consulter :: atom(), debugger, cursor, libs_dir }). -define(ERLOG_CORE, - [ - %% Logic and control. - {call, 1}, - {',', 2}, - {'!', 0}, - {';', 2}, - {fail, 0}, - {'->', 2}, - {'\\+', 1}, - {once, 1}, - {repeat, 0}, - {true, 0}, - %% Clause creation and destruction. - {abolish, 1}, - {assert, 1}, - {asserta, 1}, - {assertz, 1}, - {retract, 1}, - {retractall, 1}, - %% Clause retrieval and information. - {clause, 2}, - {current_predicate, 1}, - {predicate_property, 2}, - %% All solutions - %% External interface - {ecall, 2}, - %% File utils - {consult, 1}, - {reconsult, 1}, - %% Debug functions - {writeln, 1}, - %% Searching functions - {findall, 3}, - {findall, 2}, %support for findall - {bagof, 3}, - {setof, 3}, - {listing, 1}, - {listing, 2}, - {listing, 3}, - %% Non standart functions - {use, 1}, %load erlang library module - {to_integer, 2}, - {to_string, 2} - ] + [ + %% Logic and control. + {call, 1}, + {',', 2}, + {'!', 0}, + {';', 2}, + {fail, 0}, + {'->', 2}, + {'\\+', 1}, + {once, 1}, + {repeat, 0}, + {true, 0}, + %% Clause creation and destruction. + {abolish, 1}, + {assert, 1}, + {asserta, 1}, + {assertz, 1}, + {retract, 1}, + {retractall, 1}, + %% Clause retrieval and information. + {clause, 2}, + {current_predicate, 1}, + {predicate_property, 2}, + %% All solutions + %% External interface + {ecall, 2}, + %% File utils + {consult, 1}, + {reconsult, 1}, + {deconsult, 1}, %remove functors in file from memory + %% Debug functions + {writeln, 1}, + %% Searching functions + {findall, 3}, + {findall, 2}, %support for findall + {bagof, 3}, + {setof, 3}, + {listing, 1}, + {listing, 2}, + {listing, 3}, + %% Non standart functions + {use, 1}, %load erlang library module + {to_integer, 2}, + {to_string, 2} + ] ). \ No newline at end of file diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index fbd297b..5d8e4f4 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -18,7 +18,7 @@ -module(erlog_file). --export([consult/3, reconsult/3, load_library/3]). +-export([consult/3, reconsult/3, deconsult/3, load_library/3]). %% consult(File, Database) -> @@ -30,7 +30,7 @@ -spec consult(atom(), File :: string(), Db :: pid()) -> ok | tuple(). consult(Consulter, File, Db) -> case Consulter:load(File) of %call erlog_file_consulter implementation - {ok, Terms} -> consult_terms(fun consult_assert/2, Db, Terms); + {ok, Terms} -> iterate_terms(fun consult_assert/2, Db, Terms); Error -> Error end. @@ -38,7 +38,7 @@ consult(Consulter, File, Db) -> -spec load_library(atom(), File :: string(), Db :: pid()) -> ok | tuple(). load_library(Consulter, File, Db) -> case Consulter:load(File) of %call erlog_file_consulter implementation - {ok, Terms} -> consult_terms(fun consult_lib/2, Db, Terms); + {ok, Terms} -> iterate_terms(fun consult_lib/2, Db, Terms); Error -> Error end. @@ -46,7 +46,18 @@ load_library(Consulter, File, Db) -> reconsult(Consulter, File, Db) -> case Consulter:load(File) of %call erlog_file_consulter implementation {ok, Terms} -> - case consult_terms(fun reconsult_assert/2, {Db, []}, Terms) of + case iterate_terms(fun reconsult_assert/2, {Db, []}, Terms) of + ok -> ok; + Error -> Error + end; + Error -> Error + end. + +-spec deconsult(atom(), File :: string(), Db :: pid()) -> ok | tuple(). +deconsult(Consulter, File, Db) -> + case Consulter:load(File) of %call erlog_file_consulter implementation + {ok, Terms} -> + case iterate_terms(fun deconsult_assert/2, {Db, []}, Terms) of ok -> ok; Error -> Error end; @@ -83,23 +94,37 @@ reconsult_assert(Term0, {Db, Seen}) -> {ok, {Db, [Func | Seen]}} end. +%% @private +-spec deconsult_assert(Term0 :: term(), {Db :: pid(), Seen :: list()}) -> {ok, {Db :: pid(), list()}}. +deconsult_assert(Term0, {Db, Seen}) -> + Term1 = erlog_ed_logic:expand_term(Term0), + Func = functor(Term1), + case lists:member(Func, Seen) of + true -> + {ok, {Db, Seen}}; %TODO refactor iterate_terms not to pass DB everywhere! + false -> + check_abolish(Db, Func), + check_assert(Db, Term1), + {ok, {Db, [Func | Seen]}} + end. + %% @private %% consult_terms(InsertFun, Database, Terms) -> %% {ok,NewDatabase} | {erlog_error,Error}. %% Add terms to the database using InsertFun. Ignore directives and %% queries. --spec consult_terms(fun(), any(), list()) -> ok | tuple(). -consult_terms(Ifun, Params, [{':-', _} | Ts]) -> %TODO refactor me to make interface for Params unifyed! (or may be lists:foreach will be better this hand made recursion) - consult_terms(Ifun, Params, Ts); -consult_terms(Ifun, Params, [{'?-', _} | Ts]) -> - consult_terms(Ifun, Params, Ts); -consult_terms(Ifun, Params, [Term | Ts]) -> +-spec iterate_terms(fun(), any(), list()) -> ok | tuple(). +iterate_terms(Ifun, Params, [{':-', _} | Ts]) -> %TODO refactor me to make interface for Params unifyed! (or may be lists:foreach will be better this hand made recursion) + iterate_terms(Ifun, Params, Ts); +iterate_terms(Ifun, Params, [{'?-', _} | Ts]) -> + iterate_terms(Ifun, Params, Ts); +iterate_terms(Ifun, Params, [Term | Ts]) -> case catch Ifun(Term, Params) of - {ok, UpdParams} -> consult_terms(Ifun, UpdParams, Ts); + {ok, UpdParams} -> iterate_terms(Ifun, UpdParams, Ts); {erlog_error, E, _} -> {erlog_error, E}; {erlog_error, E} -> {erlog_error, E} end; -consult_terms(_, _, []) -> ok. +iterate_terms(_, _, []) -> ok. %% @private functor({':-', H, _B}) -> erlog_ec_support:functor(H); diff --git a/src/libs/standard/core/main/erlog_core.erl b/src/libs/standard/core/main/erlog_core.erl index 996a2e6..53a50f2 100644 --- a/src/libs/standard/core/main/erlog_core.erl +++ b/src/libs/standard/core/main/erlog_core.erl @@ -146,6 +146,13 @@ prove_goal(Param = #param{goal = {reconsult, Name}, next_goal = Next, f_consulte erlog_errors:erlog_error(Error, Db) end, erlog_ec_core:prove_body(Param#param{goal = Next}); +prove_goal(Param = #param{goal = {deconsult, Name}, next_goal = Next, f_consulter = Consulter, database = Db}) -> + case erlog_file:deconsult(Consulter, Name, Db) of + ok -> ok; + {Err, Error} when Err == erlog_error; Err == error -> + erlog_errors:erlog_error(Error, Db) + end, + erlog_ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db}) when is_atom(Library) -> try Library:load(Db) catch diff --git a/src/storage/erlog_dict.erl b/src/storage/erlog_dict.erl index e315af5..c505761 100644 --- a/src/storage/erlog_dict.erl +++ b/src/storage/erlog_dict.erl @@ -47,7 +47,7 @@ db_assertz_clause({StdLib, ExLib, Db}, {Collection, Head, Body0}) -> assertz_clause({_, _, Db} = Memory, {Head, Body0}) -> Udb = clause(Head, Body0, Memory, - fun(Functor, Cs, Body) -> + fun(Functor, Cs, Body) -> case check_duplicates(Cs, Head, Body) of true -> Db; %found - do nothing _ -> dict:append(Functor, {length(Cs), Head, Body}, Db) %not found - insert new From cbe76c9551548ae5234e4a12f7e8fa8409943198 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 26 Nov 2014 23:45:00 +0000 Subject: [PATCH 207/251] refactored erlog_memory --- include/erlog.hrl | 30 ++ src/core/erlog.erl | 35 +- src/erlog.app.src | 2 +- src/io/erlog_file.erl | 34 +- src/libs/external/cache/erlog_cache.erl | 68 ++-- src/libs/external/db/erlog_db.erl | 4 +- src/libs/external/erlog_exlib.erl | 4 +- src/libs/standard/bips/main/erlog_bips.erl | 146 ++++---- src/libs/standard/core/main/erlog_core.erl | 5 +- src/libs/standard/dcg/main/erlog_dcg.erl | 4 +- src/libs/standard/erlog_stdlib.erl | 3 +- src/libs/standard/lists/main/erlog_lists.erl | 6 +- src/libs/standard/string/erlog_string.erl | 5 +- src/libs/standard/time/main/erlog_time.erl | 4 +- src/storage/erlog_memory.erl | 361 ++++++------------- 15 files changed, 288 insertions(+), 423 deletions(-) create mode 100644 include/erlog.hrl diff --git a/include/erlog.hrl b/include/erlog.hrl new file mode 100644 index 0000000..6a708c4 --- /dev/null +++ b/include/erlog.hrl @@ -0,0 +1,30 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 26. Нояб. 2014 18:32 +%%%------------------------------------------------------------------- +-author("tihon"). + +%% Database state +-record(db_state, +{ + stdlib :: dict, %kernel-space memory + exlib :: dict, %library-space memory + database :: atom(), % callback module for user-space memory + in_mem :: dict, %integrated memory for findall operations + state :: term() % callback state +}). + +%% Core state. +-record(state, +{ + db_state :: #db_state{}, %database state + f_consulter :: atom(), %file consulter + debugger :: fun(), %debugger function + e_man :: pid(), %event manager, used for debuging and other output (not for return) + state = normal :: normal | list(), %state for solution selecting. + libs_dir :: string() %path for directory, where prolog libs are stored +}). \ No newline at end of file diff --git a/src/core/erlog.erl b/src/core/erlog.erl index c22bce9..c32d52e 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -28,8 +28,9 @@ -module(erlog). -behaviour(gen_server). --vsn('2.0'). +-vsn('3.0'). +-include("erlog.hrl"). -include("erlog_core.hrl"). %% Interface to server. @@ -38,17 +39,6 @@ %% Gen server callbacs. -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). -%% Erlang server code. --record(state, -{ - db :: atom(), %database - f_consulter :: atom(), %file consulter - debugger :: fun(), %debugger function - e_man :: pid(), %event manager, used for debuging and other output (not for return) - state = normal :: normal | list(), %state for solution selecting. - libs_dir :: string() %path for directory, where prolog libs are stored -}). - execute(Worker, Command, undefined) -> execute(Worker, Command); execute(Worker, Command, Timeout) -> gen_server:call(Worker, {execute, trim_command(Command)}, Timeout). @@ -66,9 +56,9 @@ start_link(Params) -> init(Params) -> % use custom database implementation FileCon = init_consulter(Params), - {ok, Db} = init_database(Params), + DbState = init_database(Params), LibsDir = proplists:get_value(libs_dir, Params, "../lib"), %default assumes erlog is run from ebin - ok = load_prolog_libraries(FileCon, LibsDir, Db), + ok = load_prolog_libraries(FileCon, LibsDir, DbState), ok = load_external_libraries(Params, FileCon, Db), {ok, E} = gen_event:start_link(), Debugger = init_debugger(Params), @@ -113,13 +103,14 @@ change_state({_, State}) -> State#state{state = normal}. %% @private %% Configurates database with arguments, populates it and returns. --spec init_database(Params :: proplists:proplist()) -> {ok, Pid :: pid()}. +-spec init_database(Params :: proplists:proplist()) -> #db_state{}. init_database(Params) -> - Module = proplists:get_value(database, Params, erlog_dict), %default database is dict module + Database = proplists:get_value(database, Params, erlog_dict), %default database is dict module Args = proplists:get_value(arguments, Params, []), - {ok, DbPid} = erlog_memory:start_link(Module, Args), - load_built_in(DbPid), - {ok, DbPid}. + {ok, State} = Database:new(Args), %create db and return its state + D = dict:new(), %create memory cores + DBState = #db_state{stdlib = D, exlib = D, in_mem = D, database = Database, state = State}, + load_built_in(DBState). %populate memory cores %% @private -spec init_consulter(Params :: proplists:proplist()) -> fun() | any(). @@ -132,7 +123,7 @@ init_debugger(Params) -> %% @private load_built_in(Database) -> %Load basic interpreter predicates - lists:foreach(fun(Mod) -> Mod:load(Database) end, + lists:foldl(fun(Mod, UDBState) -> Mod:load(UDBState) end, Database, [ erlog_core, %Core predicates erlog_bips, %Built in predicates @@ -143,9 +134,9 @@ load_built_in(Database) -> ]). %% @private -load_prolog_libraries(Fcon, LibsDir, Db) -> +load_prolog_libraries(Fcon, LibsDir, DbState) -> Autoload = Fcon:lookup(LibsDir ++ "/autoload"), - lists:foreach(fun(Lib) -> erlog_file:load_library(Fcon, LibsDir ++ "/autoload/" ++ Lib, Db) end, Autoload), + lists:foreach(fun(Lib) -> erlog_file:load_library(Fcon, LibsDir ++ "/autoload/" ++ Lib, DbState) end, Autoload), ok. %% @private diff --git a/src/erlog.app.src b/src/erlog.app.src index befa1cb..94b2b24 100644 --- a/src/erlog.app.src +++ b/src/erlog.app.src @@ -1,7 +1,7 @@ {application, erlog, [ {description, "Erlog , Prolog in Erlang"}, - {vsn, "2.0"}, + {vsn, "3.0"}, {registered, []}, {applications, [ kernel, diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index 5d8e4f4..4b60683 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -18,6 +18,8 @@ -module(erlog_file). +-include("erlog.hrl"). + -export([consult/3, reconsult/3, deconsult/3, load_library/3]). @@ -27,23 +29,23 @@ %% {ok,NewDatabase} | {error,Error} | {erlog_error,Error}. %% Load/reload an Erlog file into the interpreter. Reloading will %% abolish old definitons of clauses. --spec consult(atom(), File :: string(), Db :: pid()) -> ok | tuple(). -consult(Consulter, File, Db) -> +-spec consult(atom(), File :: string(), DbState :: #db_state{}) -> #db_state{}. +consult(Consulter, File, DbState) -> case Consulter:load(File) of %call erlog_file_consulter implementation - {ok, Terms} -> iterate_terms(fun consult_assert/2, Db, Terms); + {ok, Terms} -> iterate_terms(fun consult_assert/2, DbState, Terms); Error -> Error end. %% consult to library space --spec load_library(atom(), File :: string(), Db :: pid()) -> ok | tuple(). -load_library(Consulter, File, Db) -> +-spec load_library(atom(), File :: string(), DbState :: #db_state{}) -> #db_state{}. +load_library(Consulter, File, DbState) -> case Consulter:load(File) of %call erlog_file_consulter implementation - {ok, Terms} -> iterate_terms(fun consult_lib/2, Db, Terms); + {ok, Terms} -> iterate_terms(fun consult_lib/2, DbState, Terms); Error -> Error end. --spec reconsult(atom(), File :: string(), Db :: pid()) -> ok | tuple(). -reconsult(Consulter, File, Db) -> +-spec reconsult(atom(), File :: string(), DbState :: #db_state{}) -> #db_state{}. +reconsult(Consulter, File, DbState) -> case Consulter:load(File) of %call erlog_file_consulter implementation {ok, Terms} -> case iterate_terms(fun reconsult_assert/2, {Db, []}, Terms) of @@ -53,8 +55,8 @@ reconsult(Consulter, File, Db) -> Error -> Error end. --spec deconsult(atom(), File :: string(), Db :: pid()) -> ok | tuple(). -deconsult(Consulter, File, Db) -> +-spec deconsult(atom(), File :: string(), DbState :: #db_state{}) -> #db_state{}. +deconsult(Consulter, File, DbState) -> case Consulter:load(File) of %call erlog_file_consulter implementation {ok, Terms} -> case iterate_terms(fun deconsult_assert/2, {Db, []}, Terms) of @@ -65,7 +67,7 @@ deconsult(Consulter, File, Db) -> end. %% @private --spec consult_assert(Term0 :: term(), Db :: pid()) -> {ok, Db :: pid()}. +-spec consult_assert(Term0 :: term(), DbState :: #db_state{}) -> {ok, UDbState :: #db_state{}}. consult_assert(Term0, Db) -> Term1 = erlog_ed_logic:expand_term(Term0), check_assert(Db, Term1), @@ -87,7 +89,7 @@ reconsult_assert(Term0, {Db, Seen}) -> case lists:member(Func, Seen) of true -> check_assert(Db, Term1), - {ok, {Db, Seen}}; %TODO refactor consult_terms not to pass DB everywhere! + {ok, {Db, Seen}}; false -> check_abolish(Db, Func), check_assert(Db, Term1), @@ -101,7 +103,7 @@ deconsult_assert(Term0, {Db, Seen}) -> Func = functor(Term1), case lists:member(Func, Seen) of true -> - {ok, {Db, Seen}}; %TODO refactor iterate_terms not to pass DB everywhere! + {ok, {Db, Seen}}; false -> check_abolish(Db, Func), check_assert(Db, Term1), @@ -114,7 +116,7 @@ deconsult_assert(Term0, {Db, Seen}) -> %% Add terms to the database using InsertFun. Ignore directives and %% queries. -spec iterate_terms(fun(), any(), list()) -> ok | tuple(). -iterate_terms(Ifun, Params, [{':-', _} | Ts]) -> %TODO refactor me to make interface for Params unifyed! (or may be lists:foreach will be better this hand made recursion) +iterate_terms(Ifun, Params, [{':-', _} | Ts]) -> iterate_terms(Ifun, Params, Ts); iterate_terms(Ifun, Params, [{'?-', _} | Ts]) -> iterate_terms(Ifun, Params, Ts); @@ -131,8 +133,8 @@ functor({':-', H, _B}) -> erlog_ec_support:functor(H); functor(T) -> erlog_ec_support:functor(T). %% @private -check_assert(Db, Term) -> - case erlog_memory:assertz_clause(Db, Term) of +check_assert(DbState, Term) -> + case erlog_memory:assertz_clause(DbState, Term) of {erlog_error, E} -> erlog_errors:erlog_error(E); _ -> ok end. diff --git a/src/libs/external/cache/erlog_cache.erl b/src/libs/external/cache/erlog_cache.erl index 97273da..7975af9 100644 --- a/src/libs/external/cache/erlog_cache.erl +++ b/src/libs/external/cache/erlog_cache.erl @@ -17,48 +17,48 @@ %% API -export([load/1, - put_2/1, - get_2/1]). + put_2/1, + get_2/1]). -load(Db) -> - case get(erlog_cache) of - undefined -> - Ets = ets:new(erlog_cache, []), - put(erlog_cache, Ets); - _ -> ok - end, - lists:foreach(fun(Proc) -> erlog_memory:load_native_library(Db, Proc) end, ?ERLOG_CACHE). +load(DbState) -> + case get(erlog_cache) of + undefined -> + Ets = ets:new(erlog_cache, []), %TODO use smth else instead of ets. + put(erlog_cache, Ets); + _ -> ok + end, + lists:foldl(fun(Proc, UDBState) -> erlog_memory:load_native_library(UDBState, Proc) end, DbState, ?ERLOG_CACHE). put_2(Params = #param{goal = {put, _, _} = Goal, next_goal = Next, bindings = Bs}) -> - {put, Key, Value} = erlog_ec_support:dderef(Goal, Bs), - case erlog_ec_support:is_bound(Value) of %Value must exists - true -> case get(erlog_cache) of - undefined -> erlog_errors:fail(Params); - Ets -> - ets:insert(Ets, {Key, Value}), - erlog_ec_core:prove_body(Params#param{goal = Next}) - end; - false -> erlog_errors:fail(Params) - end. + {put, Key, Value} = erlog_ec_support:dderef(Goal, Bs), + case erlog_ec_support:is_bound(Value) of %Value must exists + true -> case get(erlog_cache) of + undefined -> erlog_errors:fail(Params); + Ets -> + ets:insert(Ets, {Key, Value}), + erlog_ec_core:prove_body(Params#param{goal = Next}) + end; + false -> erlog_errors:fail(Params) + end. get_2(Params = #param{goal = {get, _, _} = Goal, bindings = Bs}) -> - {get, Key, Result} = erlog_ec_support:dderef(Goal, Bs), - case get(erlog_cache) of - undefined -> erlog_errors:fail(Params); - Ets -> check_value(ets:lookup(Ets, Key), Result, Params) - end. + {get, Key, Result} = erlog_ec_support:dderef(Goal, Bs), + case get(erlog_cache) of + undefined -> erlog_errors:fail(Params); + Ets -> check_value(ets:lookup(Ets, Key), Result, Params) + end. %% @private check_value([], _, Params) -> erlog_errors:fail(Params); check_value([{_, Value}], Result, Params = #param{next_goal = Next, bindings = Bs0}) -> - case erlog_ec_support:is_bound(Result) of - true -> %compare value from cache with result - if Result == Value -> erlog_ec_core:prove_body(Params#param{goal = Next}); - true -> erlog_errors:fail(Params) - end; - false -> %save value from cache to result - Bs = erlog_ec_support:add_binding(Result, Value, Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) - end. + case erlog_ec_support:is_bound(Result) of + true -> %compare value from cache with result + if Result == Value -> erlog_ec_core:prove_body(Params#param{goal = Next}); + true -> erlog_errors:fail(Params) + end; + false -> %save value from cache to result + Bs = erlog_ec_support:add_binding(Result, Value, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) + end. diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 6199913..f097ea1 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -27,8 +27,8 @@ db_listing_3/1, db_listing_4/1, prove_call/4]). -load(Db) -> - lists:foreach(fun(Proc) -> erlog_memory:load_native_library(Db, Proc) end, ?ERLOG_DB). +load(DbState) -> + lists:foldl(fun(Proc, UDBState) -> erlog_memory:load_native_library(UDBState, Proc) end, DbState, ?ERLOG_DB). db_call_2(Param = #param{goal = {db_call, _, _} = Goal, next_goal = Next0, bindings = Bs, database = Db}) -> {db_call, Table, G} = erlog_ec_support:dderef(Goal, Bs), diff --git a/src/libs/external/erlog_exlib.erl b/src/libs/external/erlog_exlib.erl index cc0b4bb..007a8b1 100644 --- a/src/libs/external/erlog_exlib.erl +++ b/src/libs/external/erlog_exlib.erl @@ -9,5 +9,7 @@ -module(erlog_exlib). -author("tihon"). +-include("erlog.hrl"). + %% load database to library space --callback load(Db :: pid() | atom()) -> ok. \ No newline at end of file +-callback load(Db :: #db_state{}) -> #db_state{}. \ No newline at end of file diff --git a/src/libs/standard/bips/main/erlog_bips.erl b/src/libs/standard/bips/main/erlog_bips.erl index d101650..6cef8f6 100644 --- a/src/libs/standard/bips/main/erlog_bips.erl +++ b/src/libs/standard/bips/main/erlog_bips.erl @@ -32,8 +32,8 @@ %% load(Database) -> Database. %% Assert predicates into the database. -load(Db) -> - lists:foreach(fun(Head) -> erlog_memory:load_kernel_space(Db, ?MODULE, Head) end, ?ERLOG_BIPS). +load(DbState) -> + lists:foldl(fun(Head, UDBState) -> erlog_memory:load_kernel_space(UDBState, ?MODULE, Head) end, DbState, ?ERLOG_BIPS). %% prove_goal(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> %% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase} | @@ -43,106 +43,106 @@ load(Db) -> %% Term unification and comparison prove_goal(Params = #param{goal = {'=', L, R}}) -> - erlog_ec_body:unify_prove_body(L, R, Params); + erlog_ec_body:unify_prove_body(L, R, Params); prove_goal(Params = #param{goal = {'\\=', L, R}, next_goal = Next, bindings = Bs0}) -> - case erlog_ec_unify:unify(L, R, Bs0) of - {succeed, _Bs1} -> erlog_errors:fail(Params); - fail -> erlog_ec_core:prove_body(Params#param{goal = Next}) - end; + case erlog_ec_unify:unify(L, R, Bs0) of + {succeed, _Bs1} -> erlog_errors:fail(Params); + fail -> erlog_ec_core:prove_body(Params#param{goal = Next}) + end; prove_goal(Params = #param{goal = {'@>', L, R}}) -> - erlog_eb_logic:term_test_prove_body('>', L, R, Params); + erlog_eb_logic:term_test_prove_body('>', L, R, Params); prove_goal(Params = #param{goal = {'@>=', L, R}}) -> - erlog_eb_logic:term_test_prove_body('>=', L, R, Params); + erlog_eb_logic:term_test_prove_body('>=', L, R, Params); prove_goal(Params = #param{goal = {'==', L, R}}) -> - erlog_eb_logic:term_test_prove_body('==', L, R, Params); + erlog_eb_logic:term_test_prove_body('==', L, R, Params); prove_goal(Params = #param{goal = {'\\==', L, R}}) -> - erlog_eb_logic:term_test_prove_body('/=', L, R, Params); + erlog_eb_logic:term_test_prove_body('/=', L, R, Params); prove_goal(Params = #param{goal = {'@<', L, R}}) -> - erlog_eb_logic:term_test_prove_body('<', L, R, Params); + erlog_eb_logic:term_test_prove_body('<', L, R, Params); prove_goal(Params = #param{goal = {'@=<', L, R}}) -> - erlog_eb_logic:term_test_prove_body('=<', L, R, Params); + erlog_eb_logic:term_test_prove_body('=<', L, R, Params); %% Term creation and decomposition. prove_goal(Params = #param{goal = {arg, I, Ct, A}, bindings = Bs}) -> - erlog_eb_logic:prove_arg(erlog_ec_support:deref(I, Bs), erlog_ec_support:deref(Ct, Bs), A, Params); + erlog_eb_logic:prove_arg(erlog_ec_support:deref(I, Bs), erlog_ec_support:deref(Ct, Bs), A, Params); prove_goal(Params = #param{goal = {copy_term, T0, C}, bindings = Bs, var_num = Vn0}) -> - %% Use term_instance to create the copy, can ignore orddict it creates. - {T, _Nbs, Vn1} = erlog_ec_term:term_instance(erlog_ec_support:dderef(T0, Bs), Vn0), - erlog_ec_body:unify_prove_body(T, C, Params#param{var_num = Vn1}); + %% Use term_instance to create the copy, can ignore orddict it creates. + {T, _Nbs, Vn1} = erlog_ec_term:term_instance(erlog_ec_support:dderef(T0, Bs), Vn0), + erlog_ec_body:unify_prove_body(T, C, Params#param{var_num = Vn1}); prove_goal(Params = #param{goal = {functor, T, F, A}, bindings = Bs}) -> - erlog_eb_logic:prove_functor(erlog_ec_support:dderef(T, Bs), F, A, Params); + erlog_eb_logic:prove_functor(erlog_ec_support:dderef(T, Bs), F, A, Params); prove_goal(Params = #param{goal = {'=..', T, L}, bindings = Bs}) -> - erlog_eb_logic:prove_univ(erlog_ec_support:dderef(T, Bs), L, Params); + erlog_eb_logic:prove_univ(erlog_ec_support:dderef(T, Bs), L, Params); %% Type testing. prove_goal(Params = #param{goal = {atom, T0}, next_goal = Next, bindings = Bs}) -> - case erlog_ec_support:deref(T0, Bs) of - T when is_atom(T) -> erlog_ec_core:prove_body(Params#param{goal = Next}); - _Other -> erlog_errors:fail(Params) - end; + case erlog_ec_support:deref(T0, Bs) of + T when is_atom(T) -> erlog_ec_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) + end; prove_goal(Params = #param{goal = {atomic, T0}, next_goal = Next, bindings = Bs}) -> - case erlog_ec_support:deref(T0, Bs) of - T when ?IS_ATOMIC(T) -> erlog_ec_core:prove_body(Params#param{goal = Next}); - _Other -> erlog_errors:fail(Params) - end; + case erlog_ec_support:deref(T0, Bs) of + T when ?IS_ATOMIC(T) -> erlog_ec_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) + end; prove_goal(Params = #param{goal = {compound, T0}, next_goal = Next, bindings = Bs}) -> - case erlog_ec_support:deref(T0, Bs) of - T when ?IS_ATOMIC(T) -> erlog_errors:fail(Params); - _Other -> erlog_ec_core:prove_body(Params#param{goal = Next}) - end; + case erlog_ec_support:deref(T0, Bs) of + T when ?IS_ATOMIC(T) -> erlog_errors:fail(Params); + _Other -> erlog_ec_core:prove_body(Params#param{goal = Next}) + end; prove_goal(Params = #param{goal = {integer, T0}, next_goal = Next, bindings = Bs}) -> - case erlog_ec_support:deref(T0, Bs) of - T when is_integer(T) -> erlog_ec_core:prove_body(Params#param{goal = Next}); - _Other -> erlog_errors:fail(Params) - end; + case erlog_ec_support:deref(T0, Bs) of + T when is_integer(T) -> erlog_ec_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) + end; prove_goal(Params = #param{goal = {float, T0}, next_goal = Next, bindings = Bs}) -> - case erlog_ec_support:deref(T0, Bs) of - T when is_float(T) -> erlog_ec_core:prove_body(Params#param{goal = Next}); - _Other -> erlog_errors:fail(Params) - end; + case erlog_ec_support:deref(T0, Bs) of + T when is_float(T) -> erlog_ec_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) + end; prove_goal(Params = #param{goal = {number, T0}, next_goal = Next, bindings = Bs}) -> - case erlog_ec_support:deref(T0, Bs) of - T when is_number(T) -> erlog_ec_core:prove_body(Params#param{goal = Next}); - _Other -> erlog_errors:fail(Params) - end; + case erlog_ec_support:deref(T0, Bs) of + T when is_number(T) -> erlog_ec_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) + end; prove_goal(Params = #param{goal = {nonvar, T0}, next_goal = Next, bindings = Bs}) -> - case erlog_ec_support:deref(T0, Bs) of - {_} -> erlog_errors:fail(Params); - _Other -> erlog_ec_core:prove_body(Params#param{goal = Next}) - end; + case erlog_ec_support:deref(T0, Bs) of + {_} -> erlog_errors:fail(Params); + _Other -> erlog_ec_core:prove_body(Params#param{goal = Next}) + end; prove_goal(Params = #param{goal = {var, T0}, next_goal = Next, bindings = Bs}) -> - case erlog_ec_support:deref(T0, Bs) of - {_} -> erlog_ec_core:prove_body(Params#param{goal = Next}); - _Other -> erlog_errors:fail(Params) - end; + case erlog_ec_support:deref(T0, Bs) of + {_} -> erlog_ec_core:prove_body(Params#param{goal = Next}); + _Other -> erlog_errors:fail(Params) + end; %% Atom processing. prove_goal(Params = #param{goal = {atom_chars, A, L}}) -> - erlog_eb_logic:prove_atom_chars(A, L, Params); + erlog_eb_logic:prove_atom_chars(A, L, Params); prove_goal(Params = #param{goal = {atom_length, A0, L0}, bindings = Bs, database = Db}) -> - case erlog_ec_support:dderef(A0, Bs) of - A when is_atom(A) -> - Alen = length(atom_to_list(A)), %No of chars in atom - case erlog_ec_support:dderef(L0, Bs) of - L when is_integer(L) -> - erlog_ec_body:unify_prove_body(Alen, L, Params); - {_} = Var -> - erlog_ec_body:unify_prove_body(Alen, Var, Params); - Other -> erlog_errors:type_error(integer, Other, Db) - end; - {_} -> erlog_errors:instantiation_error(Db); - Other -> erlog_errors:type_error(atom, Other, Db) - end; + case erlog_ec_support:dderef(A0, Bs) of + A when is_atom(A) -> + Alen = length(atom_to_list(A)), %No of chars in atom + case erlog_ec_support:dderef(L0, Bs) of + L when is_integer(L) -> + erlog_ec_body:unify_prove_body(Alen, L, Params); + {_} = Var -> + erlog_ec_body:unify_prove_body(Alen, Var, Params); + Other -> erlog_errors:type_error(integer, Other, Db) + end; + {_} -> erlog_errors:instantiation_error(Db); + Other -> erlog_errors:type_error(atom, Other, Db) + end; %% Arithmetic evalution and comparison. prove_goal(Params = #param{goal = {is, N, E0}, bindings = Bs, database = Db}) -> - E = erlog_eb_logic:eval_arith(erlog_ec_support:deref(E0, Bs), Bs, Db), - erlog_ec_body:unify_prove_body(N, E, Params); + E = erlog_eb_logic:eval_arith(erlog_ec_support:deref(E0, Bs), Bs, Db), + erlog_ec_body:unify_prove_body(N, E, Params); prove_goal(Params = #param{goal = {'>', L, R}}) -> - erlog_eb_logic:arith_test_prove_body('>', L, R, Params); + erlog_eb_logic:arith_test_prove_body('>', L, R, Params); prove_goal(Params = #param{goal = {'>=', L, R}}) -> - erlog_eb_logic:arith_test_prove_body('>=', L, R, Params); + erlog_eb_logic:arith_test_prove_body('>=', L, R, Params); prove_goal(Params = #param{goal = {'=:=', L, R}}) -> - erlog_eb_logic:arith_test_prove_body('==', L, R, Params); + erlog_eb_logic:arith_test_prove_body('==', L, R, Params); prove_goal(Params = #param{goal = {'=\\=', L, R}}) -> - erlog_eb_logic:arith_test_prove_body('/=', L, R, Params); + erlog_eb_logic:arith_test_prove_body('/=', L, R, Params); prove_goal(Params = #param{goal = {'<', L, R}}) -> - erlog_eb_logic:arith_test_prove_body('<', L, R, Params); + erlog_eb_logic:arith_test_prove_body('<', L, R, Params); prove_goal(Params = #param{goal = {'=<', L, R}}) -> - erlog_eb_logic:arith_test_prove_body('=<', L, R, Params). \ No newline at end of file + erlog_eb_logic:arith_test_prove_body('=<', L, R, Params). \ No newline at end of file diff --git a/src/libs/standard/core/main/erlog_core.erl b/src/libs/standard/core/main/erlog_core.erl index 53a50f2..5a4ef6a 100644 --- a/src/libs/standard/core/main/erlog_core.erl +++ b/src/libs/standard/core/main/erlog_core.erl @@ -31,9 +31,8 @@ %% built_in_db(Db) -> Database. %% Create an initial clause database containing the built-in %% predicates and predefined library predicates. -load(Db) -> - lists:foreach(fun(Head) -> - erlog_memory:load_kernel_space(Db, ?MODULE, Head) end, ?ERLOG_CORE). %% Add the Erlang built-ins. +load(DbState) -> + lists:foldl(fun(Head, UDBState) -> erlog_memory:load_kernel_space(UDBState, ?MODULE, Head) end, DbState, ?ERLOG_CORE). %% prove_goal(Goal, NextGoal, ChoicePoints, Bindings, VarNum, Database) -> %% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase} | diff --git a/src/libs/standard/dcg/main/erlog_dcg.erl b/src/libs/standard/dcg/main/erlog_dcg.erl index b80444a..7982402 100644 --- a/src/libs/standard/dcg/main/erlog_dcg.erl +++ b/src/libs/standard/dcg/main/erlog_dcg.erl @@ -26,8 +26,8 @@ -export([load/1]). -export([prove_goal/1]). -load(Db) -> - lists:foreach(fun(Proc) -> erlog_memory:load_kernel_space(Db, ?MODULE, Proc) end, ?ERLOG_DCG). +load(DbState) -> + lists:foldl(fun(Head, UDBState) -> erlog_memory:load_kernel_space(UDBState, ?MODULE, Head) end, DbState, ?ERLOG_DCG). prove_goal(Params = #param{goal = {expand_term, _, _} = Goal, bindings = Bs, var_num = Vn0}) -> {expand_term, DCGRule, A2} = erlog_ec_support:dderef(Goal, Bs), diff --git a/src/libs/standard/erlog_stdlib.erl b/src/libs/standard/erlog_stdlib.erl index 3f7e839..34633d6 100644 --- a/src/libs/standard/erlog_stdlib.erl +++ b/src/libs/standard/erlog_stdlib.erl @@ -9,10 +9,11 @@ -module(erlog_stdlib). -author("tihon"). +-include("erlog.hrl"). -include("erlog_core.hrl"). %% load database to kernel space --callback load(Db :: pid() | atom()) -> ok. +-callback load(Db :: #db_state{}) -> #db_state{}. %% proves goal Goal -callback prove_goal(Params :: #param{}) -> ok. %TODO what return value? \ No newline at end of file diff --git a/src/libs/standard/lists/main/erlog_lists.erl b/src/libs/standard/lists/main/erlog_lists.erl index 4a2975e..bca9c8b 100644 --- a/src/libs/standard/lists/main/erlog_lists.erl +++ b/src/libs/standard/lists/main/erlog_lists.erl @@ -32,10 +32,8 @@ -export([load/1]). -export([prove_goal/1]). -%% load(Database) -> Database. -%% Assert predicates into the database. -load(Db) -> - lists:foreach(fun(Proc) -> erlog_memory:load_kernel_space(Db, ?MODULE, Proc) end, ?ERLOG_LISTS). +load(DbState) -> + lists:foldl(fun(Head, UDBState) -> erlog_memory:load_kernel_space(UDBState, ?MODULE, Head) end, DbState, ?ERLOG_LISTS). prove_goal(Params = #param{goal = {length, ListVar, Len}, next_goal = Next, bindings = Bs0}) -> case erlog_ec_support:deref(ListVar, Bs0) of diff --git a/src/libs/standard/string/erlog_string.erl b/src/libs/standard/string/erlog_string.erl index 00a38b1..f4b2827 100644 --- a/src/libs/standard/string/erlog_string.erl +++ b/src/libs/standard/string/erlog_string.erl @@ -17,8 +17,9 @@ %% API -export([load/1, prove_goal/1]). -load(Db) -> - lists:foreach(fun(Proc) -> erlog_memory:load_kernel_space(Db, ?MODULE, Proc) end, ?ERLOG_STRING). + +load(DbState) -> + lists:foldl(fun(Head, UDBState) -> erlog_memory:load_kernel_space(UDBState, ?MODULE, Head) end, DbState, ?ERLOG_STRING). prove_goal(Params = #param{goal = {concat, Strings, Res}, next_goal = Next, bindings = Bs0}) -> case erlog_ec_support:dderef_list(Strings, Bs0) of diff --git a/src/libs/standard/time/main/erlog_time.erl b/src/libs/standard/time/main/erlog_time.erl index 6673d13..4359b5e 100644 --- a/src/libs/standard/time/main/erlog_time.erl +++ b/src/libs/standard/time/main/erlog_time.erl @@ -18,8 +18,8 @@ -export([load/1]). -export([prove_goal/1]). -load(Db) -> - lists:foreach(fun(Proc) -> erlog_memory:load_kernel_space(Db, ?MODULE, Proc) end, ?ERLOG_TIME). +load(DbState) -> + lists:foldl(fun(Head, UDBState) -> erlog_memory:load_kernel_space(UDBState, ?MODULE, Head) end, DbState, ?ERLOG_TIME). %% Returns current timestamp. prove_goal(Params = #param{goal = {localtime, Var}, next_goal = Next, bindings = Bs0}) -> diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 3c67aa6..80043ba 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -9,13 +9,11 @@ -module(erlog_memory). -author("tihon"). +-include("erlog.hrl"). -include("erlog_core.hrl"). --behaviour(gen_server). %TODO do we really need gen_server here? - %% API --export([start_link/1, - start_link/2, +-export([ load_native_library/2, load_extended_library/2, load_extended_library/3, @@ -37,7 +35,8 @@ next/2, close/2]). --export([db_assertz_clause/3, +-export([ + db_assertz_clause/3, db_assertz_clause/4, db_asserta_clause/4, db_asserta_clause/3, @@ -50,292 +49,142 @@ -export([load_kernel_space/3]). -%% gen_server callbacks --export([init/1, - handle_call/3, - handle_cast/2, - handle_info/2, - terminate/2, - code_change/3]). - --define(SERVER, ?MODULE). - --record(state, %TODO move to erlog, remove this process as separate -{ - stdlib :: dict, %kernel-space memory - exlib :: dict, %library-space memory - database :: atom(), % callback module for user-space memory - in_mem :: dict, %integrated memory for findall operations - state :: term() % callback state -}). %%%=================================================================== %%% API %%%=================================================================== %% kernelspace predicate loading -load_kernel_space(Database, Module, Functor) -> gen_server:call(Database, {load_kernel_space, {Module, Functor}}). +load_kernel_space(DBState = #db_state{stdlib = StdLib}, Module, Functor) -> + UStdlib = dict:store(Functor, {built_in, Module}, StdLib), + DBState#db_state{stdlib = UStdlib}. %% libraryspace predicate loading -load_native_library(Database, Proc) -> gen_server:call(Database, {load_native, Proc}). +load_native_library(DBState = #db_state{stdlib = StdLib, exlib = ExLib}, {Functor, M, F}) -> + check_immutable(StdLib, Functor), + DBState#db_state{exlib = dict:store(Functor, {code, {M, F}}, ExLib)}. %% add prolog functor to libraryspace -load_extended_library(Database, {':-', Head, Body}) -> load_extended_library(Database, Head, Body); -load_extended_library(Database, Head) -> load_extended_library(Database, Head, true). -load_extended_library(Database, Head, Body) -> gen_server:call(Database, {load_extended, {Head, Body}}). +load_extended_library(DBState, {':-', Head, Body}) -> load_extended_library(DBState, Head, Body); +load_extended_library(DBState, Head) -> load_extended_library(DBState, Head, true). +load_extended_library(DBState = #db_state{stdlib = StdLib, exlib = ExLib}, Head, Body) -> + check_immutable(StdLib, erlog_ec_support:functor(Head)), + {Res, UExLib} = erlog_dict:assertz_clause({StdLib, ExLib, ExLib}, {Head, Body}), %use erlog_dict module to assert library to exlib dict + {Res, DBState#db_state{exlib = UExLib}}. %% userspace predicate loading assertz_clause(Database, {':-', Head, Body}) -> assertz_clause(Database, Head, Body); assertz_clause(Database, Head) -> assertz_clause(Database, Head, true). -assertz_clause(Database, Head, Body) -> gen_server:call(Database, {assertz_clause, {Head, Body}}). - -db_assertz_clause(Database, Collection, {':-', Head, Body}) -> db_assertz_clause(Database, Collection, Head, Body); -db_assertz_clause(Database, Collection, Head) -> db_assertz_clause(Database, Collection, Head, true). -db_assertz_clause(Database, Collection, Head, Body) -> - gen_server:call(Database, {db_assertz_clause, {Collection, Head, Body}}). +assertz_clause(DBState, Head, Body) -> + F = erlog_ec_support:functor(Head), + do_action(DBState, assertz_clause, F, {Head, Body}). asserta_clause(Database, {':-', H, B}) -> asserta_clause(Database, H, B); asserta_clause(Database, H) -> asserta_clause(Database, H, true). -asserta_clause(Database, Head, Body) -> gen_server:call(Database, {asserta_clause, {Head, Body}}). +asserta_clause(DBState, Head, Body) -> + F = erlog_ec_support:functor(Head), + do_action(DBState, asserta_clause, F, {Head, Body}). + +db_assertz_clause(Database, Collection, {':-', Head, Body}) -> db_assertz_clause(Database, Collection, Head, Body); +db_assertz_clause(Database, Collection, Head) -> db_assertz_clause(Database, Collection, Head, true). +db_assertz_clause(DBState, Collection, Head, Body) -> + F = erlog_ec_support:functor(Head), + do_action(DBState, db_assertz_clause, F, {Collection, Head, Body}). db_asserta_clause(Database, Collection, {':-', H, B}) -> db_asserta_clause(Database, Collection, H, B); db_asserta_clause(Database, Collection, H) -> db_asserta_clause(Database, Collection, H, true). -db_asserta_clause(Database, Collection, Head, Body) -> - gen_server:call(Database, {db_asserta_clause, {Collection, Head, Body}}). +db_asserta_clause(DBState, Collection, Head, Body) -> + F = erlog_ec_support:functor(Head), + do_action(DBState, db_asserta_clause, F, {Collection, Head, Body}). -db_findall(Database, Collection, Fun) -> gen_server:call(Database, {db_findall, {Collection, Fun}}). -finadll(Database, Fun) -> gen_server:call(Database, {findall, Fun}). +next(DBState, Cursor) -> + do_next(DBState, next, Cursor). +db_next(DBState, Cursor, Table) -> + do_next(DBState, db_next, {Cursor, Table}). -next(Database, Cursor) -> gen_server:call(Database, {next, Cursor}). -db_next(Database, Cursor, Table) -> gen_server:call(Database, {db_next, {Cursor, Table}}). +retract_clause(DBState, F, Ct) -> + do_action(DBState, retract_clause, F, {F, Ct}). -retract_clause(Database, F, Ct) -> gen_server:call(Database, {retract_clause, {F, Ct}}). -db_retract_clause(Database, Collection, F, Ct) -> - gen_server:call(Database, {db_retract_clause, {Collection, F, Ct}}). +db_retract_clause(DBState, Collection, F, Ct) -> + do_action(DBState, db_retract_clause, F, {Collection, F, Ct}). -abolish_clauses(Database, Func) -> gen_server:call(Database, {abolish_clauses, Func}). -db_abolish_clauses(Database, Collection, Func) -> - gen_server:call(Database, {db_abolish_clauses, {Collection, Func}}). +abolish_clauses(DBState = #db_state{stdlib = StdLib}, Func) -> + check_immutable(StdLib, Func), + check_abolish(abolish_clauses, Func, Func, DBState). -get_procedure(Database, Func) -> gen_server:call(Database, {get_procedure, Func}). -get_db_procedure(Database, Collection, Func) -> gen_server:call(Database, {get_db_procedure, {Collection, Func}}). +db_abolish_clauses(DBState = #db_state{stdlib = StdLib}, Collection, Func) -> + check_immutable(StdLib, Func), %abolishing fact from default memory need to be checked + check_abolish(db_abolish_clauses, Func, {Collection, Func}, DBState). -get_procedure_type(Database, Func) -> gen_server:call(Database, {get_procedure_type, Func}). +get_procedure(DbState, Func) -> + do_action(DbState, get_procedure, Func). -get_interp_functors(Database) -> gen_server:call(Database, get_interp_functors). +get_db_procedure(DbState, Collection, Func) -> + do_action(DbState, get_db_procedure, {Collection, Func}). -raw_store(Database, Key, Value) -> gen_server:call(Database, {raw_store, {Key, Value}}). +get_procedure_type(DbState, Func) -> + do_action(DbState, get_procedure_type, Func). -raw_fetch(Database, Key) -> gen_server:call(Database, {raw_fetch, Key}). +get_interp_functors(DbState) -> + do_action(DbState, get_interp_functors). -raw_append(Database, Key, Value) -> gen_server:call(Database, {raw_append, {Key, Value}}). +db_findall(DbState, Collection, Fun) -> + do_action(DbState, db_findall, {Collection, Fun}). -raw_erase(Database, Key) -> gen_server:call(Database, {raw_erase, Key}). +finadll(DbState, Fun) -> + do_action(DbState, findall, Fun). -listing(Database, Args) -> gen_server:call(Database, {listing, Args}). -db_listing(Database, Collection, Args) -> gen_server:call(Database, {db_listing, {Collection, Args}}). +listing(DbState, Args) -> + do_action(DbState, listing, Args). -close(Database, Cursor) -> gen_server:call(Database, {close, Cursor}). +db_listing(DbState, Collection, Args) -> + do_action(DbState, db_listing, {Collection, Args}). -%%-------------------------------------------------------------------- -%% @doc -%% Starts the server -%% -%% @end -%%-------------------------------------------------------------------- --spec(start_link(Database :: atom()) -> - {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). -start_link(Database) -> - gen_server:start_link(?MODULE, [Database], []). --spec(start_link(Database :: atom(), Params :: list() | atom()) -> - {ok, Pid :: pid()} | ignore | {error, Reason :: term()}). -start_link(Database, undefined) -> - start_link(Database); -start_link(Database, Params) -> - gen_server:start_link(?MODULE, [Database, Params], []). +raw_store(DBState = #db_state{in_mem = InMem}, Key, Value) -> + Umem = store(Key, Value, InMem), + DBState#db_state{in_mem = Umem}. -%%%=================================================================== -%%% gen_server callbacks -%%%=================================================================== +raw_fetch(#db_state{in_mem = InMem}, Key) -> + fetch(Key, InMem). -%%-------------------------------------------------------------------- -%% @private -%% @doc -%% Initializes the server -%% -%% @spec init(Args) -> {ok, State} | -%% {ok, State, Timeout} | -%% ignore | -%% {stop, Reason} -%% @end -%%-------------------------------------------------------------------- --spec(init(Args :: term()) -> - {ok, State :: #state{}} | {ok, State :: #state{}, timeout() | hibernate} | - {stop, Reason :: term()} | ignore). -init([Database]) when is_atom(Database) -> - {ok, State} = Database:new(), - {ok, init_memory(#state{database = Database, state = State})}; -init([Database, Params]) when is_atom(Database) -> - {ok, State} = Database:new(Params), - {ok, init_memory(#state{database = Database, state = State})}. - -%%-------------------------------------------------------------------- -%% @private -%% @doc -%% Handling call messages -%% -%% @end -%%-------------------------------------------------------------------- --spec(handle_call(Request :: term(), From :: {pid(), Tag :: term()}, %TODO refactor me, get rid of gen_server and its callbacks - State :: #state{}) -> - {reply, Reply :: term(), NewState :: #state{}} | - {reply, Reply :: term(), NewState :: #state{}, timeout() | hibernate} | - {noreply, NewState :: #state{}} | - {noreply, NewState :: #state{}, timeout() | hibernate} | - {stop, Reason :: term(), Reply :: term(), NewState :: #state{}} | - {stop, Reason :: term(), NewState :: #state{}}). -handle_call({load_kernel_space, {Module, Functor}}, _From, State = #state{stdlib = StdLib}) -> %load kernel space into memory - UStdlib = dict:store(Functor, {built_in, Module}, StdLib), - {reply, ok, State#state{stdlib = UStdlib}}; -handle_call({load_native, {Functor, M, F}}, _From, State = #state{stdlib = StdLib, exlib = ExLib}) -> %load library space into memory - check_immutable(StdLib, Functor), - {reply, ok, State#state{exlib = dict:store(Functor, {code, {M, F}}, ExLib)}}; -handle_call({load_extended, {H, _} = F}, _From, State = #state{stdlib = StdLib, exlib = ExLib}) -> %load library space into memory - check_immutable(StdLib, erlog_ec_support:functor(H)), - {Res, UExLib} = erlog_dict:assertz_clause({StdLib, ExLib, ExLib}, F), %use erlog_dict module to assert library to exlib dict - {reply, Res, State#state{exlib = UExLib}}; -handle_call({raw_store, {Key, Value}}, _From, State = #state{in_mem = InMem}) -> %findall store - Umem = store(Key, Value, InMem), - {reply, ok, State#state{in_mem = Umem}}; -handle_call({raw_fetch, Key}, _From, State = #state{in_mem = InMem}) -> %findall fetch - Res = fetch(Key, InMem), - {reply, Res, State}; -handle_call({raw_append, {Key, AppendValue}}, _From, State = #state{in_mem = InMem}) -> %findall append +raw_append(DBState = #db_state{in_mem = InMem}, Key, Value) -> Value = fetch(Key, InMem), - Umem = store(Key, lists:concat([Value, [AppendValue]]), InMem), - {reply, ok, State#state{in_mem = Umem}}; -handle_call({raw_erase, Key}, _From, State = #state{in_mem = InMem}) -> %findall erase + Umem = store(Key, lists:concat([Value, [Value]]), InMem), + DBState#db_state{in_mem = Umem}. + +raw_erase(DBState = #db_state{in_mem = InMem}, Key) -> Umem = dict:erase(Key, InMem), - {reply, ok, State#state{in_mem = Umem}}; -handle_call({abolish_clauses, Func}, _From, State = #state{stdlib = StdLib}) -> %call third-party db module - check_immutable(StdLib, Func), - check_abolish(abolish_clauses, Func, Func, State); -handle_call({db_abolish_clauses, {_, Func} = Params}, _From, State = #state{stdlib = StdLib}) -> %call third-party db module - check_immutable(StdLib, Func), %abolishing fact from default memory need to be checked - check_abolish(db_abolish_clauses, Func, Params, State); -handle_call({Fun, {H, _} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) - when Fun == asserta_clause; Fun == assertz_clause -> - F = erlog_ec_support:functor(H), - check_immutable(StdLib, F), %modifying fact in default memory need to be checked - check_immutable(ExLib, F), - do_action(Db, Fun, {StdLib, ExLib, DbState}, Params, State); -handle_call({Fun, {_, H, _} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) - when Fun == db_asserta_clause; Fun == db_assertz_clause -> - F = erlog_ec_support:functor(H), + DBState#db_state{in_mem = Umem}. + +close(DBState = #db_state{state = State, database = Db}, Cursor) -> + {Res, UState} = Db:close(State, Cursor), + {Res, DBState#db_state{state = UState}}. + + +%% @private +do_action(DBState = #db_state{stdlib = StdLib, exlib = ExLib, database = Db, state = State}, Fun, F, Args) -> check_immutable(StdLib, F), %modifying fact in default memory need to be checked check_immutable(ExLib, F), - do_action(Db, Fun, {StdLib, ExLib, DbState}, Params, State); -handle_call({retract_clause, {Func, _} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> - check_immutable(StdLib, Func), %modifying fact in default memory need to be checked - check_immutable(ExLib, Func), - do_action(Db, retract_clause, {StdLib, ExLib, DbState}, Params, State); -handle_call({db_retract_clause, {_, Func, _} = Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> - check_immutable(StdLib, Func), %modifying fact in default memory need to be checked - check_immutable(ExLib, Func), - do_action(Db, db_retract_clause, {StdLib, ExLib, DbState}, Params, State); -handle_call({Fun, Cursor}, _From, State = #state{state = DbState, database = Db}) when Fun == next; Fun == db_next -> %get next result by cursor - {Res, UState} = Db:Fun(DbState, Cursor), - Ans = case Res of - {cursor, After, result, Result} -> {After, Result}; %got new (or same cursor) and result. Form and return - [] -> {Cursor, []} %no result got - return old cursor and empty result - end, - {reply, Ans, State#state{state = UState}}; -handle_call({close, Cursor}, _From, State = #state{state = DbState, database = Db}) -> %get next result by cursor - {Res, UState} = Db:close(DbState, Cursor), - {reply, Res, State#state{state = UState}}; -handle_call({Fun, Params}, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module - do_action(Db, Fun, {StdLib, ExLib, DbState}, Params, State); -handle_call(Fun, _From, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> %call third-party db module - try - {Res, NewState} = Db:Fun({StdLib, ExLib, DbState}), - {reply, Res, State#state{state = NewState}} - catch - throw:E -> {reply, E, State} - end; -handle_call(_Request, _From, State) -> - {reply, ok, State}. - -%%-------------------------------------------------------------------- -%% @private -%% @doc -%% Handling cast messages -%% -%% @end -%%-------------------------------------------------------------------- --spec(handle_cast(Request :: term(), State :: #state{}) -> - {noreply, NewState :: #state{}} | - {noreply, NewState :: #state{}, timeout() | hibernate} | - {stop, Reason :: term(), NewState :: #state{}}). -handle_cast(halt, State) -> - {stop, normal, State}; -handle_cast(_Request, State) -> - {noreply, State}. - -%%-------------------------------------------------------------------- -%% @private -%% @doc -%% Handling all non call/cast messages -%% -%% @spec handle_info(Info, State) -> {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, State} -%% @end -%%-------------------------------------------------------------------- --spec(handle_info(Info :: timeout() | term(), State :: #state{}) -> - {noreply, NewState :: #state{}} | - {noreply, NewState :: #state{}, timeout() | hibernate} | - {stop, Reason :: term(), NewState :: #state{}}). -handle_info(_Info, State) -> - {noreply, State}. - -%%-------------------------------------------------------------------- + {Res, UState} = Db:Fun({StdLib, ExLib, State}, Args), + {Res, DBState#db_state{state = UState}}. + %% @private -%% @doc -%% This function is called by a gen_server when it is about to -%% terminate. It should be the opposite of Module:init/1 and do any -%% necessary cleaning up. When it returns, the gen_server terminates -%% with Reason. The return value is ignored. -%% -%% @spec terminate(Reason, State) -> void() -%% @end -%%-------------------------------------------------------------------- --spec(terminate(Reason :: (normal | shutdown | {shutdown, term()} | term()), - State :: #state{}) -> term()). -terminate(_Reason, _State) -> - ok. - -%%-------------------------------------------------------------------- +do_action(DBState = #db_state{stdlib = StdLib, exlib = ExLib, database = Db, state = State}, Fun, Args) -> + {Res, UState} = Db:Fun({StdLib, ExLib, State}, Args), + {Res, DBState#db_state{state = UState}}. + %% @private -%% @doc -%% Convert process state when code is changed -%% -%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState} -%% @end -%%-------------------------------------------------------------------- --spec(code_change(OldVsn :: term() | {down, term()}, State :: #state{}, - Extra :: term()) -> - {ok, NewState :: #state{}} | {error, Reason :: term()}). -code_change(_OldVsn, State, _Extra) -> - {ok, State}. +do_action(DBState = #db_state{stdlib = StdLib, exlib = ExLib, database = Db, state = State}, Fun) -> + {Res, UState} = Db:Fun({StdLib, ExLib, State}), + {Res, DBState#db_state{state = UState}}. -%%%=================================================================== -%%% Internal functions -%%%=================================================================== %% @private -%% Initialises three dicts for kernel, library memory and in_memory for findall operations --spec init_memory(State :: #state{}) -> UpdState :: #state{}. -init_memory(State) -> - D = dict:new(), - State#state{stdlib = D, exlib = D, in_mem = D}. +do_next(DBState = #db_state{database = Db, state = State}, Fun, Cursor) -> + {Res, UState} = Db:Fun(State, Cursor), + Ans = case Res of + {cursor, After, result, Result} -> {After, Result}; %got new (or same cursor) and result. Form and return + [] -> {Cursor, []} %no result got - return old cursor and empty result + end, + {Ans, DBState#db_state{state = UState}}. %% @private fetch(Key, Memory) -> @@ -349,21 +198,13 @@ store(Key, Value, Memory) -> dict:store(Key, Value, Memory). %% @private -check_abolish(F, Func, Params, State = #state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> +check_abolish(F, Func, Params, State = #db_state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> case dict:erase(Func, ExLib) of ExLib -> %dict not changed - was not deleted. Search userspace - do_action(Db, F, {StdLib, ExLib, DbState}, Params, State); + {_, UState} = Db:F({StdLib, ExLib, DbState}, Params), + State#db_state{state = UState}; UExlib -> %dict changed -> was deleted - {reply, ok, State#state{exlib = UExlib}} - end. - -%% @private -do_action(Db, Fun, Memory, Params, State) -> - try - {Res, UState} = Db:Fun(Memory, Params), - {reply, Res, State#state{state = UState}} - catch - throw:E -> {reply, E, State} + State#db_state{exlib = UExlib} end. %% @private From 581550258f492eece973f1f29aa7d7c62bb86ecb Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 28 Nov 2014 02:11:05 +0000 Subject: [PATCH 208/251] refactored, but not tested --- include/erlog_core.hrl | 2 +- src/core/erlog.erl | 66 ++++++++------ src/core/erlog_errors.erl | 25 +++--- src/core/erlog_file_consulter.erl | 2 +- src/core/erlog_logic.erl | 65 +++++++------- src/core/logic/erlog_ec_core.erl | 6 +- src/core/logic/erlog_ec_unify.erl | 4 +- src/io/erlog_file.erl | 89 ++++++------------- src/io/erlog_io.erl | 4 +- src/libs/external/db/erlog_db.erl | 64 ++++++------- .../standard/core/logic/erlog_ec_logic.erl | 50 ++++++----- src/libs/standard/core/main/erlog_core.erl | 64 ++++++------- src/storage/erlog_memory.erl | 9 +- 13 files changed, 220 insertions(+), 230 deletions(-) diff --git a/include/erlog_core.hrl b/include/erlog_core.hrl index e37b9e0..7e3e804 100644 --- a/include/erlog_core.hrl +++ b/include/erlog_core.hrl @@ -38,7 +38,7 @@ choice, bindings, var_num, - database, + database, %erlog.htl db_state event_man, f_consulter :: atom(), debugger, diff --git a/src/core/erlog.erl b/src/core/erlog.erl index c32d52e..3d43ddd 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -58,15 +58,17 @@ init(Params) -> % use custom database implementation FileCon = init_consulter(Params), DbState = init_database(Params), LibsDir = proplists:get_value(libs_dir, Params, "../lib"), %default assumes erlog is run from ebin - ok = load_prolog_libraries(FileCon, LibsDir, DbState), - ok = load_external_libraries(Params, FileCon, Db), - {ok, E} = gen_event:start_link(), + UdbState1 = load_prolog_libraries(FileCon, LibsDir, DbState), + UdbState2 = load_external_libraries(Params, FileCon, UdbState1), Debugger = init_debugger(Params), - case proplists:get_value(event_h, Params) of %register handler, if any - undefined -> ok; - {Module, Arguments} -> gen_event:add_handler(E, Module, Arguments) - end, - {ok, #state{db = Db, f_consulter = FileCon, e_man = E, debugger = Debugger, libs_dir = LibsDir}}. + EventMan = case proplists:get_value(event_h, Params) of %register handler, if any + undefined -> undefined; + {Module, Arguments} -> + {ok, E} = gen_event:start_link(), + gen_event:add_handler(E, Module, Arguments), + E + end, + {ok, #state{db_state = UdbState2, f_consulter = FileCon, e_man = EventMan, debugger = Debugger, libs_dir = LibsDir}}. handle_call({execute, Command}, _From, State) -> %running prolog code in normal mode {Res, _} = Repl = case erlog_scan:tokens([], Command, 1) of @@ -80,9 +82,10 @@ handle_call({select, Command}, _From, State) -> %in selection solutions mode NewState = change_state(Repl), % change state, depending on reply {reply, Res, NewState}. -handle_cast(halt, St = #state{e_man = E, db = Db}) -> +handle_cast(halt, St = #state{e_man = undefined}) -> + {stop, normal, St}; +handle_cast(halt, St = #state{e_man = E}) -> gen_event:stop(E), %stom all handlers and event man - gen_server:cast(Db, halt), {stop, normal, St}. handle_info(_, St) -> @@ -134,22 +137,27 @@ load_built_in(Database) -> ]). %% @private +-spec load_prolog_libraries(atom(), list(), #db_state{}) -> #db_state{}. load_prolog_libraries(Fcon, LibsDir, DbState) -> Autoload = Fcon:lookup(LibsDir ++ "/autoload"), - lists:foreach(fun(Lib) -> erlog_file:load_library(Fcon, LibsDir ++ "/autoload/" ++ Lib, DbState) end, Autoload), - ok. + lists:foldl( + fun(Lib, UdbState) -> + {ok, UpdDbState} = erlog_file:load_library(Fcon, LibsDir ++ "/autoload/" ++ Lib, UdbState), + UpdDbState + end, DbState, Autoload). %% @private -load_external_libraries(Params, FileCon, Database) -> +load_external_libraries(Params, FileCon, DdState) -> case proplists:get_value(libraries, Params) of - undefined -> ok; + undefined -> DdState; Libraries -> - lists:foreach( - fun(Mod) when is_atom(Mod) -> %autoload native library - Mod:load(Database); - (PrologLib) when is_list(PrologLib) -> %autoload external library - erlog_file:load_library(FileCon, PrologLib, Database) - end, Libraries) + lists:foldl( + fun(Mod, UDbState) when is_atom(Mod) -> %autoload native library + Mod:load(UDbState); + (PrologLib, UDbState) when is_list(PrologLib) -> %autoload external library + {ok, UpdDbState} = erlog_file:load_library(FileCon, PrologLib, UDbState), + UpdDbState + end, DdState, Libraries) end. %% @private @@ -164,10 +172,10 @@ run_command(Command, State) -> %% @private %% Preprocess command -preprocess_command({ok, Command}, State = #state{f_consulter = Consulter, db = Db}) when is_list(Command) -> %TODO may be remove me? - case erlog_logic:reconsult_files(Command, Db, Consulter) of - ok -> - {true, State}; +preprocess_command({ok, Command}, State = #state{f_consulter = Consulter, db_state = DbState}) when is_list(Command) -> %TODO may be remove me? + case erlog_logic:reconsult_files(Command, DbState, Consulter) of + {ok, UpdDbState} -> + {true, State#state{db_state = UpdDbState}}; {error, {L, Pm, Pe}} -> {erlog_io:format_error([L, Pm:format_error(Pe)]), State}; {Error, Message} when Error == error; Error == erlog_error -> @@ -188,9 +196,10 @@ process_command({prove, Goal}, State) -> prove_goal(Goal, State); process_command(next, State = #state{state = normal}) -> % can't select solution, when not in select mode {fail, State}; -process_command(next, State = #state{state = [Vs, Cps], db = Db, f_consulter = Consulter, libs_dir = LD}) -> - case erlog_logic:prove_result(catch erlog_errors:fail(#param{choice = Cps, database = Db, f_consulter = Consulter, libs_dir = LD}), Vs) of +process_command(next, State = #state{state = [Vs, Cps], db_state = DbState, f_consulter = Consulter, libs_dir = LD}) -> + case erlog_logic:prove_result(catch erlog_errors:fail(#param{choice = Cps, database = DbState, f_consulter = Consulter, libs_dir = LD}), Vs) of {Atom, Res, Args} -> {{Atom, Res}, State#state{state = Args}}; + {fail, Db} -> {fail, State#state{db_state = Db}}; Other -> {Other, State} end; process_command(halt, State) -> @@ -198,14 +207,15 @@ process_command(halt, State) -> {ok, State}. %% @private -prove_goal(Goal0, State = #state{db = Db, f_consulter = Consulter, e_man = Event, debugger = Deb, libs_dir = LD}) -> +prove_goal(Goal0, State = #state{db_state = Db, f_consulter = Consulter, e_man = Event, debugger = Deb, libs_dir = LD}) -> Vs = erlog_logic:vars_in(Goal0), %% Goal may be a list of goals, ensure proper goal. Goal1 = erlog_logic:unlistify(Goal0), %% Must use 'catch' here as 'try' does not do last-call %% optimisation. case erlog_logic:prove_result(catch erlog_ec_core:prove_goal(Goal1, Db, Consulter, Event, Deb, LD), Vs) of - {succeed, Res, Args} -> {{succeed, Res}, State#state{state = Args}}; + {succeed, Res, Args, UDbState} -> {{succeed, Res}, State#state{state = Args, db_state = UDbState}}; + {fail, Db} -> {fail, State#state{db_state = Db}}; OtherRes -> {OtherRes, State} end. diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index d1c1d3a..df26770 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -75,13 +75,13 @@ fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Param) -> %% @private fail_clause(#cp{data = {Ch, Cb, Db, Cursor}, next = Next, bs = Bs, vn = Vn}, Param) -> - {UCursor, Res} = erlog_memory:next(Db, Cursor), - erlog_ec_unify:unify_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}). + {{UCursor, Res}, UDb} = erlog_memory:next(Db, Cursor), + erlog_ec_unify:unify_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor, database = UDb}). %% @private fail_retract(#cp{data = {Ch, Cb, {Db, Cursor}}, next = Next, bs = Bs, vn = Vn}, Param) -> - {UCursor, Res} = erlog_memory:next(Db, Cursor), - erlog_ec_logic:retract_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}). + {{UCursor, Res}, UDb} = erlog_memory:next(Db, Cursor), + erlog_ec_logic:retract_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor, database = UDb}). %% @private fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Param) -> @@ -89,14 +89,15 @@ fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Para %% @private fail_goal_clauses(#cp{data = {G, Db, Cursor}, next = Next, bs = Bs, vn = Vn}, Param) -> - {UCursor, Res} = erlog_memory:next(Db, Cursor), - erlog_ec_core:prove_goal_clauses(Res, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}). + {{UCursor, Res}, UDb} = erlog_memory:next(Db, Cursor), + erlog_ec_core:prove_goal_clauses(Res, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor, database = UDb}). fail_findall(#cp{next = Next, data = {Tag, Bag}, bs = Bs, vn = Vn0}, Param = #param{database = Db}) -> Data = erlog_memory:raw_fetch(Db, Tag), - erlog_memory:raw_erase(Db, Tag), %Clear special entry - {Bs1, Vn1} = lists:mapfoldl(fun(B0, V0) -> %Create proper instances - {B1, _, V1} = erlog_ec_term:term_instance(erlog_ec_support:dderef(B0, Bs), V0), - {B1, V1} - end, Vn0, Data), - erlog_ec_body:unify_prove_body(Bag, Bs1, Param#param{next_goal = Next, var_num = Vn1}). \ No newline at end of file + Udb = erlog_memory:raw_erase(Db, Tag), %Clear special entry + {Bs1, Vn1} = lists:mapfoldl( + fun(B0, V0) -> %Create proper instances + {B1, _, V1} = erlog_ec_term:term_instance(erlog_ec_support:dderef(B0, Bs), V0), + {B1, V1} + end, Vn0, Data), + erlog_ec_body:unify_prove_body(Bag, Bs1, Param#param{next_goal = Next, var_num = Vn1, database = Udb}). \ No newline at end of file diff --git a/src/core/erlog_file_consulter.erl b/src/core/erlog_file_consulter.erl index e452a4e..389820b 100644 --- a/src/core/erlog_file_consulter.erl +++ b/src/core/erlog_file_consulter.erl @@ -13,4 +13,4 @@ -callback lookup(Directory :: string()) -> Files :: list(). %% consult selected file --callback load(FileLoc :: string()) -> ok. +-callback load(FileLoc :: string()) -> {ok, [Term :: term()]} | {error, Error :: term()}. diff --git a/src/core/erlog_logic.erl b/src/core/erlog_logic.erl index 3875bf5..f7402f8 100644 --- a/src/core/erlog_logic.erl +++ b/src/core/erlog_logic.erl @@ -27,25 +27,26 @@ unlistify([G | Gs]) -> {',', G, unlistify(Gs)}; unlistify([]) -> true; unlistify(G) -> G. %In case it wasn't a list. -prove_result({succeed, Cps, Bs, _Vn, _Db1}, Vs) -> - {succeed, erlog_ec_support:dderef(Vs, Bs), [Vs, Cps]}; -prove_result({fail, _Db1}, _Vs) -> - fail; +prove_result({succeed, Cps, Bs, _Vn, Db}, Vs) -> + {succeed, erlog_ec_support:dderef(Vs, Bs), [Vs, Cps], Db}; +prove_result({fail, Db}, _Vs) -> + {fail, Db}; prove_result({erlog_error, Error, _Db1}, _Vs) -> - {error, Error}; + {error, Error}; prove_result({erlog_error, Error}, _Vs) -> %No new database - {error, Error}; + {error, Error}; prove_result({'EXIT', Error}, _Vs) -> - {'EXIT', Error}. + {'EXIT', Error}. -spec reconsult_files(list(), pid(), atom()) -> ok | tuple(). -reconsult_files([], _, _) -> ok; %TODO lists:foldr instead! -reconsult_files([F | Fs], Db, Consulter) -> - case erlog_file:reconsult(Consulter, F, Db) of - ok -> reconsult_files(Fs, Db, Consulter); - {erlog_error, Error} -> {erlog_error, Error}; - {error, Error} -> {error, Error} - end; +reconsult_files(FileList, DbState, Consulter) when is_list(FileList) -> + catch lists:foldl( + fun(File, UDBState) -> + case erlog_file:reconsult(Consulter, File, UDBState) of + {ok, UpdDBState} -> UpdDBState; + {error, Error} -> throw({error, Error}) + end + end, DbState, FileList); reconsult_files(Other, _Db, _Fun) -> {error, {type_error, list, Other}}. shell_prove_result({succeed, Vs}) -> show_bindings(Vs); @@ -57,18 +58,18 @@ shell_prove_result({'EXIT', Error}) -> erlog_io:format_error("EXIT", [Error]). %% Show the bindings and query user for next solution. show_bindings([]) -> true; show_bindings(Vs) -> %TODO where atoms are created? - Out = lists:foldr( - fun({Name, Val}, Acc) -> + Out = lists:foldr( + fun({Name, Val}, Acc) -> %% [erlog_io:writeq1({'=', {Name}, Val}) | Acc] - [{Name, Val} | Acc] %TODO. Test, is this suitable for all variants? If so - writeq can be deleted. - end, [], Vs), %format reply - {{true, Out}, select}. + [{Name, Val} | Acc] %TODO. Test, is this suitable for all variants? If so - writeq can be deleted. + end, [], Vs), %format reply + {{true, Out}, select}. select_bindings(Selection, Next) -> - case string:chr(Selection, $;) of - 0 -> true; - _ -> shell_prove_result(Next) - end. + case string:chr(Selection, $;) of + 0 -> true; + _ -> shell_prove_result(Next) + end. %% vars_in(Term) -> [{Name,Var}]. %% Returns an ordered list of {VarName,Variable} pairs. @@ -77,29 +78,29 @@ vars_in(Term) -> vars_in(Term, orddict:new()). vars_in({'_'}, Vs) -> Vs; %Never in! vars_in({Name} = Var, Vs) -> orddict:store(Name, Var, Vs); vars_in(Struct, Vs) when is_tuple(Struct) -> - vars_in_struct(Struct, 2, size(Struct), Vs); + vars_in_struct(Struct, 2, size(Struct), Vs); vars_in([H | T], Vs) -> - vars_in(T, vars_in(H, Vs)); + vars_in(T, vars_in(H, Vs)); vars_in(_, Vs) -> Vs. vars_in_struct(_Str, I, S, Vs) when I > S -> Vs; vars_in_struct(Str, I, S, Vs) -> - vars_in_struct(Str, I + 1, S, vars_in(element(I, Str), Vs)). + vars_in_struct(Str, I + 1, S, vars_in(element(I, Str), Vs)). %% is_legal_term(Goal) -> true | false. %% Test if a goal is a legal Erlog term. Basically just check if %% tuples are used correctly as structures and variables. is_legal_term({V}) -> is_atom(V); is_legal_term([H | T]) -> - is_legal_term(H) andalso is_legal_term(T); + is_legal_term(H) andalso is_legal_term(T); is_legal_term(T) when is_tuple(T) -> - if tuple_size(T) >= 2, is_atom(element(1, T)) -> - are_legal_args(T, 2, size(T)); %The right tuples. - true -> false - end; + if tuple_size(T) >= 2, is_atom(element(1, T)) -> + are_legal_args(T, 2, size(T)); %The right tuples. + true -> false + end; is_legal_term(T) when ?IS_ATOMIC(T) -> true; %All constants, including [] is_legal_term(_T) -> false. are_legal_args(_T, I, S) when I > S -> true; are_legal_args(T, I, S) -> - is_legal_term(element(I, T)) andalso are_legal_args(T, I + 1, S). \ No newline at end of file + is_legal_term(element(I, T)) andalso are_legal_args(T, I + 1, S). \ No newline at end of file diff --git a/src/core/logic/erlog_ec_core.erl b/src/core/logic/erlog_ec_core.erl index ca5f13b..56d6e5c 100644 --- a/src/core/logic/erlog_ec_core.erl +++ b/src/core/logic/erlog_ec_core.erl @@ -78,10 +78,10 @@ prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bi prove_goal(Param = #param{goal = G, database = Db}) -> %% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), case catch erlog_memory:get_procedure(Db, G) of - {cursor, Cursor, result, Result} -> + {{cursor, Cursor, result, Result}, UDB} -> Fun = fun(Params) -> check_result(Result, Params) end, - run_n_close(Fun, Param#param{cursor = Cursor}); - Result -> check_result(Result, Param) + run_n_close(Fun, Param#param{cursor = Cursor, database = UDB}); + {Result, UDB} -> check_result(Result, Param#param{database = UDB}) end. %% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> diff --git a/src/core/logic/erlog_ec_unify.erl b/src/core/logic/erlog_ec_unify.erl index e35a41f..ad584da 100644 --- a/src/core/logic/erlog_ec_unify.erl +++ b/src/core/logic/erlog_ec_unify.erl @@ -43,8 +43,8 @@ unify_clauses(Ch, Cb, C, Param = #param{next_goal = Next, bindings = Bs0, var_nu Cp = #cp{type = clause, data = {Ch, Cb, Db, Cursor}, next = Next, bs = Bs0, vn = Vn0}, erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); fail -> - {UCursor, Res} = erlog_memory:next(Db, Cursor), - unify_clauses(Ch, Cb, Res, Param#param{cursor = UCursor}) + {{UCursor, Res}, UDb} = erlog_memory:next(Db, Cursor), + unify_clauses(Ch, Cb, Res, Param#param{cursor = UCursor, database = UDb}) end. unify_clause(Ch, Cb, [C], Bs0, Vn0) -> unify_clause(Ch, Cb, C, Bs0, Vn0); diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index 4b60683..c47b7bc 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -29,7 +29,7 @@ %% {ok,NewDatabase} | {error,Error} | {erlog_error,Error}. %% Load/reload an Erlog file into the interpreter. Reloading will %% abolish old definitons of clauses. --spec consult(atom(), File :: string(), DbState :: #db_state{}) -> #db_state{}. +-spec consult(atom(), File :: string(), DbState :: #db_state{}) -> {ok, #db_state{}}. consult(Consulter, File, DbState) -> case Consulter:load(File) of %call erlog_file_consulter implementation {ok, Terms} -> iterate_terms(fun consult_assert/2, DbState, Terms); @@ -37,32 +37,26 @@ consult(Consulter, File, DbState) -> end. %% consult to library space --spec load_library(atom(), File :: string(), DbState :: #db_state{}) -> #db_state{}. +-spec load_library(atom(), File :: string(), DbState :: #db_state{}) -> {ok, #db_state{}}. load_library(Consulter, File, DbState) -> case Consulter:load(File) of %call erlog_file_consulter implementation {ok, Terms} -> iterate_terms(fun consult_lib/2, DbState, Terms); Error -> Error end. --spec reconsult(atom(), File :: string(), DbState :: #db_state{}) -> #db_state{}. +-spec reconsult(atom(), File :: string(), DbState :: #db_state{}) -> {ok, #db_state{}} | {error, Error :: term()}. reconsult(Consulter, File, DbState) -> case Consulter:load(File) of %call erlog_file_consulter implementation {ok, Terms} -> - case iterate_terms(fun reconsult_assert/2, {Db, []}, Terms) of - ok -> ok; - Error -> Error - end; + iterate_terms(fun reconsult_assert/2, {DbState, []}, Terms); Error -> Error end. --spec deconsult(atom(), File :: string(), DbState :: #db_state{}) -> #db_state{}. +-spec deconsult(atom(), File :: string(), DbState :: #db_state{}) -> {ok, #db_state{}}. deconsult(Consulter, File, DbState) -> case Consulter:load(File) of %call erlog_file_consulter implementation {ok, Terms} -> - case iterate_terms(fun deconsult_assert/2, {Db, []}, Terms) of - ok -> ok; - Error -> Error - end; + iterate_terms(fun deconsult_assert/2, {DbState, []}, Terms); Error -> Error end. @@ -70,34 +64,31 @@ deconsult(Consulter, File, DbState) -> -spec consult_assert(Term0 :: term(), DbState :: #db_state{}) -> {ok, UDbState :: #db_state{}}. consult_assert(Term0, Db) -> Term1 = erlog_ed_logic:expand_term(Term0), - check_assert(Db, Term1), - {ok, Db}. %TODO refactor consult_terms not to pass DB everywhere! + erlog_memory:assertz_clause(Db, Term1). %% @private --spec consult_lib(Term0 :: term(), Db :: pid()) -> {ok, Db :: pid()}. +-spec consult_lib(Term0 :: term(), Db :: pid()) -> {ok, UDbState :: #db_state{}}. consult_lib(Term0, Db) -> Term1 = erlog_ed_logic:expand_term(Term0), - check_load(Db, Term1), - {ok, Db}. - + erlog_memory:load_extended_library(Db, Term1). %% @private --spec reconsult_assert(Term0 :: term(), {Db :: pid(), Seen :: list()}) -> {ok, {Db :: pid(), list()}}. +-spec reconsult_assert(Term0 :: term(), {Db :: #db_state{}, Seen :: list()}) -> {ok, {Db :: #db_state{}, list()}}. reconsult_assert(Term0, {Db, Seen}) -> Term1 = erlog_ed_logic:expand_term(Term0), Func = functor(Term1), case lists:member(Func, Seen) of true -> - check_assert(Db, Term1), - {ok, {Db, Seen}}; + {_, UDb} = erlog_memory:assertz_clause(Db, Term1), + {ok, {UDb, Seen}}; false -> - check_abolish(Db, Func), - check_assert(Db, Term1), - {ok, {Db, [Func | Seen]}} + {_, Udb1} = erlog_memory:abolish_clauses(Db, Func), + {_, Udb2} = erlog_memory:assertz_clause(Udb1, Term1), + {ok, {Udb2, [Func | Seen]}} end. %% @private --spec deconsult_assert(Term0 :: term(), {Db :: pid(), Seen :: list()}) -> {ok, {Db :: pid(), list()}}. +-spec deconsult_assert(Term0 :: term(), {Db :: pid(), Seen :: list()}) -> {ok, {Db :: #db_state{}, list()}}. deconsult_assert(Term0, {Db, Seen}) -> Term1 = erlog_ed_logic:expand_term(Term0), Func = functor(Term1), @@ -105,9 +96,9 @@ deconsult_assert(Term0, {Db, Seen}) -> true -> {ok, {Db, Seen}}; false -> - check_abolish(Db, Func), - check_assert(Db, Term1), - {ok, {Db, [Func | Seen]}} + {_, Udb1} = erlog_memory:abolish_clauses(Db, Func), + {_, Udb2} = erlog_memory:assertz_clause(Udb1, Term1), + {ok, {Udb2, [Func | Seen]}} end. %% @private @@ -115,41 +106,19 @@ deconsult_assert(Term0, {Db, Seen}) -> %% {ok,NewDatabase} | {erlog_error,Error}. %% Add terms to the database using InsertFun. Ignore directives and %% queries. --spec iterate_terms(fun(), any(), list()) -> ok | tuple(). -iterate_terms(Ifun, Params, [{':-', _} | Ts]) -> - iterate_terms(Ifun, Params, Ts); -iterate_terms(Ifun, Params, [{'?-', _} | Ts]) -> - iterate_terms(Ifun, Params, Ts); -iterate_terms(Ifun, Params, [Term | Ts]) -> - case catch Ifun(Term, Params) of - {ok, UpdParams} -> iterate_terms(Ifun, UpdParams, Ts); +-spec iterate_terms(fun(), any(), list()) -> {ok, #db_state{}}. +iterate_terms(Ifun, DbState, [{':-', _} | Ts]) -> + iterate_terms(Ifun, DbState, Ts); +iterate_terms(Ifun, DbState, [{'?-', _} | Ts]) -> + iterate_terms(Ifun, DbState, Ts); +iterate_terms(Ifun, DbState, [Term | Ts]) -> + case catch Ifun(Term, DbState) of + {ok, UDbState} -> iterate_terms(Ifun, UDbState, Ts); {erlog_error, E, _} -> {erlog_error, E}; {erlog_error, E} -> {erlog_error, E} end; -iterate_terms(_, _, []) -> ok. +iterate_terms(_, DbState, []) -> {ok, DbState}. %% @private functor({':-', H, _B}) -> erlog_ec_support:functor(H); -functor(T) -> erlog_ec_support:functor(T). - -%% @private -check_assert(DbState, Term) -> - case erlog_memory:assertz_clause(DbState, Term) of - {erlog_error, E} -> erlog_errors:erlog_error(E); - _ -> ok - end. - -%% @private -%% Same as check assert, but use library space -check_load(Db, Term) -> - case erlog_memory:load_extended_library(Db, Term) of - {erlog_error, E} -> erlog_errors:erlog_error(E); - _ -> ok - end. - -%% @private -check_abolish(Db, Term) -> - case erlog_memory:abolish_clauses(Db, Term) of - {erlog_error, E} -> erlog_errors:erlog_error(E); - _ -> ok - end. \ No newline at end of file +functor(T) -> erlog_ec_support:functor(T). \ No newline at end of file diff --git a/src/io/erlog_io.erl b/src/io/erlog_io.erl index 893650e..b47a5eb 100644 --- a/src/io/erlog_io.erl +++ b/src/io/erlog_io.erl @@ -49,8 +49,8 @@ load(File) -> {ok, read_stream(Fd, 1)} catch throw:Term -> Term; - error:Error -> {error, einval, Error}; - exit:Exit -> {exit, einval, Exit} + error:Error -> {error, {einval, Error}}; + exit:Exit -> {exit, {einval, Exit}} after file:close(Fd) end; diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index f097ea1..ee234e0 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -33,28 +33,28 @@ load(DbState) -> db_call_2(Param = #param{goal = {db_call, _, _} = Goal, next_goal = Next0, bindings = Bs, database = Db}) -> {db_call, Table, G} = erlog_ec_support:dderef(Goal, Bs), case erlog_memory:db_findall(Db, Table, G) of - {cursor, Cursor, result, Result} -> + {{cursor, Cursor, result, Result}, UDb} -> Fun = fun(Params) -> check_call_result(Result, Params, G, Next0) end, - erlog_ec_core:run_n_close(Fun, Param#param{cursor = Cursor}); - Result -> check_call_result(Result, Param, G, Next0) + erlog_ec_core:run_n_close(Fun, Param#param{cursor = Cursor, database = UDb}); + {Result, UDb} -> check_call_result(Result, Param#param{database = UDb}, G, Next0) end. db_assert_2(Params = #param{goal = {db_assert, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> {db_assert, Table, Fact} = erlog_ec_support:dderef(Goal, Bs), - erlog_memory:db_assertz_clause(Db, Table, Fact), - erlog_ec_core:prove_body(Params#param{goal = Next}). + {_, UDb} = erlog_memory:db_assertz_clause(Db, Table, Fact), + erlog_ec_core:prove_body(Params#param{goal = Next, database = UDb}). db_asserta_2(Params = #param{goal = {db_asserta, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> {db_asserta, Table, Fact} = erlog_ec_support:dderef(Goal, Bs), - erlog_memory:db_asserta_clause(Db, Table, Fact), - erlog_ec_core:prove_body(Params#param{goal = Next}). + {_, UDb} = erlog_memory:db_asserta_clause(Db, Table, Fact), + erlog_ec_core:prove_body(Params#param{goal = Next, database = UDb}). db_abolish_2(Params = #param{goal = {db_abolish, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> {db_abolish, Table, Fact} = erlog_ec_support:dderef(Goal, Bs), case Fact of {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> - erlog_memory:db_abolish_clauses(Db, Table, {N, A}), - erlog_ec_core:prove_body(Params#param{goal = Next}); + {_, UDb} = erlog_memory:db_abolish_clauses(Db, Table, {N, A}), + erlog_ec_core:prove_body(Params#param{goal = Next, database = UDb}); Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) end. @@ -68,21 +68,21 @@ db_retractall_2(Params = #param{goal = {db_retractall, _, _} = Goal, bindings = db_listing_2(Params = #param{goal = {db_listing, _, _} = Goal, next_goal = Next, bindings = Bs0, database = Db}) -> {db_listing, Table, Res} = erlog_ec_support:dderef(Goal, Bs0), - Content = erlog_memory:db_listing(Db, Table, []), + {Content, UDb} = erlog_memory:db_listing(Db, Table, []), Bs = erlog_ec_support:add_binding(Res, Content, Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs, database = UDb}). db_listing_3(Params = #param{goal = {db_listing, _, _, _} = Goal, next_goal = Next, bindings = Bs0, database = Db}) -> {db_listing, Table, Functor, Res} = erlog_ec_support:dderef(Goal, Bs0), - Content = erlog_memory:db_listing(Db, Table, [Functor]), + {Content, UDb} = erlog_memory:db_listing(Db, Table, [Functor]), Bs = erlog_ec_support:add_binding(Res, Content, Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs, database = UDb}). db_listing_4(Params = #param{goal = {db_listing, _, _, _, _} = Goal, next_goal = Next, bindings = Bs0, database = Db}) -> {db_listing, Table, Functor, Arity, Res} = erlog_ec_support:dderef(Goal, Bs0), - Content = erlog_memory:db_listing(Db, Table, [Functor, Arity]), + {Content, UDb} = erlog_memory:db_listing(Db, Table, [Functor, Arity]), Bs = erlog_ec_support:add_binding(Res, Content, Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs, database = UDb}). prove_retract({':-', H, B}, Table, Params) -> prove_retract(H, B, Table, Params); @@ -107,10 +107,10 @@ prove_call(G, Cs, Next0, Param = #param{bindings = Bs, choice = Cps, database = %% @private prove_retract(H, B, Table, Params = #param{database = Db}) -> case erlog_memory:get_db_procedure(Db, Table, H) of - {cursor, Cursor, result, {clauses, Cs}} -> + {{cursor, Cursor, result, {clauses, Cs}, UDB}} -> erlog_ec_core:run_n_close(fun(Param) -> - retract_clauses(H, B, Cs, Param, Table) end, Params#param{cursor = Cursor}); - undefined -> erlog_errors:fail(Params); + retract_clauses(H, B, Cs, Param, Table) end, Params#param{cursor = Cursor, database = UDB}); + {undefined, UDB} -> erlog_errors:fail(Params#param{database = UDB}); _ -> Functor = erlog_ec_support:functor(H), erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)) @@ -120,17 +120,17 @@ prove_retract(H, B, Table, Params = #param{database = Db}) -> prove_retractall(H, B, Table, Params = #param{database = Db}) -> Functor = erlog_ec_support:functor(H), case erlog_memory:get_db_procedure(Db, Table, H) of - {cursor, Cursor, result, Res} -> - check_retractall_result(Res, H, B, Functor, Table, Params#param{cursor = Cursor}); - Res -> - check_retractall_result(Res, H, B, Functor, Table, Params) + {{cursor, Cursor, result, Res}, UDb} -> + check_retractall_result(Res, H, B, Functor, Table, Params#param{cursor = Cursor, database = UDb}); + {Res, UDb} -> + check_retractall_result(Res, H, B, Functor, Table, Params#param{database = UDb}) end. %% @private retract(Ch, Cb, C, Cursor, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1, Table) -> - erlog_memory:db_retract_clause(Db, Table, erlog_ec_support:functor(Ch), element(1, C)), - Cp = #cp{type = db_retract, data = {Ch, Cb, {Db, Cursor}, Table}, next = Next, bs = Bs0, vn = Vn0}, - erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). + {_, UDb} = erlog_memory:db_retract_clause(Db, Table, erlog_ec_support:functor(Ch), element(1, C)), + Cp = #cp{type = db_retract, data = {Ch, Cb, {UDb, Cursor}, Table}, next = Next, bs = Bs0, vn = Vn0}, + erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1, database = UDb}). %% @private %% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> @@ -144,13 +144,13 @@ retract_clauses(Ch, Cb, C, Param = #param{bindings = Bs0, var_num = Vn0, databas %% We have found a right clause so now retract it. retract(Ch, Cb, C, Cursor, Param, Bs1, Vn1, Table); fail -> - {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), - retract_clauses(Ch, Cb, Res, Param#param{cursor = UCursor}, Table) + {{UCursor, Res}, UDb} = erlog_memory:db_next(Db, Cursor, Table), + retract_clauses(Ch, Cb, Res, Param#param{cursor = UCursor, database = UDb}, Table) end. fail_retract(#cp{data = {Ch, Cb, {Db, Cursor}, Table}, next = Next, bs = Bs, vn = Vn}, Param) -> - {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), - retract_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}, Table). + {{UCursor, Res}, UDb} = erlog_memory:db_next(Db, Cursor, Table), + retract_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor, database = UDb}, Table). %% @private check_call_result([], Param, _, _) -> erlog_errors:fail(Param); @@ -164,9 +164,9 @@ retractall_clauses(Table, [Clause], H, B, Params) -> retractall_clauses(Table, C retractall_clauses(Table, Clause, H, B, Params = #param{bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}) -> case erlog_ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of {succeed, _, _} -> - erlog_memory:db_retract_clause(Db, Table, erlog_ec_support:functor(H), element(1, Clause)), - {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), - retractall_clauses(Table, Res, H, B, Params#param{cursor = UCursor}); + {_, UDb1} = erlog_memory:db_retract_clause(Db, Table, erlog_ec_support:functor(H), element(1, Clause)), + {{UCursor, Res}, UDb2} = erlog_memory:db_next(UDb1, Cursor, Table), + retractall_clauses(Table, Res, H, B, Params#param{cursor = UCursor, database = UDb2}); fail -> retractall_clauses(Table, [], H, B, Params) end. diff --git a/src/libs/standard/core/logic/erlog_ec_logic.erl b/src/libs/standard/core/logic/erlog_ec_logic.erl index 5ab852b..5c876aa 100644 --- a/src/libs/standard/core/logic/erlog_ec_logic.erl +++ b/src/libs/standard/core/logic/erlog_ec_logic.erl @@ -36,10 +36,10 @@ prove_findall(T, G, B0, Param = #param{bindings = Bs, choice = Cps, next_goal = {Next1, _} = erlog_ec_logic:check_goal(G, [{findall, Tag, T}], Bs, Db, false, Label), B1 = partial_list(B0, Bs), Cp = #cp{type = findall, data = {Tag, B1}, next = Next, bs = Bs, vn = Vn}, - erlog_memory:raw_store(Db, Tag, []), %Initialise collection + UDb = erlog_memory:raw_store(Db, Tag, []), %Initialise collection %% Catch case where an erlog error occurs when cleanup database. try - erlog_ec_core:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], bindings = Bs, var_num = Vn + 1}) + erlog_ec_core:prove_body(Param#param{goal = Next1, choice = [Cp | Cps], bindings = Bs, var_num = Vn + 1, database = UDb}) catch throw:{erlog_error, E, Dba} -> Dbb = erlog_memory:raw_erase(Dba, Tag), %Clear special entry @@ -65,14 +65,16 @@ prove_ecall(Efun, Val, Param = #param{next_goal = Next, choice = Cps, bindings = %% Unify clauses matching with functor from Head with both Head and Body. prove_clause(H, B, Params = #param{database = Db}) -> Functor = erlog_ec_support:functor(H), - case erlog_memory:get_procedure(Db, H) of + {Res, UDb} = erlog_memory:get_procedure(Db, H), + case Res of {cursor, Cursor, result, {clauses, Cs}} -> - erlog_ec_core:run_n_close(fun(Param) -> erlog_ec_unify:unify_clauses(H, B, Cs, Param) end, Params#param{cursor = Cursor}); + erlog_ec_core:run_n_close(fun(Param) -> erlog_ec_unify:unify_clauses(H, B, Cs, Param) end, + Params#param{cursor = Cursor, database = UDb}); {code, _} -> erlog_errors:permission_error(access, private_procedure, erlog_ec_support:pred_ind(Functor)); built_in -> erlog_errors:permission_error(access, private_procedure, erlog_ec_support:pred_ind(Functor)); - undefined -> erlog_errors:fail(Params) + undefined -> erlog_errors:fail(Params#param{database = UDb}) end. %% prove_current_predicate(PredInd, Next, ChoicePoints, Bindings, VarNum, DataBase) -> @@ -84,8 +86,8 @@ prove_current_predicate(Pi, Param = #param{database = Db}) -> {_} -> ok; Other -> erlog_errors:type_error(predicate_indicator, Other) end, - Fs = erlog_memory:get_interp_functors(Db), - prove_predicates(Pi, Fs, Param). + {Fs, UDb} = erlog_memory:get_interp_functors(Db), + prove_predicates(Pi, Fs, Param#param{database = UDb}). prove_predicates(Pi, [F | Fs], Param = #param{next_goal = Next, choice = Cps, bindings = Bs, var_num = Vn}) -> Cp = #cp{type = current_predicate, data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, @@ -127,12 +129,12 @@ retract_clauses(Ch, Cb, C, Param = #param{next_goal = Next, choice = Cps, bindin case erlog_ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of {succeed, Bs1, Vn1} -> %% We have found a right clause so now retract it. - erlog_memory:retract_clause(Db, erlog_ec_support:functor(Ch), element(1, C)), - Cp = #cp{type = retract, data = {Ch, Cb, {Db, Cursor}}, next = Next, bs = Bs0, vn = Vn0}, - erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}); + {_, UDb} = erlog_memory:retract_clause(Db, erlog_ec_support:functor(Ch), element(1, C)), + Cp = #cp{type = retract, data = {Ch, Cb, {UDb, Cursor}}, next = Next, bs = Bs0, vn = Vn0}, + erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1, database = UDb}); fail -> - {UCursor, Res} = erlog_memory:next(Db, Cursor), - retract_clauses(Ch, Cb, Res, Param#param{cursor = UCursor}) + {{UCursor, Res}, UDb} = erlog_memory:next(Db, Cursor), + retract_clauses(Ch, Cb, Res, Param#param{cursor = UCursor, database = UDb}) end. %% well_form_goal(Goal, Tail, HasCutAfter, CutLabel) -> {Body,HasCut}. @@ -226,34 +228,37 @@ partial_list(Other, _) -> erlog_errors:type_error(list, Other). %% @private prove_retract(H, B, Params = #param{database = Db}) -> Functor = erlog_ec_support:functor(H), - case erlog_memory:get_procedure(Db, H) of + {Res, Udb} = erlog_memory:get_procedure(Db, H), + case Res of {cursor, Cursor, result, {clauses, Cs}} -> - erlog_ec_core:run_n_close(fun(Param) -> retract_clauses(H, B, Cs, Param) end, Params#param{cursor = Cursor}); + erlog_ec_core:run_n_close(fun(Param) -> retract_clauses(H, B, Cs, Param) end, + Params#param{cursor = Cursor, database = Udb}); {code, _} -> erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)); built_in -> erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)); - undefined -> erlog_errors:fail(Params) + undefined -> erlog_errors:fail(Params#param{database = Udb}) end. %% @private prove_retractall(H, B, Params = #param{database = Db}) -> Functor = erlog_ec_support:functor(H), - case erlog_memory:get_procedure(Db, H) of + {Res, Udb} = erlog_memory:get_procedure(Db, H), + case Res of {cursor, Cursor, result, Result} -> Fun = fun(Param) -> check_result(Result, H, B, Functor, Param) end, - erlog_ec_core:run_n_close(Fun, Params#param{cursor = Cursor}); + erlog_ec_core:run_n_close(Fun, Params#param{cursor = Cursor, database = Udb}); Result -> - check_result(Result, H, B, Functor, Params) + check_result(Result, H, B, Functor, Params#param{database = Udb}) end. retractall_clauses([], _, _, Params = #param{next_goal = Next}) -> erlog_ec_core:prove_body(Params#param{goal = Next}); retractall_clauses(Clause, H, B, Params = #param{bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}) -> case erlog_ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of {succeed, _, _} -> - erlog_memory:retract_clause(Db, erlog_ec_support:functor(H), element(1, Clause)), - {UCursor, Res} = erlog_memory:next(Db, Cursor), - retractall_clauses(Res, H, B, Params#param{cursor = UCursor}); + {_, Udb1} = erlog_memory:retract_clause(Db, erlog_ec_support:functor(H), element(1, Clause)), + {{UCursor, Res}, UDb2} = erlog_memory:next(Udb1, Cursor), + retractall_clauses(Res, H, B, Params#param{cursor = UCursor, database = UDb2}); fail -> retractall_clauses([], H, B, Params) end. @@ -264,5 +269,6 @@ check_result({code, _}, _, _, Functor, _) -> erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)); check_result({clauses, Cs}, H, B, _, Params) -> retractall_clauses(Cs, H, B, Params); -check_result(undefined, _, _, _, Params = #param{next_goal = Next}) -> erlog_ec_core:prove_body(Params#param{goal = Next}); +check_result(undefined, _, _, _, Params = #param{next_goal = Next}) -> + erlog_ec_core:prove_body(Params#param{goal = Next}); check_result({erlog_error, E}, _, _, _, #param{database = Db}) -> erlog_errors:erlog_error(E, Db). \ No newline at end of file diff --git a/src/libs/standard/core/main/erlog_core.erl b/src/libs/standard/core/main/erlog_core.erl index 5a4ef6a..b58f1f9 100644 --- a/src/libs/standard/core/main/erlog_core.erl +++ b/src/libs/standard/core/main/erlog_core.erl @@ -71,19 +71,19 @@ prove_goal(Param = #param{goal = repeat, next_goal = Next, choice = Cps, binding prove_goal(Param = #param{goal = {abolish, Pi0}, next_goal = Next, bindings = Bs, database = Db}) -> case erlog_ec_support:dderef(Pi0, Bs) of {'/', N, A} when is_atom(N), is_integer(A), A > 0 -> - erlog_memory:abolish_clauses(Db, {N, A}), - erlog_ec_core:prove_body(Param#param{goal = Next}); + {_, UDb} = erlog_memory:abolish_clauses(Db, {N, A}), + erlog_ec_core:prove_body(Param#param{goal = Next, database = UDb}); Pi -> erlog_errors:type_error(predicate_indicator, Pi, Db) end; prove_goal(Param = #param{goal = {Assert, C0}, next_goal = Next, bindings = Bs, database = Db}) when Assert == assert; Assert == assertz -> C = erlog_ec_support:dderef(C0, Bs), - erlog_memory:assertz_clause(Db, C), - erlog_ec_core:prove_body(Param#param{goal = Next}); + {_, UDb} = erlog_memory:assertz_clause(Db, C), + erlog_ec_core:prove_body(Param#param{goal = Next, database = UDb}); prove_goal(Param = #param{goal = {asserta, C0}, next_goal = Next, bindings = Bs, database = Db}) -> C = erlog_ec_support:dderef(C0, Bs), - erlog_memory:asserta_clause(Db, C), - erlog_ec_core:prove_body(Param#param{goal = Next}); + {_, UDb} = erlog_memory:asserta_clause(Db, C), + erlog_ec_core:prove_body(Param#param{goal = Next, database = UDb}); prove_goal(Param = #param{goal = {retract, C0}, bindings = Bs}) -> C = erlog_ec_support:dderef(C0, Bs), erlog_ec_logic:prove_retract(C, Param); @@ -99,12 +99,13 @@ prove_goal(Param = #param{goal = {current_predicate, Pi0}, bindings = Bs}) -> erlog_ec_logic:prove_current_predicate(Pi, Param); prove_goal(Param = #param{goal = {predicate_property, H0, P}, bindings = Bs, database = Db}) -> H = erlog_ec_support:dderef(H0, Bs), - case catch erlog_memory:get_procedure_type(Db, H) of - built_in -> erlog_ec_body:unify_prove_body(P, built_in, Param); - compiled -> erlog_ec_body:unify_prove_body(P, compiled, Param); - interpreted -> erlog_ec_body:unify_prove_body(P, interpreted, Param); - undefined -> erlog_errors:fail(Param); - {erlog_error, E} -> erlog_errors:erlog_error(E, Db) + {Res, UDb} = erlog_memory:get_procedure_type(Db, H), + case catch Res of + built_in -> erlog_ec_body:unify_prove_body(P, built_in, Param#param{database = UDb}); + compiled -> erlog_ec_body:unify_prove_body(P, compiled, Param#param{database = UDb}); + interpreted -> erlog_ec_body:unify_prove_body(P, interpreted, Param#param{database = UDb}); + undefined -> erlog_errors:fail(Param#param{database = UDb}); + {erlog_error, E} -> erlog_errors:erlog_error(E, UDb) end; %% External interface prove_goal(Param = #param{goal = {ecall, C0, Val}, bindings = Bs, database = Db}) -> @@ -125,6 +126,8 @@ prove_goal(Param = #param{goal = {ecall, C0, Val}, bindings = Bs, database = Db} end, erlog_ec_logic:prove_ecall(Efun, Val, Param); %% Non-standard but useful. +prove_goal(Param = #param{goal = {writeln, _}, next_goal = Next, event_man = undefined}) -> + erlog_ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {writeln, T}, next_goal = Next, bindings = Bs, event_man = Evman}) -> %% Display procedure. Res = erlog_ec_support:write(T, Bs), @@ -133,25 +136,22 @@ prove_goal(Param = #param{goal = {writeln, T}, next_goal = Next, bindings = Bs, %% File utils prove_goal(Param = #param{goal = {consult, Name}, next_goal = Next, bindings = Bs, f_consulter = Consulter, database = Db}) -> case erlog_file:consult(Consulter, erlog_ec_support:dderef(Name, Bs), Db) of - ok -> ok; + {ok, DbState} -> erlog_ec_core:prove_body(Param#param{goal = Next, database = DbState}); {Err, Error} when Err == erlog_error; Err == error -> erlog_errors:erlog_error(Error, Db) - end, - erlog_ec_core:prove_body(Param#param{goal = Next}); + end; prove_goal(Param = #param{goal = {reconsult, Name}, next_goal = Next, f_consulter = Consulter, database = Db}) -> case erlog_file:reconsult(Consulter, Name, Db) of - ok -> ok; + {ok, UdbState} -> erlog_ec_core:prove_body(Param#param{goal = Next, database = UdbState}); {Err, Error} when Err == erlog_error; Err == error -> erlog_errors:erlog_error(Error, Db) - end, - erlog_ec_core:prove_body(Param#param{goal = Next}); + end; prove_goal(Param = #param{goal = {deconsult, Name}, next_goal = Next, f_consulter = Consulter, database = Db}) -> case erlog_file:deconsult(Consulter, Name, Db) of - ok -> ok; + {ok, UDbState} -> erlog_ec_core:prove_body(Param#param{goal = Next, database = UDbState}); {Err, Error} when Err == erlog_error; Err == error -> erlog_errors:erlog_error(Error, Db) - end, - erlog_ec_core:prove_body(Param#param{goal = Next}); + end; prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db}) when is_atom(Library) -> try Library:load(Db) catch @@ -161,29 +161,29 @@ prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db erlog_ec_core:prove_body(Param#param{goal = Next}); prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db, f_consulter = Consulter, libs_dir = LD}) when is_list(Library) -> case erlog_file:load_library(Consulter, lists:concat([LD, "/", Library]), Db) of - ok -> erlog_ec_core:prove_body(Param#param{goal = Next}); + {ok, UDBState} -> erlog_ec_core:prove_body(Param#param{goal = Next, database = UDBState}); _ -> erlog_errors:fail(Param) end; prove_goal(Param = #param{goal = {listing, Res}, next_goal = Next, bindings = Bs0, database = Db}) -> - Content = erlog_memory:listing(Db, []), + {Content, Udb} = erlog_memory:listing(Db, []), Bs = erlog_ec_support:add_binding(Res, Content, Bs0), - erlog_ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); + erlog_ec_core:prove_body(Param#param{goal = Next, bindings = Bs, database = Udb}); prove_goal(Param = #param{goal = {listing, Pred, Res}, next_goal = Next, bindings = Bs0, database = Db}) -> - Content = erlog_memory:listing(Db, [Pred]), + {Content, Udb} = erlog_memory:listing(Db, [Pred]), Bs = erlog_ec_support:add_binding(Res, Content, Bs0), - erlog_ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); + erlog_ec_core:prove_body(Param#param{goal = Next, bindings = Bs, database = Udb}); prove_goal(Param = #param{goal = {listing, Pred, Arity, Res}, next_goal = Next, bindings = Bs0, database = Db}) -> - Content = erlog_memory:listing(Db, [Pred, Arity]), + {Content, Udb} = erlog_memory:listing(Db, [Pred, Arity]), Bs = erlog_ec_support:add_binding(Res, Content, Bs0), - erlog_ec_core:prove_body(Param#param{goal = Next, bindings = Bs}); + erlog_ec_core:prove_body(Param#param{goal = Next, bindings = Bs, database = Udb}); prove_goal(Param = #param{goal = {findall, T, G, B}}) -> %findall start erlog_ec_logic:prove_findall(T, G, B, Param); prove_goal(Param = #param{goal = {findall, Tag, T0}, bindings = Bs, database = Db}) -> %findall finish T1 = erlog_ec_support:dderef(T0, Bs), - erlog_memory:raw_append(Db, Tag, T1), %Append to saved list - erlog_errors:fail(Param); + UDb = erlog_memory:raw_append(Db, Tag, T1), %Append to saved list + erlog_errors:fail(Param#param{database = UDb}); prove_goal(Param = #param{goal = {bagof, Goal, Fun, Res}, choice = Cs0, bindings = Bs0, next_goal = Next, var_num = Vn, database = Db}) -> - Predicates = erlog_memory:finadll(Db, Fun), + {Predicates, UDb} = erlog_memory:finadll(Db, Fun), FunList = tuple_to_list(Fun), ResultDict = erlog_ec_support:collect_alternatives(Goal, FunList, Predicates), Collected = dict:fetch_keys(ResultDict), @@ -193,7 +193,7 @@ prove_goal(Param = #param{goal = {bagof, Goal, Fun, Res}, choice = Cs0, bindings UpdBs1 = erlog_ec_support:update_vars(Goal, FunList, Key, UpdBs0), [#cp{type = disjunction, label = Fun, next = Next, bs = UpdBs1, vn = Vn} | Acc] end, Cs0, Collected), - erlog_ec_core:prove_body(Param#param{goal = Next, bindings = UBs#cp.bs, choice = Choises, var_num = Vn + length(Choises)}); + erlog_ec_core:prove_body(Param#param{goal = Next, bindings = UBs#cp.bs, choice = Choises, var_num = Vn + length(Choises), database = UDb}); prove_goal(Param = #param{goal = {to_integer, NumV, Res}, next_goal = Next, bindings = Bs0}) -> Num = erlog_ec_support:dderef(NumV, Bs0), case catch (erlog_ec_logic:parse_int(Num)) of diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 80043ba..bed97cb 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -161,6 +161,7 @@ close(DBState = #db_state{state = State, database = Db}, Cursor) -> %% @private +-spec do_action(#db_state{}, atom(), term(), term()) -> {any(), #db_state{}}. do_action(DBState = #db_state{stdlib = StdLib, exlib = ExLib, database = Db, state = State}, Fun, F, Args) -> check_immutable(StdLib, F), %modifying fact in default memory need to be checked check_immutable(ExLib, F), @@ -168,11 +169,13 @@ do_action(DBState = #db_state{stdlib = StdLib, exlib = ExLib, database = Db, sta {Res, DBState#db_state{state = UState}}. %% @private +-spec do_action(#db_state{}, atom(), term()) -> {any(), #db_state{}}. do_action(DBState = #db_state{stdlib = StdLib, exlib = ExLib, database = Db, state = State}, Fun, Args) -> {Res, UState} = Db:Fun({StdLib, ExLib, State}, Args), {Res, DBState#db_state{state = UState}}. %% @private +-spec do_action(#db_state{}, atom()) -> {any(), #db_state{}}. do_action(DBState = #db_state{stdlib = StdLib, exlib = ExLib, database = Db, state = State}, Fun) -> {Res, UState} = Db:Fun({StdLib, ExLib, State}), {Res, DBState#db_state{state = UState}}. @@ -201,10 +204,10 @@ store(Key, Value, Memory) -> check_abolish(F, Func, Params, State = #db_state{state = DbState, database = Db, stdlib = StdLib, exlib = ExLib}) -> case dict:erase(Func, ExLib) of ExLib -> %dict not changed - was not deleted. Search userspace - {_, UState} = Db:F({StdLib, ExLib, DbState}, Params), - State#db_state{state = UState}; + {Res, UState} = Db:F({StdLib, ExLib, DbState}, Params), + {Res, State#db_state{state = UState}}; UExlib -> %dict changed -> was deleted - State#db_state{exlib = UExlib} + {ok, State#db_state{exlib = UExlib}} end. %% @private From d9cfca72f60b91a2c5f2ed39e8b345184cb08e87 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 29 Nov 2014 02:08:44 +0000 Subject: [PATCH 209/251] fix db_iteration --- src/core/erlog_errors.erl | 2 +- src/core/logic/erlog_ec_core.erl | 4 +- src/libs/external/db/erlog_db.erl | 112 ++------------------ src/libs/external/db/erlog_db_logic.erl | 133 ++++++++++++++++++++++++ 4 files changed, 142 insertions(+), 109 deletions(-) create mode 100644 src/libs/external/db/erlog_db_logic.erl diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index d1c1d3a..53edb28 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -54,7 +54,7 @@ fail(Param = #param{choice = [#cp{type = findall} = Cp | Cps]}) -> fail(Param = #param{choice = [#cp{type = retract} = Cp | Cps]}) -> fail_retract(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = db_retract} = Cp | Cps]}) -> - erlog_db:fail_retract(Cp, Param#param{choice = Cps}); + erlog_db_logic:fail_retract(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = current_predicate} = Cp | Cps]}) -> fail_current_predicate(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = ecall} = Cp | Cps]}) -> diff --git a/src/core/logic/erlog_ec_core.erl b/src/core/logic/erlog_ec_core.erl index ca5f13b..a111db1 100644 --- a/src/core/logic/erlog_ec_core.erl +++ b/src/core/logic/erlog_ec_core.erl @@ -12,7 +12,7 @@ -include("erlog_core.hrl"). %% API --export([prove_body/1, prove_goal/1, prove_goal/6, prove_goal_clauses/2, run_n_close/2]). +-export([prove_body/1, prove_goal/1, prove_goal/6, prove_goal_clauses/2, run_n_close/2, prove_goal_clause/2]). %% prove_goal(Goal, Database) -> Succeed | Fail. %% This is the main entry point into the interpreter. Check that @@ -112,7 +112,6 @@ run_n_close(Fun, Params = #param{database = Db, cursor = Cursor}) -> erlog_memory:close(Db, Cursor) end. -%% @private prove_goal_clause([], Param) -> erlog_errors:fail(Param); prove_goal_clause([L], Param) -> prove_goal_clause(L, Param); prove_goal_clause({_Tag, H0, {B0, _}}, Param = #param{goal = G, next_goal = Next, bindings = Bs0, var_num = Vn0}) -> @@ -124,6 +123,7 @@ prove_goal_clause({_Tag, H0, {B0, _}}, Param = #param{goal = G, next_goal = Next fail -> erlog_errors:fail(Param) end. + %% @private check_result({built_in, Mod}, Param) -> Mod:prove_goal(Param); check_result({code, {Mod, Func}}, Param) -> Mod:Func(Param); diff --git a/src/libs/external/db/erlog_db.erl b/src/libs/external/db/erlog_db.erl index 6199913..8c1316e 100644 --- a/src/libs/external/db/erlog_db.erl +++ b/src/libs/external/db/erlog_db.erl @@ -21,11 +21,10 @@ db_abolish_2/1, db_retract_2/1, db_retractall_2/1, - fail_retract/2, db_call_2/1, db_listing_2/1, db_listing_3/1, - db_listing_4/1, prove_call/4]). + db_listing_4/1]). load(Db) -> lists:foreach(fun(Proc) -> erlog_memory:load_native_library(Db, Proc) end, ?ERLOG_DB). @@ -34,9 +33,9 @@ db_call_2(Param = #param{goal = {db_call, _, _} = Goal, next_goal = Next0, bindi {db_call, Table, G} = erlog_ec_support:dderef(Goal, Bs), case erlog_memory:db_findall(Db, Table, G) of {cursor, Cursor, result, Result} -> - Fun = fun(Params) -> check_call_result(Result, Params, G, Next0) end, + Fun = fun(Params) -> erlog_db_logic:check_call_result(Result, Params, G, Table, Next0) end, erlog_ec_core:run_n_close(Fun, Param#param{cursor = Cursor}); - Result -> check_call_result(Result, Param, G, Next0) + Result -> erlog_db_logic:check_call_result(Result, Param, G, Table, Next0) end. db_assert_2(Params = #param{goal = {db_assert, _, _} = Goal, next_goal = Next, bindings = Bs, database = Db}) -> @@ -60,11 +59,11 @@ db_abolish_2(Params = #param{goal = {db_abolish, _, _} = Goal, next_goal = Next, db_retract_2(Params = #param{goal = {db_retract, _, _} = Goal, bindings = Bs}) -> {db_retract, Table, Fact} = erlog_ec_support:dderef(Goal, Bs), - prove_retract(Fact, Table, Params). + erlog_db_logic:prove_retract(Fact, Table, Params). db_retractall_2(Params = #param{goal = {db_retractall, _, _} = Goal, bindings = Bs}) -> {db_retractall, Table, Fact} = erlog_ec_support:dderef(Goal, Bs), - prove_retractall(Fact, Table, Params). + erlog_db_logic:prove_retractall(Fact, Table, Params). db_listing_2(Params = #param{goal = {db_listing, _, _} = Goal, next_goal = Next, bindings = Bs0, database = Db}) -> {db_listing, Table, Res} = erlog_ec_support:dderef(Goal, Bs0), @@ -82,103 +81,4 @@ db_listing_4(Params = #param{goal = {db_listing, _, _, _, _} = Goal, next_goal = {db_listing, Table, Functor, Arity, Res} = erlog_ec_support:dderef(Goal, Bs0), Content = erlog_memory:db_listing(Db, Table, [Functor, Arity]), Bs = erlog_ec_support:add_binding(Res, Content, Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). - -prove_retract({':-', H, B}, Table, Params) -> - prove_retract(H, B, Table, Params); -prove_retract(H, Table, Params) -> - prove_retract(H, true, Table, Params). - -prove_retractall({':-', H, B}, Table, Params) -> - prove_retractall(H, B, Table, Params); -prove_retractall(H, Table, Params) -> - prove_retractall(H, true, Table, Params). - -prove_call(G, Cs, Next0, Param = #param{bindings = Bs, choice = Cps, database = Db, var_num = Vn}) -> - case erlog_ec_logic:check_goal(G, Next0, Bs, Db, false, Vn) of - {[Next1 | _], true} -> - %% Must increment Vn to avoid clashes!!! - Cut = #cut{label = Vn}, - erlog_ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); - {[Next1 | _], false} -> erlog_ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, var_num = Vn + 1}) - end. - - -%% @private -prove_retract(H, B, Table, Params = #param{database = Db}) -> - case erlog_memory:get_db_procedure(Db, Table, H) of - {cursor, Cursor, result, {clauses, Cs}} -> - erlog_ec_core:run_n_close(fun(Param) -> - retract_clauses(H, B, Cs, Param, Table) end, Params#param{cursor = Cursor}); - undefined -> erlog_errors:fail(Params); - _ -> - Functor = erlog_ec_support:functor(H), - erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)) - end. - -%% @private -prove_retractall(H, B, Table, Params = #param{database = Db}) -> - Functor = erlog_ec_support:functor(H), - case erlog_memory:get_db_procedure(Db, Table, H) of - {cursor, Cursor, result, Res} -> - check_retractall_result(Res, H, B, Functor, Table, Params#param{cursor = Cursor}); - Res -> - check_retractall_result(Res, H, B, Functor, Table, Params) - end. - -%% @private -retract(Ch, Cb, C, Cursor, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1, Table) -> - erlog_memory:db_retract_clause(Db, Table, erlog_ec_support:functor(Ch), element(1, C)), - Cp = #cp{type = db_retract, data = {Ch, Cb, {Db, Cursor}, Table}, next = Next, bs = Bs0, vn = Vn0}, - erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). - -%% @private -%% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> -%% void. -%% Try to retract Head and Body using Clauses which all have the same functor. -retract_clauses(_, _, [], Param, _) -> erlog_errors:fail(Param); -retract_clauses(Ch, Cb, [C], Param, Table) -> retract_clauses(Ch, Cb, C, Param, Table); -retract_clauses(Ch, Cb, C, Param = #param{bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}, Table) -> - case erlog_ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of - {succeed, Bs1, Vn1} -> - %% We have found a right clause so now retract it. - retract(Ch, Cb, C, Cursor, Param, Bs1, Vn1, Table); - fail -> - {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), - retract_clauses(Ch, Cb, Res, Param#param{cursor = UCursor}, Table) - end. - -fail_retract(#cp{data = {Ch, Cb, {Db, Cursor}, Table}, next = Next, bs = Bs, vn = Vn}, Param) -> - {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), - retract_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}, Table). - -%% @private -check_call_result([], Param, _, _) -> erlog_errors:fail(Param); -check_call_result({clauses, Cs}, Param, G, Next) -> prove_call(G, Cs, Next, Param); -check_call_result({erlog_error, E}, #param{database = Db}, _, _) -> erlog_errors:erlog_error(E, Db); -check_call_result(Cs, Param, G, Next) -> prove_call(G, Cs, Next, Param). - -retractall_clauses(_, [], _, _, Params = #param{next_goal = Next}) -> - erlog_ec_core:prove_body(Params#param{goal = Next}); -retractall_clauses(Table, [Clause], H, B, Params) -> retractall_clauses(Table, Clause, H, B, Params); -retractall_clauses(Table, Clause, H, B, Params = #param{bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}) -> - case erlog_ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of - {succeed, _, _} -> - erlog_memory:db_retract_clause(Db, Table, erlog_ec_support:functor(H), element(1, Clause)), - {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), - retractall_clauses(Table, Res, H, B, Params#param{cursor = UCursor}); - fail -> - retractall_clauses(Table, [], H, B, Params) - end. - -%% @private -check_retractall_result({built_in, _}, _, _, Functor, _, _) -> - erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)); -check_retractall_result({code, _}, _, _, Functor, _, _) -> - erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)); -check_retractall_result({clauses, Cs}, H, B, _, Table, Params = #param{cursor = Cursor}) -> - Fun = fun(Param) -> retractall_clauses(Table, Cs, H, B, Param) end, - erlog_ec_core:run_n_close(Fun, Params#param{cursor = Cursor}); -check_retractall_result(undefined, _, _, _, _, Params = #param{next_goal = Next}) -> - erlog_ec_core:prove_body(Params#param{goal = Next}); -check_retractall_result({erlog_error, E}, _, _, _, _, #param{database = Db}) -> erlog_errors:erlog_error(E, Db). \ No newline at end of file + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}). \ No newline at end of file diff --git a/src/libs/external/db/erlog_db_logic.erl b/src/libs/external/db/erlog_db_logic.erl new file mode 100644 index 0000000..421db0b --- /dev/null +++ b/src/libs/external/db/erlog_db_logic.erl @@ -0,0 +1,133 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 29. Нояб. 2014 1:59 +%%%------------------------------------------------------------------- +-module(erlog_db_logic). +-author("tihon"). + +-include("erlog_core.hrl"). + +%% API +-export([check_call_result/5, prove_retract/3, prove_retractall/3, fail_retract/2]). + +prove_retract({':-', H, B}, Table, Params) -> + prove_retract(H, B, Table, Params); +prove_retract(H, Table, Params) -> + prove_retract(H, true, Table, Params). + +prove_retractall({':-', H, B}, Table, Params) -> + prove_retractall(H, B, Table, Params); +prove_retractall(H, Table, Params) -> + prove_retractall(H, true, Table, Params). + +fail_retract(#cp{data = {Ch, Cb, {Db, Cursor}, Table}, next = Next, bs = Bs, vn = Vn}, Param) -> + {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), + retract_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}, Table). + +check_call_result([], Param, _, _, _) -> erlog_errors:fail(Param); +check_call_result({clauses, Cs}, Param, G, Table, Next) -> prove_call(G, Cs, Next, Table, Param); +check_call_result({erlog_error, E}, #param{database = Db}, _, _, _) -> erlog_errors:erlog_error(E, Db); +check_call_result(Cs, Param, G, Table, Next) -> prove_call(G, Cs, Next, Table, Param). + +%% prove_goal_clauses(Goal, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Try to prove Goal using Clauses which all have the same functor. +prove_goal_clauses([], _, Params) -> %end of checking clauses + erlog_errors:fail(Params); +prove_goal_clauses([C], _, Params = #param{choice = Cps, var_num = Vn}) -> %for clauses with body + %% Must be smart here and test whether we need to add a cut point. + %% C has the structure {Tag,Head,{Body,BodyHasCut}}. + case element(2, element(3, C)) of + true -> + Cut = #cut{label = Vn}, + erlog_ec_core:prove_goal_clause(C, Params#param{choice = [Cut | Cps]}); + false -> + erlog_ec_core:prove_goal_clause(C, Params) + end; +prove_goal_clauses(C, Table, Params = #param{goal = G, next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps, database = Db, cursor = Cursor}) -> + Cp = #cp{type = goal_clauses, label = Vn, data = {G, Db, Table, Cursor}, next = Next, bs = Bs, vn = Vn}, + erlog_ec_core:prove_goal_clause(C, Params#param{choice = [Cp | Cps]}). + + +%% @private +prove_call(G, Cs, Next0, Table, Param = #param{bindings = Bs, choice = Cps, database = Db, var_num = Vn}) -> + case erlog_ec_logic:check_goal(G, Next0, Bs, Db, false, Vn) of + {[Next1 | _], true} -> + %% Must increment Vn to avoid clashes!!! + Cut = #cut{label = Vn}, + prove_goal_clauses(Cs, Table, Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); + {[Next1 | _], false} -> erlog_ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, var_num = Vn + 1}) + end. + +%% @private +prove_retract(H, B, Table, Params = #param{database = Db}) -> + case erlog_memory:get_db_procedure(Db, Table, H) of + {cursor, Cursor, result, {clauses, Cs}} -> + erlog_ec_core:run_n_close(fun(Param) -> + retract_clauses(H, B, Cs, Param, Table) end, Params#param{cursor = Cursor}); + undefined -> erlog_errors:fail(Params); + _ -> + Functor = erlog_ec_support:functor(H), + erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)) + end. + +%% @private +prove_retractall(H, B, Table, Params = #param{database = Db}) -> + Functor = erlog_ec_support:functor(H), + case erlog_memory:get_db_procedure(Db, Table, H) of + {cursor, Cursor, result, Res} -> + check_retractall_result(Res, H, B, Functor, Table, Params#param{cursor = Cursor}); + Res -> + check_retractall_result(Res, H, B, Functor, Table, Params) + end. + +%% @private +retract(Ch, Cb, C, Cursor, Param = #param{next_goal = Next, choice = Cps, bindings = Bs0, var_num = Vn0, database = Db}, Bs1, Vn1, Table) -> + erlog_memory:db_retract_clause(Db, Table, erlog_ec_support:functor(Ch), element(1, C)), + Cp = #cp{type = db_retract, data = {Ch, Cb, {Db, Cursor}, Table}, next = Next, bs = Bs0, vn = Vn0}, + erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cp | Cps], bindings = Bs1, var_num = Vn1}). + +%% @private +%% retract_clauses(Head, Body, Clauses, Next, ChoicePoints, Bindings, VarNum, Database) -> +%% void. +%% Try to retract Head and Body using Clauses which all have the same functor. +retract_clauses(_, _, [], Param, _) -> erlog_errors:fail(Param); +retract_clauses(Ch, Cb, [C], Param, Table) -> retract_clauses(Ch, Cb, C, Param, Table); +retract_clauses(Ch, Cb, C, Param = #param{bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}, Table) -> + case erlog_ec_unify:unify_clause(Ch, Cb, C, Bs0, Vn0) of + {succeed, Bs1, Vn1} -> + %% We have found a right clause so now retract it. + retract(Ch, Cb, C, Cursor, Param, Bs1, Vn1, Table); + fail -> + {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), + retract_clauses(Ch, Cb, Res, Param#param{cursor = UCursor}, Table) + end. + +retractall_clauses(_, [], _, _, Params = #param{next_goal = Next}) -> + erlog_ec_core:prove_body(Params#param{goal = Next}); +retractall_clauses(Table, [Clause], H, B, Params) -> retractall_clauses(Table, Clause, H, B, Params); +retractall_clauses(Table, Clause, H, B, Params = #param{bindings = Bs0, var_num = Vn0, database = Db, cursor = Cursor}) -> + case erlog_ec_unify:unify_clause(H, B, Clause, Bs0, Vn0) of + {succeed, _, _} -> + erlog_memory:db_retract_clause(Db, Table, erlog_ec_support:functor(H), element(1, Clause)), + {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), + retractall_clauses(Table, Res, H, B, Params#param{cursor = UCursor}); + fail -> + retractall_clauses(Table, [], H, B, Params) + end. + +%% @private +check_retractall_result({built_in, _}, _, _, Functor, _, _) -> + erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)); +check_retractall_result({code, _}, _, _, Functor, _, _) -> + erlog_errors:permission_error(modify, static_procedure, erlog_ec_support:pred_ind(Functor)); +check_retractall_result({clauses, Cs}, H, B, _, Table, Params = #param{cursor = Cursor}) -> + Fun = fun(Param) -> retractall_clauses(Table, Cs, H, B, Param) end, + erlog_ec_core:run_n_close(Fun, Params#param{cursor = Cursor}); +check_retractall_result(undefined, _, _, _, _, Params = #param{next_goal = Next}) -> + erlog_ec_core:prove_body(Params#param{goal = Next}); +check_retractall_result({erlog_error, E}, _, _, _, _, #param{database = Db}) -> erlog_errors:erlog_error(E, Db). \ No newline at end of file From bc3f4d5616449e6d88232e972da85ba630185af4 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 29 Nov 2014 02:19:57 +0000 Subject: [PATCH 210/251] fix db clause --- src/libs/external/db/erlog_db_logic.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libs/external/db/erlog_db_logic.erl b/src/libs/external/db/erlog_db_logic.erl index 421db0b..c068426 100644 --- a/src/libs/external/db/erlog_db_logic.erl +++ b/src/libs/external/db/erlog_db_logic.erl @@ -49,7 +49,7 @@ prove_goal_clauses([C], _, Params = #param{choice = Cps, var_num = Vn}) -> %for erlog_ec_core:prove_goal_clause(C, Params) end; prove_goal_clauses(C, Table, Params = #param{goal = G, next_goal = Next, var_num = Vn, bindings = Bs, choice = Cps, database = Db, cursor = Cursor}) -> - Cp = #cp{type = goal_clauses, label = Vn, data = {G, Db, Table, Cursor}, next = Next, bs = Bs, vn = Vn}, + Cp = #cp{type = db_goal_clauses, label = Vn, data = {G, Db, Table, Cursor}, next = Next, bs = Bs, vn = Vn}, erlog_ec_core:prove_goal_clause(C, Params#param{choice = [Cp | Cps]}). From 2675a20fd1f53f591b54d9426377bb7eb950a996 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 29 Nov 2014 02:31:58 +0000 Subject: [PATCH 211/251] fix pgc on fail --- src/core/erlog_errors.erl | 2 ++ src/libs/external/db/erlog_db_logic.erl | 7 ++++++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 53edb28..c409ab4 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -45,6 +45,8 @@ erlog_error(E) -> throw({erlog_error, E}). %% backwards over choice points until matching cut. fail(Param = #param{choice = [#cp{type = goal_clauses} = Cp | Cps]}) -> fail_goal_clauses(Cp, Param#param{choice = Cps}); +fail(Param = #param{choice = [#cp{type = db_goal_clauses} = Cp | Cps]}) -> + erlog_db_logic:fail_goal_clauses(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = Type} = Cp | Cps]}) when Type == disjunction; Type == if_then_else -> fail_disjunction(Cp, Param#param{choice = Cps}); fail(Param = #param{choice = [#cp{type = clause} = Cp | Cps]}) -> diff --git a/src/libs/external/db/erlog_db_logic.erl b/src/libs/external/db/erlog_db_logic.erl index c068426..88cd3c1 100644 --- a/src/libs/external/db/erlog_db_logic.erl +++ b/src/libs/external/db/erlog_db_logic.erl @@ -12,7 +12,7 @@ -include("erlog_core.hrl"). %% API --export([check_call_result/5, prove_retract/3, prove_retractall/3, fail_retract/2]). +-export([check_call_result/5, prove_retract/3, prove_retractall/3, fail_retract/2, fail_goal_clauses/2]). prove_retract({':-', H, B}, Table, Params) -> prove_retract(H, B, Table, Params); @@ -28,6 +28,10 @@ fail_retract(#cp{data = {Ch, Cb, {Db, Cursor}, Table}, next = Next, bs = Bs, vn {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), retract_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}, Table). +fail_goal_clauses(#cp{data = {G, Db, Table, Cursor}, next = Next, bs = Bs, vn = Vn}, Param) -> + {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), + erlog_ec_core:prove_goal_clauses(Res, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}). + check_call_result([], Param, _, _, _) -> erlog_errors:fail(Param); check_call_result({clauses, Cs}, Param, G, Table, Next) -> prove_call(G, Cs, Next, Table, Param); check_call_result({erlog_error, E}, #param{database = Db}, _, _, _) -> erlog_errors:erlog_error(E, Db); @@ -107,6 +111,7 @@ retract_clauses(Ch, Cb, C, Param = #param{bindings = Bs0, var_num = Vn0, databas retract_clauses(Ch, Cb, Res, Param#param{cursor = UCursor}, Table) end. +%% @private retractall_clauses(_, [], _, _, Params = #param{next_goal = Next}) -> erlog_ec_core:prove_body(Params#param{goal = Next}); retractall_clauses(Table, [Clause], H, B, Params) -> retractall_clauses(Table, Clause, H, B, Params); From 15c3df47930924c5cf25a42ce8de03145e8db33b Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 29 Nov 2014 02:37:29 +0000 Subject: [PATCH 212/251] another fixes --- src/libs/external/db/erlog_db_logic.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/libs/external/db/erlog_db_logic.erl b/src/libs/external/db/erlog_db_logic.erl index 88cd3c1..b92c563 100644 --- a/src/libs/external/db/erlog_db_logic.erl +++ b/src/libs/external/db/erlog_db_logic.erl @@ -30,7 +30,7 @@ fail_retract(#cp{data = {Ch, Cb, {Db, Cursor}, Table}, next = Next, bs = Bs, vn fail_goal_clauses(#cp{data = {G, Db, Table, Cursor}, next = Next, bs = Bs, vn = Vn}, Param) -> {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), - erlog_ec_core:prove_goal_clauses(Res, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}). + prove_goal_clauses(Res, Table, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}). check_call_result([], Param, _, _, _) -> erlog_errors:fail(Param); check_call_result({clauses, Cs}, Param, G, Table, Next) -> prove_call(G, Cs, Next, Table, Param); @@ -64,7 +64,7 @@ prove_call(G, Cs, Next0, Table, Param = #param{bindings = Bs, choice = Cps, data %% Must increment Vn to avoid clashes!!! Cut = #cut{label = Vn}, prove_goal_clauses(Cs, Table, Param#param{goal = Next1, choice = [Cut | Cps], var_num = Vn + 1}); - {[Next1 | _], false} -> erlog_ec_core:prove_goal_clauses(Cs, Param#param{goal = Next1, var_num = Vn + 1}) + {[Next1 | _], false} -> prove_goal_clauses(Cs, Table, Param#param{goal = Next1, var_num = Vn + 1}) end. %% @private From a7d966d2a22c7f0856fdacce1ec04d2d2039203f Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 1 Dec 2014 23:13:25 +0000 Subject: [PATCH 213/251] fix writeln --- src/interface/local/erlog_local_shell.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/interface/local/erlog_local_shell.erl b/src/interface/local/erlog_local_shell.erl index 6476824..0959efb 100644 --- a/src/interface/local/erlog_local_shell.erl +++ b/src/interface/local/erlog_local_shell.erl @@ -23,7 +23,7 @@ start() -> io:fwrite("Erlog Shell V~s (abort with ^G)\n", [erlang:system_info(version)]), - {ok, Core} = erlog:start_link(), + {ok, Core} = erlog:start_link([{event_h, {erlog_simple_printer, []}}]), start_db_if_needed(), %start default ets-implementation of stand-alone database-module server_loop(Core, normal, []). From f3310438d28902d995e721df854892f8d07ec47f Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 2 Dec 2014 00:53:07 +0000 Subject: [PATCH 214/251] fix deconsult --- src/io/erlog_file.erl | 1 - 1 file changed, 1 deletion(-) diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index 5d8e4f4..c933af9 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -104,7 +104,6 @@ deconsult_assert(Term0, {Db, Seen}) -> {ok, {Db, Seen}}; %TODO refactor iterate_terms not to pass DB everywhere! false -> check_abolish(Db, Func), - check_assert(Db, Term1), {ok, {Db, [Func | Seen]}} end. From 48701daabfb22c69295ffd263cd7dcb6c1e7bcde Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 3 Dec 2014 22:38:35 +0000 Subject: [PATCH 215/251] make prove_call public --- src/libs/external/db/erlog_db_logic.erl | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/libs/external/db/erlog_db_logic.erl b/src/libs/external/db/erlog_db_logic.erl index b92c563..601b2ce 100644 --- a/src/libs/external/db/erlog_db_logic.erl +++ b/src/libs/external/db/erlog_db_logic.erl @@ -12,7 +12,7 @@ -include("erlog_core.hrl"). %% API --export([check_call_result/5, prove_retract/3, prove_retractall/3, fail_retract/2, fail_goal_clauses/2]). +-export([check_call_result/5, prove_retract/3, prove_retractall/3, fail_retract/2, fail_goal_clauses/2, prove_call/5]). prove_retract({':-', H, B}, Table, Params) -> prove_retract(H, B, Table, Params); @@ -56,8 +56,6 @@ prove_goal_clauses(C, Table, Params = #param{goal = G, next_goal = Next, var_num Cp = #cp{type = db_goal_clauses, label = Vn, data = {G, Db, Table, Cursor}, next = Next, bs = Bs, vn = Vn}, erlog_ec_core:prove_goal_clause(C, Params#param{choice = [Cp | Cps]}). - -%% @private prove_call(G, Cs, Next0, Table, Param = #param{bindings = Bs, choice = Cps, database = Db, var_num = Vn}) -> case erlog_ec_logic:check_goal(G, Next0, Bs, Db, false, Vn) of {[Next1 | _], true} -> @@ -67,6 +65,7 @@ prove_call(G, Cs, Next0, Table, Param = #param{bindings = Bs, choice = Cps, data {[Next1 | _], false} -> prove_goal_clauses(Cs, Table, Param#param{goal = Next1, var_num = Vn + 1}) end. + %% @private prove_retract(H, B, Table, Params = #param{database = Db}) -> case erlog_memory:get_db_procedure(Db, Table, H) of From 061e1c94676da31e015c44866066ab3c75f4eb3e Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 5 Dec 2014 00:50:25 +0000 Subject: [PATCH 216/251] fix use --- src/core/logic/erlog_ec_core.erl | 15 +++------------ src/libs/standard/core/main/erlog_core.erl | 10 +++++----- 2 files changed, 8 insertions(+), 17 deletions(-) diff --git a/src/core/logic/erlog_ec_core.erl b/src/core/logic/erlog_ec_core.erl index b05655a..a9c15d8 100644 --- a/src/core/logic/erlog_ec_core.erl +++ b/src/core/logic/erlog_ec_core.erl @@ -14,34 +14,26 @@ %% API -export([prove_body/1, prove_goal/1, prove_goal/6, prove_goal_clauses/2, run_n_close/2, prove_goal_clause/2]). -%% prove_goal(Goal, Database) -> Succeed | Fail. %% This is the main entry point into the interpreter. Check that %% everything is consistent then prove the goal as a call. -spec prove_goal(Goal0 :: term(), Db :: pid(), Consuter :: atom(), Event :: pid(), Deb :: fun(), LibsDir :: string()) -> term(). prove_goal(Goal0, Db, Consulter, Event, Deb, LibsDir) -> - %% put(erlog_cut, orddict:new()), - %% put(erlog_cps, orddict:new()), - %% put(erlog_var, orddict:new()), %% Check term and build new instance of term with bindings. {Goal1, Bs, Vn} = erlog_ec_logic:initial_goal(Goal0), Params = #param{goal = [{call, Goal1}], choice = [], bindings = Bs, var_num = Vn, event_man = Event, database = Db, f_consulter = Consulter, debugger = Deb, libs_dir = LibsDir}, - erlog_ec_core:prove_body(Params). %TODO use lists:foldr instead! + erlog_ec_core:prove_body(Params). %% prove_body(Body, ChoicePoints, Bindings, VarNum, Database) -> %% {succeed,ChoicePoints,NewBindings,NewVarNum,NewDatabase}. %% Prove the goals in a body. Remove the first goal and try to prove %% it. Return when there are no more goals. This is how proving a %% goal/body succeeds. -prove_body(Params = #param{goal = [G | Gs], debugger = Deb, bindings = Bs}) -> %TODO use lists:foldr instead! - %%io:fwrite("PB: ~p\n", [{G,Gs,Cps}]), +prove_body(Params = #param{goal = [G | Gs], debugger = Deb, bindings = Bs}) -> Deb(ok, erlog_ec_support:dderef(G, Bs), Bs), prove_goal(Params#param{goal = G, next_goal = Gs}); prove_body(#param{goal = [], choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> - %%io:fwrite("Cps: ~p\nCut: ~p\nVar: ~p\nVar: ~p\n", - %% [get(erlog_cps),get(erlog_cut),get(erlog_var),dict:size(Bs)]), - %%io:fwrite("PB: ~p\n", [Cps]), - {succeed, Cps, Bs, Vn, Db}. %No more body %TODO why should we return database? + {succeed, Cps, Bs, Vn, Db}. %No more body %% Prove support first. Then find in database. prove_goal(Param = #param{goal = {{once}, Label}, next_goal = Next, choice = Cps}) -> @@ -76,7 +68,6 @@ prove_goal(Param = #param{goal = {{disj}, R}, next_goal = Next, choice = Cps, bi Cp = #cp{type = disjunction, next = R, bs = Bs, vn = Vn}, prove_body(Param#param{goal = Next, choice = [Cp | Cps]}); prove_goal(Param = #param{goal = G, database = Db}) -> -%% io:fwrite("PG: ~p\n ~p\n ~p\n", [dderef(G, Bs),Next,Cps]), case catch erlog_memory:get_procedure(Db, G) of {{cursor, Cursor, result, Result}, UDB} -> Fun = fun(Params) -> check_result(Result, Params) end, diff --git a/src/libs/standard/core/main/erlog_core.erl b/src/libs/standard/core/main/erlog_core.erl index b58f1f9..49c62c3 100644 --- a/src/libs/standard/core/main/erlog_core.erl +++ b/src/libs/standard/core/main/erlog_core.erl @@ -153,12 +153,12 @@ prove_goal(Param = #param{goal = {deconsult, Name}, next_goal = Next, f_consulte erlog_errors:erlog_error(Error, Db) end; prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db}) when is_atom(Library) -> - try Library:load(Db) + try Library:load(Db) of + Udb -> + erlog_ec_core:prove_body(Param#param{goal = Next, database = Udb}) catch - _:Error -> - erlog_errors:erlog_error(Error, Db) - end, - erlog_ec_core:prove_body(Param#param{goal = Next}); + _:_ -> erlog_errors:fail(Param) + end; prove_goal(Param = #param{goal = {use, Library}, next_goal = Next, database = Db, f_consulter = Consulter, libs_dir = LD}) when is_list(Library) -> case erlog_file:load_library(Consulter, lists:concat([LD, "/", Library]), Db) of {ok, UDBState} -> erlog_ec_core:prove_body(Param#param{goal = Next, database = UDBState}); From c58c6be8267e6e9ef11deda95a3879eae6380c42 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 5 Dec 2014 01:06:35 +0000 Subject: [PATCH 217/251] fix db-next --- src/libs/external/db/erlog_db_logic.erl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/libs/external/db/erlog_db_logic.erl b/src/libs/external/db/erlog_db_logic.erl index 2944168..6a4e33f 100644 --- a/src/libs/external/db/erlog_db_logic.erl +++ b/src/libs/external/db/erlog_db_logic.erl @@ -25,12 +25,12 @@ prove_retractall(H, Table, Params) -> prove_retractall(H, true, Table, Params). fail_retract(#cp{data = {Ch, Cb, {Db, Cursor}, Table}, next = Next, bs = Bs, vn = Vn}, Param) -> - {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), - retract_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}, Table). + {{UCursor, Res}, UDb} = erlog_memory:db_next(Db, Cursor, Table), + retract_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor, database = UDb}, Table). fail_goal_clauses(#cp{data = {G, Db, Table, Cursor}, next = Next, bs = Bs, vn = Vn}, Param) -> - {UCursor, Res} = erlog_memory:db_next(Db, Cursor, Table), - prove_goal_clauses(Res, Table, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor}). + {{UCursor, Res}, UDb} = erlog_memory:db_next(Db, Cursor, Table), + prove_goal_clauses(Res, Table, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor, database = UDb}). check_call_result([], Param, _, _, _) -> erlog_errors:fail(Param); check_call_result({clauses, Cs}, Param, G, Table, Next) -> prove_call(G, Cs, Next, Table, Param); @@ -82,7 +82,7 @@ prove_retract(H, B, Table, Params = #param{database = Db}) -> prove_retractall(H, B, Table, Params = #param{database = Db}) -> Functor = erlog_ec_support:functor(H), case erlog_memory:get_db_procedure(Db, Table, H) of - {{cursor, Cursor, result, Res}, UDb} -> + {{cursor, Cursor, result, Res}, UDb} -> check_retractall_result(Res, H, B, Functor, Table, Params#param{cursor = Cursor, database = UDb}); {Res, UDb} -> check_retractall_result(Res, H, B, Functor, Table, Params#param{database = UDb}) From 32fcfb61fb5cbdd4b25ba617d637339cf0d9f105 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 6 Dec 2014 03:31:00 +0000 Subject: [PATCH 218/251] fix case clause when using db impl --- src/io/erlog_file.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index 3fb8618..fb78e25 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -112,7 +112,7 @@ iterate_terms(Ifun, DbState, [{'?-', _} | Ts]) -> iterate_terms(Ifun, DbState, Ts); iterate_terms(Ifun, DbState, [Term | Ts]) -> case catch Ifun(Term, DbState) of - {ok, UDbState} -> iterate_terms(Ifun, UDbState, Ts); + {_, UDbState} -> iterate_terms(Ifun, UDbState, Ts); %sometimes assertz db implementations return asserted object id instead ok {erlog_error, E, _} -> {erlog_error, E}; {erlog_error, E} -> {erlog_error, E} end; From c20d258e0d1e214b14d30d2a0024efa3437547bc Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 6 Dec 2014 03:33:33 +0000 Subject: [PATCH 219/251] fix warning --- src/io/erlog_file.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/io/erlog_file.erl b/src/io/erlog_file.erl index fb78e25..9af6d12 100644 --- a/src/io/erlog_file.erl +++ b/src/io/erlog_file.erl @@ -112,9 +112,9 @@ iterate_terms(Ifun, DbState, [{'?-', _} | Ts]) -> iterate_terms(Ifun, DbState, Ts); iterate_terms(Ifun, DbState, [Term | Ts]) -> case catch Ifun(Term, DbState) of - {_, UDbState} -> iterate_terms(Ifun, UDbState, Ts); %sometimes assertz db implementations return asserted object id instead ok {erlog_error, E, _} -> {erlog_error, E}; - {erlog_error, E} -> {erlog_error, E} + {erlog_error, E} -> {erlog_error, E}; + {_, UDbState} -> iterate_terms(Ifun, UDbState, Ts) %sometimes assertz db implementations return asserted object id instead ok end; iterate_terms(_, DbState, []) -> {ok, DbState}. From c5bf49bdececee2befd2c187145ff17456c85a04 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 9 Dec 2014 02:23:42 +0000 Subject: [PATCH 220/251] fix db passing when fail in clause --- src/core/erlog_errors.erl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 6d58095..5730dab 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -76,12 +76,12 @@ fail_ecall(#cp{data = {Efun, Val}, next = Next, bs = Bs, vn = Vn}, Param) -> erlog_ec_logic:prove_ecall(Efun, Val, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private -fail_clause(#cp{data = {Ch, Cb, Db, Cursor}, next = Next, bs = Bs, vn = Vn}, Param) -> +fail_clause(#cp{data = {Ch, Cb, _, Cursor}, next = Next, bs = Bs, vn = Vn}, Param = #param{database = Db}) -> %TODO remove unneeded Db in #cp {{UCursor, Res}, UDb} = erlog_memory:next(Db, Cursor), erlog_ec_unify:unify_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor, database = UDb}). %% @private -fail_retract(#cp{data = {Ch, Cb, {Db, Cursor}}, next = Next, bs = Bs, vn = Vn}, Param) -> +fail_retract(#cp{data = {Ch, Cb, {_, Cursor}}, next = Next, bs = Bs, vn = Vn}, Param = #param{database = Db}) -> %TODO remove unneeded Db in #cp {{UCursor, Res}, UDb} = erlog_memory:next(Db, Cursor), erlog_ec_logic:retract_clauses(Ch, Cb, Res, Param#param{next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor, database = UDb}). @@ -90,7 +90,7 @@ fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Para erlog_ec_logic:prove_predicates(Pi, Fs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private -fail_goal_clauses(#cp{data = {G, Db, Cursor}, next = Next, bs = Bs, vn = Vn}, Param) -> +fail_goal_clauses(#cp{data = {G, _, Cursor}, next = Next, bs = Bs, vn = Vn}, Param = #param{database = Db}) -> %TODO remove unneeded Db in #cp {{UCursor, Res}, UDb} = erlog_memory:next(Db, Cursor), erlog_ec_core:prove_goal_clauses(Res, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor, database = UDb}). From 92997a8c0097992ae4805986fc7b4a12428588d6 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 10 Dec 2014 03:43:20 +0000 Subject: [PATCH 221/251] export debug fun --- src/interface/debugger/erlog_simple_debugger.erl | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl index 0c20203..e446054 100644 --- a/src/interface/debugger/erlog_simple_debugger.erl +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -12,7 +12,7 @@ -behaviour(gen_server). %% API --export([start_link/0, configure/1]). +-export([start_link/0, configure/1, process_reply/1]). %% gen_server callbacks -export([init/1, @@ -37,6 +37,11 @@ %%%=================================================================== %%% API %%%=================================================================== +process_reply(Dict) -> + case dict:size(Dict) of + 0 -> []; + _ -> process_vars(Dict) + end. %%-------------------------------------------------------------------- %% @doc @@ -194,6 +199,7 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== %%% Internal functions %%%=================================================================== +%% @private process_match({{_}, _, _}, _, _) -> false; %skip support functors process_match(Functor, Execute, {detailed, Functor}) -> Execute(); @@ -205,13 +211,6 @@ process_match(Functor, Execute, {arity, Pred}) -> _ -> false end. -%% @private -process_reply(Dict) -> - case dict:size(Dict) of - 0 -> []; - _ -> process_vars(Dict) - end. - %% @private process_vars(Dict) -> Keys = dict:fetch_keys(Dict), From a76309dad89013dfd6fb7e26e8150cac30cc03dd Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 10 Dec 2014 03:43:20 +0000 Subject: [PATCH 222/251] export debug fun --- src/interface/debugger/erlog_simple_debugger.erl | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl index 0c20203..e446054 100644 --- a/src/interface/debugger/erlog_simple_debugger.erl +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -12,7 +12,7 @@ -behaviour(gen_server). %% API --export([start_link/0, configure/1]). +-export([start_link/0, configure/1, process_reply/1]). %% gen_server callbacks -export([init/1, @@ -37,6 +37,11 @@ %%%=================================================================== %%% API %%%=================================================================== +process_reply(Dict) -> + case dict:size(Dict) of + 0 -> []; + _ -> process_vars(Dict) + end. %%-------------------------------------------------------------------- %% @doc @@ -194,6 +199,7 @@ code_change(_OldVsn, State, _Extra) -> %%%=================================================================== %%% Internal functions %%%=================================================================== +%% @private process_match({{_}, _, _}, _, _) -> false; %skip support functors process_match(Functor, Execute, {detailed, Functor}) -> Execute(); @@ -205,13 +211,6 @@ process_match(Functor, Execute, {arity, Pred}) -> _ -> false end. -%% @private -process_reply(Dict) -> - case dict:size(Dict) of - 0 -> []; - _ -> process_vars(Dict) - end. - %% @private process_vars(Dict) -> Keys = dict:fetch_keys(Dict), From a4e1a08eaf7763f30a89e9cabb9de7c3b2271527 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 10 Dec 2014 19:42:44 +0000 Subject: [PATCH 223/251] add timeout for select --- src/core/erlog.erl | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index c22bce9..7f536b4 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -33,7 +33,7 @@ -include("erlog_core.hrl"). %% Interface to server. --export([start_link/1, start_link/0, execute/2, select/2, execute/3]). +-export([start_link/1, start_link/0, execute/2, select/2, execute/3, select/3]). %% Gen server callbacs. -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). @@ -53,6 +53,10 @@ execute(Worker, Command, undefined) -> execute(Worker, Command); execute(Worker, Command, Timeout) -> gen_server:call(Worker, {execute, trim_command(Command)}, Timeout). execute(Worker, Command) -> gen_server:call(Worker, {execute, trim_command(Command)}). + +select(Worker, Command, undefined) -> select(Worker, Command); +select(Worker, Command, Timeout) -> gen_server:call(Worker, {select, trim_command(Command)}, Timeout). + select(Worker, Command) -> gen_server:call(Worker, {select, trim_command(Command)}). -spec start_link() -> pid(). From f21bc7a6d51724dff2e84240ccc4999c04777a88 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 11 Dec 2014 00:48:14 +0000 Subject: [PATCH 224/251] fix float negative numbers --- src/core/logic/erlog_ec_support.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/logic/erlog_ec_support.erl b/src/core/logic/erlog_ec_support.erl index 04e383d..557ffd9 100644 --- a/src/core/logic/erlog_ec_support.erl +++ b/src/core/logic/erlog_ec_support.erl @@ -87,7 +87,7 @@ functor(T) -> erlog_errors:type_error(callable, T). %% Checks - if var is normal, or binded, or < 0 (if int). Returns var's value. check_var({'-', Var}, Bs) -> case check_var(Var, Bs) of - Res when is_integer(Res) -> -1 * Res; + Res when is_number(Res) -> -1 * Res; Res -> Res end; check_var({Var}, Bs) -> check_var(erlog_ec_support:deref({Var}, Bs), Bs); From 9940a870ebdc9fd149fccdea3ce6a9bc8e085b87 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 11 Dec 2014 00:48:14 +0000 Subject: [PATCH 225/251] fix float negative numbers --- src/core/logic/erlog_ec_support.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/logic/erlog_ec_support.erl b/src/core/logic/erlog_ec_support.erl index 04e383d..557ffd9 100644 --- a/src/core/logic/erlog_ec_support.erl +++ b/src/core/logic/erlog_ec_support.erl @@ -87,7 +87,7 @@ functor(T) -> erlog_errors:type_error(callable, T). %% Checks - if var is normal, or binded, or < 0 (if int). Returns var's value. check_var({'-', Var}, Bs) -> case check_var(Var, Bs) of - Res when is_integer(Res) -> -1 * Res; + Res when is_number(Res) -> -1 * Res; Res -> Res end; check_var({Var}, Bs) -> check_var(erlog_ec_support:deref({Var}, Bs), Bs); From e6653fc31162664f969e08d7d77e444c228d44e7 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 11 Dec 2014 22:58:15 +0000 Subject: [PATCH 226/251] improve concat --- src/libs/standard/string/erlog_string.erl | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/src/libs/standard/string/erlog_string.erl b/src/libs/standard/string/erlog_string.erl index f4b2827..e9e53a8 100644 --- a/src/libs/standard/string/erlog_string.erl +++ b/src/libs/standard/string/erlog_string.erl @@ -19,12 +19,14 @@ load(DbState) -> - lists:foldl(fun(Head, UDBState) -> erlog_memory:load_kernel_space(UDBState, ?MODULE, Head) end, DbState, ?ERLOG_STRING). + lists:foldl(fun(Head, UDBState) -> + erlog_memory:load_kernel_space(UDBState, ?MODULE, Head) end, DbState, ?ERLOG_STRING). prove_goal(Params = #param{goal = {concat, Strings, Res}, next_goal = Next, bindings = Bs0}) -> case erlog_ec_support:dderef_list(Strings, Bs0) of List when is_list(List) -> - Bs1 = erlog_ec_support:add_binding(Res, lists:concat(List), Bs0), + ConcatMe = lists:foldr(fun preprocess_concat/2, [], List), + Bs1 = erlog_ec_support:add_binding(Res, ConcatMe, Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); _ -> erlog_errors:fail(Params) end; @@ -44,4 +46,13 @@ prove_goal(Params = #param{goal = {split, _, _, _} = Goal, next_goal = Next, bin {split, Str, Del, Res} = erlog_ec_support:dderef(Goal, Bs0), List = string:tokens(Str, Del), Bs1 = erlog_ec_support:add_binding(Res, List, Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}). \ No newline at end of file + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}). + + +%% @private +preprocess_concat(Object, Acc) when is_list(Object); is_tuple(Object) -> + case io_lib:printable_list(Object) of + true -> [Object | Acc]; + false -> [lists:flatten(io_lib:format("~p", [Object])) | Acc] + end; +preprocess_concat(Object, Acc) -> [Object | Acc]. \ No newline at end of file From 5fca69f4e1b3d1292ad00d2e78232bdb417178b7 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 15 Dec 2014 21:25:08 +0000 Subject: [PATCH 227/251] added math library --- include/erlog_core.hrl | 12 ++++++++++ include/erlog_math.hrl | 14 +++++++++++ src/core/erlog.erl | 10 +------- src/libs/standard/math/erlog_math.erl | 34 +++++++++++++++++++++++++++ 4 files changed, 61 insertions(+), 9 deletions(-) create mode 100644 include/erlog_math.hrl create mode 100644 src/libs/standard/math/erlog_math.erl diff --git a/include/erlog_core.hrl b/include/erlog_core.hrl index e37b9e0..3e4c4ab 100644 --- a/include/erlog_core.hrl +++ b/include/erlog_core.hrl @@ -92,4 +92,16 @@ {to_integer, 2}, {to_string, 2} ] +). + +-define(STDLIB, + [ + erlog_core, %Core predicates + erlog_bips, %Built in predicates + erlog_dcg, %DCG predicates + erlog_lists, %Common lists library + erlog_time, %Bindings for working with data and time + erlog_string, %Bindings for working with strings + erlog_math %Predicates for working with math utils + ] ). \ No newline at end of file diff --git a/include/erlog_math.hrl b/include/erlog_math.hrl new file mode 100644 index 0000000..1c537b3 --- /dev/null +++ b/include/erlog_math.hrl @@ -0,0 +1,14 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 17. Июль 2014 11:19 +%%%------------------------------------------------------------------- +-author("tihon"). + +-define(ERLOG_MATH, + [ + {round, 3} + ]). \ No newline at end of file diff --git a/src/core/erlog.erl b/src/core/erlog.erl index 7f536b4..dc3610d 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -136,15 +136,7 @@ init_debugger(Params) -> %% @private load_built_in(Database) -> %Load basic interpreter predicates - lists:foreach(fun(Mod) -> Mod:load(Database) end, - [ - erlog_core, %Core predicates - erlog_bips, %Built in predicates - erlog_dcg, %DCG predicates - erlog_lists, %Common lists library - erlog_time, %Bindings for working with data and time - erlog_string %Bindings for working with strings - ]). + lists:foreach(fun(Mod) -> Mod:load(Database) end, ?STDLIB). %% @private load_prolog_libraries(Fcon, LibsDir, Db) -> diff --git a/src/libs/standard/math/erlog_math.erl b/src/libs/standard/math/erlog_math.erl new file mode 100644 index 0000000..45ebdd2 --- /dev/null +++ b/src/libs/standard/math/erlog_math.erl @@ -0,0 +1,34 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2014, +%%% @doc +%%% +%%% @end +%%% Created : 15. Дек. 2014 21:12 +%%%------------------------------------------------------------------- +-module(erlog_math). +-author("tihon"). + +-behaviour(erlog_stdlib). + +-include("erlog_math.hrl"). +-include("erlog_core.hrl"). + +%% API +-export([load/1, prove_goal/1]). + +load(Db) -> + lists:foreach(fun(Proc) -> erlog_memory:load_kernel_space(Db, ?MODULE, Proc) end, ?ERLOG_MATH). + +prove_goal(Params = #param{goal = {round, _, _, _} = G, next_goal = Next, bindings = Bs0}) -> + {round, Number, Accuracy, Result} = erlog_ec_support:dderef(G, Bs0), + Rounded = round_float(Number, Accuracy), + case erlog_ec_support:try_add(Rounded, Result, Bs0) of + error -> erlog_errors:fail(Params); + Bs -> erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) + end. + + +%% @private +round_float(N, _) when is_integer(N) -> N; +round_float(F, Accuracy) -> P = math:pow(10, Accuracy), round(F * P) / P. \ No newline at end of file From 7319b9cab0156ec36ee60b126c40a73e6e48dd43 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 15 Dec 2014 21:38:34 +0000 Subject: [PATCH 228/251] add ability to round float to integer --- src/libs/standard/math/erlog_math.erl | 1 + 1 file changed, 1 insertion(+) diff --git a/src/libs/standard/math/erlog_math.erl b/src/libs/standard/math/erlog_math.erl index 45ebdd2..5cef9a0 100644 --- a/src/libs/standard/math/erlog_math.erl +++ b/src/libs/standard/math/erlog_math.erl @@ -31,4 +31,5 @@ prove_goal(Params = #param{goal = {round, _, _, _} = G, next_goal = Next, bindin %% @private round_float(N, _) when is_integer(N) -> N; +round_float(N, 0) -> round(N); round_float(F, Accuracy) -> P = math:pow(10, Accuracy), round(F * P) / P. \ No newline at end of file From 259b102a6792b3b814de4cfb21cafe56caede0f5 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 15 Dec 2014 21:59:50 +0000 Subject: [PATCH 229/251] fixed merge with master --- src/core/erlog.erl | 8 ++++---- src/libs/standard/math/erlog_math.erl | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/core/erlog.erl b/src/core/erlog.erl index dcd2b51..a6de23d 100644 --- a/src/core/erlog.erl +++ b/src/core/erlog.erl @@ -130,7 +130,7 @@ init_debugger(Params) -> %% @private load_built_in(Database) -> %Load basic interpreter predicates - lists:foreach(fun(Mod) -> Mod:load(Database) end, ?STDLIB). + lists:foldl(fun(Mod, UDBState) -> Mod:load(UDBState) end, Database, ?STDLIB). %% @private -spec load_prolog_libraries(atom(), list(), #db_state{}) -> #db_state{}. @@ -143,9 +143,9 @@ load_prolog_libraries(Fcon, LibsDir, DbState) -> end, DbState, Autoload). %% @private -load_external_libraries(Params, FileCon, DdState) -> +load_external_libraries(Params, FileCon, DbState) -> case proplists:get_value(libraries, Params) of - undefined -> DdState; + undefined -> DbState; Libraries -> lists:foldl( fun(Mod, UDbState) when is_atom(Mod) -> %autoload native library @@ -153,7 +153,7 @@ load_external_libraries(Params, FileCon, DdState) -> (PrologLib, UDbState) when is_list(PrologLib) -> %autoload external library {ok, UpdDbState} = erlog_file:load_library(FileCon, PrologLib, UDbState), UpdDbState - end, DdState, Libraries) + end, DbState, Libraries) end. %% @private diff --git a/src/libs/standard/math/erlog_math.erl b/src/libs/standard/math/erlog_math.erl index 45ebdd2..9de77e4 100644 --- a/src/libs/standard/math/erlog_math.erl +++ b/src/libs/standard/math/erlog_math.erl @@ -17,8 +17,8 @@ %% API -export([load/1, prove_goal/1]). -load(Db) -> - lists:foreach(fun(Proc) -> erlog_memory:load_kernel_space(Db, ?MODULE, Proc) end, ?ERLOG_MATH). +load(DbState) -> + lists:foldl(fun(Proc, UDBState) -> erlog_memory:load_kernel_space(UDBState, ?MODULE, Proc) end, DbState, ?ERLOG_MATH). prove_goal(Params = #param{goal = {round, _, _, _} = G, next_goal = Next, bindings = Bs0}) -> {round, Number, Accuracy, Result} = erlog_ec_support:dderef(G, Bs0), From a1a301a8260221b40fa3fd7b1ed76a84e095e70b Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sun, 21 Dec 2014 12:22:02 +0000 Subject: [PATCH 230/251] improve string libs --- include/erlog_string.hrl | 5 +- src/libs/standard/string/erlog_string.erl | 68 +++++++++++++++++++++-- 2 files changed, 66 insertions(+), 7 deletions(-) diff --git a/include/erlog_string.hrl b/include/erlog_string.hrl index 674ea7b..101ce79 100644 --- a/include/erlog_string.hrl +++ b/include/erlog_string.hrl @@ -13,5 +13,8 @@ {concat, 2}, {substring, 4}, {indexof, 3}, - {split, 3} + {split, 3}, + {parse_int, 2}, + {parse_float, 2}, + {str_number, 2} ]). \ No newline at end of file diff --git a/src/libs/standard/string/erlog_string.erl b/src/libs/standard/string/erlog_string.erl index e9e53a8..376edad 100644 --- a/src/libs/standard/string/erlog_string.erl +++ b/src/libs/standard/string/erlog_string.erl @@ -42,11 +42,36 @@ prove_goal(Params = #param{goal = {indexof, _, _, _} = Goal, next_goal = Next, b Bs1 = erlog_ec_support:add_binding(Res, Num, Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}) end; -prove_goal(Params = #param{goal = {split, _, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> - {split, Str, Del, Res} = erlog_ec_support:dderef(Goal, Bs0), - List = string:tokens(Str, Del), - Bs1 = erlog_ec_support:add_binding(Res, List, Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}). +prove_goal(Params = #param{goal = {parse_int, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> + {parse_int, Str, Int} = erlog_ec_support:dderef(Goal, Bs0), + case string:to_integer(Str) of + {error, _} -> + erlog_errors:fail(Params); + {Integer, _} -> + case erlog_ec_support:try_add(Integer, Int, Bs0) of + error -> erlog_errors:fail(Params); + Bs -> erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) + end + end; +prove_goal(Params = #param{goal = {parse_float, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> + {parse_float, Str, Res} = erlog_ec_support:dderef(Goal, Bs0), + case string:to_float(Str) of + {error, _} -> + erlog_errors:fail(Params); + {Float, _} -> + case erlog_ec_support:try_add(Float, Res, Bs0) of + error -> erlog_errors:fail(Params); + Bs -> erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) + end + end; +prove_goal(Params = #param{goal = {str_number, _, _} = Goal, bindings = Bs0}) -> + {str_number, Str, Num} = erlog_ec_support:dderef(Goal, Bs0), + case erlog_ec_support:is_bound(Str) of + true -> + convert_string(Str, Num, Params); %string not bound, + false -> + convert_numeric(Str, Num, Params) + end. %% @private @@ -55,4 +80,35 @@ preprocess_concat(Object, Acc) when is_list(Object); is_tuple(Object) -> true -> [Object | Acc]; false -> [lists:flatten(io_lib:format("~p", [Object])) | Acc] end; -preprocess_concat(Object, Acc) -> [Object | Acc]. \ No newline at end of file +preprocess_concat(Object, Acc) -> [Object | Acc]. + +%% @private +convert_string(Str, Num, Params) -> + case string:to_float(Str) of + {Float, _} -> + match_num(Float, Num, Params); + error -> + case string:to_integer(Str) of + {Integer, _} -> + match_num(Integer, Num, Params); + error -> + erlog_errors:fail(Params) + end + end. + +%% @private +convert_numeric(Str, Num, Params = #param{next_goal = Next, bindings = Bs0}) -> + case erlog_ec_support:is_bound(Num) of + true when is_number(Num) -> + S = lists:flatten(io_lib:format("~p", [Num])), + Bs1 = erlog_ec_support:add_binding(Str, S, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); + false -> erlog_errors:fail(Params) + end. + +%% @private +match_num(Number, ResultVar, Params = #param{next_goal = Next, bindings = Bs0}) -> + case erlog_ec_support:try_add(Number, ResultVar, Bs0) of + error -> erlog_errors:fail(Params); + Bs -> erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) + end. \ No newline at end of file From 03a4fd1a9dfe4d88f7427afaf1f0f0fda8028271 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 23 Dec 2014 21:53:25 +0000 Subject: [PATCH 231/251] fix substring --- src/libs/standard/string/erlog_string.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libs/standard/string/erlog_string.erl b/src/libs/standard/string/erlog_string.erl index 376edad..82f2299 100644 --- a/src/libs/standard/string/erlog_string.erl +++ b/src/libs/standard/string/erlog_string.erl @@ -32,7 +32,7 @@ prove_goal(Params = #param{goal = {concat, Strings, Res}, next_goal = Next, bind end; prove_goal(Params = #param{goal = {substring, _, _, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> {substring, From, To, Str, Res} = erlog_ec_support:dderef(Goal, Bs0), - Bs1 = erlog_ec_support:add_binding(Res, lists:sublist(Str, From, To - From), Bs0), + Bs1 = erlog_ec_support:add_binding(Res, lists:sublist(Str, From, To - From + 1), Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); prove_goal(Params = #param{goal = {indexof, _, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> {indexof, Str1, Str2, Res} = erlog_ec_support:dderef(Goal, Bs0), From a753a619b2b27678c16a77d5ec2005c1f161d550 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 24 Dec 2014 19:06:41 +0000 Subject: [PATCH 232/251] made substring tryadd --- src/libs/standard/string/erlog_string.erl | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/libs/standard/string/erlog_string.erl b/src/libs/standard/string/erlog_string.erl index 82f2299..128aa81 100644 --- a/src/libs/standard/string/erlog_string.erl +++ b/src/libs/standard/string/erlog_string.erl @@ -32,8 +32,11 @@ prove_goal(Params = #param{goal = {concat, Strings, Res}, next_goal = Next, bind end; prove_goal(Params = #param{goal = {substring, _, _, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> {substring, From, To, Str, Res} = erlog_ec_support:dderef(Goal, Bs0), - Bs1 = erlog_ec_support:add_binding(Res, lists:sublist(Str, From, To - From + 1), Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); + Sublist = lists:sublist(Str, From, To - From + 1), + case erlog_ec_support:try_add(Sublist, Res, Bs0) of + error -> erlog_errors:fail(Params); + Bs -> erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) + end; prove_goal(Params = #param{goal = {indexof, _, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> {indexof, Str1, Str2, Res} = erlog_ec_support:dderef(Goal, Bs0), case string:str(Str1, Str2) of From cc63e63f9eee797546508ab5c54f10acff552c90 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 24 Dec 2014 19:57:54 +0000 Subject: [PATCH 233/251] fix concat --- src/libs/standard/string/erlog_string.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libs/standard/string/erlog_string.erl b/src/libs/standard/string/erlog_string.erl index 128aa81..76d190f 100644 --- a/src/libs/standard/string/erlog_string.erl +++ b/src/libs/standard/string/erlog_string.erl @@ -26,7 +26,7 @@ prove_goal(Params = #param{goal = {concat, Strings, Res}, next_goal = Next, bind case erlog_ec_support:dderef_list(Strings, Bs0) of List when is_list(List) -> ConcatMe = lists:foldr(fun preprocess_concat/2, [], List), - Bs1 = erlog_ec_support:add_binding(Res, ConcatMe, Bs0), + Bs1 = erlog_ec_support:add_binding(Res, lists:concat(ConcatMe), Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); _ -> erlog_errors:fail(Params) end; From 541dc669ce60aa9e639541cda523b79a760e7a24 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 25 Dec 2014 20:16:25 +0000 Subject: [PATCH 234/251] remove checks from db functions --- src/storage/erlog_memory.erl | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index bed97cb..22d79d0 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -87,14 +87,12 @@ asserta_clause(DBState, Head, Body) -> db_assertz_clause(Database, Collection, {':-', Head, Body}) -> db_assertz_clause(Database, Collection, Head, Body); db_assertz_clause(Database, Collection, Head) -> db_assertz_clause(Database, Collection, Head, true). db_assertz_clause(DBState, Collection, Head, Body) -> - F = erlog_ec_support:functor(Head), - do_action(DBState, db_assertz_clause, F, {Collection, Head, Body}). + do_action(DBState, db_assertz_clause, {Collection, Head, Body}). db_asserta_clause(Database, Collection, {':-', H, B}) -> db_asserta_clause(Database, Collection, H, B); db_asserta_clause(Database, Collection, H) -> db_asserta_clause(Database, Collection, H, true). db_asserta_clause(DBState, Collection, Head, Body) -> - F = erlog_ec_support:functor(Head), - do_action(DBState, db_asserta_clause, F, {Collection, Head, Body}). + do_action(DBState, db_asserta_clause, {Collection, Head, Body}). next(DBState, Cursor) -> do_next(DBState, next, Cursor). @@ -105,14 +103,13 @@ retract_clause(DBState, F, Ct) -> do_action(DBState, retract_clause, F, {F, Ct}). db_retract_clause(DBState, Collection, F, Ct) -> - do_action(DBState, db_retract_clause, F, {Collection, F, Ct}). + do_action(DBState, db_retract_clause, {Collection, F, Ct}). abolish_clauses(DBState = #db_state{stdlib = StdLib}, Func) -> check_immutable(StdLib, Func), check_abolish(abolish_clauses, Func, Func, DBState). -db_abolish_clauses(DBState = #db_state{stdlib = StdLib}, Collection, Func) -> - check_immutable(StdLib, Func), %abolishing fact from default memory need to be checked +db_abolish_clauses(DBState, Collection, Func) -> check_abolish(db_abolish_clauses, Func, {Collection, Func}, DBState). get_procedure(DbState, Func) -> From 1ab23ea27ed625a062968c369a110db662982805 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 25 Dec 2014 20:55:01 +0000 Subject: [PATCH 235/251] fix retract --- src/libs/external/db/erlog_db_logic.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libs/external/db/erlog_db_logic.erl b/src/libs/external/db/erlog_db_logic.erl index 6a4e33f..0db313e 100644 --- a/src/libs/external/db/erlog_db_logic.erl +++ b/src/libs/external/db/erlog_db_logic.erl @@ -69,7 +69,7 @@ prove_call(G, Cs, Next0, Table, Param = #param{bindings = Bs, choice = Cps, data %% @private prove_retract(H, B, Table, Params = #param{database = Db}) -> case erlog_memory:get_db_procedure(Db, Table, H) of - {{cursor, Cursor, result, {clauses, Cs}, UDB}} -> + {{cursor, Cursor, result, {clauses, Cs}}, UDB} -> erlog_ec_core:run_n_close(fun(Param) -> retract_clauses(H, B, Cs, Param, Table) end, Params#param{cursor = Cursor, database = UDB}); {undefined, UDB} -> erlog_errors:fail(Params#param{database = UDB}); From 8d53c1b18ec23d6a8eabcc077a5867c6d9992dee Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 25 Dec 2014 21:04:00 +0000 Subject: [PATCH 236/251] fix findall --- src/storage/erlog_memory.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/storage/erlog_memory.erl b/src/storage/erlog_memory.erl index 22d79d0..7ab4ff3 100644 --- a/src/storage/erlog_memory.erl +++ b/src/storage/erlog_memory.erl @@ -143,9 +143,9 @@ raw_store(DBState = #db_state{in_mem = InMem}, Key, Value) -> raw_fetch(#db_state{in_mem = InMem}, Key) -> fetch(Key, InMem). -raw_append(DBState = #db_state{in_mem = InMem}, Key, Value) -> +raw_append(DBState = #db_state{in_mem = InMem}, Key, AppendValue) -> Value = fetch(Key, InMem), - Umem = store(Key, lists:concat([Value, [Value]]), InMem), + Umem = store(Key, lists:concat([Value, [AppendValue]]), InMem), DBState#db_state{in_mem = Umem}. raw_erase(DBState = #db_state{in_mem = InMem}, Key) -> From 6923c8a620e9aba266ac63f5d2cbc512f6149443 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 12 Jan 2015 19:17:57 +0000 Subject: [PATCH 237/251] return split --- src/libs/standard/string/erlog_string.erl | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/libs/standard/string/erlog_string.erl b/src/libs/standard/string/erlog_string.erl index 76d190f..bfec221 100644 --- a/src/libs/standard/string/erlog_string.erl +++ b/src/libs/standard/string/erlog_string.erl @@ -45,6 +45,11 @@ prove_goal(Params = #param{goal = {indexof, _, _, _} = Goal, next_goal = Next, b Bs1 = erlog_ec_support:add_binding(Res, Num, Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}) end; +prove_goal(Params = #param{goal = {split, _, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> + {split, Str, Del, Res} = erlog_ec_support:dderef(Goal, Bs0), + List = string:tokens(Str, Del), + Bs1 = erlog_ec_support:add_binding(Res, List, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); prove_goal(Params = #param{goal = {parse_int, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> {parse_int, Str, Int} = erlog_ec_support:dderef(Goal, Bs0), case string:to_integer(Str) of From 91990d7f98f184f98a8aa36bac36076383b6325e Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 14 Jan 2015 22:33:43 +0000 Subject: [PATCH 238/251] fix date diff --- src/libs/standard/time/main/erlog_time.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libs/standard/time/main/erlog_time.erl b/src/libs/standard/time/main/erlog_time.erl index 4359b5e..e3250c2 100644 --- a/src/libs/standard/time/main/erlog_time.erl +++ b/src/libs/standard/time/main/erlog_time.erl @@ -61,7 +61,7 @@ prove_goal(Params = #param{goal = {date_diff, _, _, _, _} = Goal, next_goal = Ne ok -> Diff = timer:now_diff(erlog_et_logic:ts_to_date(erlog_ec_support:check_var(TS1, Bs0)), erlog_et_logic:ts_to_date(erlog_ec_support:check_var(TS2, Bs0))) / 1000000, Time = erlog_et_logic:seconds_to_date(Diff, erlog_ec_support:check_var(Format, Bs0)), - case erlog_ec_support:try_add(Res, Time, Bs0) of + case erlog_ec_support:try_add(Time, Res, Bs0) of error -> erlog_errors:fail(Params); Bs -> erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs}) end; From c21755c5cd8e09220823475721537d1103e39fdc Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 19 Jan 2015 23:18:00 +0000 Subject: [PATCH 239/251] Made local vars appear in debugger --- .../debugger/erlog_simple_debugger.erl | 43 +++++++++++++------ 1 file changed, 30 insertions(+), 13 deletions(-) diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl index e446054..4998bda 100644 --- a/src/interface/debugger/erlog_simple_debugger.erl +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -23,6 +23,8 @@ code_change/3]). -define(SERVER, ?MODULE). +-define(LOCALVAR(X), lists:flatten(io_lib:format("localVar~p", [X]))). + -record(state, { @@ -37,6 +39,7 @@ %%%=================================================================== %%% API %%%=================================================================== +-spec process_reply(dict:dict()) -> list(). process_reply(Dict) -> case dict:size(Dict) of 0 -> []; @@ -214,21 +217,35 @@ process_match(Functor, Execute, {arity, Pred}) -> %% @private process_vars(Dict) -> Keys = dict:fetch_keys(Dict), - lists:foldl( - fun(Key, Res) -> - case dict:find(Key, Dict) of - {ok, {K}} -> - process_values(Key, K, Dict, Res); - _ -> Res - end - end, [], Keys). + {Udict, Global} = lists:foldl(fun process_var/2, {Dict, []}, Keys), + Local = dict:fold(fun process_local/3, {[], 1}, Udict), + lists:append(Global, Local). %% @private -process_values(Key, K, Dict, Res) -> - case dict:find(K, Dict) of - {ok, V} -> [{Key, V} | Res]; - error -> Res - end. +%% Get global var's values only. +process_var(Var, {Dict, Acc} = A) when is_atom(Var) -> %if global var - get its value and remove from dict + Number = dict:fetch(Var, Dict), + try + fetch_once(Number, Dict, Var, Acc) + catch + _:_ -> A + end; +process_var(_, Acc) -> Acc. %local vars and values should stay. + +%% @private +%% Create new local var and assign value to it. +process_local(Key, Value, Acc) -> + NewLocalVar = ?LOCALVAR(Key), + [{NewLocalVar, Value} | Acc]. + +%% @private +%% Fetch var's value by number and then delete it from dictionary. +fetch_once({Number}, Dict, Var, Acc) -> fetch_once(Number, Dict, Var, Acc); +fetch_once(Number, Dict, Var, Acc) -> + Val = dict:fetch(Number, Dict), %get value + UpdDict = dict:erase(Number, Dict), %delete value + UpdDict2 = dict:erase(Var, UpdDict), %delete var + {UpdDict2, [{Var, Val} | Acc]}. %% @private %% Is called when code execution is stopped. Waits for user action. From 051ab3750adaf89595057d1d5e4713ee915e71ca Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 20 Jan 2015 18:37:25 +0000 Subject: [PATCH 240/251] fix rubish --- src/interface/debugger/erlog_simple_debugger.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl index 4998bda..1c7f0df 100644 --- a/src/interface/debugger/erlog_simple_debugger.erl +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -218,7 +218,7 @@ process_match(Functor, Execute, {arity, Pred}) -> process_vars(Dict) -> Keys = dict:fetch_keys(Dict), {Udict, Global} = lists:foldl(fun process_var/2, {Dict, []}, Keys), - Local = dict:fold(fun process_local/3, {[], 1}, Udict), + Local = dict:fold(fun process_local/3, [], Udict), lists:append(Global, Local). %% @private From 2877d06f5f86f98a8b73c49a3d57267cf0298ff8 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 20 Jan 2015 21:26:34 +0000 Subject: [PATCH 241/251] change localvars to {int} --- .../debugger/erlog_simple_debugger.erl | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl index 1c7f0df..9f0d12b 100644 --- a/src/interface/debugger/erlog_simple_debugger.erl +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -223,29 +223,28 @@ process_vars(Dict) -> %% @private %% Get global var's values only. -process_var(Var, {Dict, Acc} = A) when is_atom(Var) -> %if global var - get its value and remove from dict +process_var(Var, {Dict, Acc}) when is_atom(Var) -> %if global var - get its value and remove from dict Number = dict:fetch(Var, Dict), + UDict = dict:erase(Var, Dict), %delete var try - fetch_once(Number, Dict, Var, Acc) + fetch_once(Number, UDict, Var, Acc) catch - _:_ -> A + _:_ -> {UDict, Acc} end; -process_var(_, Acc) -> Acc. %local vars and values should stay. +process_var(_, Acc) -> Acc. %local vars and values should stay. %% @private %% Create new local var and assign value to it. process_local(Key, Value, Acc) -> - NewLocalVar = ?LOCALVAR(Key), - [{NewLocalVar, Value} | Acc]. + [{{Key}, Value} | Acc]. %% @private %% Fetch var's value by number and then delete it from dictionary. fetch_once({Number}, Dict, Var, Acc) -> fetch_once(Number, Dict, Var, Acc); fetch_once(Number, Dict, Var, Acc) -> Val = dict:fetch(Number, Dict), %get value - UpdDict = dict:erase(Number, Dict), %delete value - UpdDict2 = dict:erase(Var, UpdDict), %delete var - {UpdDict2, [{Var, Val} | Acc]}. + Udict = dict:erase(Number, Dict), %delete value + {Udict, [{Var, Val} | Acc]}. %% @private %% Is called when code execution is stopped. Waits for user action. From ba3bd22f9bd7f26a14f53b6b1c47139d19c73773 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Tue, 20 Jan 2015 21:27:19 +0000 Subject: [PATCH 242/251] rem def --- src/interface/debugger/erlog_simple_debugger.erl | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/interface/debugger/erlog_simple_debugger.erl b/src/interface/debugger/erlog_simple_debugger.erl index 9f0d12b..4ecc7e0 100644 --- a/src/interface/debugger/erlog_simple_debugger.erl +++ b/src/interface/debugger/erlog_simple_debugger.erl @@ -23,8 +23,6 @@ code_change/3]). -define(SERVER, ?MODULE). --define(LOCALVAR(X), lists:flatten(io_lib:format("localVar~p", [X]))). - -record(state, { From 08897fffe6b2a65bb867777778c6235e7acfdcde Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 21 Jan 2015 22:48:08 +0000 Subject: [PATCH 243/251] improve debugger --- src/core/erlog_errors.erl | 3 ++- src/core/logic/erlog_ec_core.erl | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/core/erlog_errors.erl b/src/core/erlog_errors.erl index 5730dab..9000d5e 100644 --- a/src/core/erlog_errors.erl +++ b/src/core/erlog_errors.erl @@ -90,8 +90,9 @@ fail_current_predicate(#cp{data = {Pi, Fs}, next = Next, bs = Bs, vn = Vn}, Para erlog_ec_logic:prove_predicates(Pi, Fs, Param#param{next_goal = Next, bindings = Bs, var_num = Vn}). %% @private -fail_goal_clauses(#cp{data = {G, _, Cursor}, next = Next, bs = Bs, vn = Vn}, Param = #param{database = Db}) -> %TODO remove unneeded Db in #cp +fail_goal_clauses(#cp{data = {G, _, Cursor}, next = Next, bs = Bs, vn = Vn}, Param = #param{database = Db, debugger = Deb}) -> %TODO remove unneeded Db in #cp {{UCursor, Res}, UDb} = erlog_memory:next(Db, Cursor), + Deb(fail, G, Bs), erlog_ec_core:prove_goal_clauses(Res, Param#param{goal = G, next_goal = Next, bindings = Bs, var_num = Vn, cursor = UCursor, database = UDb}). fail_findall(#cp{next = Next, data = {Tag, Bag}, bs = Bs, vn = Vn0}, Param = #param{database = Db}) -> diff --git a/src/core/logic/erlog_ec_core.erl b/src/core/logic/erlog_ec_core.erl index a9c15d8..f1d4499 100644 --- a/src/core/logic/erlog_ec_core.erl +++ b/src/core/logic/erlog_ec_core.erl @@ -30,7 +30,7 @@ prove_goal(Goal0, Db, Consulter, Event, Deb, LibsDir) -> %% it. Return when there are no more goals. This is how proving a %% goal/body succeeds. prove_body(Params = #param{goal = [G | Gs], debugger = Deb, bindings = Bs}) -> - Deb(ok, erlog_ec_support:dderef(G, Bs), Bs), + Deb(ok, G, Bs), prove_goal(Params#param{goal = G, next_goal = Gs}); prove_body(#param{goal = [], choice = Cps, bindings = Bs, var_num = Vn, database = Db}) -> {succeed, Cps, Bs, Vn, Db}. %No more body From a3e78946fba84a48c278276d5ed94d33d7a016fa Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Sat, 31 Jan 2015 00:45:57 +0000 Subject: [PATCH 244/251] add parallel lib --- include/erlog_parallel.hrl | 16 +++++ src/libs/standard/parallel/erlog_parallel.erl | 59 +++++++++++++++++++ 2 files changed, 75 insertions(+) create mode 100644 include/erlog_parallel.hrl create mode 100644 src/libs/standard/parallel/erlog_parallel.erl diff --git a/include/erlog_parallel.hrl b/include/erlog_parallel.hrl new file mode 100644 index 0000000..552ab8b --- /dev/null +++ b/include/erlog_parallel.hrl @@ -0,0 +1,16 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2015, +%%% @doc +%%% +%%% @end +%%% Created : 30. Янв. 2015 20:06 +%%%------------------------------------------------------------------- +-author("tihon"). + +-define(ERLOG_PARALLEL, + [ + {spawn, 2}, %spawn goal processing in a new thread + {join, 2}, %wait for thread (or multiple threads) + {check, 2} %get result of thread by pid + ]). \ No newline at end of file diff --git a/src/libs/standard/parallel/erlog_parallel.erl b/src/libs/standard/parallel/erlog_parallel.erl new file mode 100644 index 0000000..51a4a24 --- /dev/null +++ b/src/libs/standard/parallel/erlog_parallel.erl @@ -0,0 +1,59 @@ +%%%------------------------------------------------------------------- +%%% @author tihon +%%% @copyright (C) 2015, +%%% @doc +%%% +%%% @end +%%% Created : 30. Янв. 2015 20:06 +%%%------------------------------------------------------------------- +-module(erlog_parallel). +-author("tihon"). + +-behaviour(erlog_stdlib). + +-include("erlog_core.hrl"). +-include("erlog_parallel.hrl"). + +%% API +-export([load/1, prove_goal/1]). + +load(DbState) -> + lists:foldl(fun(Proc, UDBState) -> + erlog_memory:load_kernel_space(UDBState, ?MODULE, Proc) end, DbState, ?ERLOG_PARALLEL). + +prove_goal(Params = #param{goal = {spawn, _, _} = G, next_goal = Next, bindings = Bs0}) -> + {spawn, Goal, Res} = erlog_ec_support:dderef(G, Bs0), + Parent = self(), + Pid = spawn(fun() -> Parent ! {self(), (catch erlog_ec_core:prove_body(Params#param{goal = Goal}))} end), + Bs1 = erlog_ec_support:add_binding(Res, Pid, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); +prove_goal(Params = #param{goal = {join, _, _} = G, next_goal = Next, bindings = Bs0}) -> + {join, Pid, Timeout} = erlog_ec_support:dderef(G, Bs0), + join(Pid, Timeout), + erlog_ec_core:prove_body(Params#param{goal = Next}); +prove_goal(Params = #param{goal = {check, _, _} = G, next_goal = Next, bindings = Bs0, var_num = Vn0}) -> + {check, Pid, Result} = erlog_ec_support:dderef(G, Bs0), + case receive_result(Pid, 0) of + empty -> + Bs1 = erlog_ec_support:add_binding(Result, not_ready, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); + {succeed, _, Bs1, Vn1, _} -> + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = dict:merge(fun merge_dicts/3, Bs0, Bs1), var_num = Vn0 + Vn1}); + _ -> erlog_errors:fail(Params) + end. + + +%% @private +merge_dicts(_, _, Value2) -> Value2. + +%% @private +receive_result(Pid, TM) -> + receive + {Pid, Result} -> Result + after TM -> empty + end. + +%% @private +join(Pids, Timeout) when is_list(Pids) -> + lists:foreach(fun(Pid) -> receive_result(Pid, Timeout) end, Pids); +join(Pid, Timeout) -> join([Pid], Timeout). \ No newline at end of file From d0b32d9b098a56a818295c3dc8d8d66c744911e2 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 2 Feb 2015 21:26:24 +0000 Subject: [PATCH 245/251] fix parallel --- lib/autoload/test.pl | 15 ++++++++++++++ src/libs/standard/parallel/erlog_parallel.erl | 20 +++++++++++++++---- 2 files changed, 31 insertions(+), 4 deletions(-) create mode 100644 lib/autoload/test.pl diff --git a/lib/autoload/test.pl b/lib/autoload/test.pl new file mode 100644 index 0000000..24bd14e --- /dev/null +++ b/lib/autoload/test.pl @@ -0,0 +1,15 @@ +test_p(R):- +use(erlog_parallel), +spawn(writeln("aaa"), P1), +spawn(writeln("bbb"), P2), +spawn(foo(5, A), P3), +join([P1, P2, P3], 5000), +check(P3, _), +R = A. + + +foo(1, a). +foo(2, b). +foo(3, c). +foo(4, d). +foo(5, e). diff --git a/src/libs/standard/parallel/erlog_parallel.erl b/src/libs/standard/parallel/erlog_parallel.erl index 51a4a24..cb7b1ab 100644 --- a/src/libs/standard/parallel/erlog_parallel.erl +++ b/src/libs/standard/parallel/erlog_parallel.erl @@ -24,7 +24,11 @@ load(DbState) -> prove_goal(Params = #param{goal = {spawn, _, _} = G, next_goal = Next, bindings = Bs0}) -> {spawn, Goal, Res} = erlog_ec_support:dderef(G, Bs0), Parent = self(), - Pid = spawn(fun() -> Parent ! {self(), (catch erlog_ec_core:prove_body(Params#param{goal = Goal}))} end), + Pid = spawn( + fun() -> + Parent ! {self(), (catch erlog_ec_core:prove_goal(Params#param{goal = Goal, next_goal = []}))}, + Parent ! {self(), finish} + end), Bs1 = erlog_ec_support:add_binding(Res, Pid, Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); prove_goal(Params = #param{goal = {join, _, _} = G, next_goal = Next, bindings = Bs0}) -> @@ -33,7 +37,7 @@ prove_goal(Params = #param{goal = {join, _, _} = G, next_goal = Next, bindings = erlog_ec_core:prove_body(Params#param{goal = Next}); prove_goal(Params = #param{goal = {check, _, _} = G, next_goal = Next, bindings = Bs0, var_num = Vn0}) -> {check, Pid, Result} = erlog_ec_support:dderef(G, Bs0), - case receive_result(Pid, 0) of + case recv_res(Pid, 0) of empty -> Bs1 = erlog_ec_support:add_binding(Result, not_ready, Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); @@ -47,13 +51,21 @@ prove_goal(Params = #param{goal = {check, _, _} = G, next_goal = Next, bindings merge_dicts(_, _, Value2) -> Value2. %% @private -receive_result(Pid, TM) -> +join_proc(Pid, TM) -> + receive + {Pid, finish} -> ok + after TM -> empty + end. + +%% @private +recv_res(Pid, TM) -> receive {Pid, Result} -> Result after TM -> empty end. + %% @private join(Pids, Timeout) when is_list(Pids) -> - lists:foreach(fun(Pid) -> receive_result(Pid, Timeout) end, Pids); + lists:foreach(fun(Pid) -> join_proc(Pid, Timeout) end, Pids); join(Pid, Timeout) -> join([Pid], Timeout). \ No newline at end of file From 9eb934a242584f0e092d671a9ca2b5042b8fcc48 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 2 Feb 2015 21:27:54 +0000 Subject: [PATCH 246/251] add claust --- src/libs/standard/parallel/erlog_parallel.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libs/standard/parallel/erlog_parallel.erl b/src/libs/standard/parallel/erlog_parallel.erl index cb7b1ab..987dce0 100644 --- a/src/libs/standard/parallel/erlog_parallel.erl +++ b/src/libs/standard/parallel/erlog_parallel.erl @@ -60,7 +60,7 @@ join_proc(Pid, TM) -> %% @private recv_res(Pid, TM) -> receive - {Pid, Result} -> Result + {Pid, Result} when Result /= finish -> Result after TM -> empty end. From 0c0997af3c70510fde79ff04ee529bfd1213dc30 Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Mon, 2 Feb 2015 21:41:59 +0000 Subject: [PATCH 247/251] improve parallel interface --- src/libs/standard/parallel/erlog_parallel.erl | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/libs/standard/parallel/erlog_parallel.erl b/src/libs/standard/parallel/erlog_parallel.erl index 987dce0..e02c6f7 100644 --- a/src/libs/standard/parallel/erlog_parallel.erl +++ b/src/libs/standard/parallel/erlog_parallel.erl @@ -33,16 +33,19 @@ prove_goal(Params = #param{goal = {spawn, _, _} = G, next_goal = Next, bindings erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); prove_goal(Params = #param{goal = {join, _, _} = G, next_goal = Next, bindings = Bs0}) -> {join, Pid, Timeout} = erlog_ec_support:dderef(G, Bs0), - join(Pid, Timeout), - erlog_ec_core:prove_body(Params#param{goal = Next}); + case catch join(Pid, Timeout) of + ok -> erlog_ec_core:prove_body(Params#param{goal = Next}); + _ -> erlog_errors:fail(Params) + end; prove_goal(Params = #param{goal = {check, _, _} = G, next_goal = Next, bindings = Bs0, var_num = Vn0}) -> {check, Pid, Result} = erlog_ec_support:dderef(G, Bs0), case recv_res(Pid, 0) of empty -> - Bs1 = erlog_ec_support:add_binding(Result, not_ready, Bs0), + Bs1 = erlog_ec_support:add_binding(Result, false, Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); {succeed, _, Bs1, Vn1, _} -> - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = dict:merge(fun merge_dicts/3, Bs0, Bs1), var_num = Vn0 + Vn1}); + Bs = erlog_ec_support:add_binding(Result, true, dict:merge(fun merge_dicts/3, Bs0, Bs1)), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs, var_num = Vn0 + Vn1}); _ -> erlog_errors:fail(Params) end. @@ -54,7 +57,7 @@ merge_dicts(_, _, Value2) -> Value2. join_proc(Pid, TM) -> receive {Pid, finish} -> ok - after TM -> empty + after TM -> throw(timeout) end. %% @private From fa7c9ec4b670a11e067f6aad0b4d349c29590f3c Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 6 Feb 2015 13:53:20 +0000 Subject: [PATCH 248/251] improve erlog_parallel --- lib/autoload/test.pl | 21 +++++++++-- src/core/erlog_logic.erl | 1 + src/core/logic/erlog_ec_support.erl | 31 ++++++++++++---- src/libs/standard/parallel/erlog_parallel.erl | 36 ++++++++++++------- 4 files changed, 66 insertions(+), 23 deletions(-) diff --git a/lib/autoload/test.pl b/lib/autoload/test.pl index 24bd14e..d9f690e 100644 --- a/lib/autoload/test.pl +++ b/lib/autoload/test.pl @@ -2,14 +2,29 @@ use(erlog_parallel), spawn(writeln("aaa"), P1), spawn(writeln("bbb"), P2), -spawn(foo(5, A), P3), +spawn(parrallel(5, check([1,Z,fii(R)])), P3), +B = 4, +C = 2, +A1 = a, +A2 = b, +A3 = c, +get(D), join([P1, P2, P3], 5000), -check(P3, _), -R = A. +check(P3, _). +get(1). +get(2). + +parrallel(F1, F2):- + BP = 5, + CP = 7, + foo(F1, F2). foo(1, a). foo(2, b). foo(3, c). foo(4, d). foo(5, e). +foo(5, check([1, 2, fii(e)])). + +fii(e). diff --git a/src/core/erlog_logic.erl b/src/core/erlog_logic.erl index f7402f8..902dfa9 100644 --- a/src/core/erlog_logic.erl +++ b/src/core/erlog_logic.erl @@ -51,6 +51,7 @@ reconsult_files(Other, _Db, _Fun) -> {error, {type_error, list, Other}}. shell_prove_result({succeed, Vs}) -> show_bindings(Vs); shell_prove_result(fail) -> false; +shell_prove_result({fail, _}) -> false; shell_prove_result({error, Error}) -> erlog_io:format_error([Error]); shell_prove_result({'EXIT', Error}) -> erlog_io:format_error("EXIT", [Error]). diff --git a/src/core/logic/erlog_ec_support.erl b/src/core/logic/erlog_ec_support.erl index 557ffd9..a1e548a 100644 --- a/src/core/logic/erlog_ec_support.erl +++ b/src/core/logic/erlog_ec_support.erl @@ -15,7 +15,7 @@ -export([new_bindings/0, get_binding/2, add_binding/3, functor/1, cut/3, collect_alternatives/3, update_result/4, update_vars/4, deref/2, dderef_list/2, - make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3, write/2, is_bound/1, try_add/3, check_var/2]). + make_vars/2, pred_ind/1, deref_list/2, dderef/2, index_of/2, index_of/3, write/2, is_bound/1, try_add/3, check_var/2, get_vars/2]). %% deref(Term, Bindings) -> Term. %% Dereference a variable, else just return the term. @@ -72,6 +72,12 @@ dderef_list(Other, _Bs) -> erlog_errors:type_error(list, Other). is_bound({N}) when is_integer(N) -> false; is_bound(_) -> true. +%% takes unbound vars from goal and return it +-spec get_vars(tuple(), dict:dict()) -> list(). +get_vars(Goal, Bs) -> + Bound = dderef(Goal, Bs), + lists:flatten(get_var(Bound, [])). + %% make_vars(Count, VarNum) -> [Var]. %% Make a list of new variables starting at VarNum. make_vars(0, _) -> []; @@ -147,10 +153,6 @@ index_of(_, [], _) -> not_found; index_of(Item, [Item | _], Index) -> Index; index_of(Item, [_ | Tl], Index) -> index_of(Item, Tl, Index + 1). -remove_nth(List, N) -> - {A, B} = lists:split(N - 1, List), - A ++ tl(B). - write(Res, Bs) when is_list(Res) -> case io_lib:printable_list(Res) of true -> Res; @@ -159,7 +161,6 @@ write(Res, Bs) when is_list(Res) -> write(Res, Bs) -> write([Res], Bs). - cut(Label, Last, Param = #param{next_goal = Next, choice = [#cut{label = Label} | Cps] = Cps0}) -> if Last -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps}); true -> erlog_ec_core:prove_body(Param#param{goal = Next, choice = Cps0}) @@ -173,6 +174,13 @@ cut(Label, Last, Param = #param{choice = [#cp{type = goal_clauses, label = Label cut(Label, Last, Param = #param{choice = [_Cp | Cps]}) -> cut(Label, Last, Param#param{choice = Cps}). + +%% @private +remove_nth(List, N) -> + {A, B} = lists:split(N - 1, List), + A ++ tl(B). + +%% @private %% cut_goal_clauses(Last, Next, Cp, Cps, Bs, Vn, Db). cut_goal_clauses(true, #cp{label = _}, Param = #param{next_goal = Next}) -> %% Just remove the choice point completely and continue. @@ -180,4 +188,13 @@ cut_goal_clauses(true, #cp{label = _}, Param = #param{next_goal = Next}) -> cut_goal_clauses(false, #cp{label = L}, Param = #param{next_goal = Next, choice = Cps}) -> %% Replace choice point with cut point then continue. Cut = #cut{label = L}, - erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). \ No newline at end of file + erlog_ec_core:prove_body(Param#param{goal = Next, choice = [Cut | Cps]}). + +%% @private +%% Get unbound vars from goal +get_var(N = {I}, Acc) when is_integer(I)-> [N | Acc]; +get_var(Tuple, Acc) when is_tuple(Tuple) -> get_var(tuple_to_list(Tuple), Acc); +get_var([First | Rest], Acc) -> + FirstPrep = get_var(First, []), + get_var(Rest, [FirstPrep | Acc]); +get_var(_, Acc) -> Acc. \ No newline at end of file diff --git a/src/libs/standard/parallel/erlog_parallel.erl b/src/libs/standard/parallel/erlog_parallel.erl index e02c6f7..7702cfa 100644 --- a/src/libs/standard/parallel/erlog_parallel.erl +++ b/src/libs/standard/parallel/erlog_parallel.erl @@ -26,7 +26,8 @@ prove_goal(Params = #param{goal = {spawn, _, _} = G, next_goal = Next, bindings Parent = self(), Pid = spawn( fun() -> - Parent ! {self(), (catch erlog_ec_core:prove_goal(Params#param{goal = Goal, next_goal = []}))}, + R = (catch erlog_ec_core:prove_goal(Params#param{goal = Goal, next_goal = []})), + reply(Parent, R, erlog_ec_support:get_vars(Goal, Bs0)), Parent ! {self(), finish} end), Bs1 = erlog_ec_support:add_binding(Res, Pid, Bs0), @@ -37,22 +38,18 @@ prove_goal(Params = #param{goal = {join, _, _} = G, next_goal = Next, bindings = ok -> erlog_ec_core:prove_body(Params#param{goal = Next}); _ -> erlog_errors:fail(Params) end; -prove_goal(Params = #param{goal = {check, _, _} = G, next_goal = Next, bindings = Bs0, var_num = Vn0}) -> +prove_goal(Params = #param{goal = {check, _, _} = G, next_goal = Next, bindings = Bs0}) -> {check, Pid, Result} = erlog_ec_support:dderef(G, Bs0), case recv_res(Pid, 0) of - empty -> - Bs1 = erlog_ec_support:add_binding(Result, false, Bs0), + error -> erlog_errors:fail(Params); + empty -> Bs1 = erlog_ec_support:add_binding(Result, false, Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); - {succeed, _, Bs1, Vn1, _} -> - Bs = erlog_ec_support:add_binding(Result, true, dict:merge(fun merge_dicts/3, Bs0, Bs1)), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs, var_num = Vn0 + Vn1}); - _ -> erlog_errors:fail(Params) + VarsGot -> + UBs = lists:foldl(fun({Var, Value}, UpdBs) -> erlog_ec_support:add_binding(Var, Value, UpdBs) end, Bs0, VarsGot), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = UBs}) end. -%% @private -merge_dicts(_, _, Value2) -> Value2. - %% @private join_proc(Pid, TM) -> receive @@ -67,8 +64,21 @@ recv_res(Pid, TM) -> after TM -> empty end. - %% @private join(Pids, Timeout) when is_list(Pids) -> lists:foreach(fun(Pid) -> join_proc(Pid, Timeout) end, Pids); -join(Pid, Timeout) -> join([Pid], Timeout). \ No newline at end of file +join(Pid, Timeout) -> join([Pid], Timeout). + +%% @private +reply(Parent, {succeed, _, Bs1, _, _}, StartVars) -> Parent ! {self(), extract_vars(StartVars, Bs1)}; +reply(Parent, _, _) -> Parent ! {self(), error}. + +%% @private +extract_vars(VarList, Bs) -> + lists:foldl( + fun({Var}, Acc) -> + case dict:find(Var, Bs) of + {ok, Value} -> [{{Var}, Value} | Acc]; + error -> Acc + end + end, [], VarList). \ No newline at end of file From 68fd467d3f5b938c281a2bacb84993600adfc55c Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Fri, 6 Feb 2015 14:05:01 +0000 Subject: [PATCH 249/251] remove test as it is not library --- lib/autoload/test.pl | 30 ------------------------------ 1 file changed, 30 deletions(-) delete mode 100644 lib/autoload/test.pl diff --git a/lib/autoload/test.pl b/lib/autoload/test.pl deleted file mode 100644 index d9f690e..0000000 --- a/lib/autoload/test.pl +++ /dev/null @@ -1,30 +0,0 @@ -test_p(R):- -use(erlog_parallel), -spawn(writeln("aaa"), P1), -spawn(writeln("bbb"), P2), -spawn(parrallel(5, check([1,Z,fii(R)])), P3), -B = 4, -C = 2, -A1 = a, -A2 = b, -A3 = c, -get(D), -join([P1, P2, P3], 5000), -check(P3, _). - -get(1). -get(2). - -parrallel(F1, F2):- - BP = 5, - CP = 7, - foo(F1, F2). - -foo(1, a). -foo(2, b). -foo(3, c). -foo(4, d). -foo(5, e). -foo(5, check([1, 2, fii(e)])). - -fii(e). From bdf7f5ad5bae06376139b0a0486e2c76e4ceee2b Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Wed, 18 Feb 2015 22:52:30 +0000 Subject: [PATCH 250/251] add support for string split and multiple vars --- src/libs/standard/string/erlog_string.erl | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/libs/standard/string/erlog_string.erl b/src/libs/standard/string/erlog_string.erl index bfec221..80b3e4b 100644 --- a/src/libs/standard/string/erlog_string.erl +++ b/src/libs/standard/string/erlog_string.erl @@ -46,10 +46,15 @@ prove_goal(Params = #param{goal = {indexof, _, _, _} = Goal, next_goal = Next, b erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}) end; prove_goal(Params = #param{goal = {split, _, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> - {split, Str, Del, Res} = erlog_ec_support:dderef(Goal, Bs0), - List = string:tokens(Str, Del), - Bs1 = erlog_ec_support:add_binding(Res, List, Bs0), - erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}); + case erlog_ec_support:dderef(Goal, Bs0) of + {split, Str, Del, Res} when is_list(Res) -> + List = string:tokens(Str, Del), + erlog_lists:prove_goal(Params#param{goal = {append, List, [], Res}}); + {split, Str, Del, Res} -> + List = string:tokens(Str, Del), + Bs1 = erlog_ec_support:add_binding(Res, List, Bs0), + erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1}) + end; prove_goal(Params = #param{goal = {parse_int, _, _} = Goal, next_goal = Next, bindings = Bs0}) -> {parse_int, Str, Int} = erlog_ec_support:dderef(Goal, Bs0), case string:to_integer(Str) of From d0f74a58bee0b77cf7e15bd7c08b52ef71ad2cae Mon Sep 17 00:00:00 2001 From: Valery Tikhonov Date: Thu, 23 Apr 2015 12:00:43 +0300 Subject: [PATCH 251/251] fix lists length when list is [1|{4}] --- src/libs/standard/lists/main/erlog_lists.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libs/standard/lists/main/erlog_lists.erl b/src/libs/standard/lists/main/erlog_lists.erl index bca9c8b..506b221 100644 --- a/src/libs/standard/lists/main/erlog_lists.erl +++ b/src/libs/standard/lists/main/erlog_lists.erl @@ -36,7 +36,7 @@ load(DbState) -> lists:foldl(fun(Head, UDBState) -> erlog_memory:load_kernel_space(UDBState, ?MODULE, Head) end, DbState, ?ERLOG_LISTS). prove_goal(Params = #param{goal = {length, ListVar, Len}, next_goal = Next, bindings = Bs0}) -> - case erlog_ec_support:deref(ListVar, Bs0) of + case erlog_ec_support:dderef_list(ListVar, Bs0) of List when is_list(List) -> Bs1 = erlog_ec_support:add_binding(Len, length(List), Bs0), erlog_ec_core:prove_body(Params#param{goal = Next, bindings = Bs1});