(* $Id: cmdlang.sml 7 2007-10-31 05:39:12Z tbourke $ *)

structure CmdLang : CMD_LANG = struct

  structure LrVals = CmdLangLrValsFn (structure FilePos = FilePos
                                      structure Token = LrParser.Token
                                      structure CmdEnv = CmdEnv)
  structure Lex    = CmdLangLexFn (structure FilePos = FilePos
                                   structure Tokens = LrVals.Tokens)
  structure Parser = JoinWithArg(structure LrParser = LrParser
                                 structure ParserData = LrVals.ParserData
                                 structure Lex = Lex)

  fun parse rdr (env, ostrm) = let
      val prError   = FilePos.error "blah" (* (Settings.progName^":")*)

      val strm = ref ostrm
      fun read _ = case rdr (!strm) of
                     NONE => ""
                   | SOME (s, strm') => s before strm := strm'

      val lexstream = Parser.makeLexer read (FilePos.newstate ())

      val tokenEOF = LrVals.Tokens.EOF (FilePos.zero, FilePos.zero)
      val tokenEOL = LrVals.Tokens.SEMICOLON (FilePos.zero, FilePos.zero)

      fun skipLine strm = let
            val (next, strm') = Parser.Stream.get strm
          in
            if Parser.sameToken (next, tokenEOF)
               orelse Parser.sameToken (next, tokenEOL)
            then strm' else skipLine strm'
          end

      fun loop ((CmdLoop.Stop, env), _) = SOME env
        | loop ((CmdLoop.Abort, _), _) = NONE
        | loop ((CmdLoop.Continue, env), strm) = let
            val (next, strm') = Parser.Stream.get strm
          in
            if Parser.sameToken (next, tokenEOF) then SOME env
            else if Parser.sameToken (next, tokenEOL)
                 then loop ((CmdLoop.Continue, env), strm')
                 else loop (Parser.parse (0, strm, prError, env)
                         handle Parser.ParseError =>
                            ((CmdLoop.Continue, env), skipLine strm))
          end

    in loop ((CmdLoop.Continue, env), lexstream) end

end