15.4.961  src/lib/src/parser-combinator.pkg

## parser-combinator.pkg

# Compiled by:
#     src/lib/std/standard.lib

# Parser combinators over readers.  These are modeled after the Haskell
# combinators of Hutton and Meijer.  The main difference is that they
# return a single result, instead of a list of results.  This means that
# "or" is a committed choice; once one branch succeeds, the others will not
# be enabled.  While this is somewhat limiting, for many applications it
# will not be a problem.  For more substantial parsing problems, one should
# use Mythryl-Yacc and/or Mythryl-Lex.


package   parser_combinator
: (weak)  Parser_Combinator                                     # Parser_Combinator     is from   src/lib/src/parser-combinator.api
{
    package sc= number_string;                                  # number_string is from   src/lib/std/src/number-string.pkg

    Parser (X, A_strm)
        =
        sc::Reader (Char, A_strm)  -> sc::Reader (X, A_strm);


    fun result v getc stream
        =
        THE (v, stream);


    fun failure getc stream
        =
        NULL;

    fun wrap (p, f) getc stream
        =
        case (p getc stream)
             THE (x, stream) =>  THE (f x, stream);
             NULL            =>  NULL;
        esac;


    fun seq_with f (p1, p2) getc stream
        =
        case (p1 getc stream)

            THE (t1, strm1)
                =>
                case (p2 getc strm1)

                    THE (t2, strm2)
                        =>
                        THE (f(t1, t2), strm2);

                    NULL => NULL;
                esac;

             NULL => NULL;
        esac;


    fun seq (p1, p2)
        =
        seq_with (\\ x = x) (p1, p2);


    fun bind (p1, p2') getc stream
        =
        case (p1 getc stream)

            THE (t1, strm1)
                =>
                p2' t1 getc strm1;

            NULL => NULL;
        esac;



    fun eat_char prior getc stream
        =
        case (getc stream)

            result as THE (c, stream')
                =>
                (prior c)  ??  result
                           ::  NULL;

            _   => NULL;
        esac;


    fun char (c: Char)
        =
        eat_char (\\ c' = (c == c'));


    fun string s getc stream
        =
        {
            fun eat (ss, stream)
                =
                case (substring::getc ss, getc stream)
                  
                     (THE (c1, ss'), THE (c2, stream'))
                         =>
                         (c1 == c2)  ??  eat (ss', stream')
                                     ::  NULL;

                     (NULL, _)
                         =>
                         THE (s, stream);

                     _   =>  NULL;
                esac;

          
            eat (substring::from_string s, stream);
        };


    fun skip_before prior p getc stream
        =
        skip' stream
        where
            fun skip' stream
                =
                case (getc stream)
                  
                     NULL => NULL;

                     THE (c, stream')
                         =>
                         (prior c)  ??  skip' stream'
                                    ::  p getc stream;
                esac;
        end;


    fun or_op (p1, p2) getc stream
        =
        case (p1 getc stream)

            NULL =>
                case (p2 getc stream)
                    NULL => NULL;
                    result => result;
                esac;

            result => result;

        esac;


    fun or' l getc stream
        =
        try_next l
        where

            fun try_next (p ! r)
                    =>
                    case (p getc stream)
                        NULL   => try_next r;
                        result => result;
                    esac;

                try_next [] => NULL;
            end;
        end;


    fun zero_or_more p getc stream
        =
        parse ([], stream)
        where
            p = p getc;

            fun parse (l, stream)
                =
                case (p stream)
                   THE (item, stream) =>  parse (item ! l, stream);
                   NULL               =>  THE  (reverse l, stream);
                esac;
        end;


    fun one_or_more p getc stream
        =
        case (zero_or_more p getc stream)
            result as (THE(_ ! _, _)) =>  result;
            _                         =>  NULL;
        esac;


    fun option p getc stream
        =
        case (p getc stream)
             THE (x, stream) =>  THE (THE x, stream);
             NULL            =>  THE (NULL, stream);
        esac;


    fun join p
        =
        bind
         ( p,
           \\ (THE x) => result x;
              NULL    => failure;
           end
         );


    # Parse a token consisting of characters satisfying the predicate.
    # If this succeeds, then the resulting string is guaranteed to be
    # non-empty.
    #
    fun token prior getc stream
        =
        case (zero_or_more (eat_char prior) getc stream)

            THE (result as _ ! _, stream)
                 =>
                 THE (implode result, stream);

            _    => NULL;
        esac;
};