-- quibble :: [String] -> String on quibble(xs) if length of xs > 1 then set applyCommas to ¬ compose([curry(my intercalate)'s |λ|(", "), my |reverse|, my tail]) intercalate(" and ", ap({applyCommas, my head}, {|reverse|(xs)})) else concat(xs) end if end quibble -- TEST ----------------------------------------------------------------------- on run script braces on |λ|(x) "{" & x & "}" end |λ| end script unlines(map(compose({braces, quibble}), ¬ append({{}, {"ABC"}, {"ABC", "DEF"}, {"ABC", "DEF", "G", "H"}}, ¬ map(|words|, ¬ {"One two three four", "Me myself I", "Jack Jill", "Loner"})))) end run -- GENERIC FUNCTIONS ---------------------------------------------------------- -- A list of functions applied to a list of arguments -- (<*> | ap) :: [(a -> b)] -> [a] -> [b] on ap(fs, xs) set {intFs, intXs} to {length of fs, length of xs} set lst to {} repeat with i from 1 to intFs tell mReturn(item i of fs) repeat with j from 1 to intXs set end of lst to |λ|(contents of (item j of xs)) end repeat end tell end repeat return lst end ap -- (++) :: [a] -> [a] -> [a] on append(xs, ys) xs & ys end append -- compose :: [(a -> a)] -> (a -> a) on compose(fs) script on |λ|(x) script on |λ|(a, f) mReturn(f)'s |λ|(a) end |λ| end script foldr(result, x, fs) end |λ| end script end compose -- concat :: [[a]] -> [a] | [String] -> String on concat(xs) script append on |λ|(a, b) a & b end |λ| end script if length of xs > 0 and class of (item 1 of xs) is string then set unit to "" else set unit to {} end if foldl(append, unit, xs) end concat -- curry :: (Script|Handler) -> Script on curry(f) script on |λ|(a) script on |λ|(b) |λ|(a, b) of mReturn(f) end |λ| end script end |λ| end script end curry -- foldl :: (a -> b -> a) -> a -> [b] -> a on foldl(f, startValue, xs) tell mReturn(f) set v to startValue set lng to length of xs repeat with i from 1 to lng set v to |λ|(v, item i of xs, i, xs) end repeat return v end tell end foldl -- foldr :: (a -> b -> a) -> a -> [b] -> a on foldr(f, startValue, xs) tell mReturn(f) set v to startValue set lng to length of xs repeat with i from lng to 1 by -1 set v to |λ|(v, item i of xs, i, xs) end repeat return v end tell end foldr -- head :: [a] -> a on head(xs) if length of xs > 0 then item 1 of xs else missing value end if end head -- intercalate :: Text -> [Text] -> Text on intercalate(strText, lstText) set {dlm, my text item delimiters} to {my text item delimiters, strText} set strJoined to lstText as text set my text item delimiters to dlm return strJoined end intercalate -- map :: (a -> b) -> [a] -> [b] on map(f, xs) tell mReturn(f) set lng to length of xs set lst to {} repeat with i from 1 to lng set end of lst to |λ|(item i of xs, i, xs) end repeat return lst end tell end map -- Lift 2nd class handler function into 1st class script wrapper -- mReturn :: Handler -> Script on mReturn(f) if class of f is script then f else script property |λ| : f end script end if end mReturn -- |reverse| :: [a] -> [a] on |reverse|(xs) if class of xs is text then (reverse of characters of xs) as text else reverse of xs end if end |reverse| -- tail :: [a] -> [a] on tail(xs) if length of xs > 1 then items 2 thru -1 of xs else {} end if end tail -- unlines :: [String] -> String on unlines(xs) intercalate(linefeed, xs) end unlines -- words :: String -> [String] on |words|(s) words of s end |words|