1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2% Bousi-Prolog command-line shell 3 4:- module(bplShell, [ 5 start_bpl_shell/0 % 6 ]). 7 8:- use_module(bplHelp). 9:- use_module(translator). 10:- use_module(evaluator). 11:- use_module(flags). 12:- use_module(foreign). 13:- use_module(utilities). 14 15:- use_module(library(lists)). 16:- use_module(library(system)). 17 18%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 19% Setting Prolog system flags 20%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 21 22:- set_prolog_flag(double_quotes, codes). 23 24 25 26%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 27% Command-line shell 28%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
37start_bpl_shell :-
38% load_history,
39 set_system_predicates,
40 flags:reset_bpl_flags,
41 evaluator:load_tpl(''),
42 bpl_shell_loop.
53bpl_shell_loop :-
54 repeat,
55 bpl_shell,
56 !.
69bpl_shell :-
70 bpl_prompt(Prompt),
71 read_shell_line(Prompt, String, Arguments),
72 non_void_input(String),
73 catch((
74 % Converts the read line into an executable term
75 translate_command(String, Arguments, Command),
76 % Executes the command or query
77 Command,
78 (Command \== true -> nl ; true)
79 % (catcher)
80 ), Error, (
81 ( Error = translate_error(ErrorMessage), !,
82 % Invalid command or query
83 writeln(ErrorMessage), nl
84 ;
85 % Exception thrown by SWI-Prolog
86 print_message(error, Error), nl
87 )
88 )),
89 % This forced fail makes Prolog to go back to the repeat/0
90 % predicate of bpl_shell_loop/0, thus repeating this predicate
91 % again without nesting calls
92 !,
93 flags:get_bpl_flag(continue('no')).
104non_void_input('') :- 105 !, 106 nl, 107 fail. 108non_void_input(_). 109 110 111 112%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 113% Predicates for reading and translating Bousi-Prolog commands 114%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
125read_shell_line(Prompt, String, Arguments) :- 126 pl_read_shell_line(Prompt, String, ArgumentsWithQuotes), 127% foreign:ext_read_shell_line(Prompt, String, ArgumentsWithQuotes), 128 utilities:remove_quotes(ArgumentsWithQuotes, Arguments). 129 130pl_read_shell_line(Prompt, String, ArgumentsWithQuotes) :- 131 flush_output, 132 write(Prompt), 133 flush_output, 134 current_input(In), 135 read_line_to_codes(In, StringCodes), 136 flush_output, 137 atom_codes(String, StringCodes), 138 split_string(StringCodes, " ()", " ()", StrArgumentsWithQuotes), 139 maplist([Cs, As] >> atom_codes(As, Cs), StrArgumentsWithQuotes, ArgumentsWithQuotes).
153translate_command(_String, [], true). 154 % String contains an empty command 155 156translate_command(_String, Arguments, Command) :- 157 % Checks if string contains a Bousi-Prolog shell command 158 phrase(command(Command), Arguments). 159 160translate_command(String, Arguments, Command) :- 161 % Checks if string contains the special solve command 162 Arguments = [sv|_], 163 % Extracts query from string and parses it 164 sub_atom(String, CommandStart, _, _, 'sv'), 165 QueryStart is CommandStart + 2, 166 sub_atom(String, QueryStart, _, 0, QueryString), 167 translator:translate_query(QueryString, Query, Bindings, Degree), 168 Command = sv(Query, Bindings, Degree). 169 170translate_command(_String, Arguments, _Command) :- 171 % Checks if string contains an invalid Bousi-Prolog shell command 172 Arguments = [Name|_], 173 command_arguments(Name, _, _), 174 throw(translate_error('Wrong number of arguments.')). 175 176translate_command(_String, Arguments, _Command) :- 177 % Checks if string contains the solve command with an invalid query 178 Arguments = [sv|_], 179 throw(translate_error('Syntax error in query.')). 180 181translate_command(String, _Arguments, Command) :- 182 % Checks if string contains a query 183 translator:translate_query(String, Query, Bindings, Degree), 184 Command = sv(Query, Bindings, Degree). 185 186translate_command(_String, _Arguments, _Command) :- 187 % String contains an unknown command or bad query 188 throw(translate_error('Syntax error in command or query.')). 189 190 191 192%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 193% DCG (Definite Clause Grammar) rules for parsing shell commands 194%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
For example, 'qt' is translated into 'qt'; 'hp pwd' is returned
as 'hp(pwd)
'; and 'ld -f test' is translated into 'ld(test,
[f])
'.
208command(Command) --> 209 % Command with no arguments 210 [Name], 211 { 212 command_arguments(Name, 0, no), 213 Command =.. [Name] 214 }. 215 216command(Command) --> 217 % Command with a list of options and one or more arguments 218 [Name], option_lists(Options), arguments(Args), 219 { 220 length(Args, ArgsCount), 221 command_arguments(Name, ArgsCount, yes), 222 append(Args, [Options], ArgsAndOptions), 223 Command =.. [Name|ArgsAndOptions] 224 }. 225 226command(Command) --> 227 % Command with one or more arguments 228 [Name], arguments(Args), 229 { 230 length(Args, NumberArgs), 231 command_arguments(Name, NumberArgs, no), 232 Command =.. [Name|Args] 233 }.
243option_lists(OptionList) --> 244 [Options], 245 { 246 % Checks that Options starts with '-' and 247 % gets characters of option list 248 atom_chars(Options, Chars), Chars = ['-'|OptionChars] 249 }, 250 option_lists(MoreOptions), 251 { 252 % Merges option lists 253 append(OptionChars, MoreOptions, OptionList) 254 }. 255 256option_lists([]) --> 257 % No more option lists 258 [].
267arguments(ArgList) --> 268 [Arg], arguments(MoreArgs), 269 { 270 ArgList = [Arg|MoreArgs] 271 }. 272 273arguments([]) --> 274 []. 275 276 277 278%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 279% Predicates for loading program files 280%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
300load_file(Filename, OverwriteTPL, ResetFlags) :- 301 % Backups the system flags so they can be restored if loading fails 302 flags:backup_bpl_flags, 303 % Gets the default BPL and TPL filenames 304 get_bpl_tpl_tpls_filenames(Filename, Directory, _BaseFilename, 305 BPLFilename, TPLFilename, TPLSFilename), 306 concat_atom([Directory, '/', BPLFilename], FullBPLFilename), 307 concat_atom([Directory, '/', TPLFilename], FullTPLFilename), 308 concat_atom([Directory, '/', TPLSFilename], FullTPLSFilename), 309 % Calls the internal predicate 310 load_file(BPLFilename, TPLFilename, 311 FullBPLFilename, FullTPLFilename, FullTPLSFilename, 312 OverwriteTPL, ResetFlags). 313 314load_file(BPLFilename, TPLFilename, 315 FullBPLFilename, FullTPLFilename, FullTPLSFilename, 316 _OverwriteTPL, ResetFlags) :- 317 exists_file(FullBPLFilename), 318 not(exists_file(FullTPLFilename)), 319 % BPL file exists but TPL doesn't, so BPL file must be translated 320 load_bpl(BPLFilename, TPLFilename, 321 FullBPLFilename, FullTPLFilename, FullTPLSFilename, 322 ResetFlags). 323 324load_file(BPLFilename, TPLFilename, 325 FullBPLFilename, FullTPLFilename, FullTPLSFilename, 326 yes, ResetFlags) :- 327 exists_file(FullBPLFilename), 328 exists_file(FullTPLFilename), 329 % BPL and TPL files exist, but TPL file must be overwritten 330 delete_file(FullTPLFilename), 331 writef('\'%w\' exists and will be overwritten.\n', [TPLFilename]), 332 load_file(BPLFilename, TPLFilename, 333 FullBPLFilename, FullTPLFilename, FullTPLSFilename, 334 no, ResetFlags). 335 336load_file(BPLFilename, TPLFilename, 337 FullBPLFilename, FullTPLFilename, FullTPLSFilename, 338 no, ResetFlags) :- 339 exists_file(FullBPLFilename), 340 exists_file(FullTPLFilename), 341 % BPL and TPL files exist, and TPL can be loaded if it's newer than BPL 342 (utilities:file_is_newer(FullTPLFilename, FullBPLFilename) -> 343 % TPL file is newer, so it might be loaded without recompiling 344 (safe_tpl(FullTPLSFilename) -> 345 % TPL file is safe to be loaded without recompiling (flags match) 346 writef('\'%w\' already exists and is being loaded...\n', [TPLFilename]), 347 load_tpl(FullBPLFilename, FullTPLFilename, ResetFlags) 348 ; 349 % TPL file is not safe and must be overwritten 350 delete_file(FullTPLFilename), 351 writef('\'%w\' must be reloaded.\n', [TPLFilename]), 352 load_bpl(BPLFilename, TPLFilename, 353 FullBPLFilename, FullTPLFilename, FullTPLSFilename, 354 ResetFlags) 355 ) 356 ; 357 % TPL file is older and must be overwritten 358 delete_file(FullTPLFilename), 359 writef('\'%w\' is older and will be overwritten.\n', [TPLFilename]), 360 load_bpl(BPLFilename, TPLFilename, 361 FullBPLFilename, FullTPLFilename, FullTPLSFilename, 362 ResetFlags) 363 ). 364 365load_file(BPLFilename, TPLFilename, 366 FullBPLFilename, FullTPLFilename, _FullTPLSFilename, 367 _OverwriteTPL, ResetFlags) :- 368 not(exists_file(FullBPLFilename)), 369 exists_file(FullTPLFilename), 370 % TPL file exists but BPL doesn't, so TPL file must be loaded 371 % (a warning is shown because the original file doesn't exist) 372 writef('WARNING: \'%w\' does not exist.\n', [BPLFilename]), 373 writef('\'%w\' already exists and is being loaded...\n', [TPLFilename]), 374 load_tpl(FullBPLFilename, FullTPLFilename, ResetFlags). 375 376load_file(BPLFilename, _TPLFilename, 377 FullBPLFilename, FullTPLFilename, _FullTPLSFilename, _OverwriteTPL, _ResetFlags) :- 378 not(exists_file(FullBPLFilename)), 379 not(exists_file(FullTPLFilename)), 380 % None of BPL and TPL files exist 381 writef('ERROR: \'%w\' does not exist.\n', [BPLFilename]).
Parses and translates a BPL source-code file, converts it into an intermediate TPL file, and then loads the latter file.
391load_bpl(BPLFilename, TPLFilename, 392 FullBPLFilename, FullTPLFilename, FullTPLSFilename, ResetFlags) :- 393 (ResetFlags==yes -> flags:reset_bpl_flags; true), 394 retractall(evaluator:sim(_, _, _)), % WARNING: If translate_program fails, previous sim is lost 395 retractall(evaluator:sim(_, _, _, _)), 396 writef('Parsing and translating \'%w\'...\n', [BPLFilename]), 397 translator:translate_program(FullBPLFilename, '', FullTPLFilename, FullTPLSFilename), 398 writef('\'%w\' is being loaded...\n', [TPLFilename]), 399 load_tpl(FullBPLFilename, FullTPLFilename, ResetFlags). 400 401load_bpl(_BPLFilename, _TPLFilename, 402 _FullBPLFilename, _FullTPLFilename, _FullTPLSFilename, _ResetFlags) :- 403 % This is only executed if translate_program/3 fails 404 flags:restore_bpl_flags, 405 write('Program not loaded.\n').
414load_tpl(FullBPLFilename, FullTPLFilename, ResetFlags) :- 415 (ResetFlags==yes -> flags:reset_bpl_flags; true), 416 evaluator:load_tpl(FullTPLFilename), 417 set_files_loaded(FullBPLFilename, ''), 418 flags:get_bpl_flag(program_prefix(ProgramPrefix)), 419 set_program_predicates(ProgramPrefix), 420 write('Program loaded!\n'). 421 422load_tpl(_FullBPLFilename, _FullTPLFilename, _ResetFlags) :- 423 % This is only executed if evaluator:load_tpl/1 fails 424 flags:restore_bpl_flags, 425 write('Program not loaded.\n').
436safe_tpl(FullTPLSFilename) :- 437 exists_file(FullTPLSFilename), 438 evaluator:current_file(OldTPLFile), 439 (OldTPLFile \== '' -> 440 concat_atom([OldTPLFile,'s'],OldTPLSFile), 441 unload_file(OldTPLSFile) 442 ; 443 true 444 ), 445 consult(FullTPLSFilename), 446 tpl_flags(Flags), 447 flags:get_bpl_flag(lambda_cut(LambdaValue)), 448 memberchk(lambda_cut(LambdaValue),Flags), 449 flags:get_bpl_flag(filtering(Filtering)), 450 memberchk(filtering(Filtering),Flags). 451 452 453 454 455%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 456% Predicates for loading ontology files 457%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
479load_ontology(Filename, OverwriteTPL, ResetFlags) :- 480 % Checks that a programs has been loaded before 481 last_program_loaded(ProgramPath, _OntologyPath), 482 ProgramPath \== '', 483 % Backups the system flags so they can be restored if loading fails 484 flags:backup_bpl_flags, 485 % Gets the default BPL, TPL and ONT filenames 486 get_bpl_tpl_tpls_filenames(ProgramPath, Directory, BaseFilename, 487 BPLFilename, _UnusedTPLFilename, _UnusedTPLSFilename), 488 get_ont_filename(Filename, ONTDirectory, BaseONTFilename, ONTFilename), 489 get_ontology_tpl_tpls_filename(BaseFilename, BaseONTFilename, TPLFilename, TPLSFilename), 490 concat_atom([Directory, '/', BPLFilename], FullBPLFilename), 491 concat_atom([ONTDirectory, '/', ONTFilename], FullONTFilename), 492 concat_atom([Directory, '/', TPLFilename], FullTPLFilename), 493 concat_atom([Directory, '/', TPLSFilename], FullTPLSFilename), 494 % Calls the internal predicate 495 load_ontology(BPLFilename, ONTFilename, TPLFilename, 496 FullBPLFilename, FullONTFilename, 497 FullTPLFilename, FullTPLSFilename, 498 OverwriteTPL, ResetFlags). 499 500load_ontology(_Filename, _OverwriteTPL, _ResetFlags) :- 501 last_program_loaded('', _), 502 write('ERROR: A program must be loaded before loading an ontology.\n'). 503 504load_ontology(BPLFilename, ONTFilename, TPLFilename, 505 FullBPLFilename, FullONTFilename, FullTPLFilename, FullTPLSFilename, 506 _OverwriteTPL, ResetFlags) :- 507 exists_file(FullBPLFilename), 508 exists_file(FullONTFilename), 509 not(exists_file(FullTPLFilename)), 510 % BPL and ontology files exist but TPL doesn't, so BPL + ontology must 511 % be translated 512 load_bpl_with_ontology(BPLFilename, ONTFilename, TPLFilename, 513 FullBPLFilename, FullONTFilename, FullTPLFilename, FullTPLSFilename, ResetFlags). 514 515load_ontology(BPLFilename, ONTFilename, TPLFilename, 516 FullBPLFilename, FullONTFilename, FullTPLFilename, FullTPLSFilename, 517 yes, ResetFlags) :- 518 exists_file(FullBPLFilename), 519 exists_file(FullONTFilename), 520 exists_file(FullTPLFilename), 521 % BPL, TPL and ontology files exist, but TPL file must be overwritten 522 delete_file(FullTPLFilename), 523 writef('\'%w\' exists and will be overwritten.\n', [TPLFilename]), 524 load_bpl_with_ontology(BPLFilename, ONTFilename, TPLFilename, 525 FullBPLFilename, FullONTFilename, FullTPLFilename, FullTPLSFilename, ResetFlags). 526 527load_ontology(BPLFilename, ONTFilename, TPLFilename, 528 FullBPLFilename, FullONTFilename, FullTPLFilename, FullTPLSFilename, 529 no, ResetFlags) :- 530 exists_file(FullBPLFilename), 531 exists_file(FullONTFilename), 532 exists_file(FullTPLFilename), 533 % BPL, TPL and ontology files exist, and TPL can be loaded if it's newer 534 % than both BPL and ontology 535 ((utilities:file_is_newer(FullTPLFilename, FullBPLFilename), 536 utilities:file_is_newer(FullTPLFilename, FullONTFilename)) -> 537 % TPL file is newer than ontology and BPL, so it ,ight be loaded 538 % without recompiling 539 (safe_tpl(FullTPLSFilename) -> 540 % TPL file is safe to be loaded without recompiling (flags match) 541 writef('\'%w\' already exists and is being loaded...\n', [TPLFilename]), 542 load_tpl_with_ontology(FullBPLFilename, FullONTFilename, FullTPLFilename, 543 ResetFlags) 544 ; 545 % TPL file is not safe and must be overwritten 546 delete_file(FullTPLFilename), 547 writef('\'%w\' must be reloaded.\n', [TPLFilename]), 548 load_bpl_with_ontology(BPLFilename, ONTFilename, TPLFilename, 549 FullBPLFilename, FullONTFilename, FullTPLFilename, FullTPLSFilename, ResetFlags) 550 ) 551 ; 552 % TPL file is older than ontology or BPL and must be overwritten 553 delete_file(FullTPLFilename), 554 writef('\'%w\' is older and will be overwritten.\n', [TPLFilename]), 555 load_bpl_with_ontology(BPLFilename, ONTFilename, TPLFilename, 556 FullBPLFilename, FullONTFilename, FullTPLFilename, FullTPLSFilename, ResetFlags) 557 ). 558 559load_ontology(_BPLFilename, ONTFilename, _TPLFilename, 560 FullBPLFilename, FullONTFilename, _FullTPLFilename, _FullTPLSFilename, 561 _OverwriteTPL, _ResetFlags) :- 562 exists_file(FullBPLFilename), 563 not(exists_file(FullONTFilename)), 564 % Original BPL file exists but ontology doesn't 565 writef('ERROR: \'%w\' ontology do not exist.\n', [ONTFilename]). 566 567load_ontology(_BPLFilename, _ONTFilename, _TPLFilename, 568 FullBPLFilename, _FullONTFilename, _FullTPLFilename, _FullTPLSFilename, 569 _OverwriteTPL, _ResetFlags) :- 570 not(exists_file(FullBPLFilename)), 571 % Original BPL file doesn't exist 572 write('ERROR: Program\'s original BPL file is needed to load an ontology.\n').
582load_bpl_with_ontology(BPLFilename, ONTFilename, TPLFilename, 583 FullBPLFilename, FullONTFilename, FullTPLFilename, FullTPLSFilename, ResetFlags) :- 584 (ResetFlags==yes -> flags:reset_bpl_flags; true), 585 writef('Parsing and translating \'%w\' using ontology \'%w\'...\n', 586 [BPLFilename, ONTFilename]), 587 translator:translate_program(FullBPLFilename, FullONTFilename, FullTPLFilename, FullTPLSFilename), 588 writef('\'%w\' is being loaded...\n', [TPLFilename]), 589 load_tpl_with_ontology(FullBPLFilename, FullONTFilename, FullTPLFilename, ResetFlags). 590 591load_bpl_with_ontology(_BPLFilename, _ONTFilename, _TPLFilename, 592 _FullBPLFilename, _FullONTFilename, _FullTPLFilename, _FullTPLSFilename, _ResetFlags) :- 593 % This is only executed if translate_program/3 fails 594 flags:restore_bpl_flags, 595 write('Ontology not loaded.\n').
606load_tpl_with_ontology(FullBPLFilename, FullONTFilename, FullTPLFilename, ResetFlags) :- 607 (ResetFlags==yes -> flags:reset_bpl_flags; true), 608 evaluator:load_tpl(FullTPLFilename), 609 set_files_loaded(FullBPLFilename, FullONTFilename), 610 flags:get_bpl_flag(program_prefix(ProgramPrefix)), 611 set_program_predicates(ProgramPrefix), 612 write('Ontology loaded!\n'). 613 614load_tpl_with_ontology(_FullBPLFilename, _FullONTFilename, _FullTPLFilename, _ResetFlags) :- 615 % This is only executed if evaluator:load_tpl/1 fails 616 flags:restore_bpl_flags, 617 write('Ontology not loaded.\n'). 618 619 620 621%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 622% Predicates for handling filenames 623%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
For example, given Filename = '/example/file.bpl', this predicate will return Directory = '/example', BaseFilename = 'file', BPLFilename = 'file.bpl' and TPLFilename = 'file.tpl'.
637get_bpl_tpl_tpls_filenames(Filename, Directory, BaseFilename, BPLFilename, TPLFilename, TPLSFilename) :-
638 % Converts filename into an absolute path and extracts
639 % its relative filename and directory
640 absolute_file_name(Filename, AbsoluteFilename),
641 file_base_name(AbsoluteFilename, RelativeFilename),
642 file_directory_name(AbsoluteFilename, Directory),
643 % Checks filename extension
644 file_name_extension(FilenameNoExtension, Extension, RelativeFilename),
645 downcase_atom(Extension, LowerCaseExtension),
646 ((LowerCaseExtension == 'bpl' ; LowerCaseExtension == 'tpl' ;
647 LowerCaseExtension == '') ->
648 % Base filename from "file.bpl" or "file." is "file"
649 BaseFilename = FilenameNoExtension
650 ;
651 % Base filename from "file.new" is "file.new"
652 BaseFilename = RelativeFilename
653 ),
654 % Builds BPL and TPL filenames
655 concat_atom([BaseFilename, '.', bpl], BPLFilenameAux),
656 concat_atom([Directory, '/', BPLFilenameAux], FullBPLFilenameAux),
657 concat_atom([Directory, '/', BaseFilename], FullBaseFilaname),
658 ((exists_file(FullBPLFilenameAux) ; not(exists_file(FullBaseFilaname))) ->
659 BPLFilename = BPLFilenameAux
660 ;
661 BPLFilename = BaseFilename
662 ),
663 concat_atom([BaseFilename, '.', tpl], TPLFilename),
664 concat_atom([TPLFilename, 's'], TPLSFilename).
For example, given Filename = '/example/ontology.ont', this predicate will return Directory = '/example', BaseFilename = 'ontology', ONTFilename = 'ontology.ont'.
678get_ont_filename(Filename, Directory, BaseFilename, ONTFilename) :-
679 % Converts filename into an absolute path and extracts
680 % relative filename and directory
681 absolute_file_name(Filename, AbsoluteFilename),
682 file_base_name(AbsoluteFilename, RelativeFilename),
683 file_directory_name(AbsoluteFilename, Directory),
684 % Checks filename extension
685 file_name_extension(FilenameNoExtension, Extension, RelativeFilename),
686 downcase_atom(Extension, LowerCaseExtension),
687 ((LowerCaseExtension == 'ont' ; LowerCaseExtension == '') ->
688 % Base filename from "file.ont" or "file." is "file"
689 BaseFilename = FilenameNoExtension
690 ;
691 % Base filename from "file.new" is "file.new"
692 BaseFilename = RelativeFilename
693 ),
694 % Builds ONT filename
695 concat_atom([BaseFilename, '.', ont], ONTFilenameAux),
696 concat_atom([Directory, '/', ONTFilenameAux], FullONTFilenameAux),
697 concat_atom([Directory, '/', BaseFilename], FullBaseFilename),
698 ((exists_file(FullONTFilenameAux) ; not(exists_file(FullBaseFilename))) ->
699 ONTFilename = ONTFilenameAux
700 ;
701 ONTFilename = BaseFilename
702 ).
For example, given ProgramBaseFilename = 'file' and OntologyBaseFilename = 'ontology', this predicate will return TPLFilename = 'file-ontology.tpl'. TPLSFilename = 'file-ontology.tpls'.
716get_ontology_tpl_tpls_filename(ProgramBaseFilename, OntologyBaseFilename, TPLFilename, TPLSFilename) :- 717 concat_atom([ProgramBaseFilename, '-', OntologyBaseFilename, '.', tpl], TPLFilename), 718 concat_atom([TPLFilename, 's'], TPLSFilename). 719 720 721 722%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 723% Predicates for solving a query 724%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
740sv(Query, Bindings, Degree) :- 741 sv_aux(Query, Bindings, Degree), 742 % This cut is used to discard all remaining choice points of the 743 % query, since it's not going to be solved again; in other words, 744 % this cut "frees" all memory used by the query 745 !. 746 747sv_aux(Query, [], Degree) :- 748 % Ground query (i.e., query has no free variables) 749 evaluator:solve_goal(Query), 750 writeln('Yes'), 751 writef('With approximation degree: %w ', [Degree]), 752 sv_actions. 753 754sv_aux(Query, Bindings, Degree) :- 755 % Non ground query (i.e., query has one or more free variables) 756 Bindings \== [], 757 evaluator:solve_goal(Query), 758 print_answer(Bindings), nl, 759 writef('With approximation degree: %w ', [Degree]), 760 sv_actions. 761 762sv_aux(_Query, _Bindings, _Degree) :- 763 % Query couldn't be solved or there're no more answers 764 writeln('No answers').
773sv_actions :-
774 flush_output,
775 get_single_char(Code),
776 char_code(Char, Code),
777 (member(Char, [';', 'n', 'r', ' ', '\t']) ->
778 % Tries to solve the query again
779 % If in host_safe mode (for the web interface) do not echo the ';'
780 % because the web server already does it.
781 % This is because get_single_char/1 does not output the user input
782 % character in the console application, by contrast with work like
783 % read_line_to_codes, which does
784 (flags:get_bpl_flag(host_safe('no')) -> writeln(';') ; true),
785 fail
786 ;
787 (member(Char, ['c', 'a', '\r', '\n']) ->
788 % Finishes query
789 writeln('.'),
790 writeln('Yes')
791 ;
792 (member(Char, ['h', '?']) ->
793 % Shows available commands
794 nl, nl,
795 writeln('Available actions:'),
796 writeln(' ; (n, r, space, tab): redo'),
797 writeln(' c (a, return): exit'),
798 writeln(' h (?): help'), nl,
799 write('Action? '), sv_actions
800 ;
801 % Invalid action
802 nl,
803 write('Unknown action: '), write(Char), writeln(' (h for help)'),
804 write('Action? '), sv_actions
805 ))).
816print_answer([]). 817 818print_answer([Name = Value]) :- 819 write(Name), write(' = '), write(Value). 820 821print_answer([Name = Value|MoreBindings]) :- 822 MoreBindings \== [], 823 print_answer([Name = Value]), nl, 824 print_answer(MoreBindings). 825 826 827 828%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 829% Shell command predicates 830%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
838hp :-
839 bplHelp:bpl_help.
847hp(Topic) :- 848 bplHelp:command_help(Topic). 849 850hp(_Topic) :- 851 writeln('ERROR: Unknown topic.').
859qt :-
860 writeln('Exiting the system...'), nl,
861% save_history,
862 halt.
870bk :- 871 check_safe_execution, 872 !, 873 flags:set_bpl_flag(continue('no')), 874 writeln('Exiting to Prolog... Type ''exit.'' to return to Bousi~Prolog.'), nl. 875% save_history. 876bk.
884ts :- 885 check_safe_execution, 886 !, 887 writeln('Testing...'), nl, 888 test:main_test. 889ts.
898ls :- 899 check_safe_execution, 900 !, 901 shell:ls. 902ls.
910pwd :- 911 check_safe_execution, 912 !, 913 working_directory(CurrentWorkingDir, CurrentWorkingDir), 914 writeln('Current working directory is:'), 915 writeln(CurrentWorkingDir). 916pwd.
925cd(Directory) :- 926 check_safe_execution, 927 !, 928 (exists_directory(Directory) 929 -> 930 working_directory(_OldDirectory, Directory), 931 working_directory(NewWorkingDir, NewWorkingDir), 932 writeln('New working directory is:'), 933 writeln(NewWorkingDir) 934 ; 935 writef('ERROR: Directory \'%w\' does not exist.\n', [Directory])). 936cd(_Directory).
947sh :- 948 check_safe_execution, 949 !, 950 (current_prolog_flag(windows, true) 951 -> 952 writeln('Starting a Windows shell...'), 953 writeln('Type \'exit\' to return to Bousi~Prolog.'), 954 (getenv('COMSPEC', Shell), ! ; Shell = 'cmd.exe'), 955 % shell/2 predicate works well on Windows Vista and 7, but hangs on 956 % XP, that's because we use win_shell/2 instead, the only difference 957 % being that win_shell/2 doesn't wait until task ends 958 win_shell(open, Shell) 959 ; 960 writeln('Starting a Unix shell...'), 961 writeln('Type \'exit\' to return to Bousi~Prolog.'), nl, 962 (getenv('SHELL', Shell), ! ; Shell = '/bin/sh'), 963 shell(Shell, _) 964 ). 965sh.
974lc :-
975 flags:get_bpl_flag(lambda_cut(LambdaValue)),
976 writef('Current lambda-cut value is: %w\n', [LambdaValue]).
985lc(Lambda) :- 986 catch(( 987 % Converts Lambda atom into a number 988 atom_chars(Lambda, LambdaChars), 989 number_chars(LambdaValue, LambdaChars), 990 LambdaValue >= 0, LambdaValue =< 1, !, 991 % Changes lambda-cut value 992 flags:remove_bpl_flag(lambda_cut(OldLambda)), 993 flags:add_bpl_flag(lambda_cut(LambdaValue)), 994 reload_on_lambda_change(OldLambda, LambdaValue), 995 writef('New lambda-cut value is: %w\n', [LambdaValue]) 996 % (catcher) 997 ), error(syntax_error(illegal_number), _), ( 998 % Lambda-cut is not a number 999 fail 1000 )). 1001 1002lc(Lambda) :- 1003 writef('ERROR: \'%w\' is a wrong lower bound for the approximation \c 1004 degree.\n', [Lambda]), 1005 writeln('Lambda-cut value must be a number in range [0.0, 1.0].'). 1006 1007 1008% reload_on_lambda_change(+OldLambda, +NewLambda) 1009% Reload the loaded program, if any, on lambda change. 1010 1011% If filtering is not enabled, do not reload 1012reload_on_lambda_change(_OldLambda, _NewLambda) :- 1013 flags:get_bpl_flag(filtering(false)), 1014 !. 1015 1016% Otherwise, test if needed on flag change 1017reload_on_lambda_change(OldLambda, NewLambda) :- 1018 reload_on_flag_change(OldLambda, NewLambda). 1019 1020 1021% reload_on_flag_change(+OldFlag, +NewFlag) 1022% Reload the loaded program, if any, on flag change. 1023 1024% No change 1025reload_on_flag_change(Flag, Flag) :- 1026 !. 1027 1028% No program loaded. An ontology requires a program previously loaded 1029reload_on_flag_change(_OldFlag, _NewFlag) :- 1030 last_program_loaded('', _), !, 1031 !. 1032 1033% Otherwise, recompiling is necessary without resetting flags 1034reload_on_flag_change(_OldFlag, _NewFlag) :- 1035 reload([r]). 1036 1037% Reload resetting flags 1038reload :- 1039 reload([]). 1040 1041% Either for a program: 1042reload(Options) :- 1043 last_program_loaded(Program, ''), 1044 ld(Program, [f | Options]), % f: force, r: reload (don't reset flags) 1045 !. 1046 1047% Or an ontology: 1048reload(Options) :- 1049 last_program_loaded(_Program, Ontology), 1050 ld(Ontology, [f, o | Options]), % f: force, o: ontology, r: reload (don't reset flags) 1051 !. 1052 1053 1054% reload_on_extra_equations(+Equations, +Added) 1055% Reload the current program (and ontology) if new equations 1056% have been added. 1057 1058% No added equations 1059reload_on_extra_equations(_Equations, no) :- 1060 !. 1061 1062% Equations added: reload with new equations 1063reload_on_extra_equations(Equations, yes) :- 1064 last_program_loaded(Program, _Ontology), 1065 Program\=='', 1066 !, 1067 % Save current program file 1068 atom_concat(Program, bak, ProgramBak), 1069 copy_file(Program, ProgramBak), 1070 % Add Equations to program 1071 append(Program), 1072 nl, 1073 findall(_, (member(sim(X,Y,D), Equations), writef('%w~%w=%w.\n',[X,Y,D])), _), 1074 told, 1075 % Reload the extended program 1076 reload, 1077 % Restore original program file 1078 copy_file(ProgramBak, Program), 1079 delete_file(ProgramBak). 1080 1081% No program already loaded. Don't reload. 1082% This typically will raise an exception on solving the query 1083reload_on_extra_equations(_Equations, yes).
1092ld :- 1093 last_program_loaded('', _), !, 1094 writeln('No program loaded.'). 1095 1096ld :- 1097 last_program_loaded(Program, ''), !, 1098 writeln('Current loaded program is:'), 1099 writeln(Program). 1100 1101ld :- 1102 last_program_loaded(Program, Ontology), 1103 writeln('Current loaded program is:'), 1104 writeln(Program), 1105 writeln('Current loaded ontology is:'), 1106 writeln(Ontology).
1116ld(Filename) :-
1117 load_file(Filename, no, yes).
1129ld(Filename, Options) :- 1130 is_list(Options), 1131 subset(Options, [f, o, r]), 1132 (member(f, Options) -> 1133 OverwriteTPL = yes 1134 ; 1135 OverwriteTPL = no 1136 ), 1137 (member(r, Options) -> 1138 ResetFlags = no 1139 ; 1140 ResetFlags = yes 1141 ), 1142 (member(o, Options) -> 1143 load_ontology(Filename, OverwriteTPL, ResetFlags) 1144 ; 1145 load_file(Filename, OverwriteTPL, ResetFlags) 1146 ). 1147 1148ld(_Filename, Options) :- 1149 member(Option, Options), 1150 not(member(Option, [f, o, r])), 1151 writef('ERROR: Unknown option: \'%w\'.\n', [Option]).
1160fl :-
1161 flags:get_bpl_flag(filtering(Boolean)),
1162 writef('Filtering enabled: %w\n', [Boolean]).
1171fl(Boolean) :- 1172 % Checks valid value 1173 memberchk(Boolean, [true, false]), 1174 !, 1175 % Changes filtering value 1176 flags:remove_bpl_flag(filtering(OldBoolean)), 1177 flags:add_bpl_flag(filtering(Boolean)), 1178 reload_on_flag_change(OldBoolean, Boolean), 1179 writef('New filtering is: %w\n', [Boolean]). 1180 1181fl(Boolean) :- 1182 writef('ERROR: \'%w\' is a wrong value. Use either \c 1183 \'true\' or \'false\'.\n', [Boolean]).
1190check_safe_execution :- 1191 flags:get_bpl_flag(host_safe('no')), 1192 !. 1193check_safe_execution :- 1194 write('ERROR: This command cannot be executed in online mode. Use the desktop application instead.'), 1195 nl, 1196 nl, 1197 fail. 1198 1199 1200 1201 1202%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1203% Predicates for reading and writing command history 1204%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1213% load_history :-
1214% history_filename(File),
1215% utilities:home_directory(HomeDirectory),
1216% concat_atom([HomeDirectory, '/', File], HistoryFile),
1217% (exists_file(HistoryFile) ->
1218% true
1219% ;
1220% % Creates a new, empty history file
1221% telling(CurrentOutput),
1222% tell(HistoryFile), told,
1223% tell(CurrentOutput)
1224% ),
1225% foreign:ext_load_shell_history(HistoryFile).
1234% save_history :- 1235% history_filename(File), 1236% max_history_commands(MaxCommands), 1237% utilities:home_directory(HomeDirectory), 1238% concat_atom([HomeDirectory, '/', File], HistoryFile), 1239% foreign:ext_save_shell_history(HistoryFile, MaxCommands). 1240 1241 1242 1243%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1244% Predicates for managing lists of predicate names 1245%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1255set_system_predicates :- 1256 true. 1257% utilities:get_predicates(PredicateNames), 1258% foreign:ext_set_system_predicate_list(PredicateNames).
1269set_program_predicates(Prefix) :- 1270 utilities:get_predicates_modules([evaluator], PredicateNames), 1271 atom_concat(Prefix, '_', FullPrefix), 1272 utilities:remove_prefixes(PredicateNames, _RealNames, FullPrefix). 1273% foreign:ext_set_program_predicate_list(RealNames). 1274 1275 1276 1277%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1278% Miscellaneous predicates 1279%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1289set_files_loaded(File, Ontology) :- 1290 last_program_loaded(OldFile, OldOntology), 1291 retract(last_program_loaded(OldFile, OldOntology)), 1292 assert(last_program_loaded(File, Ontology)), 1293 utilities:simplify_filename(File, SimplifiedFilename), 1294 flags:remove_bpl_flag(program_prefix(_OldProgramPrefix)), 1295 flags:add_bpl_flag(program_prefix(SimplifiedFilename)). 1296 1297 1298 1299%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1300% Constant predicates 1301%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1309bpl_prompt('BPL> ').
1318% history_filename('.bpl_history').
1327% max_history_commands(100).
1338command_arguments(hp, 0, no). 1339command_arguments(lc, 0, no). 1340command_arguments(fl, 0, no). 1341command_arguments(ld, 0, no). 1342command_arguments(ls, 0, no). 1343command_arguments(pwd, 0, no). 1344command_arguments(ts, 0, no). 1345command_arguments(bk, 0, no). 1346command_arguments(qt, 0, no). 1347command_arguments(sh, 0, no). 1348command_arguments(cd, 1, no). 1349command_arguments(hp, 1, no). 1350command_arguments(lc, 1, no). 1351command_arguments(fl, 1, no). 1352command_arguments(ld, 1, no). 1353command_arguments(ld, 1, yes). 1354 1355 1356 1357%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1358% Dynamic predicates 1359%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1371:- dynamic last_program_loaded/2. 1372 1373last_program_loaded('', '')