Merge branch 'trueagi-io:main' into main

.Attic/metta_lang/metta_reader.new → .Attic/canary_docme/metta_reader.pl

@@ -1,3 +1,57 @@
+/*
+ * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter
+ * Description: This file is part of the source code for a transpiler designed to convert
+ *              MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for
+ *              optimizing and transforming function/logic programs. It handles different
+ *              logical constructs and performs conversions between functions and predicates.
+ *
+ * Author: Douglas R. Miles
+ * Contact: [email protected] / [email protected]
+ * License: LGPL
+ * Repository: https://github.com/trueagi-io/metta-wam
+ *             https://github.com/logicmoo/hyperon-wam
+ * Created Date: 8/23/2023
+ * Last Modified: $LastChangedDate$  # You will replace this with Git automation
+ *
+ * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details
+ *        on how to contribute or use this project, please refer to the repository README or the project documentation.
+ *
+ * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md
+ *               file in the repository.
+ *
+ * Notes:
+ * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler.
+ * - This project is under active development, and we welcome feedback and contributions.
+ *
+ * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions.
+ *
+ * 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.
+ */
+
+
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Parsing
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
@@ -80,7 +134,7 @@
 
 
 def_compile_all(I,O):- current_predicate(compile_all/2),!,call(call,compile_all,I,O).
-def_compile_all(I,O):- wdmsg(undefined_compile_all(I)),I=O.
+def_compile_all(I,O):- fbug(undefined_compile_all(I)),I=O.
 
 
 zalwayzz(G):- call(G)*->true;throw(fail_zalwayzz(G)).
@@ -133,10 +187,10 @@
 escape_char_metta(C,S):- sformat(S,'~s',[[C]]).
 
 symbol_metta(S, Until) --> metta_wspace,!,symbol_metta(S, Until).
-symbol_metta(S, Until) --> string_until_metta(SChars,(dcg_peek(metta_white); Until)), { atomic_list_concat(SChars, S) }.
+symbol_metta(S, Until) --> string_until_metta(SChars,(dcg_peek(metta_white); Until)), { symbolic_list_concat(SChars, S) }.
 
 %comment --> `;`,!,comment_chars_metta(S).
-comment_chars_metta(S) --> string_until_metta(SChars,`\n`), { atomic_list_concat(SChars, S) }.
+comment_chars_metta(S) --> string_until_metta(SChars,`\n`), { symbolic_list_concat(SChars, S) }.
 
 %e_o_s --> file_eof,!.
 e_o_s --> \+ [_|_].
@@ -176,8 +230,8 @@
  ?,?).
 
 
-:- dynamic user:file_search_path/2.
-:- multifile user:file_search_path/2.
+    :- dynamic user:file_search_path/2.
+    :- multifile user:file_search_path/2.
 
 :- thread_local(t_l:s_reader_info/1).
 
@@ -217,9 +271,9 @@
 
 
 make_tmpfile_name(Name,Temp):-
-  atomic_list_concat(List1,'/',Name),atomic_list_concat(List1,'_',Temp1),
-  atomic_list_concat(List2,'.',Temp1),atomic_list_concat(List2,'_',Temp2),
-  atomic_list_concat(List3,'\\',Temp2),atomic_list_concat(List3,'_',Temp3),
+  symbolic_list_concat(List1,'/',Name),symbolic_list_concat(List1,'_',Temp1),
+  symbolic_list_concat(List2,'.',Temp1),symbolic_list_concat(List2,'_',Temp2),
+  symbolic_list_concat(List3,'\\',Temp2),symbolic_list_concat(List3,'_',Temp3),
   atom_concat_or_rtrace(Temp3,'.tmp',Temp),!.
 
 
@@ -290,7 +344,9 @@
 %
 
 parse_sexpr(S, Expr) :- quietly_sreader(parse_meta_term(
-      file_sexpr_with_comments, S, Expr)).
+      file_sexpr_with_comments, S, Expr)),
+     nb_setval('$parser_last_read',Expr).
+
 
 %% parse_sexpr_ascii( +Codes, -Expr) is det.
 %
@@ -315,7 +371,9 @@
 %
 % Parse S-expression from a Stream
 %
-parse_sexpr_stream(S,Expr):- quietly_sreader(parse_meta_stream(file_sexpr_with_comments,S,Expr)),!.
+parse_sexpr_stream(S,Expr):-
+  quietly_sreader(parse_meta_stream(file_sexpr_with_comments,S,Expr)),!,
+  nb_setval('$parser_last_read',Expr).
 
 :- export('//'(file_sexpr,1)).
 :- export('//'(sexpr,1)).
@@ -327,16 +385,15 @@
 
 % Use DCG for parser.
 
-%file_sexpr_with_comments(O) --> [], {clause(t_l:s_reader_info(O),_,Ref),erase(Ref)},!.
-
 
+%file_sexpr_with_comments(O) --> [], {clause(t_l:s_reader_info(O),_,Ref),erase(Ref)},!.
 file_sexpr_with_comments(end_of_file) --> file_eof,!.
+file_sexpr_with_comments('+')                 --> `+`, swhite,!.
+
 file_sexpr_with_comments(O) --> one_blank,!,file_sexpr_with_comments(O),!.  % WANT?
 file_sexpr_with_comments(end_of_file) --> `:EOF`,!.
 file_sexpr_with_comments(C)                 --> dcg_peek(`#|`),!,zalwayzz(comment_expr(C)),swhite,!.
 file_sexpr_with_comments(C)                 --> dcg_peek(`;`),!, zalwayzz(comment_expr(C)),swhite,!.
-
-
 file_sexpr_with_comments(Out) --> {kif_ok}, prolog_expr_next, prolog_readable_term(Out), !.
 file_sexpr_with_comments(Out,S,E):- \+ t_l:sreader_options(with_text,true),!,phrase(file_sexpr(Out),S,E),!.
 file_sexpr_with_comments(Out,S,E):- expr_with_text(Out,file_sexpr(O),O,S,E),!.
@@ -373,10 +430,8 @@
 % WANT?
 file_sexpr(O) --> sblank,!,file_sexpr(O),!.
 % file_sexpr(planStepLPG(Name,Expr,Value)) --> swhite,sym_or_num(Name),`:`,swhite, sexpr(Expr),swhite, `[`,sym_or_num(Value),`]`,swhite.  %   0.0003:   (PICK-UP ANDY IBM-R30 CS-LOUNGE) [0.1000]
-% file_sexpr(Term,Left,Right):- eoln(EOL),append(LLeft,[46,EOL|Right],Left),read_term_from_codes(LLeft,Term,[double_quotes(string)]),!.
-% file_sexpr(Term,Left,Right):- append(LLeft,[46|Right],Left), ( \+ member(46,Right)),read_term_from_codes(LLeft,Term,[double_quotes(string)]),!.
-
-%file_sexpr(C) --> !, s_line_metta(C), !.
+% file_sexpr(Term,Left,Right):- eoln(EOL),append(LLeft,[46,EOL|Right],Left),read_term_from_codes(LLeft,Term,[double_quotes(string),syntax_errors(fail)]),!.
+% file_sexpr(Term,Left,Right):- append(LLeft,[46|Right],Left), ( \+ member(46,Right)),read_term_from_codes(LLeft,Term,[double_quotes(string),syntax_errors(fail)]),!.
 file_sexpr(Expr) --> sexpr(Expr),!.
 % file_sexpr(Expr,H,T):- lisp_dump_break,rtrace(phrase(file_sexpr(Expr), H,T)).
 /*
@@ -483,22 +538,39 @@
 
 %sexpr(L)                   --> sblank,!,sexpr(L),!.
 %sexpr(_) --> `)`,!,{trace,break,throw_reader_error(": an object cannot start with #\\)")}.
-sexpr(X,H,T):- zalwayzz(sexpr0(X),H,M),zalwayzz(swhite,M,T), nop(if_debugging(sreader,(wdmsg(sexpr(X))))),!.
+sexpr(X,H,T):- zalwayzz(sexpr0(X),H,M),zalwayzz(swhite,M,T), nop(if_debugging(sreader,(fbug(sexpr(X))))),!.
 %sexpr(X,H,T):- zalwayzz(sexpr0(X,H,T)),!,swhite.
 is_common_lisp:- fail.
+is_scm:- fail.
+is_metta:- true.
+
+:- discontiguous(sexpr0/3).
 
 sexpr0(L)                      --> sblank,!,sexpr(L),!.
 sexpr0(L)                      --> `(`, !, swhite, zalwayzz(sexpr_list(L)),!, swhite.
 sexpr0((Expr))                 -->  `.{`, read_string_until(S,`}.`), swhite,
   {prolog_readable_term(Expr,S,_)}.
 
 
-sexpr0(['#'(quote),E])             --> `'`, !, sexpr(E).
+sexpr0(['#'(quote),E])             --> {\+ is_metta}, `'`, !, sexpr(E). % '
 sexpr0(['#'(hbackquote),E])         --> {is_scm}, `#```, !, sexpr(E).
-sexpr0(['#'(backquote),E])         --> ````, !, sexpr(E).
-sexpr0(['#BQ-COMMA-ELIPSE',E])     --> `,@`, !, sexpr(E).
+sexpr0(['#'(backquote),E])         --> {\+ is_metta}, ````, !, sexpr(E).
+sexpr0(['#BQ-COMMA-ELIPSE',E])     --> {\+ is_metta}, `,@`, !, sexpr(E).
 sexpr0(['#COMMA',E])               --> { is_common_lisp }, `,`, !, sexpr(E).
 sexpr0(['#HCOMMA',E])               --> {is_scm}, `#,`, !, sexpr(E).
+
+sexpr0('#\\'(A))--> { is_metta}, `'`,[C],`'`,{C>=32},!, {atom_codes(A,[C])}.
+
+% sexpr_metta('$STRING'(S))             --> s_string(S),!.
+
+
+
+sexpr_metta(O) --> dcg_peek(dcg_not( ( `(` ; `)` ; ` ` ;
+   sblank_ch) )),
+  (read_string_until(Text, dcg_peek( ( `(` ; `)` ; ` ` ;
+   sblank_ch) ))),!,{atom_string(O,Text)}.
+
+
 sexpr0('$OBJ'(claz_bracket_vector,V))                 --> `[`, sexpr_vector(V,`]`),!, swhite.
 
 % MeTTA/NARS % sexpr0('#'(A))              --> `|`, !, read_string_until(S,`|`), swhite,{quietly_sreader(((atom_string(A,S))))}.
@@ -535,7 +607,7 @@
 sexpr0('$COMPLEX'(R,I)) -->         (`#`, ci(`c`),`(`),!,zalwayzz(sexpr_list([R,I])),swhite,!.
 sexpr0('$OBJ'(claz_bitvector,C)) --> `#*`,radix_digits(2,C),swhite,!.
 
-sexpr0(function(E))                 --> `#\'`, sexpr(E), !. %, swhite.
+sexpr0(function(E))                 --> `#\'`, sexpr(E), !. %, swhite. % '
 sexpr0('$OBJ'(claz_vector,V))                 --> `#(`, !, zalwayzz(sexpr_vector(V,`)`)),!, swhite,!.
 
 sexpr0(Number) --> `#`,integer(Radix),ci(`r`),!,zalwayzz((signed_radix_2(Radix,Number0),extend_radix(Radix,Number0,Number))),!.
@@ -553,17 +625,19 @@
 
 /*********END HASH ***********/
 
+sexpr0(L)--> { is_metta }, sexpr_metta(L),!.
+
 sexpr0(E)    --> sym_or_num(E), swhite,!.
 sexpr0(Sym) --> `#`,integer(N123), swhite,!, {atom_concat('#',N123,Sym)}.
-sexpr0(C) -->  s_line_metta(C) , !. %s_line_metta(C), !.
-sexpr0(C) -->  s_item_metta(C, e_o_s). %s_line_metta(C), !.
+sexpr0(C) -->  s_line_metta(C) ,swhite, !. %s_line_metta(C), !.
+sexpr0(C) -->  s_item_metta(C, e_o_s), swhite. %s_line_metta(C), !.
 sexpr0(E)                      --> !,zalwayzz(sym_or_num(E)), swhite,!.
 
-is_scm:- fail.
 
 % c:/opt/logicmoo_workspace/packs_sys/logicmoo_opencog/guile/module/ice-9/and-let-star.scm
 
 priority_symbol((`|-`)).
+/*
 priority_symbol((`#=`)).
 priority_symbol((`#+`)).
 priority_symbol((`#-`)).
@@ -581,19 +655,18 @@
 priority_symbol((`-1-`)).
 priority_symbol((`1+`)).
 priority_symbol((`1-`)).
+*/
 
 sym_or_num('$COMPLEX'(L)) --> `#C(`,!, swhite, sexpr_list(L), swhite.
 %sym_or_num((E)) --> unsigned_number(S),{number_string(E,S)}.
 %sym_or_num((E)) --> unsigned_number(S),{number_string(E,S)}.
 
-sym_or_num((E)) --> lnumber(E),swhite,!.
+%sym_or_num((E)) --> lnumber(E),swhite,!.
 sym_or_num(E) --> rsymbol_maybe(``,E),!.
 %sym_or_num('#'(E)) --> [C],{atom_codes(E,[C])}.
 
 sym_or_num(E) --> dcg_xor(rsymbol(``,E),lnumber(E)),!.
-
-
-sym_or_num(E) --> dcg_xor(rsymbol(``,E),lnumber(E)),!.
+%sym_or_num(E) --> dcg_xor(rsymbol(``,E),lnumber(E)),!.
 % sym_or_num('#'(E)) --> [C],{atom_codes(E,[C])}.
 
 
@@ -603,35 +676,38 @@
 %sblank --> [C], {var(C)},!.
 
 % sblank --> comment_expr(S,I,CP),!,{assert(t_l:s_reader_info('$COMMENT'(S,I,CP)))},!,swhite.
-sblank --> comment_expr(CMT),!,{assert(t_l:s_reader_info(CMT))},!,swhite.
-sblank --> [C], {nonvar(C),charvar(C),!,bx(C =< 32)},!,swhite.
+sblank --> sblank_char, comment_expr(CMT),!,{assert(t_l:s_reader_info(CMT))},!,swhite.
+sblank --> sblank_ch.
+sblank_ch --> sblank_char,!,swhite.
+
+sblank_char --> [C], {nonvar(C),charvar(C),!,bx(C =< 32)}.
 
 sblank_line --> eoln,!.
 sblank_line --> [C],{bx(C =< 32)},!, sblank_line.
 
 s_string(Text)                 --> sexpr_string(Text).
 s_string(Text)                 --> {kif_ok},`'`, !, zalwayzz(read_string_until(Text,`'`)),!.
 
-
+:- export(sblank_ch/2).
 
 swhite --> sblank,!.
 swhite --> [].
 
 
 sexpr_lazy_list_character_count(Location, Stream, Here, Here) :-
-	sexpr_lazy_list_character_count(Here, Location, Stream).
+    sexpr_lazy_list_character_count(Here, Location, Stream).
 
 sexpr_lazy_list_character_count(Here, CharNo, Stream) :-
-	'$skip_list'(Skipped, Here, Tail),
-	(   attvar(Tail)
-	->  frozen(Tail,
-		   pure_input:read_to_input_stream(Stream, _PrevPos, Pos, _List)),
-	    stream_position_data(char_count, Pos, EndRecordCharNo),
-	    CharNo is EndRecordCharNo - Skipped
-	;   Tail == []
-	->  CharNo = end_of_file-Skipped
-	;   type_error(lazy_list, Here)
-	).
+    '$skip_list'(Skipped, Here, Tail),
+    (   attvar(Tail)
+    ->  frozen(Tail,
+           pure_input:read_to_input_stream(Stream, _PrevPos, Pos, _List)),
+        stream_position_data(char_count, Pos, EndRecordCharNo),
+        CharNo is EndRecordCharNo - Skipped
+    ;   Tail == []
+    ->  CharNo = end_of_file-Skipped
+    ;   type_error(lazy_list, Here)
+    ).
 
 
 
@@ -665,9 +741,23 @@
 sexpr_list([Car|Cdr]) --> sexpr(Car), !, sexpr_rest(Cdr),!.
 
 sexpr_rest([]) --> `)`, !.
-sexpr_rest(E) --> `.`, [C], {\+ sym_char(C)}, !, sexpr(E,C), !, `)`.
+% allow dotcons/improper lists.. but also allow dot in the middle of the list (non-CL)
+sexpr_rest(E) --> `.`, [C], {\+ sym_char(C)}, sexpr(E,C), `)` , ! .
 sexpr_rest(E) --> {kif_ok}, `@`, rsymbol(`?`,E), `)`.
-sexpr_rest([Car|Cdr]) --> sexpr(Car), !, sexpr_rest(Cdr),!.
+sexpr_rest([Car|Cdr]) --> sexpr(Car), !, {Car\==''},
+  %maybe_throw_reader_error(Car),
+   sexpr_rest(Cdr),!.
+
+maybe_throw_reader_error(Car,I,O):- Car=='',lazy_list_location(Info,I,O),!,
+  write_src(Info),
+  if_t(nb_current('$parser_last_read',V),write_src('$parser_last_read'=V)),
+  throw(ll_read_error(Info)).
+maybe_throw_reader_error(Car,I,I):-  Car=='', !,
+  ignore(sexpr_lazy_list_character_count(I,CharPos,Stream)),!,
+  Info= ics(I,CharPos,Stream),
+  write_src(Info),
+  throw(ll_read_error(Info)).
+maybe_throw_reader_error(_,I,I).
 
 sexpr_vector(O,End) --> zalwayzz(sexpr_vector0(IO,End)),!,{zalwayzz(O=IO)}.
 
@@ -699,7 +789,7 @@
 maybe_string(E,E).
 
 sym_continue([H|T]) --> [H], {sym_char(H)},!, sym_continue(T).
-sym_continue([39]) --> `'`, peek_symbol_breaker,!.
+sym_continue([39]) --> `'`, peek_symbol_breaker,!. % '
 sym_continue([]) --> peek_symbol_breaker,!.
 sym_continue([]) --> [].
 
@@ -793,7 +883,8 @@
 
 sym_char(C):- bx(C =<  32),!,fail.
 %sym_char(44). % allow comma in middle of symbol
-sym_char(C):- memberchk(C,`"()```),!,fail.  % maybe 44 ? comma maybe not # or ; ? '
+sym_char(C):- memberchk(C,`"()```),!,fail.
+% maybe 44 ? comma maybe not # or ; ? ' `'`'````'"
 %sym_char(C):- nb_current('$maybe_string',t),memberchk(C,`,.:;!%`),!,fail.
 sym_char(_):- !.
 
@@ -806,6 +897,8 @@
 :- thread_local(t_l:s2p/1).
 :- thread_local(t_l:each_file_term/1).
 
+string_to_syms:- !, false.
+string_to_syms:- option_value('string-are-atoms',true).
 
 
 %=
@@ -902,8 +995,8 @@
 char_code_int(Char,Code):- notrace_catch_fail(char_code(Char,Code)),!.
 char_code_int(Char,Code):- notrace_catch_fail(atom_codes(Char,[Code])),!.
 char_code_int(Char,Code):- atom(Char),name_to_charcode(Char,Code),!.
-char_code_int(Char,Code):- var(Char),!,wdmsg(char_code_int(Char,Code)), only_debug(break).
-char_code_int(Char,Code):- wdmsg(char_code_int(Char,Code)),only_debug(break).
+char_code_int(Char,Code):- var(Char),!,fbug(char_code_int(Char,Code)), only_debug(break).
+char_code_int(Char,Code):- fbug(char_code_int(Char,Code)),only_debug(break).
 
 char_code_to_char(N,S):- atom(N),atom_codes(N,[_]),!,S=N.
 char_code_to_char(N,S):- atom(N),!,S=N.