(* Parsing uSML * sestoft@dina.kvl.dk 2001-02-21 *)

app load ["Location", "Nonstdio", "Funlex"];

open Absyn;

(* Fancy parsing from a file; show the offending program piece on error *)

fun parseExprReport file stream lexbuf =
    let val expr = 
            Funpar.Main Funlex.Token lexbuf
            handle
               Parsing.ParseError f =>
                   let val pos1 = Lexing.getLexemeStart lexbuf
                       val pos2 = Lexing.getLexemeEnd lexbuf
                   in
                       Location.errMsg (file, stream, lexbuf) 
                                       (Location.Loc(pos1, pos2))
                                       "Syntax error."
                   end
             | Funlex.LexicalError(msg, pos1, pos2) =>
                   if pos1 >= 0 andalso pos2 >= 0 then
                       Location.errMsg (file, stream, lexbuf)
                                       (Location.Loc(pos1, pos2))
                                       ("Lexical error: " ^ msg)
                   else 
                       (Location.errPrompt ("Lexical error: " ^ msg ^ "\n\n");
                        raise Fail "Lexical error");
    in
        Parsing.clearParser();
        expr
    end
    handle exn => (Parsing.clearParser(); raise exn);

(* Parse a program from a string, with error reporting *)

fun parses str =
    parseExprReport "" (BasicIO.std_in) (Lexing.createLexerString str);

(* Create lexer from instream *)

fun createLexerStream (is : BasicIO.instream) =
    Lexing.createLexer (fn buff => fn n => Nonstdio.buff_input is buff 0 n)

(* Parse a program from a file, with error reporting *)

fun parsef file =
    let val is     = Nonstdio.open_in_bin file
        val expr   = parseExprReport file is (createLexerStream is)
                     handle exn => (BasicIO.close_in is; raise exn)
    in 
        BasicIO.close_in is;
        expr
    end


(* Examples in concrete syntax *)

val pex1 = 
    parses "let f1 x = x + 1 in f1 12 end";


(* Example: factorial *)

val pex2 = 
    parses "let fac x = if x=0 then 1 else x * fac (x-1) in fac n end";

(* Example: deep recursion to check for constant-space tail recursion *)

val pex3 = 
    parses "let deep x = if x=0 then 1 else deep (x-1) in deep count end";

val ok = [ex1, ex2, ex2] = [pex1, pex2, pex2];