GIML: Language Translation

Diversion Language translation

Write a program to translate English into Scots* or French - for example - trans scots("Do you know where Pat lives"); > "Do you ken where Pat bides"

Solution One

We require three components:
lex
A function which takes a character list and returns a "word" list. 
lex(explode "one fine day") = [["o","n","e"], ["f","i","n","e"], ["d","a","y"]]
lex 
fun firstWord nil = nil
| firstWord(h::t) = if h=hd (explode " ") then nil else h::firstWord t;
fun butFirstWord nil = nil
| butFirstWord(h::t)= if h=hd (explode " ") then t else butFirstWord t;
fun lex nil = nil
| lex l = firstWord l :: lex(butFirstWord l);
franglais or scots
These functions translate single words from one language into another 
franglais "dog" = "chien"
scots "lives" = "bides"
franglais
 fun	franglais "house" 	= "maison"
 |	franglais "dog" 	= "chien"
 |	franglais "beware"	= "regarde"
 |	franglais "at"		= "dans"
 |	franglais "the"		= "le"
 |	franglais x		= x;
The last line insures that if we have missed a word out it is unchanged: franglais "table" = "table"
trans
A function to combine these actions - to create the word list, to map the word translator across the result and to reconstruct the string.
trans
 fun trans f s = let
   val EnglishWordList = map implode (lex(explode s));
   val ForeignWordList = map f EnglishWordList;
   fun addSpace s = s^" ";
in concat(map addSpace ForeignWordList) end;
Now try trans franglais "beware the dog at Hectors house";

Solution two

The function lex could be improved so that instead of searching for a space it searches for a non-alpha character. If we also partition the list rather than remove spaces the punctuation may be retained and spaces need not be reintroduced. 
fun alpha s =  (s>= #"A" andalso s<= #"Z") orelse
                        (s>= #"a" andalso s<= #"z");
fun takewhile f nil    = nil
|   takewhile f (h::t) = if f h then h::(takewhile f t) 
                                                 else nil;
fun dropwhile f nil    = nil
|   dropwhile f (h::t) = if f h then dropwhile f t else h::t; 
fun lex nil = nil
|   lex l = (takewhile alpha l)::
            (takewhile (not o alpha) (dropwhile alpha l))::
            (lex (dropwhile (not o alpha) (dropwhile alpha l)));
fun trans f = (foldr (op ^) "") o map (f o implode) o lex o explode;
*Seemingly the use of "ken" for "know" is specific to Edinburgh which is only just in Scotland.

Thanks to Tim Larson for the corrections.