(* $Id: cmdlang.sml 17 2007-11-09 10:24:48Z 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 (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