(* auto-view.sml *) (* Copyright (C) 2008 Alley Stoughton This file is part of crypto, a cryptogram encoder/decoder. See the file COPYING.txt for copying and usage restrictions *) (* automatic view *) structure View :> VIEW where type SymLinOrd.elem = Data.sym and type pds = Data.pds and type SymSet.set = Data.SymSet.set and type SymLexicon.lexicon = Data.SymLexicon.lexicon = struct open Data structure LW = LowercaseWord datatype primary_command = QuitPC | LexiconPC of sym_lexicon | EncodePC of msg | DecodePC of msg datatype primary_response = EncodeWordsNotInLexiconPR of (int * word)list | EncodeMultipleDecodingsPR | EncodeEncodingPR of msg | DecodeNoDecodingsPR | DecodeMultipleDecodingsPR datatype secondary_command = QuitSC | AbortSC | CheckSC | HintSC | ReplaceSC of sym * sym | UndoSC datatype secondary_response = CheckNotDecodableSR | CheckDecodedSR | CheckDecodableButNotDecodedSR | HintNotDecodableSR | HintDecodedSR | HintReplaceSR of sym * sym (* val printErr : string -> unit print string on standard error output *) fun printErr s = TextIO.output(TextIO.stdErr, s) (* val wordToStr : word -> string convert a word to a string *) fun wordToStr [b] = str b | wordToStr (b :: bs) = str b ^ wordToStr bs | wordToStr nil = raise Fail "cannot happen" (* val lineToStr : line -> string convert a line to a string *) fun lineToStr nil = "" | lineToStr [x] = wordToStr x | lineToStr (x :: xs) = wordToStr x ^ " " ^ lineToStr xs (* val printMsg : msg -> unit print a message on the standard output *) fun printMsg nil = () | printMsg (x :: xs) = (print(lineToStr x); print "\n"; printMsg xs) (* val decodedPDSToStr : pds -> string convert a decoded pds to a string, using lowercase letters for new symbols *) fun decodedPDSToStr(Old _) = raise Fail "cannot happen" | decodedPDSToStr(New a) = str a (* val decodedPDWToStr : pdw -> string convert a decoded pdw to a string, using lowercase letters for new symbols *) fun decodedPDWToStr [x] = decodedPDSToStr x | decodedPDWToStr (x :: xs) = decodedPDSToStr x ^ decodedPDWToStr xs | decodedPDWToStr nil = raise Fail "cannot happen" (* val decodedPDLToStr : pdl -> string convert a decodeded pdl to a string, using lowercase letters for new symbols *) fun decodedPDLToStr nil = "" | decodedPDLToStr [x] = decodedPDWToStr x | decodedPDLToStr (x :: xs) = decodedPDWToStr x ^ " " ^ decodedPDLToStr xs (* val printDecodedPDM : pdm -> unit print a decoded pdm on the standard output, using lowercase letters for new symbols *) fun printDecodedPDM nil = () | printDecodedPDM (x :: xs) = (print(decodedPDLToStr x); print "\n"; printDecodedPDM xs) (* val lexicon : string * string -> sym_lexicon option if file can't be opened for input, then lexicon(cmd, file) returns NONE, after printing an error message on the standard error output, identified as coming from cmd otherwise, lexicon returns SOME lex, where lex is a sym_lexicon representing the contents of file non-words in the file are ignored, except that warning messages are issued on the standard error output, identified as coming from cmd *) fun lexicon(cmd, file) = let val (lex, warns) = LW.processFile (SymLexicon.empty, fn (x, lex) => SymLexicon.add(explode x, lex), fn lex => lex, fn lex => lex, LW.initError, LW.wordError, LW.newlineError, LW.eofError) file in if null warns then () else (printErr(cmd ^ ": warning: non-words in lexicon:\n"); app (fn (n, x) => printErr(cmd ^ ": line " ^ Int.toString n ^ ": \"" ^ String.toString x ^ "\"\n")) warns); SOME lex end handle UnableToOpenFile => (printErr(cmd ^ ": " ^ "unable to open file \""); printErr(String.toString(file)); printErr "\"\n"; NONE) (* val getMessage : string -> msg option getMessage cmd reads a message from the standard input; messages are terminated by end-of-file; if the message contains non-words, approprate error messages are issued on the standard error output, identified as coming from cmd, and NONE is returned; otherwise SOME of the message is returned *) fun getMessage cmd = let val (msg, errs) = LW.processStream (false, LW.initNormal, LW.wordNormal, LW.newlineNormal, LW.eofNormal, LW.initError, LW.wordError, LW.newlineError, LW.eofError) TextIO.stdIn in if null errs then SOME msg else (printErr(cmd ^ ": message contains non-words:\n"); app (fn (n, x) => printErr(cmd ^ ": line " ^ Int.toString n ^ ": \"" ^ String.toString x ^ "\"\n")) errs; NONE) end (* view data in the following datatype, values of type string are the command name, i.e., the name by which crypto was invoked the vd values represent stages of encoding or decoding a message, or of finishing up afterward *) datatype vd = Encode1VD of string * sym_lexicon * msg | Encode2VD of string * msg | Encode3VD of string | Encode4VD of pdm | Decode1VD of string * sym_lexicon * msg | Decode2VD of string * msg | Decode3VD of string | Decode4VD of pdm | Finish1VD of OS.Process.status | Finish2VD of OS.Process.status fun primaryInput (Encode1VD(cmd, lex, msg)) = (Encode2VD(cmd, msg), LexiconPC lex) | primaryInput (Encode2VD(cmd, msg)) = (Encode3VD cmd, EncodePC msg) | primaryInput (Decode1VD(cmd, lex, msg)) = (Decode2VD(cmd, msg), LexiconPC lex) | primaryInput (Decode2VD(cmd, msg)) = (Decode3VD cmd, DecodePC msg) | primaryInput (Finish1VD stat) = (Finish2VD stat, QuitPC) | primaryInput _ = raise Fail "cannot happen" fun primaryOutput(vd, resp) = case (vd, resp) of (Encode3VD cmd, EncodeWordsNotInLexiconPR ps) => (printErr(cmd ^ ": message has words not in lexicon:\n"); List.app (fn (n, x) => printErr(cmd ^ ": line " ^ Int.toString n ^ ": \"" ^ wordToStr x ^ "\"\n")) ps; Finish1VD OS.Process.failure) | (Encode3VD cmd, EncodeMultipleDecodingsPR) => (printErr(cmd ^ ": message has multiple decodings\n"); Finish1VD OS.Process.failure) | (Encode3VD _, EncodeEncodingPR msg) => (printMsg msg; Finish1VD OS.Process.success) | (Decode3VD cmd, DecodeNoDecodingsPR) => (printErr(cmd ^ ": message has no decodings\n"); Finish1VD OS.Process.failure) | (Decode3VD cmd, DecodeMultipleDecodingsPR) => (printErr(cmd ^ ": message has multiple decodings\n"); Finish1VD OS.Process.failure) | _ => raise Fail "cannot happen" fun secondaryInput (Decode3VD _, pdm, _, _) = (Decode4VD pdm, HintSC) | secondaryInput (Decode4VD _, pdm, _, _) = (Decode4VD pdm, HintSC) | secondaryInput _ = raise Fail "cannot happen" fun secondaryOutput(vd, resp) = case (vd, resp) of (Decode4VD pdm, HintDecodedSR) => (printDecodedPDM pdm; Finish1VD OS.Process.success) | (Decode4VD pdm, HintReplaceSR _) => Decode4VD pdm | _ => raise Fail "cannot happen" type abort = vd * IntInf.int fun abortable(vd, n, f) = let val cmd = case vd of Encode3VD cmd => cmd | Decode3VD cmd => cmd | _ => raise Fail "cannot happen" (* val checkAbort : abort -> abort * bool *) fun checkAbort(vd, m) = (if m > 0 andalso m mod (IntInf.fromInt n) = 0 then printErr(cmd ^ ": completed " ^ IntInf.toString m ^ " steps ...\n") else (); ((vd, m + 1), false)) val _ = printErr(cmd ^ ": computing ...\n") in case f((vd, 0 : IntInf.int), checkAbort) of (_, _, NONE) => raise Fail "cannot happen" | ((vd, m), u, x) => (printErr(cmd ^ ": terminated after completing " ^ IntInf.toString m ^ " steps\n"); (vd, u, x)) end (* argument processing *) datatype mode = EncodeMode | DecodeMode fun parseMode(cmd, mode) = case Completion.complete (StringSet.fromList["encode", "decode"]) mode of Completion.Unique "encode" => SOME EncodeMode | Completion.Unique "decode" => SOME DecodeMode | _ => (printErr(cmd ^ ": bad mode: \"" ^ mode ^ "\"\n"); NONE) val modes = ["", " where modes are:", "", " encode", " decode"] fun run(cmd, args, f) = case args of [lexFile, mode] => (case parseMode(cmd, mode) of NONE => OS.Process.failure | SOME mode => (case lexicon(cmd, lexFile) of NONE => OS.Process.failure | SOME lex => (case getMessage cmd of NONE => OS.Process.failure | SOME msg => (case f(case mode of EncodeMode => Encode1VD(cmd, lex, msg) | DecodeMode => Decode1VD(cmd, lex, msg)) of Finish2VD stat => stat | _ => raise Fail "cannot happen")))) | _ => (printErr(cmd ^ ": usage: " ^ cmd ^ " LEXICON MODE\n"); app (fn s => printErr(cmd ^ ": " ^ s ^ "\n")) modes; OS.Process.failure) end;