parse/parse.sml

   1 (* L1 Compiler
   2  * Parsing
   3  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
   4  * Modified: Frank Pfenning <fp@cs.cmu.edu>
   5  *
   6  * Glueing together the pieces produced by ML-Lex and ML-Yacc
   7  *)
   8
   9 signature PARSE =
  10 sig
  11   (* parse filename = ast
  12    * will raise ErrorMsg.Error in case of lexing or parsing error
  13    *)
  14   val parse : string -> Ast.program
  15 end
  16
  17 structure Parse :> PARSE =
  18 struct
  19
  20   structure L1LrVals = L1LrValsFn (structure Token = LrParser.Token)
  21   structure L1Lex = L1LexFn (structure Tokens = L1LrVals.Tokens)
  22   structure L1Parse = Join (structure ParserData = L1LrVals.ParserData
  23                             structure Lex = L1Lex
  24                             structure LrParser = LrParser)
  25
  26   (* Main parsing function *)
  27   fun parse filename =
  28       SafeIO.withOpenIn filename (fn instream =>
  29         let
  30           val _ = ErrorMsg.reset() (* no errors, no messages so far *)
  31           val _ = ParseState.setfile filename (* start at position 0 in filename *)
  32           fun parseerror (s, p1, p2) = ErrorMsg.error (ParseState.ext (p1,p2)) s
  33           val lexer = LrParser.Stream.streamify
  34                           (L1Lex.makeLexer (fn _ => TextIO.input instream))
  35           (* 0 = no error correction, 15 = reasonable lookahead for correction *)
  36           val (absyn, _) = L1Parse.parse(0, lexer, parseerror, ())
  37           val _ = if !ErrorMsg.anyErrors
  38                   then raise ErrorMsg.Error
  39                   else ()
  40         in
  41           absyn
  42         end)
  43       handle L1Lex.LexError => ( ErrorMsg.error NONE "lexer error" ;
  44                                raise ErrorMsg.Error )
  45            | LrParser.ParseError => raise ErrorMsg.Error (* always preceded by msg *)
  46            | e as IO.Io _ => ( ErrorMsg.error NONE (exnMessage e);
  47                                raise ErrorMsg.Error )
  48
  49 end