36
37:- module(prolog_main,
38 [ main/0,
39 argv_options/3, 40 argv_options/4, 41 argv_usage/1, 42 cli_parse_debug_options/2, 43 cli_enable_development_system/0
44 ]). 46:- autoload(library(debug)). 47:- autoload(library(threadutil)). 49:- autoload(library(apply), [maplist/3, partition/4]). 50:- autoload(library(lists), [append/3]). 51:- autoload(library(pairs), [pairs_keys/2, pairs_values/2]). 52:- autoload(library(prolog_code), [pi_head/2]). 53:- autoload(library(prolog_debug), [spy/1]). 54:- autoload(library(dcg/high_order), [sequence//3, sequence//2]). 55:- autoload(library(option), [option/2]). 56
57:- meta_predicate
58 argv_options(:, -, -),
59 argv_options(:, -, -, +),
60 argv_usage(:). 61
62:- dynamic
63 interactive/0. 64
93
94:- module_transparent
95 main/0. 96
111
112main :-
113 current_prolog_flag(break_level, _),
114 !,
115 current_prolog_flag(argv, Av),
116 context_module(M),
117 M:main(Av).
118main :-
119 context_module(M),
120 set_signals,
121 current_prolog_flag(argv, Av),
122 catch_with_backtrace(M:main(Av), Error, throw(Error)),
123 ( interactive
124 -> cli_enable_development_system
125 ; true
126 ).
127
128set_signals :-
129 on_signal(int, _, interrupt).
130
135
136interrupt(_Sig) :-
137 halt(1).
138
139 142
228
229argv_options(M:Argv, Positional, Options) :-
230 in(M:opt_type(_,_,_)),
231 !,
232 argv_options(M:Argv, Positional, Options, [on_error(halt(1))]).
233argv_options(_:Argv, Positional, Options) :-
234 argv_untyped_options(Argv, Positional, Options).
235
250
251argv_options(Argv, Positional, Options, POptions) :-
252 option(on_error(halt(Code)), POptions),
253 !,
254 E = error(_,_),
255 catch(opt_parse(Argv, Positional, Options, POptions), E,
256 ( print_message(error, E),
257 halt(Code)
258 )).
259argv_options(Argv, Positional, Options, POptions) :-
260 opt_parse(Argv, Positional, Options, POptions).
261
269
270argv_untyped_options([], Pos, Opts) =>
271 Pos = [], Opts = [].
272argv_untyped_options([--|R], Pos, Ops) =>
273 Pos = R, Ops = [].
274argv_untyped_options([H0|T0], R, Ops), sub_atom(H0, 0, _, _, --) =>
275 Ops = [H|T],
276 ( sub_atom(H0, B, _, A, =)
277 -> B2 is B-2,
278 sub_atom(H0, 2, B2, _, Name),
279 sub_string(H0, _, A, 0, Value0),
280 convert_option(Name, Value0, Value)
281 ; sub_atom(H0, 2, _, 0, Name0),
282 ( sub_atom(Name0, 0, _, _, 'no-')
283 -> sub_atom(Name0, 3, _, 0, Name),
284 Value = false
285 ; Name = Name0,
286 Value = true
287 )
288 ),
289 canonical_name(Name, PlName),
290 H =.. [PlName,Value],
291 argv_untyped_options(T0, R, T).
292argv_untyped_options([H|T0], Ops, T) =>
293 Ops = [H|R],
294 argv_untyped_options(T0, R, T).
295
296convert_option(password, String, String) :- !.
297convert_option(_, String, Number) :-
298 number_string(Number, String),
299 !.
300convert_option(_, String, Atom) :-
301 atom_string(Atom, String).
302
303canonical_name(Name, PlName) :-
304 split_string(Name, "-_", "", Parts),
305 atomic_list_concat(Parts, '_', PlName).
306
316
317opt_parse(M:Argv, _Positional, _Options, _POptions) :-
318 opt_needs_help(M:Argv),
319 !,
320 argv_usage(M:debug),
321 halt(0).
322opt_parse(M:Argv, Positional, Options, POptions) :-
323 opt_parse(Argv, Positional, Options, M, POptions).
324
325opt_needs_help(M:[Arg]) :-
326 in(M:opt_type(_, help, boolean)),
327 !,
328 in(M:opt_type(Opt, help, boolean)),
329 ( short_opt(Opt)
330 -> atom_concat(-, Opt, Arg)
331 ; atom_concat(--, Opt, Arg)
332 ),
333 !.
334opt_needs_help(_:['-h']).
335opt_needs_help(_:['-?']).
336opt_needs_help(_:['--help']).
337
338opt_parse([], Positional, Options, _, _) =>
339 Positional = [],
340 Options = [].
341opt_parse([--|T], Positional, Options, _, _) =>
342 Positional = T,
343 Options = [].
344opt_parse([H|T], Positional, Options, M, POptions), atom_concat(--, Long, H) =>
345 take_long(Long, T, Positional, Options, M, POptions).
346opt_parse([H|T], Positional, Options, M, POptions),
347 H \== '-',
348 string_concat(-, Opts, H) =>
349 string_chars(Opts, Shorts),
350 take_shorts(Shorts, T, Positional, Options, M, POptions).
351opt_parse(Argv, Positional, Options, _M, POptions),
352 option(options_after_arguments(false), POptions) =>
353 Positional = Argv,
354 Options = [].
355opt_parse([H|T], Positional, Options, M, POptions) =>
356 Positional = [H|PT],
357 opt_parse(T, PT, Options, M, POptions).
358
359
360take_long(Long, T, Positional, Options, M, POptions) :- 361 sub_atom(Long, B, _, A, =),
362 !,
363 sub_atom(Long, 0, B, _, LName0),
364 sub_atom(Long, _, A, 0, VAtom),
365 canonical_name(LName0, LName),
366 ( in(M:opt_type(LName, Name, Type))
367 -> opt_value(Type, Long, VAtom, Value),
368 Opt =.. [Name,Value],
369 Options = [Opt|OptionsT],
370 opt_parse(T, Positional, OptionsT, M, POptions)
371 ; opt_error(unknown_option(M:LName0))
372 ).
373take_long(LName0, T, Positional, Options, M, POptions) :- 374 canonical_name(LName0, LName),
375 take_long_(LName, T, Positional, Options, M, POptions).
376
377take_long_(Long, T, Positional, Options, M, POptions) :- 378 opt_bool_type(Long, Name, Value, M),
379 !,
380 Opt =.. [Name,Value],
381 Options = [Opt|OptionsT],
382 opt_parse(T, Positional, OptionsT, M, POptions).
383take_long_(Long, T, Positional, Options, M, POptions) :- 384 ( atom_concat('no_', LName, Long)
385 ; atom_concat('no', LName, Long)
386 ),
387 opt_bool_type(LName, Name, Value0, M),
388 !,
389 negate(Value0, Value),
390 Opt =.. [Name,Value],
391 Options = [Opt|OptionsT],
392 opt_parse(T, Positional, OptionsT, M, POptions).
393take_long_(Long, T, Positional, Options, M, POptions) :- 394 in(M:opt_type(Long, Name, Type)),
395 !,
396 ( T = [VAtom|T1]
397 -> opt_value(Type, Long, VAtom, Value),
398 Opt =.. [Name,Value],
399 Options = [Opt|OptionsT],
400 opt_parse(T1, Positional, OptionsT, M, POptions)
401 ; opt_error(missing_value(Long, Type))
402 ).
403take_long_(Long, _, _, _, M, _) :-
404 opt_error(unknown_option(M:Long)).
405
406take_shorts([], T, Positional, Options, M, POptions) :-
407 opt_parse(T, Positional, Options, M, POptions).
408take_shorts([H|T], Argv, Positional, Options, M, POptions) :-
409 opt_bool_type(H, Name, Value, M),
410 !,
411 Opt =.. [Name,Value],
412 Options = [Opt|OptionsT],
413 take_shorts(T, Argv, Positional, OptionsT, M, POptions).
414take_shorts([H|T], Argv, Positional, Options, M, POptions) :-
415 in(M:opt_type(H, Name, Type)),
416 !,
417 ( T == []
418 -> ( Argv = [VAtom|ArgvT]
419 -> opt_value(Type, H, VAtom, Value),
420 Opt =.. [Name,Value],
421 Options = [Opt|OptionsT],
422 take_shorts(T, ArgvT, Positional, OptionsT, M, POptions)
423 ; opt_error(missing_value(H, Type))
424 )
425 ; atom_chars(VAtom, T),
426 opt_value(Type, H, VAtom, Value),
427 Opt =.. [Name,Value],
428 Options = [Opt|OptionsT],
429 take_shorts([], Argv, Positional, OptionsT, M, POptions)
430 ).
431take_shorts([H|_], _, _, _, M, _) :-
432 opt_error(unknown_option(M:H)).
433
434opt_bool_type(Opt, Name, Value, M) :-
435 in(M:opt_type(Opt, Name, Type)),
436 ( Type == boolean
437 -> Value = true
438 ; Type = boolean(Value)
439 ).
440
441negate(true, false).
442negate(false, true).
443
447
448opt_value(Type, _Opt, VAtom, Value) :-
449 opt_convert(Type, VAtom, Value),
450 !.
451opt_value(Type, Opt, VAtom, _) :-
452 opt_error(value_type(Opt, Type, VAtom)).
453
455
456opt_convert(A|B, Spec, Value) :-
457 ( opt_convert(A, Spec, Value)
458 -> true
459 ; opt_convert(B, Spec, Value)
460 ).
461opt_convert(boolean, Spec, Value) :-
462 to_bool(Spec, Value).
463opt_convert(boolean(_), Spec, Value) :-
464 to_bool(Spec, Value).
465opt_convert(number, Spec, Value) :-
466 atom_number(Spec, Value).
467opt_convert(integer, Spec, Value) :-
468 atom_number(Spec, Value),
469 integer(Value).
470opt_convert(float, Spec, Value) :-
471 atom_number(Spec, Value0),
472 Value is float(Value0).
473opt_convert(nonneg, Spec, Value) :-
474 atom_number(Spec, Value),
475 integer(Value),
476 Value >= 0.
477opt_convert(natural, Spec, Value) :-
478 atom_number(Spec, Value),
479 integer(Value),
480 Value >= 1.
481opt_convert(between(Low, High), Spec, Value) :-
482 atom_number(Spec, Value0),
483 ( ( float(Low) ; float(High) )
484 -> Value is float(Value0)
485 ; integer(Value0),
486 Value = Value0
487 ),
488 Value >= Low, Value =< High.
489opt_convert(atom, Value, Value).
490opt_convert(oneof(List), Value, Value) :-
491 memberchk(Value, List).
492opt_convert(string, Value0, Value) :-
493 atom_string(Value0, Value).
494opt_convert(file, Spec, Value) :-
495 prolog_to_os_filename(Value, Spec).
496opt_convert(file(Access), Spec, Value) :-
497 ( Spec == '-'
498 -> Value = '-'
499 ; prolog_to_os_filename(Value, Spec),
500 ( access_file(Value, Access)
501 -> true
502 ; opt_error(access_file(Spec, Access))
503 )
504 ).
505opt_convert(term, Spec, Value) :-
506 term_string(Value, Spec, []).
507opt_convert(term(Options), Spec, Value) :-
508 term_string(Term, Spec, Options),
509 ( option(variable_names(Bindings), Options)
510 -> Value = Term-Bindings
511 ; Value = Term
512 ).
513
514to_bool(true, true).
515to_bool('True', true).
516to_bool('TRUE', true).
517to_bool(on, true).
518to_bool('On', true).
519to_bool('1', true).
520to_bool(false, false).
521to_bool('False', false).
522to_bool('FALSE', false).
523to_bool(off, false).
524to_bool('Off', false).
525to_bool('0', false).
526
553
554argv_usage(M:Level) :-
555 print_message(Level, opt_usage(M)).
556
557:- multifile
558 prolog:message//1. 559
560prolog:message(opt_usage(M)) -->
561 usage(M).
562
563usage(M) -->
564 usage_text(M:header),
565 usage_line(M),
566 usage_options(M),
567 usage_text(M:footer).
568
573
574usage_text(M:Which) -->
575 { in(M:opt_help(help(Which), Help))
576 },
577 !,
578 ( {Which == header}
579 -> user_text(M:Help), [nl]
580 ; [nl], user_text(M:Help)
581 ).
582usage_text(_) -->
583 [].
584
585user_text(M:Entries) -->
586 { is_list(Entries) },
587 sequence(help_elem(M), Entries).
588user_text(_:Help) -->
589 [ '~w'-[Help] ].
590
591help_elem(M, \Callable) -->
592 { callable(Callable) },
593 call(M:Callable),
594 !.
595help_elem(_M, Elem) -->
596 [ Elem ].
597
598usage_line(M) -->
599 [ ansi(comment, 'Usage: ', []) ],
600 cmdline(M),
601 ( {in(M:opt_help(help(usage), Help))}
602 -> user_text(M:Help)
603 ; [ ' [options]'-[] ]
604 ),
605 [ nl, nl ].
606
607cmdline(_M) -->
608 { current_prolog_flag(associated_file, AbsFile),
609 file_base_name(AbsFile, Base),
610 current_prolog_flag(os_argv, Argv),
611 append(Pre, [File|_], Argv),
612 file_base_name(File, Base),
613 append(Pre, [File], Cmd),
614 !
615 },
616 sequence(cmdarg, [' '-[]], Cmd).
617cmdline(_M) -->
618 { current_prolog_flag(saved_program, true),
619 current_prolog_flag(os_argv, OsArgv),
620 append(_, ['-x', State|_], OsArgv),
621 !
622 },
623 cmdarg(State).
624cmdline(_M) -->
625 { current_prolog_flag(os_argv, [Argv0|_])
626 },
627 cmdarg(Argv0).
628
629cmdarg(A) -->
630 [ '~w'-[A] ].
631
637
638usage_options(M) -->
639 { findall(Opt, get_option(M, Opt), Opts),
640 maplist(options_width, Opts, OptWidths),
641 max_list(OptWidths, MaxOptWidth),
642 catch(tty_size(_, Width), _, Width = 80),
643 OptColW is min(MaxOptWidth, 30),
644 HelpColW is Width-4-OptColW
645 },
646 [ ansi(comment, 'Options:', []), nl ],
647 sequence(opt_usage(OptColW, HelpColW), [nl], Opts).
648
649opt_usage(OptColW, HelpColW, opt(_Name, Type, Short, Long, Help, Meta)) -->
650 options(Type, Short, Long, Meta),
651 [ '~t~*:| '-[OptColW] ],
652 help_text(Help, OptColW, HelpColW).
653
654help_text([First|Lines], Indent, _Width) -->
655 !,
656 [ '~w'-[First], nl ],
657 sequence(rest_line(Indent), [nl], Lines).
658help_text(Text, _Indent, Width) -->
659 { string_length(Text, Len),
660 Len =< Width
661 },
662 !,
663 [ '~w'-[Text] ].
664help_text(Text, Indent, Width) -->
665 { wrap_text(Width, Text, [First|Lines])
666 },
667 [ '~w'-[First], nl ],
668 sequence(rest_line(Indent), [nl], Lines).
669
670rest_line(Indent, Line) -->
671 [ '~t~*| ~w'-[Indent, Line] ].
672
678
679wrap_text(Width, Text, Wrapped) :-
680 split_string(Text, " \t\n", " \t\n", Words),
681 wrap_lines(Words, Width, Wrapped).
682
683wrap_lines([], _, []).
684wrap_lines([H|T0], Width, [Line|Lines]) :-
685 !,
686 string_length(H, Len),
687 take_line(T0, T1, Width, Len, LineWords),
688 atomics_to_string([H|LineWords], " ", Line),
689 wrap_lines(T1, Width, Lines).
690
691take_line([H|T0], T, Width, Here, [H|Line]) :-
692 string_length(H, Len),
693 NewHere is Here+Len+1,
694 NewHere =< Width,
695 !,
696 take_line(T0, T, Width, NewHere, Line).
697take_line(T, T, _, _, []).
698
702
703options(Type, ShortOpt, LongOpts, Meta) -->
704 { append(ShortOpt, LongOpts, Opts) },
705 sequence(option(Type, Meta), [', '-[]], Opts).
706
707option(boolean, _, Opt) -->
708 opt(Opt).
709option(_, Meta, Opt) -->
710 opt(Opt),
711 ( { short_opt(Opt) }
712 -> [ ' '-[] ]
713 ; [ '='-[] ]
714 ),
715 [ ansi(var, '~w', [Meta]) ].
716
720
721options_width(opt(_Name, boolean, Short, Long, _Help, _Meta), W) =>
722 length(Short, SCount),
723 length(Long, LCount),
724 maplist(atom_length, Long, LLens),
725 sum_list(LLens, LLen),
726 W is ((SCount+LCount)-1)*2 + 727 SCount*2 +
728 LCount*2 + LLen.
729options_width(opt(_Name, _Type, Short, Long, _Help, Meta), W) =>
730 length(Short, SCount),
731 length(Long, LCount),
732 atom_length(Meta, MLen),
733 maplist(atom_length, Long, LLens),
734 sum_list(LLens, LLen),
735 W is ((SCount+LCount)-1)*2 + 736 SCount*3 + SCount*MLen +
737 LCount*3 + LLen + LCount*MLen.
738
744
745get_option(M, opt(help, boolean, [h,?], [help],
746 Help, -)) :-
747 \+ in(M:opt_type(_, help, boolean)), 748 ( in(M:opt_help(help, Help))
749 -> true
750 ; Help = "Show this help message and exit"
751 ).
752get_option(M, opt(Name, Type, Short, Long, Help, Meta)) :-
753 findall(Name, in(M:opt_type(_, Name, _)), Names),
754 list_to_set(Names, UNames),
755 member(Name, UNames),
756 findall(Opt-Type,
757 in(M:opt_type(Opt, Name, Type)),
758 Pairs),
759 option_type(Name, Pairs, TypeT),
760 functor(TypeT, Type, _),
761 pairs_keys(Pairs, Opts),
762 partition(short_opt, Opts, Short, Long),
763 ( in(M:opt_help(Name, Help))
764 -> true
765 ; Help = ''
766 ),
767 ( in(M:opt_meta(Name, Meta))
768 -> true
769 ; upcase_atom(Type, Meta)
770 ).
771
772option_type(Name, Pairs, Type) :-
773 pairs_values(Pairs, Types),
774 sort(Types, [Type|UTypes]),
775 ( UTypes = []
776 -> true
777 ; print_message(warning,
778 error(opt_error(multiple_types(Name, [Type|UTypes])),_))
779 ).
780
785
786in(Goal) :-
787 pi_head(PI, Goal),
788 current_predicate(PI),
789 call(Goal).
790
791short_opt(Opt) :-
792 atom_length(Opt, 1).
793
794 797
801
802opt_error(Error) :-
803 throw(error(opt_error(Error), _)).
804
805:- multifile
806 prolog:error_message//1. 807
808prolog:error_message(opt_error(Error)) -->
809 opt_error(Error).
810
811opt_error(unknown_option(M:Opt)) -->
812 [ 'Unknown option: '-[] ],
813 opt(Opt),
814 hint_help(M).
815opt_error(missing_value(Opt, Type)) -->
816 [ 'Option '-[] ],
817 opt(Opt),
818 [ ' requires an argument (of type ~p)'-[Type] ].
819opt_error(value_type(Opt, Type, Found)) -->
820 [ 'Option '-[] ],
821 opt(Opt), [' requires'],
822 type(Type),
823 [ ' (found '-[], ansi(code, '~w', [Found]), ')'-[] ].
824opt_error(access_file(File, exist)) -->
825 [ 'File '-[], ansi(code, '~w', [File]),
826 ' does not exist'-[]
827 ].
828opt_error(access_file(File, Access)) -->
829 { access_verb(Access, Verb) },
830 [ 'Cannot access file '-[], ansi(code, '~w', [File]),
831 ' for '-[], ansi(code, '~w', [Verb])
832 ].
833
834access_verb(read, reading).
835access_verb(write, writing).
836access_verb(append, writing).
837access_verb(execute, executing).
838
839hint_help(M) -->
840 { in(M:opt_type(Opt, help, boolean)) },
841 !,
842 [ ' (' ], opt(Opt), [' for help)'].
843hint_help(_) -->
844 [ ' (-h for help)'-[] ].
845
846opt(Opt) -->
847 { short_opt(Opt) },
848 !,
849 [ ansi(bold, '-~w', [Opt]) ].
850opt(Opt) -->
851 [ ansi(bold, '--~w', [Opt]) ].
852
853type(A|B) -->
854 type(A), [' or'],
855 type(B).
856type(oneof([One])) -->
857 !,
858 [ ' ' ],
859 atom(One).
860type(oneof(List)) -->
861 !,
862 [ ' one of '-[] ],
863 sequence(atom, [', '], List).
864type(between(Low, High)) -->
865 !,
866 [ ' a number '-[],
867 ansi(code, '~w', [Low]), '..', ansi(code, '~w', [High])
868 ].
869type(nonneg) -->
870 [ ' a non-negative integer'-[] ].
871type(natural) -->
872 [ ' a positive integer (>= 1)'-[] ].
873type(file(Access)) -->
874 [ ' a file with ~w access'-[Access] ].
875type(Type) -->
876 [ ' an argument of type '-[], ansi(code, '~w', [Type]) ].
877
878atom(A) -->
879 [ ansi(code, '~w', [A]) ].
880
881
882 885
901
902cli_parse_debug_options([], []).
903cli_parse_debug_options([H|T0], Opts) :-
904 debug_option(H),
905 !,
906 cli_parse_debug_options(T0, Opts).
907cli_parse_debug_options([H|T0], [H|T]) :-
908 cli_parse_debug_options(T0, T).
909
910debug_option(interactive(true)) :-
911 asserta(interactive).
912debug_option(debug(TopicS)) :-
913 term_string(Topic, TopicS),
914 debug(Topic).
915debug_option(spy(Atom)) :-
916 atom_pi(Atom, PI),
917 spy(PI).
918debug_option(gspy(Atom)) :-
919 atom_pi(Atom, PI),
920 tspy(PI).
921
922atom_pi(Atom, Module:PI) :-
923 split(Atom, :, Module, PiAtom),
924 !,
925 atom_pi(PiAtom, PI).
926atom_pi(Atom, Name//Arity) :-
927 split(Atom, //, Name, Arity),
928 !.
929atom_pi(Atom, Name/Arity) :-
930 split(Atom, /, Name, Arity),
931 !.
932atom_pi(Atom, _) :-
933 format(user_error, 'Invalid predicate indicator: "~w"~n', [Atom]),
934 halt(1).
935
936split(Atom, Sep, Before, After) :-
937 sub_atom(Atom, BL, _, AL, Sep),
938 !,
939 sub_atom(Atom, 0, BL, _, Before),
940 sub_atom(Atom, _, AL, 0, AfterAtom),
941 ( atom_number(AfterAtom, After)
942 -> true
943 ; After = AfterAtom
944 ).
945
946
956
957cli_enable_development_system :-
958 on_signal(int, _, debug),
959 set_prolog_flag(xpce_threaded, true),
960 set_prolog_flag(message_ide, true),
961 ( current_prolog_flag(xpce_version, _)
962 -> use_module(library(pce_dispatch)),
963 memberchk(Goal, [pce_dispatch([])]),
964 call(Goal)
965 ; true
966 ),
967 set_prolog_flag(toplevel_goal, prolog).
968
969
970 973
974:- multifile
975 prolog:called_by/2. 976
977prolog:called_by(main, [main(_)]).
978prolog:called_by(argv_options(_,_,_),
979 [ opt_type(_,_,_),
980 opt_help(_,_),
981 opt_meta(_,_)
982 ])