2016 Update

Task/Roman-numerals-Decode/AppleScript/roman-numerals-decode-1.applescript

@@ -0,0 +1,129 @@
+on run
+    map(romanValue, {"MCMXC", "MDCLXVI", "MMVIII"})
+
+    --> {1990, 1666, 2008}
+end run
+
+-- romanValue :: String -> Int
+on romanValue(s)
+    script roman
+        property mapping : [["M", 1000], ["CM", 900], ["D", 500], ["CD", 400], ¬
+            ["C", 100], ["XC", 90], ["L", 50], ["XL", 40], ["X", 10], ["IX", 9], ¬
+            ["V", 5], ["IV", 4], ["I", 1]]
+
+        -- Value of first Roman glyph + value of remaining glyphs
+        -- toArabic :: [Char] -> Int
+        on toArabic(xs)
+            script transcribe
+                -- If this glyph:value pair matches the head of the list
+                -- return the value and the tail of the list
+                -- transcribe :: (String, Number) -> Maybe (Number, [String])
+                on lambda(lstPair)
+                    set lstR to characters of (item 1 of lstPair)
+                    if isPrefixOf(lstR, xs) then
+                        -- Value of this matching glyph, with any remaining glyphs
+                        {item 2 of lstPair, drop(length of lstR, xs)}
+                    else
+                        {}
+                    end if
+                end lambda
+            end script
+
+            if length of xs > 0 then
+                set lstParse to concatMap(transcribe, mapping)
+                (item 1 of lstParse) + toArabic(item 2 of lstParse)
+            else
+                0
+            end if
+        end toArabic
+    end script
+
+    toArabic(characters of s) of roman
+end romanValue
+
+
+-- GENERIC LIBRARY FUNCTIONS
+
+-- isPrefixOf :: [a] -> [a] -> Bool
+on isPrefixOf(xs, ys)
+    if length of xs = 0 then
+        true
+    else
+        if length of ys = 0 then
+            false
+        else
+            set {x, xt} to uncons(xs)
+            set {y, yt} to uncons(ys)
+            (x = y) and isPrefixOf(xt, yt)
+        end if
+    end if
+end isPrefixOf
+
+--  drop :: Int -> a -> a
+on drop(n, a)
+    if n < length of a then
+        if class of a is text then
+            text (n + 1) thru -1 of a
+        else
+            items (n + 1) thru -1 of a
+        end if
+    else
+        {}
+    end if
+end drop
+
+-- concatMap :: (a -> [b]) -> [a] -> [b]
+on concatMap(f, xs)
+    script append
+        on lambda(a, b)
+            a & b
+        end lambda
+    end script
+
+    foldl(append, {}, map(f, xs))
+end concatMap
+
+-- 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 lambda(v, item i of xs, i, xs)
+        end repeat
+        return v
+    end tell
+end foldl
+
+-- 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 lambda(item i of xs, i, xs)
+        end repeat
+        return lst
+    end tell
+end map
+
+-- uncons :: [a] -> Maybe (a, [a])
+on uncons(xs)
+    if length of xs > 0 then
+        {item 1 of xs, rest of xs}
+    else
+        missing value
+    end if
+end uncons
+
+-- 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 lambda : f
+        end script
+    end if
+end mReturn

Task/Roman-numerals-Decode/AppleScript/roman-numerals-decode-2.applescript

@@ -0,0 +1 @@
+{1990, 1666, 2008}