tools_fastread

complete_atom(Atom,Stream,Term) :- skip_ws(Stream,C), C==0'(, !,
    get_code(Stream,_),
    % TO DO: special case for binary operators like conjunct, transform into flat list (associativity holds) meaning we can get tail-recursion
    get_term_list(Stream,close_paren,List),
    Term =.. [Atom|List].

complete_atom(Atom,_,Atom). % atom without parentheses, i.e., on its own

cur_line(1).

escape_conversion(39,39). % single quote '

escape_conversion(34,34). % double quote

escape_conversion(92,92).

escape_conversion(0'n,10).

escape_conversion(0't,9).

escape_conversion(0'b,8).

escape_conversion(0'r,13).

expect_token(Stream,ETok) :- get_next_token(Stream,RTok),!,
    (RTok = ETok -> true
    ; cur_line(L),
    format(user_error,'Unexpected token on line ~w: ~w, expected ~w~n',[L,RTok,ETok]),
    fail).

fastrw_read(S,Term,Error) :-
    catch( fast_read(S,Term1), % from library fastrw
    error(E,_),
    ( E=syntax_error(_) -> Error = true
    ; E=permission_error(_,_,_) -> Term1 = end_of_file
    ; E=consistency_error(_,_,_)
    -> add_error(tools_fastread,'Consistency error when reading from stream: ',E),
    Error = true
    ;
    add_error(tools_fastread,'Unknown error when reading from stream: ',E),
    throw(E))
    ),
    Term1 = Term.

get_atom_codes(Stream,[H|T]) :-
    peek_code(Stream,H), is_unquoted_atom_letter(H),!,
    get_code(Stream,_), get_atom_codes(Stream,T).

get_atom_codes(_,[]).

get_hex_codes(H,Stream,Acc,Res) :- is_hex_digit(H,HNr),
    !, A2 is Acc*16+HNr,
    get_code(Stream,NxtCode), get_hex_codes(NxtCode,Stream,A2,Res).

get_hex_codes(92,_,Acc,Res) :- !, Res=Acc.

get_hex_codes(X,_,_,_) :- prolog_code_error('hex literal',X),fail.

get_next_term(eof,_,'end_of_file').

get_next_term(number(C),_,Term) :- number_codes(Term,C).

get_next_term(atom(C),Stream,Term) :- atom_codes(Atom,C), complete_atom(Atom,Stream,Term).

get_next_term(open_bracket,Stream,List) :- get_term_list(Stream,close_bracket,List).

get_next_term(open_paren,Stream,'$pair'(List)) :- get_term_list(Stream,close_paren,List).

get_next_term(close_paren,_,_) :- prolog_token_error(dot),fail.

get_next_term(close_bracket,_,_) :- prolog_token_error(dot),fail.

get_next_term(comma,_,_) :- prolog_token_error(dot),fail.

get_next_term(dot,_,_) :- prolog_token_error(dot),fail.

get_next_token(Stream,Token) :- get_code(Stream,C), !,
    get_next_token1(C,Stream,Token).

get_next_token1(-1,_,eof).

get_next_token1(32,Stream,Token) :- !, get_next_token(Stream,Token).

get_next_token1(10,Stream,Token) :- !, inc_line_nr, get_next_token(Stream,Token).

get_next_token1(13,Stream,Token) :- !, get_next_token(Stream,Token).

get_next_token1(0'(,_,open_paren). % adding a cut here seems to degrade performance, but leads to backtracking

get_next_token1(0'),_,close_paren).

get_next_token1(0'[,_,open_bracket).

get_next_token1(0'],_,close_bracket).

get_next_token1(0',,_,comma).

get_next_token1(0'.,_,dot).

get_next_token1(39,Stream,atom(T)) :- !, get_quoted_atom_codes(Stream,T).

get_next_token1(0'%,Stream,Token) :- !, % line comment
    skip_until_end_of_line(Stream),!,get_next_token(Stream,Token).

get_next_token1(X,Stream,number([X|T])) :- is_digit(X),!, get_number_codes(Stream,T).

get_next_token1(X,Stream,atom([X|T])) :- is_lowcase(X),!, get_atom_codes(Stream,T).

get_next_token1(X,_,_) :- prolog_code_error(X),fail.

get_number_codes(Stream,[H|T]) :- peek_code(Stream,H), is_digit(H),
    !, get_code(Stream,_), get_number_codes(Stream,T).

get_number_codes(_,[]).

get_octal_codes(H,Stream,Acc,Res) :- is_octal_digit(H,HNr),
    !, A2 is Acc*8+HNr,
    get_code(Stream,NxtCode), get_octal_codes(NxtCode,Stream,A2,Res).

get_octal_codes(92,_,Acc,Res) :- !, Res=Acc.

get_octal_codes(X,_,_,_) :- prolog_code_error('octal literal',X),fail.

get_quoted_atom_codes(Stream,Res) :- get_code(Stream,H),
    ( H = 92 -> get_code(Stream,H2), % backslash: read next code and treat it specially
    treat_escaped_code(H2,Stream,Res)
    ; H = 39 -> Res=[]
    ; H = -1 -> format('Unterminated quoted atom: ~w~n',[H]),fail
    ; Res=[H|T], get_quoted_atom_codes(Stream,T)).

get_term_list(Stream,EndToken,List) :- get_next_token(Stream,Token), get_term_list_aux(Token,Stream,EndToken,List).

get_term_list_aux(EndToken,_,EndToken,List) :- !, List=[].

get_term_list_aux(Token,Stream,EndToken,[Term1|TList]) :- get_next_term(Token,Stream,Term1),
    get_next_token(Stream,Token2),!,
    get_term_list_aux2(Token2,Stream,EndToken,TList).

get_term_list_aux2(EndToken,_,EndToken,List) :- !, List=[].

get_term_list_aux2(comma,Stream,EndToken,[Term1|TList]) :-
    get_next_token(Stream,Token1),
    get_next_term(Token1,Stream,Term1),!,
    get_next_token(Stream,Token2),
    get_term_list_aux2(Token2,Stream,EndToken,TList).

get_term_list_aux2(Token2,_,EndToken,_) :-
    format(user_error,'Unexpected token: ~w, expected ~w~n',[Token2,EndToken]),fail.

inc_line_nr :- retract(cur_line(N)), N1 is N+1, assertz(cur_line(N1)).

is_digit(X) :- X=45 ; (X>=48, X=<57).

is_hex_digit(X,Nr) :- X>=48, X=<57, Nr is X-48.

is_hex_digit(X,Nr) :- X>=65, X=<70, Nr is X-55. % upper-case A-F

is_hex_digit(X,Nr) :- X>=97, X=<102, Nr is X-87. % lower-case a-f

is_lowcase(X) :- X>=97, X=<122.

is_octal_digit(X,Nr) :- X>=48, X=<55, Nr is X-48.

is_skip_whitespace(32).

is_skip_whitespace(10) :- inc_line_nr.

is_skip_whitespace(13).

is_unquoted_atom_letter(X) :- X>=97, X=<122.

is_unquoted_atom_letter(X) :- X>=65, X=<90.

is_unquoted_atom_letter(X) :- X=95.

is_unquoted_atom_letter(X) :- X>=48, X=<57.

known_arity(empty_set,empty_set(Pos),[Pos]).

known_arity(boolean_true,boolean_true(Pos),[Pos]).

known_arity(boolean_false,boolean_false(Pos),[Pos]).

known_arity(identifier,identifier(Pos,ID),[Pos,ID]).

known_arity(integer,integer(Pos,I),[Pos,I]).

known_arity(string,string(Pos,I),[Pos,I]).

known_arity(equal,equal(Pos,A,B),[Pos,A,B]).

known_arity(not_equal,not_equal(Pos,A,B),[Pos,A,B]).

known_arity(couple,couple(Pos,L),[Pos,L]).

known_arity(set_extension,set_extension(Pos,L),[Pos,L]).

known_arity(sequence_extension,sequence_extension(Pos,L),[Pos,L]).

known_arity(conjunct,conjunct(Pos,A,B),[Pos,A,B]).

known_arity(disjunct,disjunct(Pos,A,B),[Pos,A,B]).

known_arity(interval,interval(Pos,A,B),[Pos,A,B]).

known_arity(member,member(Pos,A,B),[Pos,A,B]).

known_arity(function,function(Pos,A,B),[Pos,A,B]).

known_arity(assign,assign(Pos,A,B),[Pos,A,B]).

known_arity(p3,p3(A,B,C),[A,B,C]).

known_arity(p4,p4(A,B,C,D),[A,B,C,D]).

known_arity(p5,p5(A,B,C,D,E),[A,B,C,D,E]).

prolog_code_error(Code) :- cur_line(L),
    format(user_error,'Unexpected character on line ~w: ~w "~s"~n',[L,Code,[Code]]),
    add_error(fastread,'Unexpected character code on line:',Code:line(L)).

prolog_code_error(Kind,Code) :- cur_line(L),
    format(user_error,'Unexpected character for ~w on line ~w: ~w "~s"~n',[Kind,L,Code,[Code]]),
    add_error(fastread,'Unexpected character code on line:',Kind:Code:line(L)).

prolog_token_error(Tok) :- cur_line(L),
    %format(user_error,'Unexpected token on line ~w: ~w~n',[L,Tok]),
    add_error(fastread,'Unexpected token on line:',Tok:L).

read_term_from_stream(Stream,Term) :-
    get_next_token(Stream,Token),!,
    get_next_term(Token,Stream,Term),!,
    (Term='end_of_file' -> true
    ; expect_token(Stream,dot)).

read_term_from_string(Codes,Term) :-
    open_codes_stream(Codes,Stream),
    read_term_from_stream(Stream,Term),
    close(Stream).

read_terms(Stream) :-
    read_term_from_stream(Stream,Term),
    %read(Stream,Term), % Prolog's read
    write_term(Term,[max_depth(5),numbervars(true)]),nl,
    !,
    (Term = 'end_of_file' -> true
    ; read_terms(Stream)).

read_terms(Stream) :-
    get_code(Stream,C),
    format('Could not process: ~w~n',[C]).

read_test(1) :-
    term_read('/Users/leuschel/git_root/prob_examples/public_examples/B/Demo/Bakery0.prob').

read_test(3) :-
    term_read('/Users/leuschel/git_root/prob_examples/public_examples/B/PerformanceTests/Generated/Generated4000.prob').

read_test(4) :-
    term_read('/Users/leuschel/git_root/prob_examples/public_examples/B/PerformanceTests/Generated/Generated10000.prob').

read_test(7) :-
    term_read('/Users/leuschel/git_root/private_examples/ClearSy/2019_Nov/rule_perf4/rule_split.prob').

read_test(8) :-
    term_read('/Users/leuschel/git_root/prob_examples/public_examples/B/PerformanceTests/SATLIB/sudoku.prob').

read_tokens(Stream) :-
    get_next_token(Stream,Tok), % print_token(Tok),
    !,
    (Tok = eof -> true
    ; read_tokens(Stream)).

read_tokens(Stream) :-
    get_code(Stream,C),
    format('Could not process: ~w~n',[C]).

reset_line_nr :- retract(cur_line(_)), assertz(cur_line(1)).

skip_until_end_of_line(Stream) :- get_code(Stream,H),
    (H = 10 -> inc_line_nr
    ; H = -1 -> format('Unterminated % comment~n',[]), prolog_token_error(H), fail
    ; skip_until_end_of_line(Stream)).

skip_ws(Stream,NextCode) :- peek_code(Stream,C),
    (is_skip_whitespace(C) -> get_code(Stream,_),skip_ws(Stream,NextCode)
    ; NextCode=C).

term_read(File) :- statistics(walltime,_),
    open(File,read,Stream),read_terms(Stream),close(Stream),
    statistics(walltime,[_,W1]), format('~n% Walltime ~w ms to tokenise and read ~w~n',[W1,File]),
    print_memory_used_wo_gc.

tok_read(File) :- statistics(walltime,_),
    %open(File,read,Stream1),reset_line_nr, repeat, get_code(Stream1,C), C = -1,!, close(Stream1),
    %statistics(walltime,[_,W1]), format('~n% Walltime ~w ms to get_codes ~w~n',[W1,File]),
    open(File,read,Stream),reset_line_nr,
    read_tokens(Stream),close(Stream),
    statistics(walltime,[_,W2]), format('~n% Walltime ~w ms to tokenise ~w~n',[W2,File]),
    print_memory_used_wo_gc.

tok_test(1) :-
    tok_read('/Users/leuschel/git_root/prob_examples/public_examples/B/Demo/Bakery0.prob').

tok_test(2) :-
    tok_read('/Users/leuschel/git_root/prob_examples/public_examples/B/Benchmarks/CAN_BUS_tlc.prob').

tok_test(3) :-
    tok_read('/Users/leuschel/git_root/prob_examples/public_examples/B/PerformanceTests/Generated/Generated4000.prob').

tok_test(4) :-
    tok_read('/Users/leuschel/git_root/prob_examples/public_examples/B/PerformanceTests/Generated/Generated10000.prob').

tok_test(7) :-
    tok_read('/Users/leuschel/git_root/private_examples/ClearSy/2019_Nov/rule_perf4/rule_split.prob').

treat_escaped_code(Code,Stream,[NewCode|T]) :- escape_conversion(Code,NewCode),!,
    get_quoted_atom_codes(Stream,T).

treat_escaped_code(Octal,Stream,[OctResult|T]) :- is_octal_digit(Octal,Nr),!, % treat chars like \374\
    get_code(Stream,NxtCode),
    get_octal_codes(NxtCode,Stream,Nr,OctResult),
    get_quoted_atom_codes(Stream,T).

treat_escaped_code(0'x,Stream,[HexResult|T]) :- !, % treat chars like \x21D4\
    get_code(Stream,NxtCode),
    get_hex_codes(NxtCode,Stream,0,HexResult),
    get_quoted_atom_codes(Stream,T).

treat_escaped_code(10,Stream,T) :- !, %\LFD ignored ; TO DO: also support 13
    get_quoted_atom_codes(Stream,T).

treat_escaped_code(-1,_,_) :- !, format('Unterminated quoted atom ending with backslash at: ~w~n',[end_of_file]),fail.

treat_escaped_code(X,_,_) :- prolog_code_error('escape sequence',X),fail.