signature IO =
sig
    exception IOError of string

    val readFrom: string -> string

    val writeTo: string -> string -> unit

end;

structure IO :> IO =
struct
    exception IOError of string

    fun readFrom fileName = 
	TextIO.inputAll (TextIO.openIn fileName)
	handle Io _ => raise IOError fileName

    fun writeTo fileName str = 
	(TextIO.output (TextIO.openOut fileName, str);
	 TextIO.flushOut (TextIO.openOut fileName))
	handle Io _ => raise IOError fileName

end;

structure Item =
struct

    datatype item = WHITESPACE of string
		  | COMMENT of string
		  | STRINGCONSTANT of string
		  | DECLARATOR of string
		  | KEYWORD of string
		  | IDENTIFIER of string
		  | ASTERISK
		  | PARENOPEN
		  | PARENCLOSE
		  | CHARS of string

end;

signature Scan =
sig

    datatype item = datatype Item.item

    type text

    val fromString : string -> text
    val toString : text -> string

    exception ScanError of string

    val getItem : text -> (item * text) option

(*    val items : text -> item list*)

end;

structure Scan :> Scan =
struct

    datatype item = datatype Item.item

    type text = char list

    fun fromString str = explode str
    fun toString str = implode str

    exception ScanError of string

    fun isComment (#"(" :: #"*" :: _) = true
      | isComment _ = false

    fun getComment ([], 0, _) = []
      | getComment ([], _, _) = raise Fail "Comments does not end!!!"
      | getComment (_, 0, _) = []
      | getComment ((x::xr), n, k) = 
         if x = #"(" andalso k = 0
	 then x :: getComment(xr, n, 1)
	 else if x = #"*" andalso k = 1
	      then x::getComment(xr, n+1, 0)
	      else if x = #"*" andalso k = 0
		   then getComment(xr, n, 2)
	           else if x = #")" andalso k = 2
			then if n = 1
			     then []
			     else #"*" :: #")" :: getComment(xr, n-1, 0)
			else x::getComment(xr, n, 0)    

    fun getConstant ((x::xr), k)
	= if x = #"\\" andalso k = 0
	     then x :: getConstant(xr, 1)
	     else if x = #"\"" andalso k = 0
		  then []
		  else x :: getConstant (xr, 0)

    fun removeStart (0, xr) = xr
      | removeStart (n, (x::xr)) = removeStart(n-1,xr)

    val listDeclarators = 
	["exception", "fun", "val", "abstype","datatype",
	 "eqtype","type","withtype","functor",
	 "signature","structure"]

    val listKeywords =
	["and", "andalso", "as","case","do","else","end",
	 "fn","handle","if","in","infix","infixr","let",
	 "local","nonfix","of","op","open","orelse","raise",
	 "rec","then","while","include","sharing","sig",
	 "struct","where"]

    fun isVoid #"(" = true
      | isVoid #")" = true
      | isVoid #"*" = true
      | isVoid #"\\" = true
      | isVoid #"\"" = true
      | isVoid c = Char.isSpace c

    fun untilWhitespace (x::xr)
	= if isVoid x
	  then []
	  else x :: untilWhitespace xr

    fun untilNonWhitespace (x::xr)
	= if isVoid x
	  then x :: untilNonWhitespace xr
	  else []

    fun whichItem (#"\""::_) = (STRINGCONSTANT, "")
      | whichItem (#"*"::_) = (ASTERISK, "")
      | whichItem (#")"::_) = (PARENCLOSE, "")
      | whichItem ((x::xr) as t)
       = if Char.isAlpha x
	 then 
	   let
	     val stringCheck = implode (untilWhitespace t)
	   in
	     if List.exists (fn x => x = stringCheck) listDeclarators
	     then (DECLARATOR, stringCheck)
	     else if List.exists (fn x => x = stringCheck) listKeywords
		  then (KEYWORD, stringCheck)
		  else (IDENTIFIER, stringCheck)
	   end
	 else if Char.isSpace x
	      then (WHITESPACE, implode (untilNonWhitespace l))
	      else if isComment t
		   then (COMMENT, "")
	           else if x = #"("
			then (PARENOPEN, "")
			else (OTHER, x)

    fun getItem (l as (x::xs)) = 
	case whichItem l of
	     (WHITESPACE, str) => SOME (WHITESPACE str, removeStart(size str, l))
	   | (ASTERISK, _) => SOME (ASTERISK "*", xs)
	   | (PARENOPEN, _) => SOME (PARENOPEN "(", xs)
	   | (PARENCLOSE, _) => SOME (PARENCLOSE ")", xs)
	   | (STRINGCONSTANT, _) =>
	        let
		  val txt = implode (getConstant(xr, 0))
		  val len = size txt
		in
		  SOME (STRINGCONSTANT txt, removeStart(len,xs))
		end
	   | (DECLARATOR, str) => SOME (DECLARATOR str, removeStart(size str, l))
	   | (KEYWORD, str) => SOME (KEYWORD str, removeStart(size str, l))
	   | (IDENTIFIER, str) => SOME (IDENTIFIER str, removeStart(size str, l))
	   | (OTHER, str) => SOME (OTHER str, xs)

(*    fun items txt = raise Fail "Scan.items"*)

end;