mirror of
https://github.com/KevinMidboe/linguist.git
synced 2025-10-29 17:50:22 +00:00
Merge branch 'master' into pro
This commit is contained in:
Paul Chaignon
1051
samples/Prolog/admin.pl
Executable file
1051
samples/Prolog/admin.pl
Executable file
File diff suppressed because it is too large
Load Diff
11
samples/Prolog/dleak-report.script!
Normal file
11
samples/Prolog/dleak-report.script!
Normal file
@@ -0,0 +1,11 @@
|
||||
#!/usr/bin/env swipl
|
||||
|
||||
:- set_prolog_flag(verbose, silent).
|
||||
:- use_module(dleak).
|
||||
|
||||
:- initialization
|
||||
main, halt.
|
||||
|
||||
main :-
|
||||
current_prolog_flag(argv, [File]),
|
||||
dleak(File).
|
||||
5
samples/Prolog/ex6.pl
Normal file
5
samples/Prolog/ex6.pl
Normal file
@@ -0,0 +1,5 @@
|
||||
%6.8
|
||||
subset(Set, Subset) :-
|
||||
append(L1, Subset, Set).
|
||||
powerset(Set, Subset) :-
|
||||
bagof(Subset, subset(Set, Subset), Subset).
|
||||
260
samples/Prolog/format_spec.pl
Normal file
260
samples/Prolog/format_spec.pl
Normal file
@@ -0,0 +1,260 @@
|
||||
:- module(format_spec, [ format_error/2
|
||||
, format_spec/2
|
||||
, format_spec//1
|
||||
, spec_arity/2
|
||||
, spec_types/2
|
||||
]).
|
||||
|
||||
:- use_module(library(dcg/basics), [eos//0, integer//1, string_without//2]).
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(when), [when/2]).
|
||||
|
||||
% TODO loading this module is optional
|
||||
% TODO it's for my own convenience during development
|
||||
%:- use_module(library(mavis)).
|
||||
|
||||
%% format_error(+Goal, -Error:string) is nondet.
|
||||
%
|
||||
% True if Goal exhibits an Error in its format string. The
|
||||
% Error string describes what is wrong with Goal. Iterates each
|
||||
% error on backtracking.
|
||||
%
|
||||
% Goal may be one of the following predicates:
|
||||
%
|
||||
% * format/2
|
||||
% * format/3
|
||||
% * debug/3
|
||||
format_error(format(Format,Args), Error) :-
|
||||
format_error_(Format, Args,Error).
|
||||
format_error(format(_,Format,Args), Error) :-
|
||||
format_error_(Format,Args,Error).
|
||||
format_error(debug(_,Format,Args), Error) :-
|
||||
format_error_(Format,Args,Error).
|
||||
|
||||
format_error_(Format,Args,Error) :-
|
||||
format_spec(Format, Spec),
|
||||
!,
|
||||
is_list(Args),
|
||||
spec_types(Spec, Types),
|
||||
types_error(Args, Types, Error).
|
||||
format_error_(Format,_,Error) :-
|
||||
% \+ format_spec(Format, _),
|
||||
format(string(Error), "Invalid format string: ~q", [Format]).
|
||||
|
||||
types_error(Args, Types, Error) :-
|
||||
length(Types, TypesLen),
|
||||
length(Args, ArgsLen),
|
||||
TypesLen =\= ArgsLen,
|
||||
!,
|
||||
format( string(Error)
|
||||
, "Wrong argument count. Expected ~d, got ~d"
|
||||
, [TypesLen, ArgsLen]
|
||||
).
|
||||
types_error(Args, Types, Error) :-
|
||||
types_error_(Args, Types, Error).
|
||||
|
||||
types_error_([Arg|_],[Type|_],Error) :-
|
||||
ground(Arg),
|
||||
\+ is_of_type(Type,Arg),
|
||||
message_to_string(error(type_error(Type,Arg),_Location),Error).
|
||||
types_error_([_|Args],[_|Types],Error) :-
|
||||
types_error_(Args, Types, Error).
|
||||
|
||||
|
||||
% check/0 augmentation
|
||||
:- multifile check:checker/2.
|
||||
:- dynamic check:checker/2.
|
||||
check:checker(format_spec:checker, "format/2 strings and arguments").
|
||||
|
||||
:- dynamic format_fail/3.
|
||||
|
||||
checker :-
|
||||
prolog_walk_code([ module_class([user])
|
||||
, infer_meta_predicates(false)
|
||||
, autoload(false) % format/{2,3} are always loaded
|
||||
, undefined(ignore)
|
||||
, trace_reference(_)
|
||||
, on_trace(check_format)
|
||||
]),
|
||||
retract(format_fail(Goal,Location,Error)),
|
||||
print_message(warning, format_error(Goal,Location,Error)),
|
||||
fail. % iterate all errors
|
||||
checker. % succeed even if no errors are found
|
||||
|
||||
check_format(Module:Goal, _Caller, Location) :-
|
||||
predicate_property(Module:Goal, imported_from(Source)),
|
||||
memberchk(Source, [system,prolog_debug]),
|
||||
can_check(Goal),
|
||||
format_error(Goal, Error),
|
||||
assert(format_fail(Goal, Location, Error)),
|
||||
fail.
|
||||
check_format(_,_,_). % succeed to avoid printing goals
|
||||
|
||||
% true if format_error/2 can check this goal
|
||||
can_check(Goal) :-
|
||||
once(clause(format_error(Goal,_),_)).
|
||||
|
||||
prolog:message(format_error(Goal,Location,Error)) -->
|
||||
prolog:message_location(Location),
|
||||
['~n In goal: ~q~n ~s'-[Goal,Error]].
|
||||
|
||||
|
||||
%% format_spec(-Spec)//
|
||||
%
|
||||
% DCG for parsing format strings. It doesn't yet generate format
|
||||
% strings from a spec. See format_spec/2 for details.
|
||||
format_spec([]) -->
|
||||
eos.
|
||||
format_spec([escape(Numeric,Modifier,Action)|Rest]) -->
|
||||
"~",
|
||||
numeric_argument(Numeric),
|
||||
modifier_argument(Modifier),
|
||||
action(Action),
|
||||
format_spec(Rest).
|
||||
format_spec([text(String)|Rest]) -->
|
||||
{ when((ground(String);ground(Codes)),string_codes(String, Codes)) },
|
||||
string_without("~", Codes),
|
||||
{ Codes \= [] },
|
||||
format_spec(Rest).
|
||||
|
||||
|
||||
%% format_spec(+Format, -Spec:list) is semidet.
|
||||
%
|
||||
% Parse a format string. Each element of Spec is one of the following:
|
||||
%
|
||||
% * `text(Text)` - text sent to the output as is
|
||||
% * `escape(Num,Colon,Action)` - a format escape
|
||||
%
|
||||
% `Num` represents the optional numeric portion of an esape. `Colon`
|
||||
% represents the optional colon in an escape. `Action` is an atom
|
||||
% representing the action to be take by this escape.
|
||||
format_spec(Format, Spec) :-
|
||||
when((ground(Format);ground(Codes)),text_codes(Format, Codes)),
|
||||
once(phrase(format_spec(Spec), Codes, [])).
|
||||
|
||||
%% spec_arity(+FormatSpec, -Arity:positive_integer) is det.
|
||||
%
|
||||
% True if FormatSpec requires format/2 to have Arity arguments.
|
||||
spec_arity(Spec, Arity) :-
|
||||
spec_types(Spec, Types),
|
||||
length(Types, Arity).
|
||||
|
||||
|
||||
%% spec_types(+FormatSpec, -Types:list(type)) is det.
|
||||
%
|
||||
% True if FormatSpec requires format/2 to have arguments of Types. Each
|
||||
% value of Types is a type as described by error:has_type/2. This
|
||||
% notion of types is compatible with library(mavis).
|
||||
spec_types(Spec, Types) :-
|
||||
phrase(spec_types(Spec), Types).
|
||||
|
||||
spec_types([]) -->
|
||||
[].
|
||||
spec_types([Item|Items]) -->
|
||||
item_types(Item),
|
||||
spec_types(Items).
|
||||
|
||||
item_types(text(_)) -->
|
||||
[].
|
||||
item_types(escape(Numeric,_,Action)) -->
|
||||
numeric_types(Numeric),
|
||||
action_types(Action).
|
||||
|
||||
numeric_types(number(_)) -->
|
||||
[].
|
||||
numeric_types(character(_)) -->
|
||||
[].
|
||||
numeric_types(star) -->
|
||||
[number].
|
||||
numeric_types(nothing) -->
|
||||
[].
|
||||
|
||||
action_types(Action) -->
|
||||
{ atom_codes(Action, [Code]) },
|
||||
{ action_types(Code, Types) },
|
||||
phrase(Types).
|
||||
|
||||
|
||||
%% text_codes(Text:text, Codes:codes).
|
||||
text_codes(Var, Codes) :-
|
||||
var(Var),
|
||||
!,
|
||||
string_codes(Var, Codes).
|
||||
text_codes(Atom, Codes) :-
|
||||
atom(Atom),
|
||||
!,
|
||||
atom_codes(Atom, Codes).
|
||||
text_codes(String, Codes) :-
|
||||
string(String),
|
||||
!,
|
||||
string_codes(String, Codes).
|
||||
text_codes(Codes, Codes) :-
|
||||
is_of_type(codes, Codes).
|
||||
|
||||
|
||||
numeric_argument(number(N)) -->
|
||||
integer(N).
|
||||
numeric_argument(character(C)) -->
|
||||
"`",
|
||||
[C].
|
||||
numeric_argument(star) -->
|
||||
"*".
|
||||
numeric_argument(nothing) -->
|
||||
"".
|
||||
|
||||
|
||||
modifier_argument(colon) -->
|
||||
":".
|
||||
modifier_argument(no_colon) -->
|
||||
\+ ":".
|
||||
|
||||
|
||||
action(Action) -->
|
||||
[C],
|
||||
{ is_action(C) },
|
||||
{ atom_codes(Action, [C]) }.
|
||||
|
||||
|
||||
%% is_action(+Action:integer) is semidet.
|
||||
%% is_action(-Action:integer) is multi.
|
||||
%
|
||||
% True if Action is a valid format/2 action character. Iterates all
|
||||
% acceptable action characters, if Action is unbound.
|
||||
is_action(Action) :-
|
||||
action_types(Action, _).
|
||||
|
||||
%% action_types(?Action:integer, ?Types:list(type))
|
||||
%
|
||||
% True if Action consumes arguments matching Types. An action (like
|
||||
% `~`), which consumes no arguments, has `Types=[]`. For example,
|
||||
%
|
||||
% ?- action_types(0'~, Types).
|
||||
% Types = [].
|
||||
% ?- action_types(0'a, Types).
|
||||
% Types = [atom].
|
||||
action_types(0'~, []).
|
||||
action_types(0'a, [atom]).
|
||||
action_types(0'c, [integer]). % specifically, a code
|
||||
action_types(0'd, [integer]).
|
||||
action_types(0'D, [integer]).
|
||||
action_types(0'e, [float]).
|
||||
action_types(0'E, [float]).
|
||||
action_types(0'f, [float]).
|
||||
action_types(0'g, [float]).
|
||||
action_types(0'G, [float]).
|
||||
action_types(0'i, [any]).
|
||||
action_types(0'I, [integer]).
|
||||
action_types(0'k, [any]).
|
||||
action_types(0'n, []).
|
||||
action_types(0'N, []).
|
||||
action_types(0'p, [any]).
|
||||
action_types(0'q, [any]).
|
||||
action_types(0'r, [integer]).
|
||||
action_types(0'R, [integer]).
|
||||
action_types(0's, [text]).
|
||||
action_types(0'@, [callable]).
|
||||
action_types(0't, []).
|
||||
action_types(0'|, []).
|
||||
action_types(0'+, []).
|
||||
action_types(0'w, [any]).
|
||||
action_types(0'W, [any, list]).
|
||||
194
samples/Prolog/func.pl
Normal file
194
samples/Prolog/func.pl
Normal file
@@ -0,0 +1,194 @@
|
||||
:- module(func, [ op(675, xfy, ($))
|
||||
, op(650, xfy, (of))
|
||||
, ($)/2
|
||||
, (of)/2
|
||||
]).
|
||||
:- use_module(library(list_util), [xfy_list/3]).
|
||||
:- use_module(library(function_expansion)).
|
||||
:- use_module(library(arithmetic)).
|
||||
:- use_module(library(error)).
|
||||
|
||||
|
||||
% true if the module whose terms are being read has specifically
|
||||
% imported library(func).
|
||||
wants_func :-
|
||||
prolog_load_context(module, Module),
|
||||
Module \== func, % we don't want func sugar ourselves
|
||||
predicate_property(Module:of(_,_),imported_from(func)).
|
||||
|
||||
|
||||
%% compile_function(+Term, -In, -Out, -Goal) is semidet.
|
||||
%
|
||||
% True if Term represents a function from In to Out
|
||||
% implemented by calling Goal. This multifile hook is
|
||||
% called by $/2 and of/2 to convert a term into a goal.
|
||||
% It's used at compile time for macro expansion.
|
||||
% It's used at run time to handle functions which aren't
|
||||
% known at compile time.
|
||||
% When called as a hook, Term is guaranteed to be =nonvar=.
|
||||
%
|
||||
% For example, to treat library(assoc) terms as functions which
|
||||
% map a key to a value, one might define:
|
||||
%
|
||||
% :- multifile compile_function/4.
|
||||
% compile_function(Assoc, Key, Value, Goal) :-
|
||||
% is_assoc(Assoc),
|
||||
% Goal = get_assoc(Key, Assoc, Value).
|
||||
%
|
||||
% Then one could write:
|
||||
%
|
||||
% list_to_assoc([a-1, b-2, c-3], Assoc),
|
||||
% Two = Assoc $ b,
|
||||
:- multifile compile_function/4.
|
||||
compile_function(Var, _, _, _) :-
|
||||
% variables storing functions must be evaluated at run time
|
||||
% and can't be compiled, a priori, into a goal
|
||||
var(Var),
|
||||
!,
|
||||
fail.
|
||||
compile_function(Expr, In, Out, Out is Expr) :-
|
||||
% arithmetic expression of one variable are simply evaluated
|
||||
\+ string(Expr), % evaluable/1 throws exception with strings
|
||||
arithmetic:evaluable(Expr),
|
||||
term_variables(Expr, [In]).
|
||||
compile_function(F, In, Out, func:Goal) :-
|
||||
% composed functions
|
||||
function_composition_term(F),
|
||||
user:function_expansion(F, func:Functor, true),
|
||||
Goal =.. [Functor,In,Out].
|
||||
compile_function(F, In, Out, Goal) :-
|
||||
% string interpolation via format templates
|
||||
format_template(F),
|
||||
( atom(F) ->
|
||||
Goal = format(atom(Out), F, In)
|
||||
; string(F) ->
|
||||
Goal = format(string(Out), F, In)
|
||||
; error:has_type(codes, F) ->
|
||||
Goal = format(codes(Out), F, In)
|
||||
; fail % to be explicit
|
||||
).
|
||||
compile_function(Dict, In, Out, Goal) :-
|
||||
is_dict(Dict),
|
||||
Goal = get_dict(In, Dict, Out).
|
||||
|
||||
%% $(+Function, +Argument) is det.
|
||||
%
|
||||
% Apply Function to an Argument. A Function is any predicate
|
||||
% whose final argument generates output and whose penultimate argument
|
||||
% accepts input.
|
||||
%
|
||||
% This is realized by expanding function application to chained
|
||||
% predicate calls at compile time. Function application itself can
|
||||
% be chained.
|
||||
%
|
||||
% ==
|
||||
% Reversed = reverse $ sort $ [c,d,b].
|
||||
% ==
|
||||
:- meta_predicate $(2,+).
|
||||
$(_,_) :-
|
||||
throw(error(permission_error(call, predicate, ($)/2),
|
||||
context(_, '$/2 must be subject to goal expansion'))).
|
||||
|
||||
user:function_expansion($(F,X), Y, Goal) :-
|
||||
wants_func,
|
||||
( func:compile_function(F, X, Y, Goal) ->
|
||||
true
|
||||
; var(F) -> Goal = % defer until run time
|
||||
( func:compile_function(F, X, Y, P) ->
|
||||
call(P)
|
||||
; call(F, X, Y)
|
||||
)
|
||||
; Goal = call(F, X, Y)
|
||||
).
|
||||
|
||||
|
||||
%% of(+F, +G) is det.
|
||||
%
|
||||
% Creates a new function by composing F and G. The functions are
|
||||
% composed at compile time to create a new, compiled predicate which
|
||||
% behaves like a function. Function composition can be chained.
|
||||
% Composed functions can also be applied with $/2.
|
||||
%
|
||||
% ==
|
||||
% Reversed = reverse of sort $ [c,d,b].
|
||||
% ==
|
||||
:- meta_predicate of(2,2).
|
||||
of(_,_).
|
||||
|
||||
|
||||
%% format_template(Format) is semidet.
|
||||
%
|
||||
% True if Format is a template string suitable for format/3.
|
||||
% The current check is very naive and should be improved.
|
||||
format_template(Format) :-
|
||||
atom(Format), !,
|
||||
atom_codes(Format, Codes),
|
||||
format_template(Codes).
|
||||
format_template(Format) :-
|
||||
string(Format),
|
||||
!,
|
||||
string_codes(Format, Codes),
|
||||
format_template(Codes).
|
||||
format_template(Format) :-
|
||||
error:has_type(codes, Format),
|
||||
memberchk(0'~, Format). % ' fix syntax highlighting
|
||||
|
||||
|
||||
% True if the argument is a function composition term
|
||||
function_composition_term(of(_,_)).
|
||||
|
||||
% Converts a function composition term into a list of functions to compose
|
||||
functions_to_compose(Term, Funcs) :-
|
||||
functor(Term, Op, 2),
|
||||
Op = (of),
|
||||
xfy_list(Op, Term, Funcs).
|
||||
|
||||
% Thread a state variable through a list of functions. This is similar
|
||||
% to a DCG expansion, but much simpler.
|
||||
thread_state([], [], Out, Out).
|
||||
thread_state([F|Funcs], [Goal|Goals], In, Out) :-
|
||||
( compile_function(F, In, Tmp, Goal) ->
|
||||
true
|
||||
; var(F) ->
|
||||
instantiation_error(F)
|
||||
; F =.. [Functor|Args],
|
||||
append(Args, [In, Tmp], NewArgs),
|
||||
Goal =.. [Functor|NewArgs]
|
||||
),
|
||||
thread_state(Funcs, Goals, Tmp, Out).
|
||||
|
||||
user:function_expansion(Term, func:Functor, true) :-
|
||||
wants_func,
|
||||
functions_to_compose(Term, Funcs),
|
||||
debug(func, 'building composed function for: ~w', [Term]),
|
||||
variant_sha1(Funcs, Sha),
|
||||
format(atom(Functor), 'composed_function_~w', [Sha]),
|
||||
debug(func, ' name: ~s', [Functor]),
|
||||
( func:current_predicate(Functor/2) ->
|
||||
debug(func, ' composed predicate already exists', [])
|
||||
; true ->
|
||||
reverse(Funcs, RevFuncs),
|
||||
thread_state(RevFuncs, Threaded, In, Out),
|
||||
xfy_list(',', Body, Threaded),
|
||||
Head =.. [Functor, In, Out],
|
||||
func:assert(Head :- Body),
|
||||
func:compile_predicates([Functor/2])
|
||||
).
|
||||
|
||||
|
||||
% support foo(x,~,y) evaluation
|
||||
user:function_expansion(Term, Output, Goal) :-
|
||||
wants_func,
|
||||
compound(Term),
|
||||
|
||||
% has a single ~ argument
|
||||
setof( X
|
||||
, ( arg(X,Term,Arg), Arg == '~' )
|
||||
, [N]
|
||||
),
|
||||
|
||||
% replace ~ with a variable
|
||||
Term =.. [Name|Args0],
|
||||
nth1(N, Args0, ~, Rest),
|
||||
nth1(N, Args, Output, Rest),
|
||||
Goal =.. [Name|Args].
|
||||
Reference in New Issue
Block a user