-- pascal :: Generator [[Int]] on pascal() script nextRow on |λ|(row) zipWith(my plus, {0} & row, row & {0}) end |λ| end script iterate(nextRow, {1}) end pascal on run showPascal(take(7, pascal())) end run -- showPascal :: [[Int]] -> String on showPascal(xs) set w to length of intercalate(" ", item -1 of xs) script align on |λ|(x) |center|(w, space, intercalate(" ", x)) end |λ| end script unlines(map(align, xs)) end showPascal -- GENERIC ABSTRACTIONS ------------------------------------------------------- -- center :: Int -> Char -> String -> String on |center|(n, cFiller, strText) set lngFill to n - (length of strText) if lngFill > 0 then set strPad to replicate(lngFill div 2, cFiller) as text set strCenter to strPad & strText & strPad if lngFill mod 2 > 0 then cFiller & strCenter else strCenter end if else strText end if end |center| -- intercalate :: String -> [String] -> String on intercalate(sep, xs) set {dlm, my text item delimiters} to {my text item delimiters, sep} set s to xs as text set my text item delimiters to dlm return s end intercalate -- iterate :: (a -> a) -> a -> Generator [a] on iterate(f, x) script property v : missing value property g : mReturn(f)'s |λ| on |λ|() if missing value is v then set v to x else set v to g(v) end if return v end |λ| end script end iterate -- length :: [a] -> Int on |length|(xs) set c to class of xs if list is c or string is c then length of xs else 2 ^ 30 -- (simple proxy for non-finite) end if end |length| -- 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 -- min :: Ord a => a -> a -> a on min(x, y) if y < x then y else x end if end min -- Lift 2nd class handler function into 1st class script wrapper -- mReturn :: First-class m => (a -> b) -> m (a -> b) on mReturn(f) if class of f is script then f else script property |λ| : f end script end if end mReturn -- plus :: Num -> Num -> Num on plus(a, b) a + b end plus -- Egyptian multiplication - progressively doubling a list, appending -- stages of doubling to an accumulator where needed for binary -- assembly of a target length -- replicate :: Int -> a -> [a] on replicate(n, a) set out to {} if n < 1 then return out set dbl to {a} repeat while (n > 1) if (n mod 2) > 0 then set out to out & dbl set n to (n div 2) set dbl to (dbl & dbl) end repeat return out & dbl end replicate -- take :: Int -> [a] -> [a] -- take :: Int -> String -> String on take(n, xs) set c to class of xs if list is c then if 0 < n then items 1 thru min(n, length of xs) of xs else {} end if else if string is c then if 0 < n then text 1 thru min(n, length of xs) of xs else "" end if else if script is c then set ys to {} repeat with i from 1 to n set end of ys to xs's |λ|() end repeat return ys else missing value end if end take -- unlines :: [String] -> String on unlines(xs) set {dlm, my text item delimiters} to ¬ {my text item delimiters, linefeed} set str to xs as text set my text item delimiters to dlm str end unlines -- unwords :: [String] -> String on unwords(xs) set {dlm, my text item delimiters} to {my text item delimiters, space} set s to xs as text set my text item delimiters to dlm return s end unwords -- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] on zipWith(f, xs, ys) set lng to min(|length|(xs), |length|(ys)) if 1 > lng then return {} set xs_ to take(lng, xs) -- Allow for non-finite set ys_ to take(lng, ys) -- generators like cycle etc set lst to {} tell mReturn(f) repeat with i from 1 to lng set end of lst to |λ|(item i of xs_, item i of ys_) end repeat return lst end tell end zipWith