anchor.diff:  %% See the License for the specific language governing permissions and
   %% limitations under the License.
   
  -%% File    : lfe_parse.erl
  -%% Author  : Robert Virding
  -%% Purpose : A simple Sexpr parser.
  -%% A simple sexpr parser. It is both re-entrant and returns excess
  -%% tokens. The main engine is pretty naively coded at the moment.
  -
   -module(lfe_parse).
   
  --export([sexpr/1,sexpr/2,format_error/1]).
  -
  -%% Define IS_MAP/1 macro for is_map/1 bif.
  --ifdef(HAS_MAPS).
  --define(IS_MAP(T), is_map(T)).
  --else.
  --define(IS_MAP(T), false).
  --endif.
  +-export([format_error/1]).
  +
  +%% The root symbol entry points
  +-export([form/1,form/2]).
  +
  +%% User code. This is placed here to allow extra attributes.
   
   -define(CATCH(E, Error), try E catch _:_ -> Error end).
   
  -%% We define the syntax as an LL(1) and write/generate a parser for
  -%% it. We also define the grammar with the same form as for yecc even
  -%% though we have no automatic generator.
  -%%
  -%% Terminals
  -%%    symbol number string binary fun '(' ')' '[' ']' '.' '\'' ',' '@' ',@' '`'
  -%%       '#(' '#B(' '#M(' '#.' '#\''.
  -%%
  -%% Nonterminals form sexpr list list_tail proper_list .
  -%%
  -%%  0 form -> sexpr : '$1'.
  -%%  1 sexpr -> symbol : val('$1').
  -%%  2 sexpr -> number : val('$1').
  -%%  3 sexpr -> string : val('$1').
  -%% 21 sexpr -> binary : val('$1').
  -%%  4 sexpr -> '#\'' : make_fun(val('$1')).
  -%% 22 sexpr -> '#.' sexpr : eval_expr(line('$1'), val('$2')).
  -%%  5 sexpr -> '\'' sexpr : [quote,'$2'].
  -%%  6 sexpr -> '`' sexpr : [backquote,'$2'].
  -%%  7 sexpr -> ',' sexpr : [unquote,'$2'].
  -%%  8 sexpr -> ',@' sexpr : ['unquote-splicing','$2'].
  -%%  9 sexpr -> ( list ) : '$2'.
  -%% 10 sexpr -> [ list ] : '$2'.
  -%% 11 sexpr -> '#(' proper_list ')' : list_to_tuple('$2').
  -%% 12 sexpr -> '#B(' proper_list ')' : make_bin(line('$1'), '$2').
  -%% 13 sexpr -> '#M(' proper_list ')' : make_map(line('$1'), '$2').
  -%% 14 list -> sexpr list_tail : ['$1'|'$2].
  -%% 15 list -> empty : [].
  -%% 16 list_tail -> sexpr list_tail : ['$1'|'$2'].
  -%% 17 list_tail -> . sexpr : '$2'.
  -%% 18 list_tail -> empty : [].
  -%% 19 proper_list -> sexpr proper_list : ['$1'|'$2'].
  -%% 20 proper_list -> empty : [].
  -
  -%% The computed First and Follow sets for the productions. This is the
  -%% only really tricky bit.
  -%%
  -%% First(f) = {symbol number string #' ( [ ' ` , ,@ #( #B( #M(}
  -%% First(s) = {symbol number string #' ( [ ' ` , ,@ #( #B( #M(}
  -%% First(l) = {symbol number string #' ( [ ' ` , ,@ #( #B( #M( empty}
  -%% First(t) = {symbol number string #' ( [ . ' ` , ,@ #( #B( #M( empty}
  -%% First(p) = {symbol number string #' ( [ ' ` , ,@ #( #B( #M( empty}
  -%% Follow(f) = empty
  -%% Follow(s) = {symbol number string #' ( [ ) ] ' ` , ,@ #( #B( #M(}
  -%% Follow(l) = {symbol number string #' ( [ ) ] ' ` , ,@ #( #B( #M(}
  -%% Follow(t) = {symbol number string #' ( [ ) ] ' ` , ,@ #( #B( #M(}
  -%% Follow(p) = {symbol number string #' ( [ ) ] ' ` , ,@ #( #B( #M(}
  -
  -%% The table (tedious).
  -%% Top  symbol      (         )       [       ]       .       '`,,@   #(#B(#M(
  -%%  f   f->s      f->s              f->s                      f->s    f->s
  -%%  s   s->sym    s->( l )          s->[ s ]                  s->' s  s->( p )
  -%%  l   l->s t    l->s t     l->e   l->s t   l->e             l->s t  l->s t
  -%%  t   t->s t    t->s t     t->e   t->s t   t->e   t->. s    t->s t  t->s t
  -%%  p   p->s p    p->s p     p->e   p->s p   p->e             p->s p  p->s p
  -
  -%% The non-terminal types.
  --define(FORM, 0).
  --define(EXPR, 1).
  --define(LIST, 2).
  --define(TAIL, 3).
  --define(PROP, 4).
  -
  -%% Start non-terminal state.
  -start() -> ?FORM.
  -
  -%% The reductions, we are naive and straight forward here.
  -reduce(0, Vs) -> Vs;                            %f->s
  -reduce(1, [T|Vs]) -> [val(T)|Vs];               %s->symbol
  -reduce(2, [T|Vs]) -> [val(T)|Vs];               %s->number
  -reduce(3, [T|Vs]) -> [val(T)|Vs];               %s->string
  -reduce(21, [T|Vs]) -> [val(T)|Vs];              %s->binary
  -reduce(4, [T|Vs]) ->                            %s->fun
  -    [make_fun(val(T))|Vs];
  -reduce(22, [S,D|Vs]) ->                         %s->#. s
  -    [eval_expr(line(D), S)|Vs];
  -reduce(5, [S,_|Vs]) -> [[quote,S]|Vs];          %s->' s
  -reduce(6, [S,_|Vs]) -> [[backquote,S]|Vs];      %s->` s
  -reduce(7, [S,_|Vs]) -> [[unquote,S]|Vs];        %s->, s
  -reduce(8, [S,_|Vs]) ->                          %s->,@ s
  -    [['unquote-splicing',S]|Vs];
  -reduce(9, [_,L,_|Vs]) -> [L|Vs];                %s->( s )
  -reduce(10, [_,L,_|Vs]) -> [L|Vs];               %s->[ s ]
  -reduce(11, [_,L,_|Vs]) ->                       %s->#( p )
  -    [list_to_tuple(L)|Vs];
  -reduce(12, [_,L,B|Vs]) ->                       %s->#B( p )
  -    [make_bin(line(B), L)|Vs];
  -reduce(13, [_,L,M|Vs]) ->                       %s->#M( p )
  -    [make_map(line(M), L)|Vs];
  -reduce(14, [T,H|Vs]) -> [[H|T]|Vs];             %l->s t
  -reduce(15, Vs) -> [[]|Vs];                      %l->empty
  -reduce(16, [T,H|Vs]) -> [[H|T]|Vs];             %t->s t
  -reduce(17, [T,_|Vs]) -> [T|Vs];                 %t->. s
  -reduce(18, Vs) -> [[]|Vs];                      %t->empty
  -reduce(19, [T,H|Vs]) -> [[H|T]|Vs];             %p->s t
  -reduce(20, Vs) -> [[]|Vs].                      %p->empty
  -
  -%% The table, this gets pretty big but is very straight forward.
  -table(?FORM, symbol) -> [?EXPR];
  -table(?FORM, number) -> [?EXPR];
  -table(?FORM, string) -> [?EXPR];
  -table(?FORM, binary) -> [?EXPR];
  -table(?FORM, '#\'') -> [?EXPR];
  -table(?FORM, '#.') -> [?EXPR];
  -table(?FORM, '\'') -> [?EXPR];
  -table(?FORM, '`') -> [?EXPR];
  -table(?FORM, ',') -> [?EXPR];
  -table(?FORM, ',@') -> [?EXPR];
  -table(?FORM, '(') -> [?EXPR];
  -table(?FORM, '[') -> [?EXPR];
  -table(?FORM, '#(') -> [?EXPR];
  -table(?FORM, '#B(') -> [?EXPR];
  -table(?FORM, '#M(') -> [?EXPR];
  -
  -table(?EXPR, symbol) -> [symbol,{reduce,1}];
  -table(?EXPR, number) -> [number,{reduce,2}];
  -table(?EXPR, string) -> [string,{reduce,3}];
  -table(?EXPR, binary) -> [binary,{reduce,21}];
  -table(?EXPR, '#\'') -> ['#\'',{reduce,4}];
  -table(?EXPR, '#.') -> ['#.',?EXPR,{reduce,22}];
  -table(?EXPR, '\'') -> ['\'',?EXPR,{reduce,5}];
  -table(?EXPR, '`') -> ['`',?EXPR,{reduce,6}];
  -table(?EXPR, ',') -> [',',?EXPR,{reduce,7}];
  -table(?EXPR, ',@') -> [',@',?EXPR,{reduce,8}];
  -table(?EXPR, '(') -> ['(',?LIST,')',{reduce,9}];
  -table(?EXPR, '[') -> ['[',?LIST,']',{reduce,10}];
  -table(?EXPR, '#(') -> ['#(',?PROP,')',{reduce,11}];
  -table(?EXPR, '#B(') -> ['#B(',?PROP,')',{reduce,12}];
  -table(?EXPR, '#M(') -> ['#M(',?PROP,')',{reduce,13}];
  -
  -table(?LIST, symbol) -> [?EXPR,?TAIL,{reduce,14}];
  -table(?LIST, number) -> [?EXPR,?TAIL,{reduce,14}];
  -table(?LIST, string) -> [?EXPR,?TAIL,{reduce,14}];
  -table(?LIST, binary) -> [?EXPR,?TAIL,{reduce,14}];
  -table(?LIST, '#\'') -> [?EXPR,?TAIL,{reduce,14}];
  -table(?LIST, '#.') -> [?EXPR,?TAIL,{reduce,14}];
  -table(?LIST, '\'') -> [?EXPR,?TAIL,{reduce,14}];
  -table(?LIST, '`') -> [?EXPR,?TAIL,{reduce,14}];
  -table(?LIST, ',') -> [?EXPR,?TAIL,{reduce,14}];
  -table(?LIST, ',@') -> [?EXPR,?TAIL,{reduce,14}];
  -table(?LIST, '(') -> [?EXPR,?TAIL,{reduce,14}];
  -table(?LIST, '[') -> [?EXPR,?TAIL,{reduce,14}];
  -table(?LIST, '#(') -> [?EXPR,?TAIL,{reduce,14}];
  -table(?LIST, '#B(') -> [?EXPR,?TAIL,{reduce,14}];
  -table(?LIST, '#M(') -> [?EXPR,?TAIL,{reduce,14}];
  -table(?LIST, ')') -> [{reduce,15}];
  -table(?LIST, ']') -> [{reduce,15}];
  -
  -table(?TAIL, symbol) -> [?EXPR,?TAIL,{reduce,16}];
  -table(?TAIL, number) -> [?EXPR,?TAIL,{reduce,16}];
  -table(?TAIL, string) -> [?EXPR,?TAIL,{reduce,16}];
  -table(?TAIL, binary) -> [?EXPR,?TAIL,{reduce,16}];
  -table(?TAIL, '#\'') -> [?EXPR,?TAIL,{reduce,16}];
  -table(?TAIL, '#.') -> [?EXPR,?TAIL,{reduce,16}];
  -table(?TAIL, '\'') -> [?EXPR,?TAIL,{reduce,16}];
  -table(?TAIL, '`') -> [?EXPR,?TAIL,{reduce,16}];
  -table(?TAIL, ',') -> [?EXPR,?TAIL,{reduce,16}];
  -table(?TAIL, ',@') -> [?EXPR,?TAIL,{reduce,16}];
  -table(?TAIL, '(') -> [?EXPR,?TAIL,{reduce,16}];
  -table(?TAIL, '[') -> [?EXPR,?TAIL,{reduce,16}];
  -table(?TAIL, '#(') -> [?EXPR,?TAIL,{reduce,16}];
  -table(?TAIL, '#B(') -> [?EXPR,?TAIL,{reduce,16}];
  -table(?TAIL, '#M(') -> [?EXPR,?TAIL,{reduce,16}];
  -table(?TAIL, '.') -> ['.',?EXPR,{reduce,17}];
  -table(?TAIL, ')') -> [{reduce,18}];
  -table(?TAIL, ']') -> [{reduce,18}];
  -
  -table(?PROP, symbol) -> [?EXPR,?PROP,{reduce,19}];
  -table(?PROP, number) -> [?EXPR,?PROP,{reduce,19}];
  -table(?PROP, string) -> [?EXPR,?PROP,{reduce,19}];
  -table(?PROP, binary) -> [?EXPR,?PROP,{reduce,19}];
  -table(?PROP, '#\'') -> [?EXPR,?PROP,{reduce,19}];
  -table(?PROP, '#.') -> [?EXPR,?PROP,{reduce,19}];
  -table(?PROP, '\'') -> [?EXPR,?PROP,{reduce,19}];
  -table(?PROP, '`') -> [?EXPR,?PROP,{reduce,19}];
  -table(?PROP, ',') -> [?EXPR,?PROP,{reduce,19}];
  -table(?PROP, ',@') -> [?EXPR,?PROP,{reduce,19}];
  -table(?PROP, '(') -> [?EXPR,?PROP,{reduce,19}];
  -table(?PROP, '[') -> [?EXPR,?PROP,{reduce,19}];
  -table(?PROP, '#(') -> [?EXPR,?PROP,{reduce,19}];
  -table(?PROP, '#B(') -> [?EXPR,?PROP,{reduce,19}];
  -table(?PROP, '#M(') -> [?EXPR,?PROP,{reduce,19}];
  -table(?PROP, ')') -> [{reduce,20}];
  -table(?PROP, ']') -> [{reduce,20}];
  -
  -table(_, _) -> error.
  -
  -%% sexpr(Tokens) ->
  -%%      {ok,Line,Sexpr,Rest} | {more,Continuation} | {error,Error,Rest}.
  -%% sexpr(Continuation, Tokens) ->
  -%%      {ok,Line,Sexpr,Rest} | {more,Continuation} | {error,Error,Rest}.
  -
  -sexpr(Ts) -> sexpr([], Ts).                     %Start with empty state
  -
  -sexpr(Cont, Ts) -> parse1(Cont, Ts).
  -
  --record(lp, {l=none,st=[],vs=[]}).              %Line, States, Values
  -
  -%% parse1(Continuation, Tokens) ->
  -%%      {ok,Line,Sexpr,Rest} | {more,Continuation} | {error,Error,Rest}.
  -%%  This is the opt-level of the LL engine. It
  -%%  initialises/packs/unpacks the continuation information.
  -
  -parse1([], Ts) ->                               %First call
  -    Start = start(),                            %The start state.
  -    parse1(#lp{l=none,st=[Start],vs=[]}, Ts);
  -parse1(#lp{l=none}=Lp, [T|_]=Ts) ->             %Guarantee a start line
  -    parse1(Lp#lp{l=line(T)}, Ts);
  -parse1(#lp{l=L,st=St0,vs=Vs0}, Ts) ->
  -    try
  -        parse2(Ts, St0, Vs0) of
  -        {done,Rest,[],[V]} -> {ok,L,V,Rest};
  -        {more,[],St1,Vs1} -> {more,#lp{l=L,st=St1,vs=Vs1}};
  -        {error,Line,Error,Rest,_,_} ->
  -            %% Can't really continue from errors here.
  -            {error,{Line,?MODULE,Error},Rest}
  -    catch
  -        throw:{user_error,Error} ->
  -            {error,Error,[]}
  -    end.
  -
  -%% parse2(Tokens, StateStack, ValueStack) ->
  -%%     {done,Ts,Sstack,Vstack} | {more,Ts,Sstack,Vstack} |
  -%%     {error,Line,Error,Ts,Sstack,Vstack}.
  -%%  Main loop of the parser engine. Handle any reductions on the top
  -%%  of the StateStack, then try to match type of next token with top
  -%%  state. If we have a match, it is a terminal, then push token onto
  -%%  value stack, else try to find new state(s) from table using
  -%%  current state and token type and push them onto state
  -%%  stack. Continue until no states left.
  -
  -parse2(Ts, [{reduce,R}|St], Vs0) ->
  -    %% io:fwrite("p: ~p\n", [{R,Vs}]),
  -    %% Try to reduce values and push value on value stack.
  -    case reduce(R, Vs0) of
  -        {error,L,E} -> {error,L,E,Ts,St,Vs0};
  -        Vs1 -> parse2(Ts, St, Vs1)
  -    end;
  -parse2(Ts, [], Vs) -> {done,Ts,[],Vs};          %All done
  -parse2([T|Ts]=Ts0, [S|St]=St0, Vs) ->
  -    %% io:fwrite("p: ~p\n", [{St0,Ts0}]),
  -    %% Try to match token type against state on stack.
  -    case type(T) of
  -        S -> parse2(Ts, St, [T|Vs]);            %Match
  -        Type ->                                 %Try to predict
  -            case table(S, Type) of
  -                error -> {error,line(T),{illegal,Type},Ts0,St0,Vs};
  -                Top -> parse2(Ts0, Top ++ St, Vs)
  -            end
  -    end;
  -parse2([], St, Vs) ->                           %Need more tokens
  -    {more,[],St,Vs};
  -parse2({eof,L}=Ts, St, Vs) ->                   %No more tokens
  -    {error,L,missing_token,Ts,St,Vs}.
  -
  -%% Access the fields of a token.
  -type(T) -> element(1, T).
  -line(T) -> element(2, T).
  -val(T) -> element(3, T).
  +%% For backwards compatibility
  +-export([sexpr/1,sexpr/2]).
  +
  +sexpr(Ts) -> form(Ts).
  +sexpr(Cont, Ts) -> form(Cont, Ts).
   
   %% make_fun(String) -> FunList.
   %%  Convert a fun string to a fun sexpr.
  
positive.code:     ?CATCH(lfe_eval:expr(Expr),
             return_error(Line, "bad #. expression")).
  
  %% format_error(Error) -> String.
  %%  Format errors to printable string.
  
  format_error(missing_token) -> "missing token";
  format_error({illegal,What}) ->
      lfe_io:fwrite1("illegal ~p", [What]);
  format_error(Error) ->
      %% A useful catch all.
      case io_lib:deep_char_list(Error) of
          true -> Error;
          false -> lfe_io:print1(Error)
      end.
  
  %% return_error(Error).
  %%  To be used in grammar files to throw an error message to the
  %%  parser toplevel.
  
  -compile({nowarn_unused_function, return_error/2}).
  -spec return_error(integer(), any()) -> no_return().
  
  return_error(Line, Message) ->
      throw({user_error, {Line, ?MODULE, Message}}).
  
negative.code: %% Copyright (c) 2009-2015 Robert Virding
  %%
  %% Licensed under the Apache License, Version 2.0 (the "License");
  %% you may not use this file except in compliance with the License.
  