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;