1:- if(\+ current_module(sxpr_reader)).    2:- module(s3xpr,[
    3  codelist_to_forms/2,
    4  svar_fixvarname/2,
    5  with_kifvars/1,
    6  current_input_to_forms/2,
    7  input_to_forms/2,
    8  input_to_forms/3,
    9  input_to_forms_debug/1,
   10  input_to_forms_debug/2,
   11  sexpr_sterm_to_pterm_list/3,
   12  sexpr//1,
   13  fixvars/4,
   14  txt_to_codes/2,
   15  with_lisp_translation/2,
   16  to_untyped/2,
   17  ok_var_name/1,
   18  with_all_rest_info/1,
   19  svar_fixvarname/2,
   20  sexpr_sterm_to_pterm/2,
   21  lisp_read/2,
   22  phrase_from_stream_nd/2,
   23  write_trans/4,
   24  parse_sexpr/2]).   25
   26:- use_module(library(logicmoo/dcg_must)).   27:- use_module(library(logicmoo/dcg_meta)).   28:- use_module(library(logicmoo_common)).   29:- use_module(library(backcomp)).   30:- use_module(library(rbtrees)).   31
   32%:- meta_predicate always_b(//,?,?).
   33%:- meta_predicate bx(0).
   34:- meta_predicate call_proc(1,?).   35:- meta_predicate dcg_and2(//,//,?,?).   36:- meta_predicate dcg_each_call_cleanup(0,//,0,?,?).   37:- meta_predicate dcg_not(//,?,?).   38:- meta_predicate dcg_phrase(//,?,?).   39:- meta_predicate dcg_xor(//,//,?,?).   40%:- meta_predicate expr_with_text(*,2,*,*,*).
   41
   42:- meta_predicate remove_optional_char(//,?,?).   43
   44:- meta_predicate sexpr_vector0(*,//,?,?).   45:- meta_predicate with_all_rest_info(1).   46:- meta_predicate with_lisp_translation_stream(*,1).   47:- meta_predicate write_trans(+,*,2,?).   48
   49
   50
   51
   52def_is_characterp(CH):- current_predicate(is_characterp/1),!,call(call,is_characterp,CH).
   53def_is_characterp_def('#\\'(_)).
   54
   55def_to_prolog_string(I,O):- current_predicate(to_prolog_string/2),!,call(call,to_prolog_string,I,O).
   56def_to_prolog_string(I,O):- any_to_string(I,O).
   57
   58
   59def_compile_all(I,O):- current_predicate(compile_all/2),!,call(call,compile_all,I,O).
   60def_compile_all(I,O):- wdmsg(undefined_compile_all(I)),I=O.
   61
   62
   63%:- meta_predicate(always(0)).
   64%always(G):- must(G).
   65
   66:- use_module(library(logicmoo/filestreams)).   67%:- use_module(library(bugger)).
   68
   69:- if(exists_file('./header')).   70% :- include('./header').
   71:- endif.   72%:- use_module(eightball).
   73
   74:- thread_local(t_l:sreader_options/2).   75kif_ok:- t_l:sreader_options(logicmoo_read_kif,TF),!,TF==true.
   76
   77with_kif_ok(G):-
   78  locally(t_l:sreader_options(logicmoo_read_kif,true),G).
   79
   80with_kif_not_ok(G):-
   81  locally(t_l:sreader_options(logicmoo_read_kif,false),G).
   82
   83
   84:- meta_predicate((with_lisp_translation(+,1),input_to_forms_debug(+,:))).   85:- meta_predicate sexpr_vector(*,//,
   86 ?,?).   87
   88
   89:- dynamic user:file_search_path/2.   90:- multifile user:file_search_path/2.   91
   92:- thread_local(t_l:s_reader_info/1).   93
   94:- meta_predicate(quietly_sreader(0)).   95quietly_sreader(G):- !, call(G).
   96quietly_sreader(G):- quietly(G).

 with_lisp_translation(+FileOrStream, :Pred1) is det

With File or Stream read all S-expressions submitting each to Pred1

  102with_lisp_translation(In,Pred1):-
  103   is_stream(In),!,with_lisp_translation_stream(In,Pred1).
  104with_lisp_translation(Other,Pred1):- 
  105   setup_call_cleanup(l_open_input(Other,In),
  106     with_lisp_translation_stream(In,Pred1),
  107     ignore(notrace_catch_fail(close(In)))),!.
  108
  109with_lisp_translation_stream(In,Pred1):- 
  110   repeat,
  111      once((lisp_read(In,O))),
  112      (O== end_of_file 
  113         -> (with_all_rest_info(Pred1),!) ; 
  114         (((once((zalwayz(call_proc(Pred1,O))))),fail))).
  115
  116call_proc(Pred1,O):- call(Pred1,O),!,with_all_rest_info(Pred1),!.
  117
  118with_all_rest_info(Pred1):- 
  119 forall(clause(t_l:s_reader_info(O2),_,Ref),
  120  (zalwayz(once(call(Pred1,O2))),erase(Ref))),!.
  121
  122parse_sexpr_untyped(I,O):- quietly((parse_sexpr(I,M))),!,quietly_sreader((to_untyped(M,O))),!.
  123
  124read_pending_whitespace(In):- repeat, peek_char(In,Code),
  125   (( \+ char_type(Code,space), \+ char_type(Code,white))-> ! ; (get_char(In,_),fail)).
  126
  127
  128make_tmpfile_name(Name,Temp):- 
  129  atomic_list_concat(List1,'/',Name),atomic_list_concat(List1,'_',Temp1),
  130  atomic_list_concat(List2,'.',Temp1),atomic_list_concat(List2,'_',Temp2),
  131  atomic_list_concat(List3,'\\',Temp2),atomic_list_concat(List3,'_',Temp3),
  132  atom_concat_or_rtrace(Temp3,'.tmp',Temp),!.
  133  
  134
  135
  136
  137:- meta_predicate(with_lisp_translation_cached(:,2,1)).  138:- meta_predicate(maybe_cache_lisp_translation(+,+,2)).  139
  140with_lisp_translation_cached(M:LFile,WithPart2,WithPart1):- 
  141   absolute_file_name(LFile,File),
  142   make_tmpfile_name(LFile,Temp),
  143   maybe_cache_lisp_translation(File,Temp,WithPart2),!,
  144   finish_lisp_translation_cached(M,File,Temp,WithPart1).
  145
  146finish_lisp_translation_cached(M,File,Temp,WithPart1):-
  147   multifile(M:lisp_trans/2),
  148   dynamic(M:lisp_trans/2),
  149   file_base_name(File,BaseName),
  150   M:load_files([Temp],[qcompile(auto)]),
  151   forall(M:lisp_trans(Part2,BaseName:Line),
  152   once((b_setval('$lisp_translation_line',Line),
  153         zalwayz(M:call(WithPart1,Part2))))).
  154  
  155maybe_cache_lisp_translation(File,Temp,_):- \+ file_needs_rebuilt(Temp,File),!.
  156maybe_cache_lisp_translation(File,Temp,WithPart2):- 
  157 file_base_name(File,BaseName),
  158 setup_call_cleanup(open(Temp,write,Outs),
  159  must_det((format(Outs,'~N~q.~n',[:- multifile(lisp_trans/2)]),
  160            format(Outs,'~N~q.~n',[:- dynamic(lisp_trans/2)]),
  161            format(Outs,'~N~q.~n',[:- style_check(-singleton)]),
  162            format(Outs,'~N~q.~n',[lisp_trans(translated(File,Temp,BaseName),BaseName:( -1))]),            
  163            with_lisp_translation(File,write_trans(Outs,BaseName,WithPart2)),
  164            format(Outs,'~N~q.~n',[end_of_file]))),
  165  ((ignore(notrace_catch_fail(flush_output(Outs),_,true)),ignore(notrace_catch_fail(close(Outs),_,true))))),!.
  166  
  167
  168write_trans(Outs,File,WithPart2,Lisp):-
  169   zalwayz((call(WithPart2,Lisp,Part),
  170   nb_current('$lisp_translation_line',Line),
  171   format(Outs,'~N~q.~n',[lisp_trans(Part,File:Line)]))),!.
  172
  173/* alternate method*/
  174phrase_from_stream_partial(Grammar, In):-
  175  phrase_from_stream((Grammar,!,lazy_forgotten(In)), In).
  176
  177lazy_forgotten(In,UnUsed,UnUsed):- 
  178  (is_list(UnUsed)-> true ; append(UnUsed,[],UnUsed)),
  179  length(UnUsed,PlzUnread),
  180  seek(In, -PlzUnread, current, _).
  181
  182
  183% :- use_module(library(yall)).
  184% :- rtrace.
  185% tstl(I):- with_lisp_translation(I,([O]>>(writeq(O),nl))).
  186tstl(I):- with_kifvars(with_lisp_translation(I,writeqnl)).
  187
  188with_kifvars(Goal):- 
  189  locally(t_l:sreader_options(logicmoo_read_kif,true),Goal).
  190
  191
  192
  193%:- thread_local(t_l:fake_buffer_codes/2).

 parse_sexpr(:TermS, -Expr) is det

Parse S-expression.

  201parse_sexpr(S, Expr) :- quietly(parse_meta_term(file_sexpr_with_comments, S, Expr)),!.

 parse_sexpr_ascii(+Codes, -Expr) is det

Parse S-expression Codes.

  207parse_sexpr_ascii(S, Expr) :- quietly(parse_meta_ascii(file_sexpr_with_comments, S,Expr)),!.
  208
  209
  210parse_sexpr_ascii_as_list(Text, Expr) :- txt_to_codes(Text,DCodes),
  211 clean_fromt_ws(DCodes,Codes),!,append([`(`,Codes,`)`],NCodes),!, 
  212 phrase(sexpr_rest(Expr), NCodes, []).

 parse_sexpr_string(+Codes, -Expr) is det

Parse S-expression That maybe sees string from Codes.

  219parse_sexpr_string(S,Expr):- 
  220 locally_setval('$maybe_string',t,parse_sexpr(string(S), Expr)),!.

 parse_sexpr_stream(+Stream, -Expr) is det

Parse S-expression from a Stream

  226parse_sexpr_stream(S,Expr):- quietly(parse_meta_stream(file_sexpr_with_comments,S,Expr)),!.
  227
  228:- export('//'(file_sexpr,1)).  229:- export('//'(sexpr,1)).  230
  231% for offline use of this lisp reader
  232intern_and_eval(UTC,V):- current_predicate(lisp_compiled_eval/2),!,
  233  call(call,(reader_intern_symbols(UTC,M),!,lisp_compiled_eval(M,V))).
  234intern_and_eval(UTC,'$intern_and_eval'(UTC)).
  235
  236% Use DCG for parser.
  237
  238
  239%file_sexpr_with_comments(O) --> [], {clause(t_l:s_reader_info(O),_,Ref),erase(Ref)},!.
  240file_sexpr_with_comments(end_of_file) --> file_eof,!.
  241file_sexpr_with_comments(O) --> one_blank,!,file_sexpr_with_comments(O),!.  % WANT? 
  242file_sexpr_with_comments(end_of_file) --> `:EOF`,!.
  243file_sexpr_with_comments(C)                 --> dcg_peek(`#|`),!,zalwayz(comment_expr(C)),swhite,!.
  244file_sexpr_with_comments(C)                 --> dcg_peek(`;`),!, zalwayz(comment_expr(C)),swhite,!.
  245file_sexpr_with_comments(Out) --> {kif_ok}, prolog_expr_next, prolog_readable_term(Out), !.
  246file_sexpr_with_comments(Out,S,E):- \+ t_l:sreader_options(with_text,true),!,phrase(file_sexpr(Out),S,E),!.
  247file_sexpr_with_comments(Out,S,E):- expr_with_text(Out,file_sexpr(O),O,S,E),!.
  248
  249prolog_expr_next--> dcg_peek(`:-`).
  250prolog_expr_next--> dcg_peek(read_string_until(S,(eol;`.`))),{atom_contains(S,':-')}.
  251prolog_expr_next--> dcg_peek(`.{`).
  252
  253prolog_readable_term(Expr) -->  `.`,prolog_readable_term(Read), {arg(1,Read,Expr),!}.
  254prolog_readable_term(Expr,S,E):- 
  255  catch((read_term_from_codes(S,Expr,[subterm_positions(FromTo),cycles(true), module( baseKB),
  256   double_quotes(string),
  257   comments(CMT), variable_names(Vars)]),implode_threse_vars(Vars),
  258   arg(2,FromTo,To), length(TermCodes,To),
  259   append(TermCodes,Remaining,S),
  260   `.`=[Dot],(Remaining=[Dot|E]/*;Remaining=E*/),!,
  261    must(record_plterm_comments(CMT))),_,fail).
  262record_plterm_comments(L):- is_list(L),!,maplist(record_plterm_comments,L).
  263record_plterm_comments(_-CMT):- assert(t_l:s_reader_info(CMT)).
  264
  265
  266% in Cyc there was a fitness heuristic that every time an logical axiom had a generated a unique consequent it was considered to have utility as it would expand the breadth of a search .. the problem often was those consequents would feed a another axiom's antecedant where that 
  267:- asserta((system:'$and'(X,Y):- (X,Y))).  268
  269%expr_with_text(Out,DCG,O,S,E):- 
  270%   call(DCG,S,E) -> append(S,Some,E) -> get_sexpr_with_comments(O,Some,Out,S,E),!.
  271
  272get_sexpr_with_comments(O,_,O,_,_):- compound(O),functor(O,'$COMMENT',_),!.
  273get_sexpr_with_comments(O,Txt,with_text(O,Str),S,_E):-append(Txt,_,S),!,text_to_string(Txt,Str).
  274%file_sexpr_with_comments(O,with_text(O,Txt),S,E):- copy_until_tail(S,Copy),text_to_string_safe(Copy,Txt),!.
  275
  276
  277file_sexpr(end_of_file) --> file_eof,!.
  278% WANT? 
  279file_sexpr(O) --> sblank,!,file_sexpr(O),!.
  280% 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]
  281% 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)]),!.
  282% 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)]),!.
  283file_sexpr(Expr) --> sexpr(Expr),!.
  284% file_sexpr(Expr,H,T):- lisp_dump_break,rtrace(phrase(file_sexpr(Expr), H,T)).
  285/*
  286file_sexpr(Expr) --> {fail},
  287   sexpr_lazy_list_character_count(Location,Stream),
  288  {break,
  289   seek(Stream,Location,bof,_),   
  290   read_clause(Stream,Expr,[cycles(true),double_quotes(string),variable_names(Vars)]),
  291   implode_threse_vars(Vars)},!.
  292
  293file_sexpr(Expr) --> sexpr(Expr),!.
  294
  295file_sexpr(end_of_file) --> [].
  296*/
  297% file_sexpr('$ERROR'(S_EOF)) --> read_until_eof_e(Unitl_EOF),!,{sformat(S_EOF,'~s',[Unitl_EOF])}.
  298% read_until_eof_e(Unitl_EOF,S,E):- append(S,E,Unitl_EOF),break,is_list(Unitl_EOF),!.
  299
  300%read_dispatch(E,[Disp,Char|In],Out):- read_dispatch_char([Disp,Char],E,In,Out). 
  301read_dispatch(E,[DispatCH|In],Out):- read_dispatch_char([DispatCH],E,In,Out). 
  302
  303read_dispatch_char(DispatCH,Form,In,Out):- sread_dyn:plugin_read_dispatch_char(DispatCH,Form,In,Out),!.
  304% read_dispatch_char(`@`,Form,In,Out):- phrase(sexpr(Form), In, Out),!.
  305
  306read_dispatch_error(Form,In,Out):- trace, dumpST,trace_or_throw((read_dispatch_error(Form,In,Out))).
  307
  308
  309
  310                                                                  
  311:- multifile(sread_dyn:plugin_read_dispatch_char/4).  312:- dynamic(sread_dyn:plugin_read_dispatch_char/4).  313
  314:- use_module(library(dcg/basics)).  315
  316% #x Hex
  317sread_dyn:plugin_read_dispatch_char([DispatCH],Form,In,Out):-
  318  member(DispatCH,`Xx`),(phrase((`-`,dcg_basics:xinteger(FormP)), In, Out)),!,Form is -FormP.
  319
  320sread_dyn:plugin_read_dispatch_char([DispatCH],Form,In,Out):-
  321  member(DispatCH,`Xx`),!,zalwayz(phrase(dcg_basics:xinteger(Form), In, Out)),!.
  322
  323% #B Binary
  324sread_dyn:plugin_read_dispatch_char([DispatCH],Form,In,Out):-
  325  member(DispatCH,`Bb`),!,phrase(signed_radix_2(2,Form), In, Out),!.
  326
  327% #O Octal
  328sread_dyn:plugin_read_dispatch_char([DispatCH],Form,In,Out):-
  329  member(DispatCH,`Oo`),!,phrase(signed_radix_2(8,Form), In, Out),!.
  330
  331signed_radix_2(W,V)--> signed_radix_2_noext(W,Number),extend_radix(W,Number,V).
  332
  333signed_radix_2_noext(W,Number) --> `-`,!,unsigned_radix_2(W,NumberP),{Number is - NumberP },!.
  334signed_radix_2_noext(W,Number) --> `+`,!,unsigned_radix_2(W,Number).
  335signed_radix_2_noext(W,Number) --> unsigned_radix_2(W,Number).
  336
  337unsigned_radix_2(W,Number) --> radix_digits(W,Xs),!,{mkvar_w(Xs,W,Number)},!.
  338
  339
  340radix(Radix)-->`#`,integer(Radix),ci(`r`).
  341radix(16)-->`#`,ci(`X`).
  342radix(8)-->`#`,ci(`O`).
  343radix(2)-->`#`,ci(`B`).
  344
  345signed_radix_number(V)--> radix(Radix),!,signed_radix_2(Radix,V).
  346unsigned_radix_number(V)--> radix(Radix),!,unsigned_radix_2(Radix,V).
  347
  348extend_radix(Radix,Number0,'$RATIO'(Number0,Number1)) --> `/`,unsigned_radix_2(Radix,Number1).
  349%extend_radix(Radix,Number0,'/'(NumberB,Number1)) --> `.`,radix_number(Radix,Number1),{NumberB is (Number0*Number1)+1},!.
  350%extend_radix(Radix,Number0,'/'(NumberB,NumberR)) --> `.`,radix_number(Radix,Number1),{NumberR is Number1 * Radix, NumberB is (Number0*Number1)+1},!.
  351extend_radix(_Radix,Number,Number) --> [].
  352
  353radix_digits(OF,[X|Xs]) --> xdigit(X),{X<OF},!,radix_digits(OF,Xs).
  354radix_digits(OF,[X|Xs]) --> alpha_to_lower(C),{X is C - 87,X<OF},!,radix_digits(OF,Xs).
  355radix_digits(_,[]) --> [].
  356
  357
  358
  359mkvar_w([W0|Weights], Base, Val) :-
  360  mkvar_w(Weights, Base, W0, Val).
  361  
  362mkvar_w([], _, W, W).
  363mkvar_w([H|T], Base, W0, W) :-
  364  W1 is W0*Base+(H),
  365  mkvar_w(T, Base, W1, W).
  366
  367
  368ci([])--> !, [].
  369ci([U|Xs]) --> {to_lower(U,X)},!,alpha_to_lower(X),ci(Xs).
  370  
  371
  372remove_optional_char(S)--> S,!.
  373remove_optional_char(_)-->[].
  374
  375implode_threse_vars([N='$VAR'(N)|Vars]):-!, implode_threse_vars(Vars).
  376implode_threse_vars([]).
  377
  378ugly_sexpr_cont('$OBJ'([S|V]))                 --> rsymbol_maybe(``,S), sexpr_vector(V,`>`),swhite,!.
  379ugly_sexpr_cont('$OBJ'(V))                 -->  sexpr_vector(V,`>`),swhite,!.
  380ugly_sexpr_cont('$OBJ'(V))                 -->  sexpr_vector(V,`>`),swhite,!.
  381ugly_sexpr_cont('$OBJ'(V))                 -->  read_string_until_pairs(VS,`>`), swhite,{parse_sexpr_ascii_as_list(VS,V)},!.
  382ugly_sexpr_cont('$OBJ'(sugly,S))                 -->  read_string_until(S,`>`), swhite,!.

 sexpr(L)// is det

  387%sexpr(L)                   --> sblank,!,sexpr(L),!.
  388%sexpr(_) --> `)`,!,{trace,break,throw_reader_error(": an object cannot start with #\\)")}.
  389sexpr(X,H,T):- zalwayz(sexpr0(X),H,M),zalwayz(swhite,M,T), nop(if_debugging(sreader,(wdmsg(sexpr(X))))),!.
  390%sexpr(X,H,T):- zalwayz(sexpr0(X,H,T)),!,swhite.
  391
  392sexpr0(L)                      --> sblank,!,sexpr(L),!.
  393sexpr0(L)                      --> `(`, !, swhite, zalwayz(sexpr_list(L)),!, swhite.
  394sexpr0((Expr))                 -->  `.{`, read_string_until(S,`}.`), swhite,
  395  {prolog_readable_term(Expr,S,_)}.
  396
  397
  398sexpr0(['#'(quote),E])             --> `'`, !, sexpr(E).
  399sexpr0(['#'(backquote),E])         --> ````, !, sexpr(E).
  400sexpr0(['#BQ-COMMA-ELIPSE',E])     --> `,@`, !, sexpr(E).
  401sexpr0(['#COMMA',E])               --> `,`, !, sexpr(E).
  402sexpr0('$OBJ'(claz_bracket_vector,V))                 --> `[`, sexpr_vector(V,`]`),!, swhite.
  403sexpr0('#'(A))              --> `|`, !, read_string_until(S,`|`), swhite,{quietly_sreader(((atom_string(A,S))))}.
  404
  405% maybe this is KIF
  406sexpr0('?'(E))              --> {kif_ok}, `?`, dcg_peek(([C],{sym_char(C)})),!, rsymbol(``,E), swhite.
  407% @TODO if KIF sexpr('#'(E))              --> `&%`, !, rsymbol(`#$`,E), swhite.
  408
  409sexpr0('$STRING'(S))             --> s_string(S),!.
  410
  411/******** BEGIN HASH ************/
  412
  413sexpr0('#\\'(35))                 --> `#\\#`,!, swhite.
  414sexpr0(E)                      --> `#`,read_dispatch(E),!.
  415
  416%sexpr('#\\'(C))                 --> `#\\`,ci(`u`),!,remove_optional_char(`+`),dcg_basics:xinteger(C),!.
  417%sexpr('#\\'(C))                 --> `#\\`,dcg_basics:digit(S0), swhite,!,{atom_codes(C,[S0])}.
  418sexpr0('#\\'(32))                 --> `#\\ `,!.
  419sexpr0('#\\'(C))                 --> `#\\`,!,zalwayz(rsymbol(``,C)), swhite.
  420
  421%sexpr(['#-',K,Out]) --> `#-`,!,sexpr(C),swhite,expr_with_text(Out,sexpr(O),O),!,{as_keyword(C,K)}.
  422%sexpr(['#+',K,Out]) --> `#+`,!,sexpr(C),swhite,expr_with_text(Out,sexpr(O),O),!,{as_keyword(C,K)}.
  423
  424sexpr0(['#-',K,O]) --> `#-`,!,sexpr(C),swhite,sexpr(O),!,{as_keyword(C,K)},!.
  425sexpr0(['#+',K,O]) --> `#+`,!,sexpr(C),swhite,sexpr(O),!,{as_keyword(C,K)},!.
  426
  427sexpr0(P) --> `#`,ci(`p`),!,zalwayz((sexpr(C),{f_pathname(C,P)})),!.
  428sexpr0('$S'(C)) -->                  (`#`, ci(`s`),`(`),!,zalwayz(sexpr_list(C)),swhite,!.
  429%sexpr('$COMPLEX'(R,I)) --> `#`,ci(`c`),`(`,!,  lnumber(R),lnumber(I),`)`.
  430sexpr0('$COMPLEX'(R,I)) -->         (`#`, ci(`c`),`(`),!,zalwayz(sexpr_list([R,I])),swhite,!.
  431sexpr0('$OBJ'(claz_bitvector,C)) --> `#*`,radix_digits(2,C),swhite,!.
  432
  433sexpr0(function(E))                 --> `#\'`, sexpr(E), !. %, swhite.
  434sexpr0('$OBJ'(claz_vector,V))                 --> `#(`, !, zalwayz(sexpr_vector(V,`)`)),!, swhite,!.
  435
  436sexpr0(Number) --> `#`,integer(Radix),ci(`r`),!,zalwayz((signed_radix_2(Radix,Number0),extend_radix(Radix,Number0,Number))),!.
  437sexpr0('$ARRAY'(Dims,V)) --> `#`,integer(Dims),ci(`a`),!,sexpr(V).
  438sexpr0(V)                    --> `#.`, !,sexpr(C),{to_untyped(C,UTC),!,intern_and_eval(UTC,V)},!.
  439sexpr0('#'(E))              --> `#:`, !,zalwayz(rsymbol(`#:`,E)), swhite.
  440
  441sexpr0(OBJ)--> `#<`,!,zalwayz(ugly_sexpr_cont(OBJ)),!.
  442
  443% @TODO if CYC sexpr('#'(E))              --> `#$`, !, rsymbol(`#$`,E), swhite.
  444% @TODO if scheme sexpr('#'(t))                 --> `#t`, !, swhite.
  445% @TODO if schemesexpr('#'(f))                 --> `#f`, !, swhite.
  446
  447% sexpr(E)                      --> `#`,read_dispatch_error(E).
  448
  449/*********END HASH ***********/
  450
  451sexpr0(E)                      --> !,zalwayz(sym_or_num(E)), swhite,!.
  452
  453
  454priority_symbol((`#+`)).
  455priority_symbol((`#-`)).
  456priority_symbol((`#false`)).
  457priority_symbol((`#true`)).
  458priority_symbol((`#nil`)).
  459priority_symbol((`#null`)).
  460priority_symbol((`#f`)).
  461priority_symbol((`#t`)).
  462priority_symbol((`+1+`)).
  463priority_symbol((`+1-`)).
  464priority_symbol((`-#+`)).
  465priority_symbol((`-1+`)).
  466priority_symbol((`-1-`)).
  467priority_symbol((`1+`)).
  468priority_symbol((`1-`)).
  469
  470sym_or_num('$COMPLEX'(L)) --> `#C(`,!, swhite, sexpr_list(L), swhite.
  471%sym_or_num((E)) --> unsigned_number(S),{number_string(E,S)}.
  472%sym_or_num((E)) --> unsigned_number(S),{number_string(E,S)}.
  473
  474sym_or_num((E)) --> lnumber(E),swhite,!.
  475sym_or_num(E) --> rsymbol_maybe(``,E),!.
  476%sym_or_num('#'(E)) --> [C],{atom_codes(E,[C])}.
  477
  478sym_or_num(E) --> dcg_xor(rsymbol(``,E),lnumber(E)),!.
  479% sym_or_num('#'(E)) --> [C],{atom_codes(E,[C])}.
  480
  481
  482dcg_xor(DCG1,DCG2,S,E):- copy_term(DCG1,DCG1C),phrase(DCG1C,S,E),!,
  483  (phrase(DCG2,S,[])->true;zalwayz(DCG1C=DCG1)),!.
  484dcg_xor(_,DCG2,S,E):- phrase(DCG2,S,E),!.
  485%sblank --> [C], {var(C)},!.
  486
  487% sblank --> comment_expr(S,I,CP),!,{assert(t_l:s_reader_info('$COMMENT'(S,I,CP)))},!,swhite.
  488sblank --> comment_expr(CMT),!,{assert(t_l:s_reader_info(CMT))},!,swhite.
  489sblank --> [C], {nonvar(C),charvar(C),!,bx(C =< 32)},!,swhite.
  490
  491sblank_line --> eoln,!.
  492sblank_line --> [C],{bx(C =< 32)},!, sblank_line.
  493
  494s_string(Text)                 --> sexpr_string(Text).
  495s_string(Text)                 --> {kif_ok},`'`, !, zalwayz(read_string_until_no_esc(Text,`'`)),!.
  496
  497
  498
  499swhite --> sblank,!.
  500swhite --> [].
  501
  502
  503sexpr_lazy_list_character_count(Location, Stream, Here, Here) :-
  504	sexpr_lazy_list_character_count(Here, Location, Stream).
  505
  506sexpr_lazy_list_character_count(Here, CharNo, Stream) :-
  507	'$skip_list'(Skipped, Here, Tail),
  508	(   attvar(Tail)
  509	->  frozen(Tail,
  510		   pure_input:read_to_input_stream(Stream, _PrevPos, Pos, _List)),
  511	    stream_position_data(char_count, Pos, EndRecordCharNo),
  512	    CharNo is EndRecordCharNo - Skipped
  513	;   Tail == []
  514	->  CharNo = end_of_file-Skipped
  515	;   type_error(lazy_list, Here)
  516	).
  517
  518
  519
  520comment_expr('$COMMENT'(Expr,I,CP)) --> comment_expr_3(Expr,I,CP),!.
  521
  522comment_expr_3(T,N,CharPOS) --> {\+ kif_ok}, `#|`, !, my_lazy_list_location(file(_,_,N,CharPOS)),!, zalwayz(read_string_until_no_esc(S,`|#`)),!,
  523  {text_to_string_safe(S,T)},!.
  524comment_expr_3(T,N,CharPOS) -->  `;`,!, my_lazy_list_location(file(_,_,N,CharPOS)),!,zalwayz(read_string_until_no_esc(S,eoln)),!,
  525  {text_to_string_safe(S,T)},!.
  526comment_expr_3(T,N,CharPOS) --> {kif_ok}, `#!`,!, my_lazy_list_location(file(_,_,N,CharPOS)),!,zalwayz(read_string_until_no_esc(S,eoln)),!,
  527  {text_to_string_safe(S,T)},!.
  528
  529
  530sexprs([H|T]) --> sexpr(H), !, sexprs(T).
  531sexprs([]) --> [].
  532
  533
  534:- export('//'(sexpr_list,1)).  535 
  536
  537peek_symbol_breaker_or_number --> dcg_peek([C]),{\+ sym_char(C),\+ char_type(C,digit)}.
  538peek_symbol_breaker --> dcg_peek([C]),{\+ sym_char(C)}.
  539peek_symbol_breaker --> one_blank.
  540
  541sexpr_list(X) --> one_blank,!,sexpr_list(X).
  542sexpr_list([]) --> `)`, !.
  543%sexpr_list(_) --> `.`, [C], {\+ sym_char(C)}, {fail}.
  544sexpr_list([Car|Cdr]) --> sexpr(Car), !, sexpr_rest(Cdr),!.
  545
  546sexpr_rest([]) --> `)`, !.
  547sexpr_rest(E) --> `.`, [C], {\+ sym_char(C)}, !, sexpr(E,C), !, `)`.
  548sexpr_rest(E) --> {kif_ok}, `@`, rsymbol(`?`,E), `)`.
  549sexpr_rest([Car|Cdr]) --> sexpr(Car), !, sexpr_rest(Cdr),!.
  550
  551sexpr_vector(O,End) --> zalwayz(sexpr_vector0(IO,End)),!,{zalwayz(O=IO)}.
  552
  553sexpr_vector0(X) --> one_blank,!,sexpr_vector0(X).
  554sexpr_vector0([],End) --> End, !.
  555sexpr_vector0([First|Rest],End) --> sexpr(First), !, sexpr_vector0(Rest,End).
  556
  557%s_string_cont(Until,"")             --> Until,!, swhite.
  558:- encoding(iso_latin_1).
  559sexpr_string(Text)                 --> `�`, !, zalwayz(read_string_until_no_esc(Text,`�`)),!.
  560sexpr_string(Text)                 --> `"`, !, zalwayz(read_string_until_no_esc(Text,`"`)),!.
  561sexpr_string(Text)                 --> `#|`, !, zalwayz(read_string_until_no_esc(Text,`|#`)),!.
  562%sexpr_string([C|S],End) --> `\\`,!, zalwayz(escaped_char(C)),!, sexpr_string(S,End).
  563%sexpr_string([],End) --> End, !.
  564% sexpr_string([32|S]) --> [C],{eoln(C)}, sexpr_string(S).
  565%sexpr_string([C|S],End) --> [C],!,sexpr_string(S,End).
  566
  567rsymbol_chars([C1,C2|Rest]) --> [C1,C2], {priority_symbol([C1,C2|Rest])},Rest,!.
  568rsymbol_chars([C|S])--> [C], {sym_char(C)},!, sym_continue(S),!.
  569%rsymbol_cont(Prepend,E) --> sym_continue(S), {append(Prepend,S,AChars),string_to_atom(AChars,E)},!.
  570
  571rsymbol(Chars,E) --> rsymbol_chars(List), {append(Chars,List,AChars),string_to_atom(AChars,E)},!.
  572
  573rsymbol_maybe(Prepend,ES) --> rsymbol(Prepend,E),{maybe_string(E,ES)},!.
  574
  575maybe_string(E,ES):- nb_current('$maybe_string',t),!,text_to_string_safe(E,ES),!.
  576maybe_string(E,E).
  577
  578sym_continue([H|T]) --> [H], {sym_char(H)},!, sym_continue(T).
  579sym_continue([]) --> peek_symbol_breaker,!.
  580sym_continue([]) --> [].
  581
  582string_vector([First|Rest]) --> sexpr(First), !, string_vector(Rest),!.
  583string_vector([]) --> [], !.
  584
  585% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
  586
  587lnumber(_)--> [C],{code_type(C,alpha)},!,{fail}.
  588lnumber(N)-->  lnumber0(N),!. % (peek_symbol_breaker;[]).
  589
  590oneof_ci(OneOf,[C])--> {member(C,OneOf)},ci([C]). 
  591dcg_and2(DCG1,DCG2,S,E) :- dcg_phrase(DCG1,S,E),!,dcg_phrase(DCG2,S,E),!.
  592dcg_each_call_cleanup(Setup,DCG,Cleanup,S,E) :- each_call_cleanup(Setup,dcg_phrase(DCG,S,E),Cleanup).
  593dcg_phrase(\+ DCG1,S,E):- !, \+ phrase(DCG1,S,E).
  594dcg_phrase(DCG1,S,E):- phrase(DCG1,S,E),!.
  595
  596dcg_not(DCG1,S,E) :- \+ dcg_phrase(DCG1,S,E).
  597
  598enumber(N)--> lnumber(L),!,{to_untyped(L,N)},!.
  599
  600/*
  601Format  Minimum Precision  Minimum Exponent Size  
  602Short   13 bits            5 bits                 
  603Single  24 bits            8 bits                 
  604Double  50 bits            8 bits                 
  605Long    50 bits            8 bits   
  606*/
  607
  608float_e_type(`E`,claz_single_float).
  609float_e_type(`f`,claz_single_float).
  610float_e_type(`d`,claz_double_float).
  611float_e_type(`L`,claz_long_float).
  612float_e_type(`s`,claz_short_float).
  613
  614lnumber_exp('$EXP'(N,T,E))-->snumber_no_exp(N),!,oneof_ci(`EsfdL`,TC),dcg_basics:integer(E),{exp:float_e_type(TC,T)},!.
  615lnumber_exp('$EXP'(N,T,E))-->dcg_basics:integer(N),!,oneof_ci(`EsfdL`,TC),dcg_basics:integer(E),!,{float_e_type(TC,T)},!.
  616
  617
  618lnumber0(N) --> lnumber_exp(N),!.
  619lnumber0('$RATIO'(N,D)) --> sint(N),`/`,uint(D),!.
  620lnumber0(N) --> snumber_no_exp(N),!.
  621%lnumber0(N) --> dcg_basics:number(N),!.
  622
  623
  624snumber_no_exp(N)--> `-`,!,unumber_no_exp(S),{N is -S},!.
  625snumber_no_exp(N)--> `+`,!,unumber_no_exp(N),!.
  626snumber_no_exp(N)--> unumber_no_exp(N),!.
  627%snumber_no_exp(N)-->  sint(N),!.
  628
  629
  630sint(N) --> signed_radix_number(N),!.
  631sint(N)--> `-`,!,uint(S),{N is -S},!.                          
  632sint(N)--> `+`,!,uint(N),!.
  633sint(N)--> uint(N),!.
  634
  635natural_int(_) --> dcg_not(dcg_basics:digit(_)),!,{fail}.
  636natural_int(N) --> dcg_basics:integer(N),!.
  637
  638digits_dot_digits --> natural_int(_),!,`.`,!,natural_int(_),!.
  639
  640unumber_no_exp(N) --> dcg_and2(digits_dot_digits,dcg_basics:float(N)),!.
  641unumber_no_exp(N) --> `.`,!,dcg_basics:digit(S0),!,dcg_basics:digits(S),{(notrace_catch_fail(number_codes(N,[48,46,S0|S])))},!.
  642unumber_no_exp(N)--> natural_int(E),`.`,natural_int(S),{(notrace_catch_fail(number_codes(ND,[48,46|S]))),N is ND + E},!.
  643unumber_no_exp(N) --> natural_int(N),!,remove_optional_char(`.`),!.
  644
  645uint(N) --> unsigned_radix_number(N),!.
  646uint(N) --> natural_int(N),!,remove_optional_char(`.`),!.
  647
  648
  649% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
  650
  651
  652%= 	 	 

 sexpr(?E, ?C, ?X, ?Z) is det

S-Expression.

  658sexpr(E,C,X,Z) :- swhite([C|X],Y), sexpr(E,Y,Z),!.
  659
  660% dquote semicolon parens  hash qquote  comma backquote
  661
  662%= 	 	 

 sym_char(?C) is det

Sym Char. (not ";()#',` )

  670sym_char(C):- bx(C =<  32),!,fail.
  671%sym_char(44). % allow comma in middle of symbol
  672sym_char(C):- memberchk(C,`";()#'```),!,fail.  % maybe 44 ? comma
  673%sym_char(C):- nb_current('$maybe_string',t),memberchk(C,`,.:;!%`),!,fail.
  674sym_char(_):- !.
  675
  676sym_char_start(C):- C\==44,C\==59,sym_char(C).
  677
  678
  679
  680:- thread_initialization(nb_setval('$maybe_string',[])).  681
  682:- thread_local(t_l:s2p/1).  683:- thread_local(t_l:each_file_term/1).  684
  685
  686
  687%= 	 	 

 to_unbackquote(?I, ?O) is det

Converted To Unbackquote.

  693to_unbackquote(I,O):-to_untyped(I,O),!.
  694
  695:- export(to_untyped/2).  696
  697
  698%atom_or_string(X):- (atom(X);string(X)),!.
  699as_keyword(C,K):- atom(C),!,(atom_concat_or_rtrace(':',_,C)->K=C;atom_concat_or_rtrace(':',C,K)),!.
  700as_keyword(C,C):- \+compound(C),!.
  701as_keyword([A|B],[AK|BK]):- !, as_keyword(A,AK),as_keyword(B,BK),!.
  702as_keyword(C,C).

 to_untyped(:TermVar, :TermName) is det

Converted To Untyped.

  709to_untyped(S,S):- var(S),!.
  710to_untyped(S,S):- is_dict(S),!.
  711to_untyped([],[]):-!.
  712to_untyped('#-'(C,I),'#-'(K,O)):- as_keyword(C,K),!,to_untyped(I,O),!.
  713to_untyped('#+'(C,I),'#+'(K,O)):- as_keyword(C,K),!,to_untyped(I,O),!.
  714to_untyped('?'(S),_):- S=='??',!.
  715% to_untyped('?'(S),'$VAR'('_')):- S=='??',!.
  716% to_untyped(VAR,NameU):-atom(VAR),atom_concat_or_rtrace('#$',NameU,VAR),!.
  717to_untyped(VAR,NameU):-atom(VAR),(atom_concat_or_rtrace(N,'.',VAR)->true;N=VAR),(notrace_catch_fail(atom_number(N,NameU))),!.
  718%to_untyped(S,s(L)):- string(S),atom_contains(S,' '),atomic_list_concat(['(',S,')'],O),parse_sexpr_string(O,L),!.
  719to_untyped(S,S):- string(S),!.
  720to_untyped(S,S):- number(S),!.
  721%to_untyped(S,O):- atom(S),notrace_catch_fail(atom_number(S,O)),!.
  722to_untyped(Var,'$VAR'(Name)):-svar(Var,Name),!.
  723to_untyped('?'(Var),'$VAR'(Name)):-svar_fixvarname(Var,Name),!.
  724to_untyped(Atom,Atom):- \+ compound(Atom),!.
  725to_untyped('@'(Var),'$VAR'(Name)):-svar_fixvarname(Var,Name),!.
  726to_untyped('#'(S),O):- !, (nonvar(S)->to_untyped(S,O) ; O='#'(S)).
  727to_untyped('$CHAR'(S),C):-!,to_untyped('#\\'(S),C),!.
  728to_untyped('#\\'(S),C):-to_char(S,C),!.
  729to_untyped('#\\'(S),'#\\'(S)):-!.
  730to_untyped('$OBJ'([FUN, F]),O):- atom(FUN),!,to_untyped('$OBJ'(FUN, F),O).
  731to_untyped('$OBJ'([FUN| F]),O):- atom(FUN),!,to_untyped('$OBJ'(FUN, F),O).
  732to_untyped('$OBJ'(S),'$OBJ'(O)):-to_untyped(S,O),!.
  733to_untyped('$OBJ'(Ungly,S),'$OBJ'(Type,O)):- text_to_string_safe(Ungly,Str),string_to_atom(Str,Type),to_untyped(S,O),!.
  734to_untyped('$OBJ'(Ungly,S),'$OBJ'(Ungly,O)):-to_untyped(S,O),!.
  735to_untyped('$OBJ'(Ungly,S),O):-to_untyped(S,SO),!,O=..[Ungly,SO].
  736to_untyped('$COMPLEX'(N0,D0),N):- to_untyped(D0,D), notrace_catch_fail(( 0 =:= D)),to_untyped(N0,N).
  737to_untyped('$RATIO'(N0,D0),V):- to_untyped(N0,N),to_untyped(D0,D), notrace_catch_fail(( 0 is N mod D, V is N div D)).
  738to_untyped('$NUMBER'(S),O):-nonvar(S),to_number(S,O),to_untyped(S,O),!.
  739to_untyped('$NUMBER'(S),'$NUMBER'(claz_short_float,S)):- float(S),!.
  740to_untyped('$NUMBER'(S),'$NUMBER'(claz_bignum,S)).
  741to_untyped('$EXP'(I,'E',E),N):- (notrace_catch_fail(N is 0.0 + ((I * 10^E)))),!.
  742to_untyped('$EXP'(I,claz_single_float,E),N):- (notrace_catch_fail(N is 0.0 + ((I * 10^E)))),!.
  743to_untyped('$EXP'(I,T,E),'$NUMBER'(T,N)):- (notrace_catch_fail(N is (I * 10^E))),!.
  744to_untyped('$EXP'(I,T,E),'$EXP'(I,T,E)):-!.
  745
  746to_untyped(with_text(I,_Txt),O):-to_untyped(I,O),!.
  747to_untyped(with_text(I,Txt),with_text(O,Txt)):-to_untyped(I,O),!.
  748
  749% to_untyped([[]],[]):-!.
  750to_untyped('$STR'(Expr),Forms):- (text_to_string_safe(Expr,Forms);to_untyped(Expr,Forms)),!.
  751to_untyped('$STRING'(Expr),'$STRING'(Forms)):- (text_to_string_safe(Expr,Forms);to_untyped(Expr,Forms)),!.
  752to_untyped(['#'(Backquote),Rest],Out):- Backquote == backquote, !,to_untyped(['#'('#BQ'),Rest],Out).
  753to_untyped(['#'(S)|Rest],OOut):- nonvar(S), is_list(Rest),must_maplist(to_untyped,[S|Rest],[F|Mid]), 
  754          ((atom(F),t_l:s2p(F))-> Out=..[F|Mid];Out=[F|Mid]),
  755          to_untyped(Out,OOut).
  756to_untyped(ExprI,ExprO):- ExprI=..[F|Expr],atom_concat_or_rtrace('$',_,F),!,must_maplist(to_untyped,Expr,TT),ExprO=..[F|TT].
  757
  758% to_untyped([H|T],Forms):-is_list([H|T]),zalwayz(text_to_string_safe([H|T],Forms);maplist(to_untyped,[H|T],Forms)).
  759to_untyped([H|T],[HH|TT]):-!,zalwayz((to_untyped(H,HH),!,to_untyped(T,TT))).
  760to_untyped(ExprI,ExprO):- zalwayz(ExprI=..Expr),
  761  must_maplist(to_untyped,Expr,[HH|TT]),(atom(HH)-> ExprO=..[HH|TT] ; ExprO=[HH|TT]),!.
  762% to_untyped(Expr,Forms):-def_compile_all(Expr,Forms),!.
  763
  764to_number(S,S):-number(S),!.
  765to_number(S,N):- text_to_string_safe(S,Str),number_string(N,Str),!.
  766
  767
  768to_char(S,'#\\'(S)):- var(S),!.
  769to_char('#'(S),C):- !, to_char(S,C).
  770to_char('#\\'(S),C):- !, to_char(S,C).
  771to_char(S,C):- atom(S),atom_concat('^',SS,S),upcase_atom(SS,SU),atom_codes(SU,[N64]),N is N64-64,N>=0,!,to_char(N,C).
  772to_char(S,C):- atom(S),atom_codes(S,[N]),!,to_char(N,C).
  773to_char(N,C):- text_to_string_safe(N,Str),name_to_charcode(Str,Code),to_char(Code,C),!.
  774%to_char(N,'#\\'(S)):- to_number(N,NC),!,char_code_to_char(NC,S),!.
  775to_char(N,'#\\'(S)):- integer(N),!,char_code_to_char(N,S),!.
  776to_char(N,'#\\'(N)).
  777
  778char_code_int(Char,Code):- notrace_catch_fail(char_code(Char,Code)),!.
  779char_code_int(Char,Code):- notrace_catch_fail(atom_codes(Char,[Code])),!.
  780char_code_int(Char,Code):- atom(Char),name_to_charcode(Char,Code),!.
  781char_code_int(Char,Code):- var(Char),!,wdmsg(char_code_int(Char,Code)), only_debug(break).
  782char_code_int(Char,Code):- wdmsg(char_code_int(Char,Code)),only_debug(break).
  783
  784char_code_to_char(N,S):- atom(N),atom_codes(N,[_]),!,S=N.
  785char_code_to_char(N,S):- atom(N),!,S=N.
  786%char_code_to_char(N,S):- code_type(N,graph),atom_codes(S,[N]),atom(S),!.
  787%char_code_to_char(N,O):- \+ integer(N),char_type(N,_),!,N=O.
  788%char_code_to_char(32,' '):-!.
  789%char_code_to_char(N,N):- \+ code_type(N,graph),!.
  790%char_code_to_char(N,N):- code_type(N,white),!.
  791char_code_to_char(N,S):-  notrace_catch_fail(atom_codes(S,[N])),!.
  792
  793
  794
  795name_to_charcode(Str,Code):-find_from_name(Str,Code),!.
  796name_to_charcode(Str,Code):-text_upper(Str,StrU),find_from_name2(StrU,Code).
  797name_to_charcode(Str,Code):-string_codes(Str,[S,H1,H2,H3,H4|HEX]),memberchk(S,`Uu`),char_type(H4,xdigit(_)),
  798   notrace_catch_fail(read_from_codes([48, 120,H1,H2,H3,H4|HEX],Code)).
  799name_to_charcode(Str,Code):-string_codes(Str,[S,H1|BASE10]),memberchk(S,`nd`),char_type(H1,digit),
  800   notrace_catch_fail(read_from_codes([H1|BASE10],Code)).
  801
  802find_from_name(Str,Code):-string_codes(Str,Chars),lisp_code_name_extra(Code,Chars).
  803find_from_name(Str,Code):-lisp_code_name(Code,Str).
  804find_from_name(Str,Code):-string_chars(Str,Chars),lisp_code_name(Code,Chars).
  805
  806make_lisp_character(I,O):-quietly(to_char(I,O)).
  807
  808f_code_char(CH,CC):- zalwayz(to_char(CH,CC)),!.
  809f_name_char(Name,CC):- zalwayz((def_to_prolog_string(Name,CH),name_to_charcode(CH,Code),to_char(Code,CC))).
  810f_char_name(CH,CC):- zalwayz(def_is_characterp(CH)),zalwayz(code_to_name(CH,CC)).
  811f_char_int(CH,CC):-  zalwayz(def_is_characterp(CH)),zalwayz('#\\'(C)=CH),(integer(C)->CC=C;char_code_int(C,CC)).
  812f_char_code(CH,CC):- f_char_int(CH,CC).
  813
  814to_prolog_char('#\\'(X),O):-!,to_prolog_char(X,O).
  815to_prolog_char(Code,Char):- number(Code),!,zalwayz(char_code_int(Char,Code)),!.
  816%to_prolog_char(S,S):- atom(S),char_type(S,_),!.
  817to_prolog_char(Atom,Char):- name(Atom,[C|Odes]),!,
  818  ((Odes==[] -> char_code_int(Char,C); 
  819  zalwayz((text_to_string(Atom,String),name_to_charcode(String,Code),char_code_int(Char,Code))))).
  820
  821code_to_name(Char,Str):- number(Char),Char=Code,!,zalwayz((code_to_name0(Code,Name),!,text_to_string(Name,Str))).
  822code_to_name(Char,Str):- zalwayz((to_prolog_char(Char,PC),char_code_int(PC,Code),code_to_name0(Code,Name),!,text_to_string(Name,Str))).
  823
  824code_to_name0(Code,Name):-lisp_code_name_extra(Code,Name).
  825code_to_name0(Code,Name):-lisp_code_name(Code,Name).
  826code_to_name0(Code,Name):- Code<32, Ascii is Code+64,atom_codes(Name,[94,Ascii]).
  827code_to_name0(Code,Name):- code_type(Code,graph),!,atom_codes(Name,[Code]).
  828
  829
  830find_from_name2(Str,Code):-find_from_name(Str,Code).
  831find_from_name2(Str,Code):-lisp_code_name(Code,Chars),text_upper(Chars,Str).
  832find_from_name2(Str,Code):-lisp_code_name_extra(Code,Chars),text_upper(Chars,Str).
  833
  834text_upper(T,U):-text_to_string_safe(T,S),string_upper(S,U).
  835
  836lisp_code_name_extra(0,`Null`).
  837lisp_code_name_extra(1,`Soh`).
  838lisp_code_name_extra(2,`^B`).
  839lisp_code_name_extra(7,`Bell`).
  840lisp_code_name_extra(7,`bell`).
  841lisp_code_name_extra(8,`BCKSPC`).
  842lisp_code_name_extra(10,`Newline`).
  843lisp_code_name_extra(10,`LF`).
  844lisp_code_name_extra(10,`Linefeed`).
  845lisp_code_name_extra(11,`Vt`).
  846lisp_code_name_extra(27,`Escape`).
  847lisp_code_name_extra(27,`Esc`).
  848lisp_code_name_extra(32,`Space`).
  849lisp_code_name_extra(28,`fs`).
  850lisp_code_name_extra(13,`Ret`).
  851
  852
  853% @TODO undo this temp speedup
  854:- set_prolog_flag(all_lisp_char_names,false).  855:- use_module('chars.data').  856/*
  857
  858(with-open-file (strm "lisp_code_names.pl" :direction :output :if-exists :supersede :if-does-not-exist :create)
  859 (format  strm ":- module(lisp_code_names,[lisp_code_name/2]).~%:- set_prolog_flag(double_quotes,chars).~%~%")
  860 (loop for i from 0 to 655360 do (let ((cname (char-name (code-char i))) (uname4 (format ()  "U~4,'0X" i)) (uname8 (format ()  "U~8,'0X" i)))
  861  (unless (equal cname uname4) (unless (equal cname uname8)  (format  strm "lisp_code_name(~A,~S).~%" i  cname ))))))
  862*/