Skip to content

Commit

Permalink
svar_fixvarname
Browse files Browse the repository at this point in the history
  • Loading branch information
TeamSPoon committed Dec 11, 2024
1 parent 14a77f5 commit 208360f
Showing 1 changed file with 104 additions and 22 deletions.
126 changes: 104 additions & 22 deletions prolog/metta_lang/metta_parser.pl
Original file line number Diff line number Diff line change
Expand Up @@ -206,6 +206,35 @@
svar_fixvarname(SVAR, UP):- integer(SVAR),UP=SVAR,!.
svar_fixvarname(SVAR, UP):- svar(SVAR,UP),!.
svar_fixvarname(SVAR, UP):- n_to_vn(UP,SVAR),!.
% convert_to_var_name(+Input, -VarName)
% Converts Input (atom or string) into a Prolog-legal variable name.
% It replaces illegal characters with underscores and then prefixes the name with '_'.
svar_fixvarname(Input, VarName) :-
% Convert input to character list
( atom(Input) -> atom_chars(Input, Chars)
; string(Input) -> string_chars(Input, Chars)
),
% Transform each character into an allowed sequence
maplist(char_to_allowed_sequence, Chars, TransformedList),
% Flatten the list of lists into a single list of chars
flatten(TransformedList, SafeChars),
% Always prefix with '_'
VarChars = ['_'|SafeChars],
atom_chars(VarName, VarChars).

% char_to_allowed_sequence(+Char, -Sequence)
% If Char is alphanumeric or '_', it is kept as is.
% Otherwise, convert it into '_<ASCII_CODE>'.
char_to_allowed_sequence(Char, [Char]) :-
(char_type(Char, alnum); Char == '_'), !.
char_to_allowed_sequence(Char, Sequence) :-
% Get ASCII code
char_code(Char, Code),
% Convert code to a list of digits
number_chars(Code, CodeChars),
% Build a sequence like ['_', '5', '4'] for Code = 54, for example
Sequence = ['_'|CodeChars].


%! svar_fixname(?Var, ?NameO) is det.
%
Expand Down Expand Up @@ -782,21 +811,31 @@
% @arg Item The item read from the stream.
read_sexpr(I,O):- string(I), open_string(I,S),!,read_sexpr(S,O).
read_sexpr(I,O):-
catch(read_sexpr_or_error(I,O),E,handle_read_error(E)).

handle_read_error(E):-
write_src_uo(E),
print_message(error,E),
%throw(E),
%throw('$aborted'),
!.

read_sexpr_or_error(I,O):-
setup_call_cleanup( flag('$file_src_ordinal',Ordinal,Ordinal+1_000_000),
setup_call_cleanup(
(nb_current('$file_src_depth', Lvl)->true;(Lvl=0,nb_setval('$file_src_depth', Lvl))),
cont_sexpr(is_delimiter(),I, O),
cont_sexpr(is_delimiter,I, O),
b_setval('$file_src_depth', Lvl)),
nop(flag('$file_src_ordinal',_,Ordinal))).


%! cont_sexpr(+EndChar:atom, +Stream:stream, -Item) is det.
%
% Reads a single item (S-expression or comment) from the specified stream, handling different formats and encodings.
% Throws an error with stream position if the S-expression cannot be parsed.
% @arg EndChar that denotes the end of a symbol.
% @arg Stream Stream from which to read.
% @arg Item The item read from the stream.


cont_sexpr(EndChar, Stream, Item):-
skip_spaces(Stream), % Ignore whitespace before reading the expression.
read_line_char(Stream, StartRange),
Expand All @@ -806,22 +845,65 @@
push_item_range(Item, Range).


cont_sexpr_once(EndChar, Stream, Item):-
skip_spaces(Stream), % Ignore whitespace before reading the expression.
cont_sexpr_once(EndChar, Stream, Item) :-
skip_spaces(Stream),
get_char(Stream, Char),
( Char = '(' -> read_list(')', Stream, Item) % If '(', read an S-expression list.
; paren_pair(Char,EndOfParen,Functor) -> (read_list(EndOfParen, Stream, It3m), Item = [Functor,It3m]) % If '[' or '{', read an S-expression list.
% ; paren_pair(_,Char,_) -> (sformat(Reason,"Unexpected start character: '~w'",[Char]), throw_stream_error(Stream, syntax_error(unexpected_char(Char),Reason)))
; Char = '{' -> (read_list('}', Stream, It3m), Item = ['{...}',It3m]) % If '{', read an S-expression list.
; Char = '"' -> read_quoted_string(Stream, '"', Item) % Read a quoted string.
; (Char = '!', nb_current('$file_src_depth', 0)) -> (cont_sexpr_once(EndChar, Stream, Subr), Item = exec(Subr)) % Read called directive
; (Char = '#', peek_char(Stream, '(')) -> (cont_sexpr_once(EndChar, Stream, Subr), univ_maybe_var(Item,Subr)) % Read SExpr as Prolog Expression
; (Char = '#', peek_char(Stream, '{')) -> (read_prolog_syntax(Stream, Subr), Subr= {Item}) % Read Prolog Expression
; Char = '\'' -> read_quoted_symbol(Stream, '\'', Item) % Read a quoted symbol.
; Char = '`' -> read_quoted_symbol(Stream, '`', Item) % Read a backquoted symbol.
; Char = end_of_file -> Item = end_of_file % If EOF, set Item to 'end_of_file'.
; read_symbolic(EndChar, Stream, Char, Item) % Otherwise, read a symbolic expression.
), !.
cont_sexpr_from_char(EndChar, Stream, Char, Item), !.

% If EOF, return end_of_file
cont_sexpr_from_char(_EndChar, _Stream, end_of_file, end_of_file).

% If '(', read an S-expression list.
cont_sexpr_from_char(_EndChar, Stream, '(', Item) :-
read_list(')', Stream, Item).

% If '[', '{', etc. - using paren_pair
cont_sexpr_from_char(_EndChar, Stream, Char, Item) :- paren_pair(Char, EndOfParen, Functor),
read_list(EndOfParen, Stream, It3m),
Item = [Functor, It3m].

% Unexpected start character
cont_sexpr_from_char(EndChar, Stream, Char, Item) :- paren_pair(_, Char, _),
nb_current('$file_src_depth', 0),
sformat(Reason, "Unexpected start character: '~w'", [Char]),
throw_stream_error(Stream, syntax_error(unexpected_char(Char), Reason)),
% keep going we consumed the Char (if thorw_stream_error/2 permits)
cont_sexpr(EndChar, Stream, Item).

% If '"', read a quoted string.
cont_sexpr_from_char(_EndChar, Stream, '"', Item) :-
read_quoted_string(Stream, '"', Item).

% If '!' followed by '(', '#', or file depth 0, read a directive to be executed
cont_sexpr_from_char(EndChar, Stream, '!', Item) :-
( peek_char(Stream, '(')
; peek_char(Stream, '#')
; nb_current('$file_src_depth', 0)),
cont_sexpr_once(EndChar, Stream, Subr),
Item = exec(Subr).

% If '#' followed by '(', read SExpr as Prolog Expression
cont_sexpr_from_char(EndChar, Stream, '#', Item) :- peek_char(Stream, '('),
cont_sexpr_once(EndChar, Stream, Subr),
univ_maybe_var(Item, Subr).

% If '#' followed by '{', read Prolog syntax until '}' and a period
cont_sexpr_from_char(_EndChar, Stream, '#', Item) :- peek_char(Stream, '{'),
read_prolog_syntax(Stream, Subr),
Subr = {Item}.

% If '\'', read a quoted symbol.
cont_sexpr_from_char(_EndChar, Stream, '\'', Item) :-
read_quoted_symbol(Stream, '\'', Item).

% If '`', read a backquoted symbol.
cont_sexpr_from_char(_EndChar, Stream, '`', Item) :-
read_quoted_symbol(Stream, '`', Item).

% Otherwise, read a symbolic expression.
cont_sexpr_from_char(EndChar, Stream, Char, Item) :-
read_symbolic(EndChar, Stream, Char, Item).


can_do_level(0).
can_do_level(_).
Expand Down Expand Up @@ -1012,7 +1094,6 @@
% @arg Reason The reason for the error.
throw_stream_error(Stream, Reason) :-
read_position(Stream, Line, Col, CharPos, _),
trace,
throw(stream_error(Line:Col:CharPos, Reason)).

%! read_single_line_comment(+Stream:stream) is det.
Expand Down Expand Up @@ -1149,12 +1230,13 @@
nb_current('$file_src_depth', LvL),
flag('$file_src_ordinal',Ordinal,Ordinal+1),
succ(LvL,LvLNext),
nb_setval('$file_src_depth', LvLNext),
read_position(Stream, Line, Col, CharPos, _),
setup_call_cleanup(
nb_setval('$file_src_depth', LvLNext),
catch(read_list_cont(EndChar, Stream, List),
stream_error(_Where,Why),
throw(stream_error(Line:Col:CharPos,Why))),
nb_setval('$file_src_depth', LvL).
nb_setval('$file_src_depth', LvL)).

read_list_cont(EndChar, Stream, List) :-
skip_spaces(Stream), % Skip any leading spaces before reading.
Expand Down Expand Up @@ -1315,5 +1397,5 @@
arg(_, v( /*'(', ')', */ end_of_file), Char). % Other delimiters include parentheses and end of file.

% Ensure the program runs upon initialization.
:- initialization(main_init, main).
% :- initialization(main_init, main).

0 comments on commit 208360f

Please sign in to comment.