(* FP-eksamensopgave, MLDoc *)
(* Forfatter: Anders Bjerg Pedersen, 070183 *)
(* Afleveringsdato: 27. oktober 2006 *)
app use ["Item.sml", "IO.sig", "Scan.sig", "Decl.sig", "Display.sig"];
app load ["Msp","FileSys"];
(* Implementering af modul IO: *)
structure IO :> IO =
struct
exception IOError of string;
open FileSys;
(* readFrom-funktionen bruger meget fra aflevering 6, tilføjet en exception: *)
fun readFrom "" = ""
| readFrom fileName =
let val ins = TextIO.openIn fileName
in
TextIO.inputAll ins before TextIO.closeIn ins
end handle IO => raise IOError fileName;
(* writeTo ligner meget, dog skal der her tages højde for, at systemet giver
exception Io, hvis der forsøges openOut på en skrivebeskyttet fil: *)
fun writeTo fileName str =
let val ous = TextIO.openOut fileName handle Io _ => raise IOError fileName
in
TextIO.output(ous,str) before TextIO.closeOut ous
end;
end
(*----------------------------------------------------------------------*)
(*----------------------------------------------------------------------*)
(* Implementering af modul Scan: *)
structure Scan :> Scan =
struct
datatype item = datatype Item.item;
(* BEMÆRK: Kildekoden i dette modul kan være korrekt eller ukorrekt,
hvilket medfører, at ukorrekt kildekode alligevel fortolkes. *)
(* Vi sætter vores text-type til string, dermed bliver
konverteringsfunktionerne trivielle: *)
type text = string;
fun fromString str = str;
fun toString str = str;
(* To lister med declarators og keywords og to funktioner, der er sande, hvis en
streng er iblandt en af listerne: *)
val declarator' = ["exception","fun","val","abstype","datatype","eqtype","type","withtype",
"functor","signature","structure"];
val keyword' = ["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 declarator y = List.exists (fn x => x = y) declarator';
fun keyword y = List.exists (fn x => x = y) keyword';
exception ScanError of string
(* Funktionen f tager 4 argumenter: en streng, der skal tjekkes; hvad der skal tjekkes efter;
en akkumulator, der indeholder resten af str og til sidst en variabel, der har længden af test.
BEMÆRK: der tages IKKE højde for indlejrede kommentarer eller anførselstegn!
Desuden går vi efter specifikationen, at en uafsluttet kommentar/streng returnerer NONE: *)
fun f("",_,_,_) = NONE
| f(str,test,akk,l) =
if size str < l then NONE
else
if String.substring(str,0,l) = test
then SOME((if l=2 then COMMENT else STRINGCONSTANT) akk,String.substring(str,l,(size str) - l))
else f(String.substring(str,1,(size str)-1),test,akk ^ String.substring(str,0,1),l);
(* Og de to funktioner getComment og getStringConstant bruger så f til at returnere indholdet
af hvad, der nu er tjekket efter. *)
fun getComment "" = NONE
| getComment str = f(str,"*)","",2);
fun getStringConstant "" = NONE
| getStringConstant str = f(str,"\"","",1);
(* getWhiteSpaces' returnerer den længste streng af mellemrumstegn
ud fra en char list.
getWhitespaces får en streng som input fra getWhiteSpaces' og returnerer
tuplet bestående af den længste følge af mellemrumstegn efterfulgt
af resten af strengen: *)
fun getWhiteSpaces' [] = ""
| getWhiteSpaces' (x::xs) =
if Char.isSpace(x) then (str x) ^ getWhiteSpaces'(xs)
else "";
fun getWhiteSpaces("") = ("","")
| getWhiteSpaces(x) =
let val y = getWhiteSpaces'(explode(x))
val rest = String.substring(x,size y,size x - size y)
in
(y,rest)
end;
(* getWord virker på nøjagtig samme måde som getWhiteSpaces, blot returnerer
den det længste "ord", der indleder strengen, efterfulgt af resten.
BEMÆRK: på grund af min udformning af getWord, kan den godt returnere
et ord af længde 1. Dette har meget uheldige konsekvenser, da vi så kan
få en meget lang række identifiers i stedet for chars fra vores getItem,
som vi ingen steder får lavet om. Dette er uheldig mangel i implementationen. *)
fun getWord' [] = ""
| getWord' (x::xs) =
if Char.isAlpha(x) then (str x) ^ getWord'(xs)
else "";
fun getWord("") = ("","")
| getWord(x) =
let val y = getWord'(explode(x))
val rest = String.substring(x,size y,size x - size y)
in
(y,rest)
end;
(* Og næsten det samme med getChars, her er der bare lidt flere betingelser,
der skal være opfyldt: *)
fun getChars' [] = ""
| getChars' (x::xs) =
if not(Char.isSpace x orelse Char.isAlpha x orelse x = #"("
orelse x = #"*" orelse x = #")" orelse x = #"\"") then (str x) ^ getChars'(xs)
else "";
fun getChars("") = ("","")
| getChars(x) =
let val y = getChars'(explode(x))
val rest = String.substring(x,size y,size x - size y)
in
(y,rest)
end;
(* Vi anvender skabelonen fra kursets forum til udformningen af getItem.
Vores getItem'-funktion pattern matcher på en char list og returnerer
SOME(item,rest), hvis charlisten indledes af noget brugbart, ellers
returneres NONE. getItem på en streng kalder så getItem på den
tilsvarende charlist: *)
local
fun getItem' (css as #"(" :: #"*" :: cs) = getComment(implode(cs))
| getItem' (css as #"\"" :: cs) = getStringConstant(implode(cs))
| getItem' (#"(" :: cs) = SOME(PARENOPEN,implode(cs))
| getItem' (#")" :: cs) = SOME(PARENCLOSE,implode(cs))
| getItem' (#"*" :: cs) = SOME(ASTERISK,implode(cs))
| getItem' (css as x :: cs) =
if Char.isSpace x
then
let
val (whitespaces,rest) = getWhiteSpaces(implode(css))
in
SOME (WHITESPACE whitespaces,rest)
end
else
if Char.isAlpha x
then
let
val (word,rest) = getWord(implode(css))
in
if keyword word
then SOME(KEYWORD word,rest)
else
if declarator word
then SOME (DECLARATOR word,rest)
else SOME (IDENTIFIER word,rest)
end
else
let
val (other,rest) = getChars(implode(css))
in
SOME(CHARS other,rest)
end
in
fun getItem(x) = getItem'(explode(x))
end;
(* Til sidst er der items-funktionen, der giver os en liste med alle de leksikalske
elementer i en text. Den bruger selvfølgelig getItem: *)
local
fun items'("") = []
| items'(x) = case getItem(fromString(x)) of
NONE => raise ScanError x
| SOME(a,b) => a :: items'(b)
in
fun items(x) = items'(fromString(x))
end;
end
(*----------------------------------------------------------------------*)
(*----------------------------------------------------------------------*)
(* Implementering af modul Decl: *)
structure Decl :> Decl =
struct
datatype item = datatype Item.item
type declaration = { declarator : string, identifier : string, comment : string }
(* BEMÆRK: Vi anvender "skabelonen" givet på kursets forum! *)
(* Funktionen cleanSpace fjerner whitespaces fra en liste af items: *)
fun cleanSpace([]) = []
| cleanSpace((WHITESPACE _)::xs) = cleanSpace(xs)
| cleanSpace(x::xs) = x :: cleanSpace(xs);
(* Funktionen records producerer declarations i en liste, og records samler
funktionaliteten af cleanSpace og records' og genererer dermed den ønskede
liste af poster: *)
local
fun records'([]) = []
| records'((COMMENT x1)::(DECLARATOR x2)::(IDENTIFIER x3)::xs)
= {comment=x1,declarator=x2,identifier=x3}::records'(xs)
| records'((DECLARATOR x2)::(IDENTIFIER x3)::xs)
= {comment="",declarator=x2,identifier=x3}::records'(xs)
| records'(x::xs) = records'(xs)
in
fun records(xs) = records'(cleanSpace(xs))
end;
(* Til at sortere listen med declarations bruger vi igen vores
sorteringsfunktion qsortWith fra aflevering 5: *)
local
fun partition(_,[],samlg) = ([],[])
| partition(pivot,x::xr,samlg)
= let val (xv,xh) = partition(pivot,xr,samlg)
in if samlg(x,pivot) then (x::xv,xh)
else (xv,x::xh)
end
fun quicksort([],samlg) = []
| quicksort(x::xr,samlg)
= let val (xv,xh) = partition(x,xr,samlg)
in quicksort(xv,samlg) @ x :: quicksort(xh,samlg)
end
in
fun qsortWith samlg s = quicksort(s,samlg)
end;
(* Vi grupperer vores deklaratorer efter deres type og laver funktioner,
der tjekker, om en streng er blandt deklaratorerne: *)
val valDec = ["exception","fun","val"];
val typDec = ["abstype","datatype","eqtype","type","withtype"];
val modDec = ["functor","signature","structure"];
fun isValDec(str) = List.exists (fn x => x = str) valDec;
fun isTypDec(str) = List.exists (fn x => x = str) typDec;
fun isModDec(str) = List.exists (fn x => x = str) modDec;
(* Vores sorteringsfunktion tjekker slavisk, om to declarations står korrekt efter hinanden: *)
fun sort({comment=_:string,declarator=d1:string,identifier=i1:string},{comment=_,declarator=d2,identifier=i2}) =
if isModDec(d1) then not(isModDec(d2)) orelse i1 <= i2
else
if isTypDec(d1) then not(isModDec(d2)) andalso (isValDec(d2) orelse i1 <= i2)
else
isValDec(d1) andalso i1 <= i2;
(* Og til sidst anvendes qsortWith på records-funktionen efter sorteringen sort: *)
fun decls(xs) = qsortWith sort (records(xs));
end
(*----------------------------------------------------------------------*)
(*----------------------------------------------------------------------*)
(* Implementering af modul Display: *)
structure Display :> Display =
struct
datatype item = datatype Item.item
type declaration = { declarator : string, identifier : string, comment : string }
open Msp;
(* Vi erklærer konkateneringsoperatoren for wseq som infix: *)
infix &&;
(* Og sætter vores displaytype til Msp.wseq, derfor er vores to
konverteringsfunktioner nødt til at være hhv. $ og flatten: *)
type display = Msp.wseq;
fun fromString str = $ str;
fun toString str = flatten str;
(* Funktionen convWhitespaces laver en WHITESPACE-tegnfølge om til dens HTML-repræsentation, og
funktionen displayItem laver pattern matching på inputtet og anvender htmlencode
til at erstatte de relevante tegn (&,<,>) i kommentarer og lignende. Den bruger
så funktioner fra Msp til den relevante formatering af de forskellige items: *)
fun convWhitespaces("") = Empty
| convWhitespaces(str) =
( case String.sub(str,0) of
#" " => fromString(" ")
| #"\n" => fromString("
")
| #"\t" => fromString(" ")
| _ => fromString(String.substring(str,0,1)) )
&& convWhitespaces(String.substring(str,1,(size str)-1));
fun displayItem(WHITESPACE x) = convWhitespaces(x)
| displayItem(COMMENT x) = fromString("(*" ^ htmlencode(x) ^ "*)")
| displayItem(STRINGCONSTANT x) = fromString("\"" ^ htmlencode(x) ^ "\"")
| displayItem(DECLARATOR x) = strong(fromString(x))
| displayItem(KEYWORD x) = strong(fromString(x))
| displayItem(IDENTIFIER x) = em(fromString(x))
| displayItem(ASTERISK) = fromString("*")
| displayItem(PARENOPEN) = fromString("(")
| displayItem(PARENCLOSE) = fromString(")")
| displayItem(CHARS x) = fromString(htmlencode(x));
(* Vores displayProg bruger så displayItem på en liste og sætter
/hhv. foran og bagved vores "oversatte" items: *) local fun displayProg' [] = fromString("") | displayProg'(x::xs) = displayItem(x) && displayProg'(xs) in fun displayProg(x) = pre( displayProg'(x) ) end; (* Til sidst er der displayDecls-funktionen, som igen anvender funktioner fra Msp til at generere vores HTML-tabel: *) local fun displayDecls' [] = fromString("") | displayDecls'(xs as {declarator=x,identifier=y,comment=z}::xr) = tr( td( strong(fromString(x)) ) && td( em(fromString(y)) ) && td( fromString(z) ) ) && displayDecls'(xr) in fun displayDecls(x) = pre( table( displayDecls'(x) ) ) end; end (*----------------------------------------------------------------------*) (*----------------------------------------------------------------------*) (* Implementering af testmodulet for IO: *) (* Jeg har her haft svært ved at se nødvendigheden af flere testtilfælde. Både readFrom og writeTo testes, ligesom beskyttede filer testes.*) structure TestIO = struct local fun remove fileName = FileSys.remove fileName handle SysErr _ => () fun setup test = let val fileName = FileSys.tmpName () in test fileName before remove fileName end handle _ => false val unwritableFile = "beskyt.sml" (* Set to file name that cannot be written to *) open IO in val testIO00 = setup (fn fileName => (writeTo fileName ""; readFrom fileName = "")) val testIO01 = setup (fn fileName => (writeTo fileName "foobar"; readFrom fileName = "foobar")) val testIO02 = setup (fn fileName => (remove fileName; readFrom fileName; false) handle IOError str => fileName = str) val testIO03 = (writeTo unwritableFile "foobar"; false) handle IOError str => unwritableFile = str | _ => false end end (*----------------------------------------------------------------------*) (*----------------------------------------------------------------------*) (* Implementering af testmodulet for Scan: *) structure TestScan = struct (* Test of conversion property between text and string *) local fun testConversion txt = Scan.toString (Scan.fromString txt) = txt in val testScan00 = testConversion "" handle _ => false val testScan01 = testConversion "\tfoo\t\rbar\n" handle _ => false end local open Item val items = Scan.items o Scan.fromString val getItem = Scan.getItem o Scan.fromString in (* Af uvisse grunde giver denne test false, selvom getItem er defineret til at være NONE, hvis den køres på den tomme streng: *) val testComment00 = (case getItem "" of NONE => true | _ => false) handle _ => false val testComment01 = (case getItem "(*foo=0" of NONE => true | _ => false) handle _ => false val testComment02 = (case getItem "(*foobar*)" of SOME (COMMENT "foobar", rest) => Scan.toString rest = "" | _ => false) handle _ => false val testStringConstant00 = (case getItem "\"blablablabla\"" of SOME (STRINGCONSTANT "blablablabla", rest) => Scan.toString rest = "" | _ => false) handle _ => false val testStringConstant01 = (case getItem "\"blabla\"bloblo\"" of SOME (STRINGCONSTANT "blabla", rest) => Scan.toString rest = "bloblo\"" | _ => false) handle _ => false (* Denne test udelukker vi, da vi ikke tager højde for indlejrede anførselstegn: val testStringConstant02 = (case getItem "\"blablabla\\\"" of NONE => true | _ => false) handle _ => false *) val testItems00 = (items ("") = [] handle _ => false) handle _ => false val testItems01 = (items (" \n ") = [WHITESPACE " \n "]) handle _ => false val testItems02 = (items ("print \"Hello, World\"") = [IDENTIFIER "print", WHITESPACE " ", STRINGCONSTANT "Hello, World"]) handle _ => false val testItems03 = (items ("foo=0") = [IDENTIFIER "foo", CHARS "=0"]) handle _ => false val testItems04 = (items ("foo : int = 0") = [IDENTIFIER "foo", WHITESPACE " ", CHARS ":", WHITESPACE " ", IDENTIFIER "int", WHITESPACE " ", CHARS "=", WHITESPACE " ", CHARS "0"]) handle _ => false val testItems05 = (items ("(*foo(*bar*)*)0") = [COMMENT "foo(*bar", ASTERISK, PARENCLOSE, CHARS "0"]) handle _ => false (* I nedenstående tilfælde bemærker vi, at den indlejrede kommentar ikke opfanges, men at der i stedet "løbes hen over" den: *) val testItems06 = (items ("(* dkjdf \n (* ... djf *) kjdff\t") = [COMMENT " dkjdf \n (* ... djf ", WHITESPACE " ", IDENTIFIER "kjdff", WHITESPACE "\t"]) handle _ => false end end (*----------------------------------------------------------------------*) (*----------------------------------------------------------------------*) (* Implementering af testmodulet for Decl:.*) structure TestDecl = struct open Decl val testDecl01 = decls([WHITESPACE " ",COMMENT "En kommentar...",COMMENT "En exception:", DECLARATOR "exception",IDENTIFIER "IOError",WHITESPACE "\n",DECLARATOR "fun",IDENTIFIER "records"]) = [{comment = "En exception:", declarator = "exception",identifier = "IOError"}, {comment = "", declarator = "fun", identifier = "records"}]; val testDecl02 = decls([WHITESPACE " ",COMMENT "En kommentar...",COMMENT "En funktion:", DECLARATOR "fun",IDENTIFIER "records",WHITESPACE "\n",DECLARATOR "exception",IDENTIFIER "IOError"]) = [{comment = "", declarator = "exception", identifier = "IOError"}, {comment = "En funktion:", declarator = "fun", identifier = "records"}]; val testDecl03 = decls([WHITESPACE " ",COMMENT "En funktion, der laver...",COMMENT "En funktion 2:", DECLARATOR "fun",IDENTIFIER "records2",WHITESPACE "\n",DECLARATOR "fun",IDENTIFIER "records1"]) = [{comment = "", declarator = "fun", identifier = "records1"}, {comment = "En funktion 2:", declarator = "fun", identifier = "records2"}]; end (*----------------------------------------------------------------------*) (*----------------------------------------------------------------------*) (* Implementering af testmodulet for Display *) structure TestDisplay = struct local (* Test of conversion property between display and string *) fun testConversion txt = Display.toString (Display.fromString txt) = txt in val testConversion00 = testConversion "" handle _ => false val testConversion01 = testConversion "\tfoo\t\rbar\n" handle _ => false end local (* Replace tabs by 8 blanks each *) val untabify = String.translate (fn #"\t" => " " | c => str c) (* Split off input until first occurrence of a particular character *) fun splitUntil c = StringCvt.splitl (fn c' => c <> c') List.getItem (* Replace HTML entities (w/o leading '&' and trailing ';' by character denoted *) fun unescape "amp" = #"&" | unescape "lt" = #"<" | unescape "gt" = #">" | unescape "nbsp" = #" " | unescape escSeq = raise Fail ("Unexpected HTML-entity: &" ^ escSeq ^ ";") (* Remove HTML tags and entities from input character list *) fun removeMarkup' (cs as #"<" :: cs') = (case splitUntil #">" cs' of ("br/", _ :: cs'') => #"\n" :: removeMarkup' cs'' | (_, _ :: cs'') => removeMarkup' cs'' | _ => raise Fail ("End of tag character not found: " ^ implode cs)) | removeMarkup' (cs as #"&" :: cs') = (case splitUntil #";" cs' of (escSeq, _ :: cs'') => unescape escSeq :: removeMarkup' cs'' | _ => raise Fail ("Missing ';' at end of HTML-entity: " ^ implode cs)) | removeMarkup' (c :: cs) = c :: removeMarkup' cs | removeMarkup' nil = nil (* Remove HTML tags and entities from input string *) val removeMarkup = implode o removeMarkup' o explode (* Give list of file names to be checked; here it is assumed that the exam structures and signatures are stored in the current catalogue under the following names. *) val MLDocFiles = [ "IO.sig", "IO.sml", "Item.sml", "Scan.sig", "Scan.sml", "Decl.sig", "Decl.sml", "Display.sig", "Display.sml", "MLDoc.sml", "TestIO.sml", "TestScan.sml", "TestDecl.sml", "TestDisplay.sml" ]; (* Checks whether output of displayProg, with markup removed, is identical to input src after replacing tabs by 8 blanks each. This function can be used to test if the output of displayProg retains the source code (including whitespace), if displayProg only inserts HTML-tags and escapes '<', '>', '&', ' ' and the newline character, but does nothing else. If displayProg adds HTML-comments, processing instructions, adds Javascript or similar, this test function must be adapted to be usable for testing visual correctness of the output of displayProg *) fun testDisplayProg fileName = let val str = IO.readFrom fileName in removeMarkup (Display.toString (Display.displayProg (Scan.items (Scan.fromString str)))) = untabify str end handle _ => false val display = removeMarkup o Display.toString o Display.displayItem open Item in val testDisplay01 = (display (STRINGCONSTANT "dkjfdf\\\"df\\\"\\\"\n") = "\"dkjfdf\\\"df\\\"\\\"\n\"") handle _ => false val testDisplay02 = (display (COMMENT "**\n\td(*dk\nf**)kd\njf") = "(***\n\td(*dk\nf**)kd\njf*)") handle _ => false val testDisplay03 = (display (WHITESPACE " \n\t\r \n \n") = untabify " \n\t\r \n \n") handle _ => false val testDisplay04 = (display (DECLARATOR "abstype") = "abstype") handle _ => false val testDisplay05 = (display (KEYWORD "open") = "open") handle _ => false val testDisplay06 = (display (IDENTIFIER "xX_'...YY561._") = "xX_'...YY561._") handle _ => false val testDisplay07 = (display ASTERISK = "*") handle _ => false val testDisplay08 = (display PARENOPEN = "(") handle _ => false val testDisplay09 = (display PARENCLOSE = ")") handle _ => false val testDisplay10 = (display (CHARS "=}@£${[]}+´´``|~¨^'--_.:,;\\<>1234567890!#¤%&/=?") = "=}@£${[]}+´´``|~¨^'--_.:,;\\<>1234567890!#¤%&/=?") handle _ => false val testDisplay11 = Display.toString(Display.displayProg([(WHITESPACE " "), COMMENT "blablablabla",WHITESPACE " \r\n ",DECLARATOR "fun",WHITESPACE " ", IDENTIFIER "testDisplayProg"])) = "
(*blablablabla*) \r"; (* Nedenstående test fejler, men jeg kan ikke umiddelbart se hvorfor: *) val testDisplayProgMLDocFiles = List.all testDisplayProg MLDocFiles end end (*----------------------------------------------------------------------*) (*----------------------------------------------------------------------*) open TestIO; open TestScan; open TestDecl; open TestDisplay;
" ^ "fun testDisplayProg