Merge pull request #1291 from github/997-local

997 local
This commit is contained in:
Arfon Smith
2014-06-20 10:49:46 +01:00
3 changed files with 772 additions and 25 deletions

View File

@@ -765,8 +765,8 @@
"exception.zep.php"
]
},
"tokens_total": 637830,
"languages_total": 828,
"tokens_total": 639782,
"languages_total": 830,
"tokens": {
"ABAP": {
"*/**": 1,
@@ -53362,27 +53362,330 @@
"TWO_PI": 1
},
"Prolog": {
"-": 52,
"-": 161,
"module": 3,
"(": 327,
"format_spec": 12,
"[": 87,
"format_error/2": 1,
"format_spec/2": 1,
"format_spec//1": 1,
"spec_arity/2": 1,
"spec_types/2": 1,
"]": 87,
")": 326,
".": 107,
"use_module": 8,
"library": 8,
"dcg/basics": 1,
"eos//0": 1,
"integer//1": 1,
"string_without//2": 1,
"error": 6,
"when": 3,
"when/2": 1,
"%": 71,
"mavis": 1,
"format_error": 8,
"+": 14,
"Goal": 29,
"Error": 25,
"string": 8,
"is": 12,
"nondet.": 1,
"format": 8,
"Format": 23,
"Args": 19,
"format_error_": 5,
"_": 30,
"debug": 4,
"Spec": 10,
"is_list": 1,
"spec_types": 8,
"Types": 16,
"types_error": 3,
"length": 4,
"TypesLen": 3,
"ArgsLen": 3,
"types_error_": 4,
"Arg": 6,
"|": 25,
"Type": 3,
"ground": 5,
"is_of_type": 2,
"message_to_string": 1,
"type_error": 1,
"_Location": 1,
"multifile": 2,
"check": 3,
"checker/2.": 2,
"dynamic": 2,
"checker": 3,
"format_fail/3.": 1,
"prolog_walk_code": 1,
"module_class": 1,
"user": 5,
"infer_meta_predicates": 1,
"false": 2,
"autoload": 1,
"format/": 1,
"{": 7,
"}": 7,
"are": 3,
"always": 1,
"loaded": 1,
"undefined": 1,
"ignore": 1,
"trace_reference": 1,
"on_trace": 1,
"check_format": 3,
"retract": 1,
"format_fail": 2,
"Location": 6,
"print_message": 1,
"warning": 1,
"fail.": 3,
"iterate": 1,
"all": 1,
"errors": 2,
"checker.": 1,
"succeed": 2,
"even": 1,
"if": 1,
"no": 1,
"found": 1,
"Module": 4,
"_Caller": 1,
"predicate_property": 1,
"imported_from": 1,
"Source": 2,
"memberchk": 2,
"system": 1,
"prolog_debug": 1,
"can_check": 2,
"assert": 2,
"to": 5,
"avoid": 1,
"printing": 1,
"goals": 1,
"once": 3,
"clause": 1,
"prolog": 2,
"message": 1,
"message_location": 1,
"//": 1,
"eos.": 1,
"escape": 2,
"Numeric": 4,
"Modifier": 2,
"Action": 15,
"Rest": 12,
"numeric_argument": 5,
"modifier_argument": 3,
"action": 6,
"text": 4,
"String": 6,
";": 12,
"Codes": 21,
"string_codes": 4,
"string_without": 1,
"list": 4,
"semidet.": 3,
"text_codes": 6,
"phrase": 3,
"spec_arity": 2,
"FormatSpec": 2,
"Arity": 3,
"positive_integer": 1,
"det.": 4,
"type": 2,
"Item": 2,
"Items": 2,
"item_types": 3,
"numeric_types": 5,
"action_types": 18,
"number": 3,
"character": 2,
"star": 2,
"nothing": 2,
"atom_codes": 4,
"Code": 2,
"Text": 1,
"codes": 5,
"Var": 5,
"var": 4,
"Atom": 3,
"atom": 6,
"N": 5,
"integer": 7,
"C": 5,
"colon": 1,
"no_colon": 1,
"is_action": 4,
"multi.": 1,
"a": 4,
"d": 3,
"e": 1,
"float": 3,
"f": 1,
"G": 2,
"I": 1,
"n": 1,
"p": 1,
"any": 3,
"r": 1,
"s": 2,
"t": 1,
"W": 1,
"func": 13,
"op": 2,
"xfy": 2,
"of": 8,
"/2": 3,
"list_util": 1,
"xfy_list/3": 1,
"function_expansion": 5,
"arithmetic": 2,
"wants_func": 4,
"prolog_load_context": 1,
"we": 1,
"don": 1,
"used": 1,
"at": 3,
"compile": 3,
"time": 3,
"for": 1,
"macro": 1,
"expansion.": 1,
"compile_function/4.": 1,
"compile_function": 8,
"Expr": 5,
"In": 15,
"Out": 16,
"evaluable/1": 1,
"throws": 1,
"exception": 1,
"with": 2,
"strings": 1,
"evaluable": 1,
"term_variables": 1,
"F": 26,
"function_composition_term": 2,
"Functor": 8,
"true": 5,
"..": 6,
"format_template": 7,
"has_type": 2,
"fail": 1,
"be": 4,
"explicit": 1,
"Dict": 3,
"is_dict": 1,
"get_dict": 1,
"Function": 5,
"Argument": 1,
"Apply": 1,
"an": 1,
"Argument.": 1,
"A": 1,
"predicate": 4,
"whose": 2,
"final": 1,
"argument": 2,
"generates": 1,
"output": 1,
"and": 2,
"penultimate": 1,
"accepts": 1,
"input.": 1,
"This": 1,
"realized": 1,
"by": 2,
"expanding": 1,
"function": 2,
"application": 2,
"chained": 1,
"calls": 1,
"time.": 1,
"itself": 1,
"can": 3,
"chained.": 2,
"Reversed": 2,
"reverse": 4,
"sort": 2,
"c": 2,
"b": 4,
"meta_predicate": 2,
"throw": 1,
"permission_error": 1,
"call": 4,
"context": 1,
"X": 10,
"Y": 7,
"defer": 1,
"until": 1,
"run": 1,
"P": 2,
"Creates": 1,
"new": 2,
"composing": 1,
"G.": 1,
"The": 1,
"functions": 2,
"composed": 1,
"create": 1,
"compiled": 1,
"which": 1,
"behaves": 1,
"like": 1,
"function.": 1,
"composition": 1,
"Composed": 1,
"also": 1,
"applied": 1,
"/2.": 1,
"fix": 1,
"syntax": 1,
"highlighting": 1,
"functions_to_compose": 2,
"Term": 10,
"Funcs": 7,
"functor": 1,
"Op": 3,
"xfy_list": 2,
"thread_state": 4,
"Goals": 2,
"Tmp": 3,
"instantiation_error": 1,
"append": 2,
"NewArgs": 2,
"variant_sha1": 1,
"Sha": 2,
"current_predicate": 1,
"Functor/2": 2,
"RevFuncs": 2,
"Threaded": 2,
"Body": 2,
"Head": 2,
"compile_predicates": 1,
"Output": 2,
"compound": 1,
"setof": 1,
"arg": 1,
"Name": 2,
"Args0": 2,
"nth1": 2,
"lib": 1,
"(": 49,
"ic": 1,
")": 49,
".": 25,
"vabs": 2,
"Val": 8,
"AbsVal": 10,
"#": 9,
";": 1,
"labeling": 2,
"[": 21,
"]": 21,
"vabsIC": 1,
"or": 1,
"faitListe": 3,
"_": 2,
"First": 2,
"|": 12,
"Rest": 6,
"Taille": 2,
"Min": 2,
"Max": 2,
@@ -53397,7 +53700,6 @@
"Xi.": 1,
"checkPeriode": 3,
"ListVar": 2,
"length": 1,
"Length": 2,
"<": 1,
"X1": 2,
@@ -53418,9 +53720,6 @@
"christie": 3,
"parents": 4,
"brother": 1,
"X": 3,
"Y": 2,
"F": 2,
"M": 2,
"turing": 1,
"Tape0": 2,
@@ -53429,9 +53728,7 @@
"q0": 1,
"Ls": 12,
"Rs": 16,
"reverse": 1,
"Ls1": 4,
"append": 1,
"qf": 1,
"Q0": 2,
"Ls0": 6,
@@ -53439,14 +53736,10 @@
"symbol": 3,
"Sym": 6,
"RsRest": 2,
"once": 1,
"rule": 1,
"Q1": 2,
"NewSym": 2,
"Action": 2,
"action": 4,
"Rs1": 2,
"b": 2,
"left": 4,
"stay": 1,
"right": 1,
@@ -68898,7 +69191,7 @@
"PostScript": 107,
"PowerShell": 12,
"Processing": 74,
"Prolog": 468,
"Prolog": 2420,
"Propeller Spin": 13519,
"Protocol Buffer": 63,
"PureScript": 1652,
@@ -69092,7 +69385,7 @@
"PostScript": 1,
"PowerShell": 2,
"Processing": 1,
"Prolog": 3,
"Prolog": 5,
"Propeller Spin": 10,
"Protocol Buffer": 1,
"PureScript": 4,
@@ -69155,5 +69448,5 @@
"Zephir": 5,
"Zimpl": 1
},
"md5": "896b4ca841571551a8fe421eec69b0f6"
"md5": "95cec2f85e2b8d7b956746aab7aa16aa"
}

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].