Merge pull request #3257 from triska/include

ISO: Implement the include/1 directive

src/toplevel.pl

@@ -220,6 +220,77 @@ expand_op_list([Op | OtherOps], Pri, Spec, [(:- op(Pri, Spec, Op)) | OtherResult
     expand_op_list(OtherOps, Pri, Spec, OtherResults).
 
 
+% Implement the include/1 directive via term expansion.
+
+user:term_expansion((:- Include), Clauses) :-
+        nonvar(Include),
+        Include = include(File0),
+        (   si:atom_si(File0) ->
+            atom_chars(File0, File),
+            format("% Warning: include/1: atom arguments are deprecated. Use chars for file paths:~n", []),
+            format("% :- include(\"~s\").~n", [File])
+        ;   error:must_be(chars, File0),
+            File = File0
+        ),
+        '$toplevel':gather_clauses_from_file(File, Clauses).
+
+
+gather_clauses_from_file(File, Clauses) :-
+        (   file_exists(File) ->
+            setup_call_cleanup(open(File, read, Stream),
+                               gather_clauses_(Stream, File, Clauses),
+                               close(Stream))
+        ;   format("include/1: ~s does not exist.", [File]),
+            Clauses = []
+        ).
+
+
+gather_clauses_(Stream, _, []) :- at_end_of_stream(Stream), !.
+gather_clauses_(Stream, File, Clauses) :-
+        catch((read(Stream, Clause),
+               Continue = true),
+              Error,
+              (   Error = error(syntax_error(incomplete_reduction),_),
+                  at_end_of_stream(Stream) ->
+                  true
+              ;   format("~s: ~q~n", [File,Error])
+              )),
+        (   Continue == true ->
+            (   var(Clause) ->
+                format("~s: variable clause is ignored.~n", [File]),
+                gather_clauses_(Stream, File, Clauses)
+            ;   Clause = (?- _Query) ->
+                devour_answer_descriptions(Stream, File, Clauses)
+            ;   Clauses = [Clause|Rest],
+                gather_clauses_(Stream, File, Rest)
+            )
+        ;   Clauses = []
+        ).
+
+
+devour_answer_descriptions(Stream, File, Clauses) :-
+        catch((read(Stream, Clause),
+               Continue = true),
+              Error,
+              (   Error = error(syntax_error(incomplete_reduction),_),
+                  at_end_of_stream(Stream) ->
+                  true
+              ;   format("~s: ~q~n", [File,Error])
+              )),
+        (   Continue == true ->
+            (   var(Clause) ->
+                format("~s: variable clause is ignored.~n", [File])
+            ;   Clause = (?- _Query) ->
+                devour_answer_descriptions(Stream, File, Clauses)
+            ;   loader:answer_description(Clause) ->
+                devour_answer_descriptions(Stream, File, Clauses)
+            ;   Clauses = [Clause|Rest],
+                gather_clauses_(Stream, File, Rest)
+            )
+        ;   Clauses = []
+        ).
+
+
 read_and_match :-
     '$read_query_term'(_, Term, _, _, VarList),
     instruction_match(Term, VarList).