KevinMidboe/linguist
1
0
Fork 0
mirror of https://github.com/KevinMidboe/linguist.git synced 2025-10-29 09:40:21 +00:00
Code Issues Packages Projects Releases Wiki Activity

Add misclassified Prolog samples

Browse Source 
These two files are incorrectly classified as Perl.  They should be
classified as Prolog.  There are many distinctive tokens in each file
which clearly differentiate between Perl and Prolog.
This commit is contained in:
Michael Hendricks
2014-03-17 08:56:45 -06:00
parent f39456ee47
commit ee3c9bcdbd
2 changed files with 454 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

260
samples/Prolog/format_spec.pl Normal file
View 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
View 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].