[Ur] Combinator Parsing in Ur: Anonymous function remains at code generation

[Adam Chlipala]

On 07/17/2014 10:19 PM, orchidaceae phalaenopsis wrote:
> Hi! We're trying to implement Parsec in Ur/Web (following
> http://research.microsoft.com/en-us/um/people/daan/download/papers/parsec-paper.pdf
> ). When trying to use our implementation we got "Anonymous function
> remains at code generation".
>
> [...]
> Here's a test case:
> https://gist.github.com/yuuko273/1352059b69e71d7015dd .

I've pushed an Ur/Web change to the public repository, fixing a 
program-analysis bug that stood in the way of your example working. 
However, there were two other issues to address, and I've attached my 
refactoring of your code, which works fine.

First, you were wrapping parsers inside a single-constructor datatype.  
The compiler's program analysis isn't generally smart enough to 
understand functions hidden inside datatypes, and program analysis is 
needed to remove all uses of first-class functions in server-side code.  
I changed the parser type to be a synonym instead, and I also made it an 
abstract type in a module, to get type-class resolution to work properly.

> * When attempting to run a parser on the empty string:
>
> Error triggers unlimited retry: Couldn't allocate new heap chunk
> contiguously; increasing size to 1024
> Error triggers unlimited retry: Couldn't allocate new heap chunk
> contiguously; increasing size to 131072
> Error triggers unlimited retry: Couldn't allocate new heap chunk
> contiguously; increasing size to 262144

The issue here was just an infinite loop in your parsing code! Function 
[upTo] would diverge on negative [i], which appears when the input 
string is empty.
-------------- next part --------------
structure Parse : sig
    con parser :: Type -> Type
    val runParser : a ::: Type -> parser a -> string -> option a
    val monad_parser : monad parser
    val satisfy : (char -> bool) -> parser char
    val char : char -> parser char
end = struct
    datatype reply a = Success of a * list char
                     | Failure

    datatype consumed a = Consumed of reply a
                        | Empty of reply a

    type parser a = list char -> consumed a

    fun stringToList (s : string) : list char =
        let
	    fun upTo acc i =
                if i < 0 then acc
	        else if i = 0 then 0 :: acc
	        else upTo (i :: acc) (i - 1)
        in
	    List.mp (String.sub s) (upTo [] (String.length s - 1))
        end

    fun runParser [a] (p : parser a) (s : string) : option a =
        let
            fun reply [a] (r : reply a) : option a =
                case r of
                    Success (a, _) => Some a
                  | Failure => None
        in
            case p (stringToList s) of
	        Consumed r => reply r
              | Empty r => reply r
        end

    fun return' [a] (x : a) : parser a = fn input => Empty (Success (x, input))

    fun bind' [a] [b] (p : parser a) (f : a -> parser b) : parser b =
     fn input => case p input of
		     Empty (Success (x, xs))    => f x xs
		   | Empty Failure              => Empty Failure
		   | Consumed (Success (x, xs)) => f x xs
		   | Consumed Failure           => Consumed Failure

    val monad_parser = mkMonad {Bind = @@bind', Return = @@return'}


    fun satisfy (test : char -> bool) : parser char =
     fn input => case input of
		     [] => Empty Failure
	           | x :: xs => if test x then
				    Consumed (Success (x, xs))
			        else
                                    Empty Failure

    fun char (c : char) : parser char = satisfy (eq c)
end

open Parse

val testcase : parser unit =
    _ <- char #"x";
    _ <- char #"y";
    return ()

fun main () : transaction page =
    case (runParser testcase "", runParser testcase "xy") of
	(None, Some ()) => return <xml>Tests passed.</xml>
      | _ => return <xml>Tests failed.</xml>