content: use AppleScript version "2.4"
  use framework "Foundation"
  use scripting additions
  
  
  -- sternBrocot :: Generator [Int]
  on sternBrocot()
      script go
          on |λ|(xs)
              set x to snd(xs)
              tail(xs) & {fst(xs) + x, x}
          end |λ|
      end script
      fmapGen(my head, iterate(go, {1, 1}))
  end sternBrocot
  
  
  -- TEST ------------------------------------------------------------------
  on run
      set sbs to take(1200, sternBrocot())
      set ixSB to zip(sbs, enumFrom(1))
  
      script low
          on |λ|(x)
              12 ≠ fst(x)
          end |λ|
      end script
  
      script sameFst
          on |λ|(a, b)
              fst(a) = fst(b)
          end |λ|
      end script
  
      script asList
          on |λ|(x)
              {fst(x), snd(x)}
          end |λ|
      end script
  
      script below100
          on |λ|(x)
              100 ≠ fst(x)
          end |λ|
      end script
  
      script fullyReduced
          on |λ|(ab)
              1 = gcd(|1| of ab, |2| of ab)
          end |λ|
      end script
  
      unlines(map(showJSON, ¬
          {take(15, sbs), ¬
              take(10, map(asList, ¬
                  nubBy(sameFst, ¬
                      sortBy(comparing(fst), ¬
                          takeWhile(low, ixSB))))), ¬
              asList's |λ|(fst(take(1, dropWhile(below100, ixSB)))), ¬
              all(fullyReduced, take(1000, zip(sbs, tail(sbs))))}))
  end run
  
  --> [1,1,2,1,3,2,3,1,4,3,5,2,5,3,4]
  --> [[1,32],[2,24],[3,40],[4,36],[5,44],[6,33],[7,38],[8,42],[9,35],[10,39]]
  --> [100,1179]
  --> true
  
  
  -- GENERIC ABSTRACTIONS -------------------------------------------------------
  
  
  -- Absolute value.
  -- abs :: Num -> Num
  on abs(x)
      if 0 > x then
          -x
      else
          x
      end if
  end abs
  
  -- Applied to a predicate and a list, `all` determines if all elements
  -- of the list satisfy the predicate.
  -- all :: (a -> Bool) -> [a] -> Bool
  on all(p, xs)
      tell mReturn(p)
          set lng to length of xs
          repeat with i from 1 to lng
              if not |λ|(item i of xs, i, xs) then return false
          end repeat
          true
      end tell
  end all
  
  -- comparing :: (a -> b) -> (a -> a -> Ordering)
  on comparing(f)
      script
          on |λ|(a, b)
              tell mReturn(f)
                  set fa to |λ|(a)
                  set fb to |λ|(b)
                  if fa < fb then
                      -1
                  else if fa > fb then
                      1
                  else
                      0
                  end if
              end tell
          end |λ|
      end script
  end comparing
  
  
  -- drop :: Int -> [a] -> [a]
  -- drop :: Int -> String -> String
  on drop(n, xs)
      set c to class of xs
      if c is not script then
          if c is not string then
              if n < length of xs then
                  items (1 + n) thru -1 of xs
              else
                  {}
              end if
          else
              if n < length of xs then
                  text (1 + n) thru -1 of xs
              else
                  ""
              end if
          end if
      else
          take(n, xs) -- consumed
          return xs
      end if
  end drop
  
  -- dropWhile :: (a -> Bool) -> [a] -> [a]
  -- dropWhile :: (Char -> Bool) -> String -> String
  on dropWhile(p, xs)
      set lng to length of xs
      set i to 1
      tell mReturn(p)
          repeat while i ≤ lng and |λ|(item i of xs)
              set i to i + 1
          end repeat
      end tell
      drop(i - 1, xs)
  end dropWhile
  
  -- enumFrom :: a -> [a]
  on enumFrom(x)
      script
          property v : missing value
          property blnNum : class of x is not text
          on |λ|()
              if missing value is not v then
                  if blnNum then
                      set v to 1 + v
                  else
                      set v to succ(v)
                  end if
              else
                  set v to x
              end if
              return v
          end |λ|
      end script
  end enumFrom
  
  -- filter :: (a -> Bool) -> [a] -> [a]
  on filter(f, xs)
      tell mReturn(f)
          set lst to {}
          set lng to length of xs
          repeat with i from 1 to lng
              set v to item i of xs
              if |λ|(v, i, xs) then set end of lst to v
          end repeat
          return lst
      end tell
  end filter
  
  -- fmapGen <$> :: (a -> b) -> Gen [a] -> Gen [b]
  on fmapGen(f, gen)
      script
          property g : gen
          property mf : mReturn(f)'s |λ|
          on |λ|()
              set v to g's |λ|()
              if v is missing value then
                  v
              else
                  mf(v)
              end if
          end |λ|
      end script
  end fmapGen
  
  -- fst :: (a, b) -> a
  on fst(tpl)
      if class of tpl is record then
          |1| of tpl
      else
          item 1 of tpl
      end if
  end fst
  
  -- gcd :: Int -> Int -> Int
  on gcd(a, b)
      set x to abs(a)
      set y to abs(b)
      repeat until y = 0
          if x > y then
              set x to x - y
          else
              set y to y - x
          end if
      end repeat
      return x
  end gcd
  
  -- head :: [a] -> a
  on head(xs)
      if xs = {} then
          missing value
      else
          item 1 of xs
      end if
  end head
  
  -- iterate :: (a -> a) -> a -> Gen [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 ^ 29 - 1) -- (maxInt - 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
  
  
  -- nubBy :: (a -> a -> Bool) -> [a] -> [a]
  on nubBy(f, xs)
      set g to mReturn(f)'s |λ|
  
      script notEq
          property fEq : g
          on |λ|(a)
              script
                  on |λ|(b)
                      not fEq(a, b)
                  end |λ|
              end script
          end |λ|
      end script
  
      script go
          on |λ|(xs)
              if (length of xs) > 1 then
                  set x to item 1 of xs
                  {x} & go's |λ|(filter(notEq's |λ|(x), items 2 thru -1 of xs))
              else
                  xs
              end if
          end |λ|
      end script
  
      go's |λ|(xs)
  end nubBy
  
  -- partition :: predicate -> List -> (Matches, nonMatches)
  -- partition :: (a -> Bool) -> [a] -> ([a], [a])
  on partition(f, xs)
      tell mReturn(f)
          set ys to {}
          set zs to {}
          repeat with x in xs
              set v to contents of x
              if |λ|(v) then
                  set end of ys to v
              else
                  set end of zs to v
              end if
          end repeat
      end tell
      Tuple(ys, zs)
  end partition
  
  -- showJSON :: a -> String
  on showJSON(x)
      set c to class of x
      if (c is list) or (c is record) then
          set ca to current application
          set {json, e} to ca's NSJSONSerialization's dataWithJSONObject:x options:0 |error|:(reference)
          if json is missing value then
              e's localizedDescription() as text
          else
              (ca's NSString's alloc()'s initWithData:json encoding:(ca's NSUTF8StringEncoding)) as text
          end if
      else if c is date then
          "\"" & ((x - (time to GMT)) as «class isot» as string) & ".000Z" & "\""
      else if c is text then
          "\"" & x & "\""
      else if (c is integer or c is real) then
          x as text
      else if c is class then
          "null"
      else
          try
              x as text
          on error
              ("«" & c as text) & "»"
          end try
      end if
  end showJSON
  
  -- snd :: (a, b) -> b
  on snd(tpl)
      if class of tpl is record then
          |2| of tpl
      else
          item 2 of tpl
      end if
  end snd
  
  
  -- Enough for small scale sorts.
  -- Use instead sortOn :: Ord b => (a -> b) -> [a] -> [a]
  -- which is equivalent to the more flexible sortBy(comparing(f), xs)
  -- and uses a much faster ObjC NSArray sort method
  -- sortBy :: (a -> a -> Ordering) -> [a] -> [a]
  on sortBy(f, xs)
      if length of xs > 1 then
          set h to item 1 of xs
          set f to mReturn(f)
          script
              on |λ|(x)
                  f's |λ|(x, h) ≤ 0
              end |λ|
          end script
          set lessMore to partition(result, rest of xs)
          sortBy(f, |1| of lessMore) & {h} & ¬
              sortBy(f, |2| of lessMore)
      else
          xs
      end if
  end sortBy
  
  -- tail :: [a] -> [a]
  on tail(xs)
      set blnText to text is class of xs
      if blnText then
          set unit to ""
      else
          set unit to {}
      end if
      set lng to length of xs
      if 1 > lng then
          missing value
      else if 2 > lng then
          unit
      else
          if blnText then
              text 2 thru -1 of xs
          else
              rest of xs
          end if
      end if
  end tail
  
  -- 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 v to xs's |λ|()
              if missing value is v then
                  return ys
              else
                  set end of ys to v
              end if
          end repeat
          return ys
      else
          missing value
      end if
  end take
  
  -- takeWhile :: (a -> Bool) -> [a] -> [a]
  -- takeWhile :: (Char -> Bool) -> String -> String
  on takeWhile(p, xs)
      if script is class of xs then
          takeWhileGen(p, xs)
      else
          tell mReturn(p)
              repeat with i from 1 to length of xs
                  if not |λ|(item i of xs) then ¬
                      return take(i - 1, xs)
              end repeat
          end tell
          return xs
      end if
  end takeWhile
  
  -- takeWhileGen :: (a -> Bool) -> Gen [a] -> [a]
  on takeWhileGen(p, xs)
      set ys to {}
      set v to |λ|() of xs
      tell mReturn(p)
          repeat while (|λ|(v))
              set end of ys to v
              set v to xs's |λ|()
          end repeat
      end tell
      return ys
  end takeWhileGen
  
  -- Tuple (,) :: a -> b -> (a, b)
  on Tuple(a, b)
      {type:"Tuple", |1|:a, |2|:b, length:2}
  end Tuple
  
  -- 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
  
  -- zip :: [a] -> [b] -> [(a, b)]
  on zip(xs, ys)
      zipWith(Tuple, xs, ys)
  end zip
  
  -- 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
  