(* MLton 20020329 (built Fri Mar 29 21:56:03 2002 on asv-058) *)
(*   created this file on Wed Apr  3 11:12:56 2002. *)
(* Do not edit this file. *)
(* Flag settings:  *)
(*    chunk: chunk per function *)
(*    debug: false *)
(*    defines: [] *)
(*    detect overflow: true *)
(*    drop passes: [] *)
(*    exn history: false *)
(*    fixed heap: None *)
(*    gc check: Limit *)
(*    host: self *)
(*    host type: Linux *)
(*    indentation: 3 *)
(*    includes: [mlton.h] *)
(*    inline: NonRecursive {product = 320,small = 60} *)
(*    input file: sources *)
(*    instrument: false *)
(*    instrument Sxml: false *)
(*    keepSSA: false *)
(*    keep diagnostics: [] *)
(*    keep dot: false *)
(*    keep passes: [] *)
(*    lib dir: /usr/local/lib/mlton/self *)
(*    limit check: loop headers (fullCFG = false, loopExits = true) *)
(*    limit check counts: false *)
(*    loop passes: 1 *)
(*    native: true *)
(*    native commented: 0 *)
(*    native live stack: false *)
(*    native optimize: 1 *)
(*    native move hoist: true *)
(*    native copy prop: true *)
(*    native cutoff: 100 *)
(*    native live transfer: 8 *)
(*    native future: 64 *)
(*    native ieee fp: false *)
(*    native split: Some (20000) *)
(*    new return: false *)
(*    polyvariance: Some ({rounds = 2,small = 30,product = 300}) *)
(*    print at fun entry: false *)
(*    profile: false *)
(*    safe: true *)
(*    show basis used: false *)
(*    show types: false *)
(*    stack cont: false *)
(*    static: false *)
(*    TextIO buffer size: 4096 *)
(*    type check: false *)
(*    use basis library: true *)
(*    verbosity: Silent *)
(* start of FunctionalIO/srcSML/FunctionalIO_sig.sml *)
(*
    This file is part of the FunctionalIO project -
    which provides functional input streams.
    
    Copyright (C) 2000 ANOQ of the Sun (alias Johnny Andersen).
    
    E-mail: anoq@HardcoreProcessing.com

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Library General Public
    License as published by the Free Software Foundation; either
    version 2 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Library General Public License for more details.

    As a special exception, if you do not do anything which is not in
    the spirit of the GNU Library General Public License, you are not
    required to physically compile this software into a separate library,
    since this is generally not possible with current Stanard ML compilers.
    However if you do something which is not in the spirit of the
    GNU Library General Public License you will have to follow the
    licence perpetually - thus disallowing you to use it for any
    commercial purposes at all.

    If you are interested in a warranty or commercial support for this
    software, contact Hardcore Processing <sales@HardcoreProcessing.com>
    for more information.

    You should have received a copy of the GNU Library General Public
    License along with this library; if not, write to the Free
    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)

signature FUNCTIONAL_IO =
  sig
    include IO
  
    type vector
    type elem
    type instream
    type outstream

    val input : instream -> vector * instream
    val input1 : instream -> (elem * instream) option
    val inputN : (instream * int) -> vector * instream

    val closeIn : instream -> unit (* Closes file for further input.
                                      New end of file becomes the furthest
                                      position in the file that has been read
                                      internally. *)
  end

signature FUNC_BIN_IO =
  sig
    include FUNCTIONAL_IO

    val openIn : string -> instream
  end

(* For now we just keep things simple *)
signature FUNC_TEXT_IO = FUNC_BIN_IO(* stop of FunctionalIO/srcSML/FunctionalIO_sig.sml *)
(* start of FunctionalIO/srcSML/FunctionalIO.sml *)
(*
    This file is part of the FunctionalIO project -
    which provides functional input streams.
    
    Copyright (C) 2000 ANOQ of the Sun (alias Johnny Andersen).
    
    E-mail: anoq@HardcoreProcessing.com

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Library General Public
    License as published by the Free Software Foundation; either
    version 2 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Library General Public License for more details.

    As a special exception, if you do not do anything which is not in
    the spirit of the GNU Library General Public License, you are not
    required to physically compile this software into a separate library,
    since this is generally not possible with current Stanard ML compilers.
    However if you do something which is not in the spirit of the
    GNU Library General Public License you will have to follow the
    licence perpetually - thus disallowing you to use it for any
    commercial purposes at all.

    If you are interested in a warranty or commercial support for this
    software, contact Hardcore Processing <sales@HardcoreProcessing.com>
    for more information.

    You should have received a copy of the GNU Library General Public
    License along with this library; if not, write to the Free
    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)

(* Notice: This is not thread safe! *)
functor FFunctionalIO(type vec
                      type element
                      type instream
                      val impOpenIn : string -> instream
                      val impCloseIn : instream -> unit
                      val impInput : instream -> vec
                      val vecConcat : vec list -> vec
                      val vecExtract : (vec * int * int option) -> vec
                      val vecSub : (vec * int) -> element
                      val vecLength : vec -> int) =
  struct
    open IO

    type vector = vec
    type elem = element

    datatype impInChunk =
      ImpInChunkEnd
    | ImpInChunkVector of vector * (impInChunk ref)
    | ImpInChunkStream of instream

    (* The integer is a functional position in the first
       vector chunk - if there is a vector chunk at all. *)
    type instream = int * (impInChunk ref)
    type outstream = unit

    (* Internal function implementing inputN *)
    fun fInputN _ acc inStrRef ImpInChunkEnd n =
          (* (print "inputN, ChunkEnd\n"; *)
          (vecConcat (rev acc), (0, inStrRef))
      | fInputN pos acc inStrRef (ImpInChunkVector (v, next)) n =
          let
            (* val _ = print "inputN, ChunkVector\n" *)
            val len = vecLength v - pos
          in
            if len = n then
              if pos = 0 then
                (vecConcat (rev (v::acc)), (0, next))
              else
                let
                  val data = vecExtract (v, pos, SOME(n)) 
                in
                  (vecConcat (rev (data::acc)), (0, next))
                end
            else if len > n then
              let
                val data = vecExtract (v, pos, SOME(n))
              in
                (vecConcat (rev (data::acc)),
                 (pos + n, inStrRef))
              end
            else (* i.e.: len < n *)
              let
                val data = vecExtract (v, pos, SOME(len))
              in
                fInputN 0 (data::acc) next (!next) (n - len)
              end
          end
      | fInputN _ acc inStrRef (ImpInChunkStream inStr) n =
          let
            (* val _ = print "inputN, ChunkStream\n" *)
            val newVec = impInput inStr
            val _ = inStrRef :=
                      (case vecLength newVec of
                         0 => (impCloseIn inStr;
                               ImpInChunkEnd)
                       | _ => ImpInChunkVector
                                (newVec, ref (ImpInChunkStream inStr)))
          in
            fInputN 0 acc inStrRef (!inStrRef) n
          end
          

    (* FIXME: Return 0-length vector for NONE? *)
    fun inputN ((pos, inStr), n) =
          if n < 0 then (* FIXME: No check for maxLen! *)
            raise Size
          else
            fInputN pos nil inStr (!inStr) n

    (* FIXME: Implement more efficiently... *)
    fun input1 inStr =
          let
            val (v, s) = inputN (inStr, 1)
          in
            if vecLength v >= 1 then
              SOME(vecSub (v, 0), s)
            else
              NONE
          end

    (* Internal function implementing input *)
    fun fInput pos inStrRef (ImpInChunkVector (v, next)) =
          (vecExtract (v, pos, NONE), (0, next))
      | fInput pos inStrRef _ =
          (* FIXME: Implement more efficiently? *)
          fInputN 0 nil inStrRef (!inStrRef) 64

    fun input (pos, inStr) =
          fInput pos inStr (!inStr)

    (* Internal function implementing closeIn
       Maybe we should make a more general parametrized
       traverse function... *)
    fun fCloseIn inStrRef (ImpInChunkStream inStr) =
          (impCloseIn inStr;
           inStrRef := ImpInChunkEnd)
      | fCloseIn _ ImpInChunkEnd =
          ()
      | fCloseIn _ (ImpInChunkVector (_, next)) =
          fCloseIn next (!next)

    (* Closes file for further input.
       New end of file becomes the furthest
       position in the file that has been read
       internally. *)
    fun closeIn (_, inStr) =
          fCloseIn inStr (!inStr)

    fun openIn fileName =
          (0,
           ref (ImpInChunkStream
                  (impOpenIn fileName)))
  end

structure Word8Vector = 
  struct
     open Word8Vector
     fun extract (arr, s, l) = 
       Word8VectorSlice.vector (Word8VectorSlice.slice (arr, s, l))
  end
structure CharVector = 
  struct
     open CharVector
     fun extract (arr, s, l) = 
       CharVectorSlice.vector (CharVectorSlice.slice (arr, s, l))
  end

structure FuncBinIO =
  FFunctionalIO(type vec = Word8Vector.vector
                type element = Word8.word
                type instream = BinIO.instream
                val impOpenIn = BinIO.openIn
                val impCloseIn = BinIO.closeIn
                val impInput = BinIO.input
                val vecConcat = Word8Vector.concat
                val vecExtract = Word8Vector.extract
                val vecSub = Word8Vector.sub
                val vecLength = Word8Vector.length)
    :> FUNC_BIN_IO
         where type vector = Word8Vector.vector
           and type elem = Word8.word

structure FuncTextIO =
  FFunctionalIO(type vec = CharVector.vector
                type element = Char.char
                type instream = TextIO.instream
                val impOpenIn = TextIO.openIn
                val impCloseIn = TextIO.closeIn
                val impInput = TextIO.input
                val vecConcat = CharVector.concat
                val vecExtract = CharVector.extract
                val vecSub = CharVector.sub
                val vecLength = CharVector.length)
    :> FUNC_TEXT_IO
         where type vector = CharVector.vector
           and type elem = Char.char(* stop of FunctionalIO/srcSML/FunctionalIO.sml *)
(* start of ParsingToolkit/srcSML/ParserCombinators_sig.sml *)
(*
    This file is part of the ParsingToolkit project -
    which provides combinator parsers for functional input streams.
    
    Copyright (C) 2000 ANOQ of the Sun (alias Johnny Andersen).
    
    Authors: Fritz Henglein <henglein@it.edu>
             ANOQ of the Sun (alias Johnny Andersen)
               <anoq@HardcoreProcessing.com>

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Library General Public
    License as published by the Free Software Foundation; either
    version 2 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Library General Public License for more details.

    As a special exception, if you do not do anything which is not in
    the spirit of the GNU Library General Public License, you are not
    required to physically compile this software into a separate library,
    since this is generally not possible with current Stanard ML compilers.
    However if you do something which is not in the spirit of the
    GNU Library General Public License you will have to follow the
    licence perpetually - thus disallowing you to use it for any
    commercial purposes at all.

    If you are interested in a warranty or commercial support for this
    software, contact Hardcore Processing <sales@HardcoreProcessing.com>
    for more information.

    You should have received a copy of the GNU Library General Public
    License along with this library; if not, write to the Free
    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)

(* Built upon Fritz Henglein's implementation of
   parser combinators as found in Larry Paulson's
   "ML for the Working Programmer"  *)

signature PARSER_COMBINATORS =
  sig
    type instream (* This is FuncTextIO.instream in TextIOParserCombinators
                         and FuncBinIO.instream in BinIOParserCombinators *)
    type vec (* This is string in TextIOParserCombinators
                    and Word8Vector.vector in BinIOParserCombinators *)
    type elem (* This is char in TextIOParserCombinators
                     and Word8.word in BinIOParserCombinators *)

    (* This is the type of a parser. A parser is a function
       taking a functional instream as argument. It returns
       a value that has been created by the parser during parsing,
       and a new functional instream with the stream position
       updated to where the parser stopped reading. *)
    type 'a parser = instream -> ('a * instream)

    (* SyntaxError is raised when a parser fails to parse. *)
    exception SyntaxError of string * instream

    (* Functions given to the >> combinator are expected to
       raise ValidityError on invalid arguments. *)
    exception ValidityError of string

    (* The combinators *)
    (* The purpose of this combinator is to try parsing with
       2 parser functions and return the result of the
       first function that succeeds. *)
    val || : ('a parser) * ('a parser) -> ('a parser)

    (* This combinator will execute 2 parsers in sequence and
       return a pair of the results of the parsers. *)
    val -- : ('a parser) * ('b parser) -> (('a * 'b) parser)

    (* This combinator executes 2 parsers in sequence and
       ignores the result of the first parser. *)
    val $-- : ('a parser) * ('b parser) -> ('b parser)

    (* This combinator executes 2 parsers in sequence and
       ignores the result of the second parser. *)
    val --$ : ('a parser) * ('b parser) -> ('a parser)

    (* Execute a parser and run the result through a function. *)
    val >> : ('a parser) * ('a -> 'b) -> ('b parser)

    (* This combinator is for reading an verifying an expected keyword. *)
    val $$ : vec -> (vec parser)

    (* Some handy built-in parsers. *)

    (* Doesn't parse anything, just returns nil. *)
    val empty : ('a list) parser

    (* Given a predicate, returns a parser that will read an
       element from the stream if the predicate is true. *)
    val getIf : (elem -> bool) -> (elem parser)

    (* Given a parser, returns a parser that will read a list
       of values with the given parser. Parses as many values as possible. *)
    val repeat : ('a parser) -> (('a list) parser)

    (* Given a predicate, returns a parser that will read a list of
       elements, until the predicate is false. *)
    val repeatIf : (elem -> bool) -> ((elem list) parser)

    (* Given a number n and a parser, returns a parser that
       parses a list of n values with the given parser. *)
    val repeatN : int -> ('a parser) -> ('a list parser)

    (* Same as repeatIf, except that this will read at least one
       value - or fail. *)
    val repeatOneIf : (elem -> bool) -> ((elem list) parser)
  end
(* stop of ParsingToolkit/srcSML/ParserCombinators_sig.sml *)
(* start of ParsingToolkit/srcSML/ParserCombinators.sml *)
(*
    This file is part of the ParsingToolkit project -
    which provides combinator parsers for functional input streams.
    
    Copyright (C) 2000 ANOQ of the Sun (alias Johnny Andersen).
    
    Authors: Fritz Henglein <henglein@it.edu>
             ANOQ of the Sun (alias Johnny Andersen)
               <anoq@HardcoreProcessing.com>

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Library General Public
    License as published by the Free Software Foundation; either
    version 2 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Library General Public License for more details.

    As a special exception, if you do not do anything which is not in
    the spirit of the GNU Library General Public License, you are not
    required to physically compile this software into a separate library,
    since this is generally not possible with current Stanard ML compilers.
    However if you do something which is not in the spirit of the
    GNU Library General Public License you will have to follow the
    licence perpetually - thus disallowing you to use it for any
    commercial purposes at all.

    If you are interested in a warranty or commercial support for this
    software, contact Hardcore Processing <sales@HardcoreProcessing.com>
    for more information.

    You should have received a copy of the GNU Library General Public
    License along with this library; if not, write to the Free
    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)

(* Built upon Fritz Henglein's implementation of
   parser combinators as found in Larry Paulson's
   "ML for the Working Programmer"  *)

infix 6 $--
infix 6 --$
infix 5 --
infix 3 >>
(* infix 1 // *)
infix 0 ||

functor FParserCombinators(structure FIO : FUNCTIONAL_IO
                           type vec
                           type elem
                           val elemToString : elem -> string
                           val vecLength : vec -> int
                           val vecEqual : (vec * vec) -> bool
                           val vecToString : vec -> string
                           sharing type elem = FIO.elem
                           sharing type vec = FIO.vector)
          :> PARSER_COMBINATORS where type instream = FIO.instream
                                  and type vec = vec
                                  and type elem = elem =
  struct
    type instream = FIO.instream
    type vec = vec
    type elem = elem
    
    (* FIXME: Use FIO.StreamIO.PrimIO.compare instead... *)
    (* val csSize = Substring.size *)

    (* Exceptions for combinator errors *)
    exception SyntaxError of string * instream
    exception ValidityError of string

    type 'a parser = instream -> ('a * instream)

    fun (pf1 || pf2) stream =
          pf1 stream handle
            exn1 as (SyntaxError (_, stream1)) => 
              (pf2 stream handle
                 exn2 as (SyntaxError (_, stream2)) =>
                   raise exn1
                   (* FIXME: We could compare with FIO.StreamIO.PrimIO.compare if it was implemented *)
                   (* if csSize stream1 < csSize stream2 then
                     raise exn1
                   else
                     raise exn2 *) )

    fun (pf1 -- pf2) stream = 
          let
            val (res1, stream1) = pf1 stream
            val (res2, stream2) = pf2 stream1
          in
            ((res1, res2), stream2)
          end 

    fun (pf1 $-- pf2) stream = 
          let
            val (_, stream1) = pf1 stream
          in
            pf2 stream1
          end 

    fun (pf1 --$ pf2) stream = 
          let
            val (res1, stream1) = pf1 stream
            val (_, stream2) = pf2 stream1
          in
            (res1, stream2)
          end

    fun (pf >> f) stream =
          let
            val (res, stream') = pf stream
          in
            (f res, stream') handle
              ValidityError msg =>
                raise SyntaxError (msg, stream')
          end 

    fun $$ s stream =
          let
            val (v, stream2) = FIO.inputN (stream, vecLength s)
          in
            if vecEqual (v, s) then
              (s, stream2)
            else
              raise SyntaxError ((vecToString s) ^ " expected", stream)
          end

    fun empty stream = (nil, stream)

    (* Utility functions *)
    (* This implementation (and several others I've tried) runs
       out of memory on test.rib. I assume it is because of the
       stack of exceptions. *)
    (*
    fun repeat pf stream = 
          (pf -- repeat pf >> op:: || empty) stream *)

    (* Working implementation of repeat - takes 1.45 sec for parsing
       test.rib when using SML/NJ 110.0.6 on Linux on a 166Mhz Pentium.
       It does not use huge amounts of memory when compared to the amount
       of data being read. *)
    fun repeat pf stream =
          let
            fun oneIter stream =
                  let
                    val (res, stream') = pf stream
                  in
                    (SOME(res), stream')
                  end
                    handle SyntaxError _ =>
                      (NONE, stream)

            fun rep acc (NONE, stream) =
                  (rev acc, stream)
              | rep acc (SOME(res), stream) =
                  rep (res :: acc) (oneIter stream)
          in
            rep nil (oneIter stream)
          end

    fun repeatN n pf stream =
          if n > 0 then
            let
              fun oneIter stream =
                    let
                      val (res, stream') = pf stream
                    in
                      (SOME(res), stream')
                    end
                      handle SyntaxError _ =>
                        (NONE, stream)
  
              fun rep n acc (NONE, stream) =
                    raise SyntaxError ("Could not repeat parser the last " ^ (Int.toString n) ^ " times!", stream)
                | rep n acc (SOME(res), stream) =
                    if n > 0 then
                      rep (n - 1) (res :: acc) (oneIter stream)
                    else
                      (rev (res::acc), stream)
            in
              (* We subtract 1 from n because we call oneIter once already here *)
              rep (n - 1) nil (oneIter stream)
            end
          else
            (nil, stream)

    fun getIf pred stream =
          case FIO.input1 stream of
            SOME (res as (e, stream')) =>
              if pred e then
                res
              else
                raise SyntaxError ((elemToString e) ^ " unexpected", stream)
          | NONE =>
              raise SyntaxError ("Unexpected end of file", stream)

    fun repeatIf pred =
          repeat (getIf pred)

    fun repeatOneIf pred =
          getIf pred -- repeatIf pred >> op::
  end

structure TextIOParserCombinators =
  FParserCombinators(structure FIO = FuncTextIO
                     type vec = string
                     type elem = char
                     val elemToString = Char.toString
                     val vecLength = size
                     val vecEqual = (fn (s1, s2) => s1 = s2)
                     val vecToString = (fn s => s))

structure BinIOParserCombinators =
  FParserCombinators(structure FIO = FuncBinIO
                     type vec = Word8Vector.vector
                     type elem = Word8.word
                     (* FIXME: These anonymous functions are ugly...
                               implement them somewhere else *)
                     val elemToString = (fn e =>
                                           Char.toString
                                             (chr (Word8.toInt e)))
                     val vecLength = Word8Vector.length
                     val vecEqual = (fn (v1, v2) =>
                                       #2 (Word8Vector.foldl
                                             (fn (e, (index, value)) =>
                                                (index + 1,
                                                 value andalso ((Word8.compare (e, Word8Vector.sub (v2, index))) = EQUAL)))
                                             (0, true) v1))
                     val vecToString = (fn v =>
                                          String.concat
                                            (Word8Vector.foldr
                                               (fn (e, acc) => (elemToString e)::acc)
                                               nil v)))
(* stop of ParsingToolkit/srcSML/ParserCombinators.sml *)
(* start of ParsingToolkit/srcSML/TextIOParserCombExtra_sig.sml *)
(*
    This file is part of the ParsingToolkit project -
    which provides combinator parsers for functional input streams.
    
    Copyright (C) 2000 ANOQ of the Sun (alias Johnny Andersen).
    
    Authors: Fritz Henglein <henglein@it.edu>
             ANOQ of the Sun (alias Johnny Andersen)
               <anoq@HardcoreProcessing.com>

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Library General Public
    License as published by the Free Software Foundation; either
    version 2 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Library General Public License for more details.

    As a special exception, if you do not do anything which is not in
    the spirit of the GNU Library General Public License, you are not
    required to physically compile this software into a separate library,
    since this is generally not possible with current Stanard ML compilers.
    However if you do something which is not in the spirit of the
    GNU Library General Public License you will have to follow the
    licence perpetually - thus disallowing you to use it for any
    commercial purposes at all.

    If you are interested in a warranty or commercial support for this
    software, contact Hardcore Processing <sales@HardcoreProcessing.com>
    for more information.

    You should have received a copy of the GNU Library General Public
    License along with this library; if not, write to the Free
    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)

(* Built upon Fritz Henglein's implementation of
   parser combinators as found in Larry Paulson's
   "ML for the Working Programmer"  *)

signature TEXT_IO_PARSER_COMB_EXTRA =
  sig
    type instream = TextIOParserCombinators.instream
    type elem = TextIOParserCombinators.elem
    type 'a parser = 'a TextIOParserCombinators.parser

    val isWhitespaceChar : char -> bool
    val isLetterChar : char -> bool
    val isDigitChar : char -> bool

    val whitespaceForce : elem list parser
    val whitespace : elem list parser

    val getReal : instream -> real * instream
    val getRealWS : real parser
  end
(* stop of ParsingToolkit/srcSML/TextIOParserCombExtra_sig.sml *)
(* start of ParsingToolkit/srcSML/TextIOParserCombExtra.sml *)
(*
    This file is part of the ParsingToolkit project -
    which provides combinator parsers for functional input streams.
    
    Copyright (C) 2000 ANOQ of the Sun (alias Johnny Andersen).
    
    Authors: Fritz Henglein <henglein@it.edu>
             ANOQ of the Sun (alias Johnny Andersen)
               <anoq@HardcoreProcessing.com>

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Library General Public
    License as published by the Free Software Foundation; either
    version 2 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Library General Public License for more details.

    As a special exception, if you do not do anything which is not in
    the spirit of the GNU Library General Public License, you are not
    required to physically compile this software into a separate library,
    since this is generally not possible with current Stanard ML compilers.
    However if you do something which is not in the spirit of the
    GNU Library General Public License you will have to follow the
    licence perpetually - thus disallowing you to use it for any
    commercial purposes at all.

    If you are interested in a warranty or commercial support for this
    software, contact Hardcore Processing <sales@HardcoreProcessing.com>
    for more information.

    You should have received a copy of the GNU Library General Public
    License along with this library; if not, write to the Free
    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)

(* Built upon Fritz Henglein's implementation of
   parser combinators as found in Larry Paulson's
   "ML for the Working Programmer"  *)

functor FTextIOParserCombExtra() :> TEXT_IO_PARSER_COMB_EXTRA =
  struct
    open TextIOParserCombinators
    
    (* Character predicates *)

    fun isWhitespaceChar #" " = true
      | isWhitespaceChar #"\009" = true
      | isWhitespaceChar #"\r" = true
      | isWhitespaceChar #"\n" = true
      | isWhitespaceChar _ = false

    val isLetterChar = Char.isAlpha (* must be generalized! *)
    val isDigitChar = Char.isDigit

    (* Lexical scanner functions *)
    val whitespaceForce =
          repeatOneIf isWhitespaceChar

    val whitespace =
          repeatIf isWhitespaceChar

    fun getReal stream =
          let
            val (digits, stream1) =
                   repeatOneIf (fn c => isDigitChar c orelse
                                        c = #"." orelse
                                        c = #"-")
                               stream
            val realChars = map (fn c => if c = #"-" then #"~" else c) digits
            val realStr = implode realChars
          in
            case Real.fromString realStr of
              NONE =>
                raise SyntaxError ("The string " ^ realStr ^ " is not a real number", stream1)
            | SOME r =>
                (r, stream1)
          end

    val getRealWS = getReal --$ whitespace
  end

structure TextIOParserCombExtra = FTextIOParserCombExtra()(* stop of ParsingToolkit/srcSML/TextIOParserCombExtra.sml *)
(* start of RepeatParserCombinatorTest.sml *)
(* Create a text file with a Standard ML Modules code snippet *)
val outStr = TextIO.openOut "RepeatParserCombinator.txt"
val _ = TextIO.output (outStr, "structure MyStruct = struct end")
val _ = TextIO.closeOut outStr

(* Now for the combinator parser test using the repeat and >> combinators *)
structure FIO = FuncTextIO

local
open TextIOParserCombinators
in
     (* White space *)
      fun isWhitespaceChar #" " = true
        | isWhitespaceChar #"\009" = true
        | isWhitespaceChar #"\r" = true
        | isWhitespaceChar #"\n" = true
        | isWhitespaceChar _ = false

      val whitespace =
            (repeatIf isWhitespaceChar) >> (fn _ => ())
      (* End white *)

      val EQUALS = ($$ "=") -- whitespace

      fun isIdentChar c =
            Char.isAlphaNum c orelse c = #"'" orelse c = #"_"

      fun isIdentStartChar c =
            Char.isAlpha c orelse c = #"'"

      fun isSymbolChar (#"!") = true
        | isSymbolChar (#"%") = true
        | isSymbolChar (#"&") = true
        | isSymbolChar (#"$") = true
        | isSymbolChar (#"#") = true
        | isSymbolChar (#"+") = true
        | isSymbolChar (#"-") = true
        | isSymbolChar (#"/") = true
        | isSymbolChar (#":") = true
        | isSymbolChar (#"<") = true
        | isSymbolChar (#"=") = true
        | isSymbolChar (#">") = true
        | isSymbolChar (#"?") = true
        | isSymbolChar (#"@") = true
        | isSymbolChar (#"\\") = true
        | isSymbolChar (#"~") = true
        | isSymbolChar (#"`") = true
        | isSymbolChar (#"^") = true
        | isSymbolChar (#"|") = true
        | isSymbolChar (#"*") = true
        | isSymbolChar _ = false

      val alphaIdentNoWS = ((getIf isIdentStartChar) -- (repeatIf isIdentChar))
                               >> (fn (a, b) => implode (a::b))
      val symbolIdentNoWS = (repeatOneIf isSymbolChar) >> implode

      val identNoWS = alphaIdentNoWS || symbolIdentNoWS
      val ident = identNoWS --$ whitespace

      fun validateReserved res str =
            if str = res then
              str
            else
              raise ValidityError ("Expected token " ^ res ^
                                   " not found! Found " ^ str ^
                                   " instead.")

      fun reserved parser res inStr =
            (parser >> (validateReserved res)) inStr

      (* And the next is really beautiful functional programming :) *)
      val STRUCTURE = reserved ident "structure"
      val STRUCT = reserved ident "struct"
      val END = reserved ident "end"

      fun parseStructure inStr =
            let
              val (result, inStr2) =
                     ((((STRUCTURE $-- ident) --$ (EQUALS --$ STRUCT)) --$ END)
                       >> (fn str => str))
                       inStr
            in
              result
            end
              handle (SyntaxError (msg, inStr)) =>
                  (print ("Syntax error while parsing:\n" ^ msg ^ "\n"); "")
              | _ =>
                  (print "Error during parsing!\n"; "")

      fun import fileName =
            let
              val inStr = FIO.openIn fileName
              val result = parseStructure inStr
              val _ = FIO.closeIn inStr
            in
              result
            end
end (* end local *)

val structureName = import "RepeatParserCombinator.txt"
val _ = print ("The name of the structure is: " ^ structureName)
val _ = print "\n"
(* stop of RepeatParserCombinatorTest.sml *)