(* Background: the case expression *) (* See pg 82 *) fun factorial(0) = 1 | factorial(n) = n * factorial(n-1); fun factorial(n) = case n of 0 => 1 | x => x * factorial(x-1); (* Background: the "option" family of types *) (* See pg 83 *) fun homemadeHd(x::rest) = SOME x | homemadeHd([]) = NONE; fun findIth([], i) = NONE | findIth(a::rest, 0) = SOME a | findIth(a::rest, i) = findIth(rest, i - 1); datatype tree = Oak | Elm | Maple | Spruce | Fir | Pine | Willow; datatype vegetable = Carrot | Zucchini | Tomato | Cucumber | Lettuce; datatype grain = Wheat | Oat | Barley | Maize; datatype plot = Grove of tree | Garden of vegetable | Field of grain | Vacant; fun getTreeList([]) = [] | getTreeList(a::rest) = case a of Grove(t) => SOME t :: getTreeList(rest) | x => NONE::getTreeList(rest); getTreeList([Field(Oat), Grove(Elm), Grove(Fir), Vacant, Garden(Carrot), Grove(Oak)]); (* Background: "as" *) (* Based on Ullman, "Elements of ML Programming", pg 68 *) fun merge([], bb) = bb | merge(aa, []) = aa | merge(aa as a::aRest, bb as b::bRest) = if a < b then a::merge(aRest,bb) else b::merge(aa, bRest); merge([4, 8, 27, 43, 107], [5, 9, 12, 17, 22, 73]); (* Background: Exceptions *) (* See pg 52 *) exception NotAGarden of plot; fun replaceTomato(subst, Garden(Tomato)) = Garden(subst) | replaceTomato(subst, Garden(x)) = Garden(x) | replaceTomato(subst, y) = raise NotAGarden(y); (* Background: mutual recursion *) (* See pg 261-264. Take-skip example from Ullman, pg 62 *) fun take([]) = [] | take(x::rest) = x::skip(rest) and skip([]) = [] | skip(y::rest) = take(rest); (* bad *) fun isEven(0) = true | isEven(n) = isOdd(n-1) and isOdd(1) = true | isOdd(n) = isEven(n-1); fun isEven(0) = true | isEven(n) = isOdd(n-1) and isOdd(0) = false | isOdd(n) = isEven(n-1); (* -------------- "Feature presentation" begins here -------------- *) (* Make it so that ML expands structured results to 25 levels (default is 5) and string to length 150 (default is 70)*) Control.Print.printDepth := 25; Control.Print.stringDepth := 150; (* based on a list from grammar.yourdictionary.com *) val adjectives = ["adorable", "adventurous", "aggressive", "agreeable", "alert", "alive", "amused", "angry", "annoyed", "annoying", "anxious", "arrogant", "ashamed", "attractive", "average", "awful", "bad", "beautiful", "better", "bewildered", "big", "black", "bloody", "blue", "blue-eyed", "blushing", "bored", "brainy", "brave", "breakable", "bright", "busy", "calm", "careful", "cautious", "charming", "cheerful", "clean", "clear", "clever", "cloudy", "clumsy", "colorful", "combative", "comfortable", "concerned", "condemned", "confused", "cooperative", "courageous", "crazy", "creepy", "crowded", "cruel", "curious", "cute", "dangerous", "dark", "dead", "defeated", "defiant", "delightful", "depressed", "determined", "different", "difficult", "disgusted", "distinct", "disturbed", "dizzy", "doubtful", "drab", "dull", "eager", "easy", "elated", "elegant", "embarrassed", "enchanting", "encouraging", "energetic", "enthusiastic", "envious", "evil", "excited", "expensive", "exuberant", "fair", "faithful", "famous", "fancy", "fantastic", "fast", "fierce", "filthy", "fine", "foolish", "fragile", "frail", "frantic", "friendly", "frightened", "funny", "gentle", "gifted", "glamorous", "gleaming", "glorious", "good", "gorgeous", "graceful", "grieving", "grotesque", "grumpy", "handsome", "happy", "healthy", "helpful", "helpless", "hilarious", "homeless", "homely", "horrible", "hungry", "hurt", "ill", "important", "impossible", "inexpensive", "innocent", "inquisitive", "itchy", "jealous", "jittery", "jolly", "joyous", "kind", "lazy", "light", "lively", "lonely", "long", "lovely", "lucky", "magnificent", "misty", "modern", "motionless", "muddy", "mushy", "mysterious", "nasty", "naughty", "nervous", "nice", "nutty", "obedient", "obnoxious", "odd", "old-fashioned", "open", "outrageous", "outstanding", "panicky", "perfect", "plain", "pleasant", "poised", "poor", "powerful", "precious", "prickly", "proud", "puzzled", "quaint", "real", "red", "relieved", "repulsive", "rich", "scary", "selfish", "shiny", "shy", "silly", "sleepy", "smart", "smelly", "smiling", "smoggy", "sore", "sparkling", "splendid", "spotless", "stormy", "strange", "stupid", "successful", "super", "talented", "tame", "tender", "tense", "terrible", "testy", "thankful", "thoughtful", "thoughtless", "tired", "tough", "troubled", "ugliest", "ugly", "uninterested", "unsightly", "unusual", "upset", "uptight", "vast", "victorious", "vivacious", "wandering", "weary", "wicked", "wild", "witty", "worrisome", "worried", "wrong", "zany", "zealous"]; val prepositions = ["aboard", "about", "above", "across", "after", "against", "along", "amid", "among", "anti", "around", "as", "at", "before", "behind", "below", "beneath", "beside", "besides", "between", "beyond", "but", "by", "concerning", "considering", "despite", "down", "during", "except", "excepting", "excluding", "following", "for", "from", "in", "inside", "into", "like", "minus", "near", "of", "off", "on", "onto", "opposite", "outside", "over", "past", "per", "plus", "regarding", "round", "save", "since", "than", "through", "to", "toward", "towards", "under", "underneath", "unlike", "until", "up", "upon", "versus", "via", "with", "within", "without"]; val articles = ["a", "an", "the"] val nouns = ["man", "woman", "dog", "unicorn", "ball", "field", "tree", "sky", "cyclops", "teacher", "pizza", "Christian", "cat", "rain"]; val adverbs = ["quickly", "slowly", "dreamily", "happily", "shyly", "really", "hilariously"]; val transitiveVerbs = ["chased", "saw", "greeted", "bit", "loved", "knew", "believed", "proved", "concerned"]; val intransitiveVerbs = ["ran", "slept", "sat", "stood"]; val linkingVerbs = ["was", "felt", "seemed"]; datatype noun = Noun of string; datatype article = Art of string; datatype adjective = Adj of string; datatype preposition = Prep of string; datatype transitiveVerb = TV of string; datatype intransitiveVerb = IV of string; datatype linkingVerb = LV of string; datatype adverb = Adv of string; datatype nounPhrase = ConcNounPhrase of (article * adjective option * noun) | AbsNounPhrase of sentence and verbPhrase = TVP of (transitiveVerb * nounPhrase) | IVP of (intransitiveVerb) | LVP of (linkingVerb * adjective) and predicate = Predicate of (adverb option * verbPhrase) and prepPhrase = PrepPhrase of (preposition * nounPhrase) and sentence = Sentence of (nounPhrase * predicate * prepPhrase option); exception unknownWord of string; fun contains(x, []) = false | contains(x, y::rest) = if x = y then true else contains(x, rest); fun parseArticle(a::rest) = if contains(a, articles) then (Art(a), rest) else raise unknownWord("Expected article, found " ^ a); fun parseAdjective(a::rest) = if contains(a, adjectives) then (SOME (Adj(a)), rest) else (NONE, a::rest); fun parseNoun(a::rest) = if contains(a, nouns) then (Noun(a), rest) else raise unknownWord("Expected noun, found " ^ a); fun parsePreposition(a::rest) = if contains(a, prepositions) then (Prep(a), rest) else raise unknownWord("Expected preposition, found " ^ a); fun parseAdverb(a::rest) = if contains(a, adverbs) then (SOME (Adv(a)), rest) else (NONE, a::rest); fun parseNounPhrase(wordList as a::rest) = if a = "that" then let val (sent, rest1) = parseSentence(rest) in (AbsNounPhrase(sent), rest1) end else let val (art, rest1) = parseArticle(wordList); val (adj, rest2) = parseAdjective(rest1); val (nn, rest3) = parseNoun(rest2); in (ConcNounPhrase(art, adj, nn), rest3) end and parsePrepPhrase(wordList) = let val (prep, rest1) = parsePreposition(wordList); val (nPh, rest2) = parseNounPhrase(rest1); in (PrepPhrase(prep, nPh), rest2) end and parseTransVerb(vb, wordList) = let val (dirObj, rest) = parseNounPhrase(wordList); in (TVP(vb, dirObj), rest) end and parseLinkingVerb(vb, wordList) = let val (adj, rest) = parseAdjective(wordList); in (LVP(vb, valOf(adj)), rest) end and parseVerbPhrase(vb::rest) = if contains(vb, transitiveVerbs) then parseTransVerb(TV(vb), rest) else if contains(vb, intransitiveVerbs) then (IVP(IV(vb)), rest) else if contains(vb, linkingVerbs) then parseLinkingVerb(LV(vb), rest) else raise unknownWord("Expected verb, found " ^ vb) and parsePredicate(wordList) = let val (adv, rest1) = parseAdverb(wordList); val (vPh, rest2) = parseVerbPhrase(rest1); in (Predicate(adv, vPh), rest2) end and parseSentence(wordList) = let val (subj, rest1) = parseNounPhrase(wordList); val (pred, rest2) = parsePredicate(rest1); in case rest2 of [] => (Sentence(subj, pred, NONE), []) | next::rest3 => if contains(next, prepositions) then let val (prPh, rest4) = parsePrepPhrase(next::rest3); in (Sentence(subj, pred, SOME prPh), rest4) end else (Sentence(subj, pred, NONE), rest2) end and parseString(message) = #1(parseSentence(String.tokens(fn(x) => not(Char.isAlpha(x)))(message))); parseString("the man happily believed that the woman knew that the man proved that the man loved the woman"); parseString("that the unicorn bit the pizza proved that the unicorn felt vivacious"); fun diagramNP(ConcNounPhrase(Art(a), adj, Noun(n))) = n ^ ", "^ a ^ (case adj of SOME(Adj(aa)) => ", "^ aa | NONE => "") | diagramNP(AbsNounPhrase(s)) = "that(" ^ diagram(s) ^ ")" and diagramVP(TVP(TV(v), nPh)) = v ^ ":(" ^ diagramNP(nPh) ^ ")" | diagramVP(IVP(IV(v))) = v | diagramVP(LVP(LV(v), Adj(a))) = v ^ "--" ^ a and diagramPred(Predicate(SOME(Adv(a)), vPh)) = diagramVP(vPh) ^ ", " ^ a | diagramPred(Predicate(NONE, vPh)) = diagramVP(vPh) and diagramPrepPh(SOME (PrepPhrase(Prep(p), nPh))) = p ^ "(" ^ diagramNP(nPh) ^ ")" | diagramPrepPh(NONE) = "" and diagram(Sentence(nPh, pred, pPh)) = "(" ^ diagramNP(nPh) ^ ")(" ^ diagramPred(pred) ^ "(" ^ diagramPrepPh(pPh) ^ "))"; fun interrogativeT(TV("chased")) = ("did", "chase") | interrogativeT(TV("saw")) = ("did", "see") | interrogativeT(TV("greeted")) = ("did", "greet") | interrogativeT(TV("bit")) = ("did", "bite") | interrogativeT(TV("loved")) = ("did", "love") | interrogativeT(TV("knew")) = ("did", "know") | interrogativeT(TV("believed")) = ("did", "believe") | interrogativeT(TV("proved")) = ("did", "prove") | interrogativeT(TV("concerned")) = ("did", "concern"); fun interrogativeI(IV("ran")) = ("did", "run") | interrogativeI(IV("slept")) = ("did", "sleep") | interrogativeI(IV("sat")) = ("did", "sit") | interrogativeI(IV("stood")) = ("did", "stand"); fun interrogativeL(LV("was")) = ("was", "") | interrogativeL(LV("felt")) = ("did", "feel") | interrogativeL(LV("seemed")) = ("did", "seem"); fun printNounPhrase(ConcNounPhrase(Art(a), adj, Noun(n))) = a ^ " " ^ (case adj of SOME(Adj(aa)) => aa ^ " " | NONE => "") ^ n | printNounPhrase(AbsNounPhrase(s)) = "that " ^ printSentence(s) and printPrepPhrase(SOME(PrepPhrase(Prep(p), nPh))) = " " ^ p ^ " " ^ printNounPhrase(nPh) | printPrepPhrase(NONE) = "" and printAdverb(SOME(Adv(aa))) = " " ^ aa | printAdverb(NONE) = "" and printVerbPhrase(TVP(TV(v), np)) = v ^ " " ^ printNounPhrase(np) | printVerbPhrase(IVP(IV(v))) = v | printVerbPhrase(LVP(LV(v), Adj(a))) = v ^ " " ^ a and printPredicate(Predicate(adv, vph)) = (case adv of SOME(Adv(aa)) => aa ^ " " | NONE => "") ^ printVerbPhrase(vph) and printSentence(Sentence(np, pr, prph)) = printNounPhrase(np) ^ " " ^ printPredicate(pr) ^ printPrepPhrase(prph); fun makeInterrogative(Sentence(subj, Predicate(adv, TVP(v, dObj)), prPh)) = let val (v1, v2) = interrogativeT(v) in "why " ^ v1 ^ " " ^ printNounPhrase(subj) ^ " " ^ v2 ^ " " ^ printNounPhrase(dObj) ^ printAdverb(adv) ^ printPrepPhrase(prPh) ^ "?" end | makeInterrogative(Sentence(subj, Predicate(adv, IVP(v)), prPh)) = let val (v1, v2) = interrogativeI(v) in "why " ^ v1 ^ " " ^ printNounPhrase(subj) ^ " " ^ v2 ^ printAdverb(adv) ^ printPrepPhrase(prPh) ^ "?" end | makeInterrogative(Sentence(subj, Predicate(adv, LVP(v, Adj(a))), prPh)) = let val (v1, v2) = interrogativeL(v) in "why " ^ v1 ^ " " ^ printNounPhrase(subj) ^ " " ^ v2 ^ printAdverb(adv) ^ " " ^ a ^ printPrepPhrase(prPh) ^ "?" end; exception implausibleVocative of string; (* stubs for your part (submit your answers to these in one big paste, specifying 6.3.x as the exercise). *) fun imperativeT(TV("chased")) = "chase" ... fun imperativeI(IV("ran")) = "run" ... fun imperativeL(LV("was")) = "be" ... fun printVocative(ConcNounPhrase(art, adj, Noun(n))) = "o " ^ (case adj of SOME(Adj(aa)) => ?? ^ " " | NONE => ??) ^ n | printVocative(AbsNounPhrase(s)) = raise implausibleVocative("Cannot speak to a proposition"); fun makeImperative(Sentence(subj, Predicate(adv, TVP(v, dObj)), prPh)) = let val v1 = imperativeT(v) in ?? end | makeImperative(Sentence(subj, Predicate(adv, IVP(v)), prPh)) = let val v1 = imperativeI(v) in ?? end | makeImperative(Sentence(subj, Predicate(adv, LVP(v, Adj(a))), prPh)) = let val v1 = imperativeL(v) in ?? end;