/* Part of SWI-Prolog Author: Jan Wielemaker E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org Copyright (c) 2014-2023, University of Amsterdam VU University Amsterdam CWI, Amsterdam SWI-Prolog Solutions b.v. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ :- module(prolog_pretty_print, [ print_term/2 % +Term, +Options ]). :- autoload(library(option), [merge_options/3, select_option/3, select_option/4, option/2, option/3]). /** Pretty Print Prolog terms This module is a first start of what should become a full-featured pretty printer for Prolog terms with many options and parameters. Eventually, it should replace portray_clause/1 and various other special-purpose predicates. @tbd This is just a quicky. We need proper handling of portray/1, avoid printing very long terms multiple times, spacing (around operators), etc. @tbd Use a record for the option-processing. @tbd The current approach is far too simple, often resulting in illegal terms. */ :- predicate_options(print_term/2, 2, [ output(stream), right_margin(integer), left_margin(integer), tab_width(integer), indent_arguments(integer), auto_indent_arguments(integer), operators(boolean), write_options(list), fullstop(boolean), nl(boolean) ]). %! print_term(+Term, +Options) is det. % % Pretty print a Prolog term. The following options are processed: % % - output(+Stream) % Define the output stream. Default is `user_output` % - right_margin(?Column) % Width of a line. If the output is a _tty_ and tty_size/2 % can produce a size the default is the number of columns % minus 8. Otherwise the default is 72 characters. If the % Column is unbound it is unified with the computed value. % - left_margin(+Integer) % Left margin for continuation lines. Default is the current % line position or `0` if that is not available. % - tab_width(+Integer) % Distance between tab-stops. Default is 8 characters. % - indent_arguments(+Spec) % Defines how arguments of compound terms are placed. Defined % values are: % $ `false` : % Simply place them left to right (no line-breaks) % $ `true` : % Place them vertically, aligned with the open bracket (not % implemented) % $ `auto` (default) : % As horizontal if line-width is not exceeded, vertical % otherwise. See also auto_indent_arguments(Int) % $ An integer : % Place them vertically aligned, spaces to the right of % the beginning of the head. % - auto_indent_arguments(+Integer) % Used by indent_arguments(auto) to decide whether to introduce % a newline after the `(` or not. If specified and > 0, this % provides the default integer for indent_arguments(Int). The % "hanging" mode is used if otherwise the indentation increment % is twice this value. % - operators(+Boolean) % This is the inverse of the write_term/3 option `ignore_ops`. % Default is to respect them. % - write_options(+List) % List of options passed to write_term/3 for terms that are % not further processed. Default: % % ``` % [ numbervars(true), % quoted(true), % portray(true) % ] % ``` % - fullstop(Boolean) % If `true` (default `false`), add a full stop (.) to the output. % - nl(Boolean) % If `true` (default `false`), add a newline to the output. print_term(Term, Options) :- defaults(Defs0), select_option(write_options(WrtDefs), Defs0, Defs), select_option(write_options(WrtUser), Options, Options1, []), merge_options(WrtUser, WrtDefs, WrtOpts), merge_options(Options1, Defs, Options2), Options3 = [write_options(WrtOpts)|Options2], default_margin(Options3, Options4), \+ \+ print_term_2(Term, Options4). print_term_2(Term, Options) :- prepare_term(Term, Template, Cycles, Constraints), option(write_options(WrtOpts), Options), option(max_depth(MaxDepth), WrtOpts, infinite), dict_create(Context, #, [max_depth(MaxDepth)|Options]), pp(Template, Context, Options), print_extra(Cycles, Context, 'where', Options), print_extra(Constraints, Context, 'with constraints', Options), ( option(fullstop(true), Options) -> option(output(Out), Options), put_char(Out, '.') ; true ), ( option(nl(true), Options) -> option(output(Out2), Options), nl(Out2) ; true ). print_extra([], _, _, _) :- !. print_extra(List, Context, Comment, Options) :- option(output(Out), Options), format(Out, ', % ~w', [Comment]), context(Context, indent, Indent), NewIndent is Indent+4, modify_context(Context, [indent=NewIndent], Context1), print_extra_2(List, Context1, Options). print_extra_2([H|T], Context, Options) :- option(output(Out), Options), context(Context, indent, Indent), indent(Out, Indent, Options), pp(H, Context, Options), ( T == [] -> true ; format(Out, ',', []), print_extra_2(T, Context, Options) ). %! prepare_term(+Term, -Template, -Cycles, -Constraints) % % Prepare a term, possibly holding cycles and constraints for % printing. prepare_term(Term, Template, Cycles, Constraints) :- term_attvars(Term, []), !, Constraints = [], '$factorize_term'(Term, Template, Factors), bind_non_cycles(Factors, 1, Cycles), numbervars(Template+Cycles+Constraints, 0, _, [singletons(true)]). prepare_term(Term, Template, Cycles, Constraints) :- copy_term(Term, Copy, Constraints), '$factorize_term'(Copy, Template, Factors), bind_non_cycles(Factors, 1, Cycles), numbervars(Template+Cycles+Constraints, 0, _, [singletons(true)]). bind_non_cycles([], _, []). bind_non_cycles([V=Term|T], I, L) :- unify_with_occurs_check(V, Term), !, bind_non_cycles(T, I, L). bind_non_cycles([H|T0], I, [H|T]) :- H = ('$VAR'(Name)=_), atom_concat('_S', I, Name), I2 is I + 1, bind_non_cycles(T0, I2, T). defaults([ output(user_output), depth(0), indent_arguments(auto), auto_indent_arguments(4), operators(true), write_options([ quoted(true), numbervars(true), portray(true), attributes(portray) ]), priority(1200) ]). default_margin(Options0, Options) :- default_right_margin(Options0, Options1), default_indent(Options1, Options). default_right_margin(Options0, Options) :- option(right_margin(Margin), Options0), !, ( var(Margin) -> tty_right_margin(Options0, Margin) ; true ), Options = Options0. default_right_margin(Options0, [right_margin(Margin)|Options0]) :- tty_right_margin(Options0, Margin). tty_right_margin(Options, Margin) :- option(output(Output), Options), stream_property(Output, tty(true)), catch(tty_size(_Rows, Columns), error(_,_), fail), !, Margin is Columns - 8. tty_right_margin(_, 72). default_indent(Options0, Options) :- option(output(Output), Options0), ( stream_property(Output, position(Pos)) -> stream_position_data(line_position, Pos, Column) ; Column = 0 ), option(left_margin(LM), Options0, Column), Options = [indent(LM)|Options0]. /******************************* * CONTEXT * *******************************/ context(Ctx, Name, Value) :- get_dict(Name, Ctx, Value). modify_context(Ctx0, Mapping, Ctx) :- Ctx = Ctx0.put(Mapping). dec_depth(Ctx, Ctx) :- context(Ctx, max_depth, infinite), !. dec_depth(Ctx0, Ctx) :- ND is Ctx0.max_depth - 1, Ctx = Ctx0.put(max_depth, ND). /******************************* * PP * *******************************/ pp(Primitive, Ctx, Options) :- ( atomic(Primitive) ; var(Primitive) ; Primitive = '$VAR'(Var), ( integer(Var) ; atom(Var) ) ), !, pprint(Primitive, Ctx, Options). pp(Portray, _Ctx, Options) :- option(write_options(WriteOptions), Options), option(portray(true), WriteOptions), option(output(Out), Options), with_output_to(Out, user:portray(Portray)), !. pp(List, Ctx, Options) :- List = [_|_], !, context(Ctx, indent, Indent), context(Ctx, depth, Depth), option(output(Out), Options), option(indent_arguments(IndentStyle), Options), ( ( IndentStyle == false -> true ; IndentStyle == auto, print_width(List, Width, Options), option(right_margin(RM), Options), Indent + Width < RM ) -> pprint(List, Ctx, Options) ; format(Out, '[ ', []), Nindent is Indent + 2, NDepth is Depth + 1, modify_context(Ctx, [indent=Nindent, depth=NDepth, priority=999], NCtx), pp_list_elements(List, NCtx, Options), indent(Out, Indent, Options), format(Out, ']', []) ). pp(Dict, Ctx, Options) :- is_dict(Dict), !, dict_pairs(Dict, Tag, Pairs), option(output(Out), Options), option(indent_arguments(IndentStyle), Options), context(Ctx, indent, Indent), ( IndentStyle == false ; Pairs == [] -> pprint(Dict, Ctx, Options) ; IndentStyle == auto, print_width(Dict, Width, Options), option(right_margin(RM), Options), Indent + Width < RM % fits on a line, simply write -> pprint(Dict, Ctx, Options) ; compound_indent(Out, '~q{ ', Tag, Indent, Nindent, Options), context(Ctx, depth, Depth), NDepth is Depth + 1, modify_context(Ctx, [indent=Nindent, depth=NDepth], NCtx0), dec_depth(NCtx0, NCtx), pp_dict_args(Pairs, NCtx, Options), BraceIndent is Nindent - 2, % '{ ' indent(Out, BraceIndent, Options), write(Out, '}') ). pp(Term, Ctx, Options) :- % handle operators compound(Term), compound_name_arity(Term, Name, Arity), current_op(Prec, Type, Name), match_op(Type, Arity, Kind, Prec, Left, Right), option(operators(true), Options), !, quoted_op(Name, QName), option(output(Out), Options), context(Ctx, indent, Indent), context(Ctx, depth, Depth), context(Ctx, priority, CPrec), NDepth is Depth + 1, modify_context(Ctx, [depth=NDepth], Ctx1), dec_depth(Ctx1, Ctx2), LeftOptions = Ctx2.put(priority, Left), FuncOptions = Ctx2.put(embrace, never), RightOptions = Ctx2.put(priority, Right), ( Kind == prefix -> arg(1, Term, Arg), ( ( space_op(Name) ; need_space(Name, Arg, FuncOptions, RightOptions) ) -> Space = ' ' ; Space = '' ), ( CPrec >= Prec -> format(atom(Buf), '~w~w', [QName, Space]), atom_length(Buf, AL), NIndent is Indent + AL, write(Out, Buf), modify_context(Ctx2, [indent=NIndent, priority=Right], Ctx3), pp(Arg, Ctx3, Options) ; format(atom(Buf), '(~w~w', [QName,Space]), atom_length(Buf, AL), NIndent is Indent + AL, write(Out, Buf), modify_context(Ctx2, [indent=NIndent, priority=Right], Ctx3), pp(Arg, Ctx3, Options), format(Out, ')', []) ) ; Kind == postfix -> arg(1, Term, Arg), ( ( space_op(Name) ; need_space(Name, Arg, FuncOptions, LeftOptions) ) -> Space = ' ' ; Space = '' ), ( CPrec >= Prec -> modify_context(Ctx2, [priority=Left], Ctx3), pp(Arg, Ctx3, Options), format(Out, '~w~w', [Space,QName]) ; format(Out, '(', []), NIndent is Indent + 1, modify_context(Ctx2, [indent=NIndent, priority=Left], Ctx3), pp(Arg, Ctx3, Options), format(Out, '~w~w)', [Space,QName]) ) ; arg(1, Term, Arg1), % Infix operators arg(2, Term, Arg2), ( print_width(Term, Width, Options), option(right_margin(RM), Options), Indent + Width < RM -> ToWide = false, ( ( space_op(Name) ; need_space(Arg1, Name, LeftOptions, FuncOptions) ; need_space(Name, Arg2, FuncOptions, RightOptions) ) -> Space = ' ' ; Space = '' ) ; ToWide = true, ( ( is_solo(Name) ; space_op(Name) ) -> Space = '' ; Space = ' ' ) ), ( CPrec >= Prec -> ( ToWide == true, infix_list(Term, Name, List), List == [_,_|_] -> Pri is min(Left,Right), modify_context(Ctx2, [space=Space, priority=Pri], Ctx3), pp_infix_list(List, QName, 2, Ctx3, Options) ; modify_context(Ctx2, [priority=Left], Ctx3), pp(Arg1, Ctx3, Options), format(Out, '~w~w~w', [Space,QName,Space]), modify_context(Ctx2, [priority=Right], Ctx4), pp(Arg2, Ctx4, Options) ) ; ( ToWide == true, infix_list(Term, Name, List), List = [_,_|_] -> Pri is min(Left,Right), format(Out, '( ', []), NIndent is Indent + 2, modify_context(Ctx2, [space=Space, indent=NIndent, priority=Pri], Ctx3), pp_infix_list(List, QName, 0, Ctx3, Options), indent(Out, Indent, Options), format(Out, ')', []) ; format(Out, '(', []), NIndent is Indent + 1, modify_context(Ctx2, [indent=NIndent, priority=Left], Ctx3), pp(Arg1, Ctx3, Options), format(Out, '~w~w~w', [Space,QName,Space]), modify_context(Ctx2, [priority=Right], Ctx4), pp(Arg2, Ctx4, Options), format(Out, ')', []) ) ) ). pp(Term, Ctx, Options) :- % compound option(output(Out), Options), option(indent_arguments(IndentStyle), Options), context(Ctx, indent, Indent), ( IndentStyle == false -> pprint(Term, Ctx, Options) ; IndentStyle == auto, print_width(Term, Width, Options), option(right_margin(RM), Options), Indent + Width < RM % fits on a line, simply write -> pprint(Term, Ctx, Options) ; compound_name_arguments(Term, Name, Args), compound_indent(Out, '~q(', Name, Indent, Nindent, Options), context(Ctx, depth, Depth), NDepth is Depth + 1, modify_context(Ctx, [indent=Nindent, depth=NDepth, priority=999], NCtx0), dec_depth(NCtx0, NCtx), pp_compound_args(Args, NCtx, Options), write(Out, ')') ). compound_indent(Out, Format, Functor, Indent, Nindent, Options) :- option(indent_arguments(IndentStyle), Options), format(string(Buf2), Format, [Functor]), write(Out, Buf2), atom_length(Buf2, FunctorIndent), ( IndentStyle == auto, option(auto_indent_arguments(IndentArgs), Options), IndentArgs > 0, FunctorIndent > IndentArgs*2 -> true ; IndentArgs = IndentStyle ), ( integer(IndentArgs) -> Nindent is Indent + IndentArgs, ( FunctorIndent > IndentArgs -> indent(Out, Nindent, Options) ; true ) ; Nindent is Indent + FunctorIndent ). quoted_op(Op, Atom) :- is_solo(Op), !, Atom = Op. quoted_op(Op, Q) :- format(atom(Q), '~q', [Op]). %! infix_list(+Term, ?Op, -List) is semidet. % % True when List is a list of subterms of Term that are the result of % the nested infix operator Op. Deals both with `xfy` and `yfx` % operators. infix_list(Term, Op, List) :- phrase(infix_list(Term, Op), List). infix_list(Term, Op) --> { compound(Term), compound_name_arity(Term, Op, 2) }, ( {current_op(_Pri, xfy, Op)} -> { arg(1, Term, H), arg(2, Term, Term2) }, [H], infix_list(Term2, Op) ; {current_op(_Pri, yfx, Op)} -> { arg(1, Term, Term2), arg(2, Term, T) }, infix_list(Term2, Op), [T] ). infix_list(Term, Op) --> {atom(Op)}, % we did something before [Term]. pp_infix_list([H|T], QName, IncrIndent, Ctx, Options) => pp(H, Ctx, Options), context(Ctx, space, Space), ( T == [] -> true ; option(output(Out), Options), format(Out, '~w~w', [Space,QName]), context(Ctx, indent, Indent), NIndent is Indent+IncrIndent, indent(Out, NIndent, Options), modify_context(Ctx, [indent=NIndent], Ctx2), pp_infix_list(T, QName, 0, Ctx2, Options) ). %! pp_list_elements(+List, +Ctx, +Options) is det. % % Print the elements of a possibly open list as a vertical list. pp_list_elements(_, Ctx, Options) :- context(Ctx, max_depth, 0), !, option(output(Out), Options), write(Out, '...'). pp_list_elements([H|T], Ctx0, Options) :- dec_depth(Ctx0, Ctx), pp(H, Ctx, Options), ( T == [] -> true ; nonvar(T), T = [_|_] -> option(output(Out), Options), write(Out, ','), context(Ctx, indent, Indent), indent(Out, Indent, Options), pp_list_elements(T, Ctx, Options) ; option(output(Out), Options), context(Ctx, indent, Indent), indent(Out, Indent-2, Options), write(Out, '| '), pp(T, Ctx, Options) ). pp_compound_args([], _, _). pp_compound_args([H|T], Ctx, Options) :- pp(H, Ctx, Options), ( T == [] -> true ; T = [_|_] -> option(output(Out), Options), write(Out, ','), context(Ctx, indent, Indent), indent(Out, Indent, Options), pp_compound_args(T, Ctx, Options) ; option(output(Out), Options), context(Ctx, indent, Indent), indent(Out, Indent-2, Options), write(Out, '| '), pp(T, Ctx, Options) ). :- if(current_predicate(is_dict/1)). pp_dict_args([Name-Value|T], Ctx, Options) :- option(output(Out), Options), line_position(Out, Pos0), pp(Name, Ctx, Options), write(Out, ':'), line_position(Out, Pos1), context(Ctx, indent, Indent), Indent2 is Indent + Pos1-Pos0, modify_context(Ctx, [indent=Indent2], Ctx2), pp(Value, Ctx2, Options), ( T == [] -> true ; option(output(Out), Options), write(Out, ','), indent(Out, Indent, Options), pp_dict_args(T, Ctx, Options) ). :- endif. % match_op(+Type, +Arity, +Precedence, -LeftPrec, -RightPrec match_op(fx, 1, prefix, P, _, R) :- R is P - 1. match_op(fy, 1, prefix, P, _, P). match_op(xf, 1, postfix, P, L, _) :- L is P - 1. match_op(yf, 1, postfix, P, P, _). match_op(xfx, 2, infix, P, A, A) :- A is P - 1. match_op(xfy, 2, infix, P, L, P) :- L is P - 1. match_op(yfx, 2, infix, P, P, R) :- R is P - 1. %! indent(+Out, +Indent, +Options) % % Newline and indent to the indicated column. Respects the option % =tab_width=. Default is 8. If the tab-width equals zero, % indentation is emitted using spaces. indent(Out, Indent, Options) :- option(tab_width(TW), Options, 8), nl(Out), ( TW =:= 0 -> tab(Out, Indent) ; Tabs is Indent // TW, Spaces is Indent mod TW, forall(between(1, Tabs, _), put(Out, 9)), tab(Out, Spaces) ). %! print_width(+Term, -W, +Options) is det. % % Width required when printing `normally' left-to-right. print_width(Term, W, Options) :- option(right_margin(RM), Options), option(write_options(WOpts), Options), ( catch(write_length(Term, W, [max_length(RM)|WOpts]), error(_,_), fail) % silence uncaught exceptions from -> true % nested portray callbacks ; W = RM ). %! pprint(+Term, +Context, +Options) % % The bottom-line print-routine. pprint(Term, Ctx, Options) :- option(output(Out), Options), pprint(Out, Term, Ctx, Options). pprint(Out, Term, Ctx, Options) :- option(write_options(WriteOptions), Options), context(Ctx, max_depth, MaxDepth), ( MaxDepth == infinite -> write_term(Out, Term, WriteOptions) ; MaxDepth =< 0 -> format(Out, '...', []) ; write_term(Out, Term, [max_depth(MaxDepth)|WriteOptions]) ). /******************************* * SHARED WITH term_html.pl * *******************************/ %! is_op1(+Name, -Type, -Priority, -ArgPriority, +Options) is semidet. % % True if Name is an operator taking one argument of Type. is_op1(Name, Type, Pri, ArgPri, Options) :- operator_module(Module, Options), current_op(Pri, OpType, Module:Name), argpri(OpType, Type, Pri, ArgPri), !. argpri(fx, prefix, Pri0, Pri) :- Pri is Pri0 - 1. argpri(fy, prefix, Pri, Pri). argpri(xf, postfix, Pri0, Pri) :- Pri is Pri0 - 1. argpri(yf, postfix, Pri, Pri). %! is_op2(+Name, -LeftPri, -Pri, -RightPri, +Options) is semidet. % % True if Name is an operator taking two arguments of Type. is_op2(Name, LeftPri, Pri, RightPri, Options) :- operator_module(Module, Options), current_op(Pri, Type, Module:Name), infix_argpri(Type, LeftPri, Pri, RightPri), !. infix_argpri(xfx, ArgPri, Pri, ArgPri) :- ArgPri is Pri - 1. infix_argpri(yfx, Pri, Pri, ArgPri) :- ArgPri is Pri - 1. infix_argpri(xfy, ArgPri, Pri, Pri) :- ArgPri is Pri - 1. %! need_space(@Term1, @Term2, +LeftOptions, +RightOptions) % % True if a space is needed between Term1 and Term2 if they are % printed using the given option lists. need_space(T1, T2, _, _) :- ( is_solo(T1) ; is_solo(T2) ), !, fail. need_space(T1, T2, LeftOptions, RightOptions) :- end_code_type(T1, TypeR, LeftOptions.put(side, right)), end_code_type(T2, TypeL, RightOptions.put(side, left)), \+ no_space(TypeR, TypeL). no_space(punct, _). no_space(_, punct). no_space(quote(R), quote(L)) :- !, R \== L. no_space(alnum, symbol). no_space(symbol, alnum). %! end_code_type(+Term, -Code, Options) % % True when code is the first/last character code that is emitted % by printing Term using Options. end_code_type(_, Type, Options) :- MaxDepth = Options.max_depth, integer(MaxDepth), Options.depth >= MaxDepth, !, Type = symbol. end_code_type(Term, Type, Options) :- primitive(Term, _), !, quote_atomic(Term, S, Options), end_type(S, Type, Options). end_code_type(Dict, Type, Options) :- is_dict(Dict, Tag), !, ( Options.side == left -> end_code_type(Tag, Type, Options) ; Type = punct ). end_code_type('$VAR'(Var), Type, Options) :- Options.get(numbervars) == true, !, format(string(S), '~W', ['$VAR'(Var), [numbervars(true)]]), end_type(S, Type, Options). end_code_type(List, Type, _) :- ( List == [] ; List = [_|_] ), !, Type = punct. end_code_type(OpTerm, Type, Options) :- compound_name_arity(OpTerm, Name, 1), is_op1(Name, OpType, Pri, ArgPri, Options), \+ Options.get(ignore_ops) == true, !, ( Pri > Options.priority -> Type = punct ; op_or_arg(OpType, Options.side, OpArg), ( OpArg == op -> end_code_type(Name, Type, Options) ; arg(1, OpTerm, Arg), arg_options(Options, ArgOptions), end_code_type(Arg, Type, ArgOptions.put(priority, ArgPri)) ) ). end_code_type(OpTerm, Type, Options) :- compound_name_arity(OpTerm, Name, 2), is_op2(Name, LeftPri, Pri, _RightPri, Options), \+ Options.get(ignore_ops) == true, !, ( Pri > Options.priority -> Type = punct ; arg(1, OpTerm, Arg), arg_options(Options, ArgOptions), end_code_type(Arg, Type, ArgOptions.put(priority, LeftPri)) ). end_code_type(Compound, Type, Options) :- compound_name_arity(Compound, Name, _), end_code_type(Name, Type, Options). op_or_arg(prefix, left, op). op_or_arg(prefix, right, arg). op_or_arg(postfix, left, arg). op_or_arg(postfix, right, op). end_type(S, Type, Options) :- number(S), !, ( (S < 0 ; S == -0.0), Options.side == left -> Type = symbol ; Type = alnum ). end_type(S, Type, Options) :- Options.side == left, !, left_type(S, Type). end_type(S, Type, _) :- right_type(S, Type). left_type(S, Type), atom(S) => sub_atom(S, 0, 1, _, Start), syntax_type(Start, Type). left_type(S, Type), string(S) => sub_string(S, 0, 1, _, Start), syntax_type(Start, Type). left_type(S, Type), blob(S, _) => syntax_type("<", Type). right_type(S, Type), atom(S) => sub_atom(S, _, 1, 0, End), syntax_type(End, Type). right_type(S, Type), string(S) => sub_string(S, _, 1, 0, End), syntax_type(End, Type). right_type(S, Type), blob(S, _) => syntax_type(")", Type). syntax_type("\"", quote(double)) :- !. syntax_type("\'", quote(single)) :- !. syntax_type("\`", quote(back)) :- !. syntax_type(S, Type) :- string_code(1, S, C), ( code_type(C, prolog_identifier_continue) -> Type = alnum ; code_type(C, prolog_symbol) -> Type = symbol ; code_type(C, space) -> Type = layout ; Type = punct ). is_solo(Var) :- var(Var), !, fail. is_solo(','). is_solo(';'). is_solo('!'). %! primitive(+Term, -Class) is semidet. % % True if Term is a primitive term, rendered using the CSS % class Class. primitive(Term, Type) :- var(Term), !, Type = 'pl-avar'. primitive(Term, Type) :- atom(Term), !, Type = 'pl-atom'. primitive(Term, Type) :- blob(Term,_), !, Type = 'pl-blob'. primitive(Term, Type) :- string(Term), !, Type = 'pl-string'. primitive(Term, Type) :- integer(Term), !, Type = 'pl-int'. primitive(Term, Type) :- rational(Term), !, Type = 'pl-rational'. primitive(Term, Type) :- float(Term), !, Type = 'pl-float'. %! operator_module(-Module, +Options) is det. % % Find the module for evaluating operators. operator_module(Module, Options) :- Module = Options.get(module), !. operator_module(TypeIn, _) :- '$current_typein_module'(TypeIn). %! arg_options(+Options, -OptionsOut) is det. % % Increment depth in Options. arg_options(Options, Options.put(depth, NewDepth)) :- NewDepth is Options.depth+1. quote_atomic(Float, String, Options) :- float(Float), Format = Options.get(float_format), !, format(string(String), Format, [Float]). quote_atomic(Plain, Plain, _) :- number(Plain), !. quote_atomic(Plain, String, Options) :- Options.get(quoted) == true, !, ( Options.get(embrace) == never -> format(string(String), '~q', [Plain]) ; format(string(String), '~W', [Plain, Options]) ). quote_atomic(Var, String, Options) :- var(Var), !, format(string(String), '~W', [Var, Options]). quote_atomic(Plain, Plain, _). space_op(:-).