ink std to import

fibonacci.ink

helper := (a, b, n) => n :: {
  0 -> a,
  _ -> helper(b, a+b, n-1)
}
(n) => helper(0, 1, n)

quicksort.ink

# minimal quicksort implementation using hoare partition

{map, clone} := import("std.ink")

sortBy := (v, pred) => (
  vPred := map(v, pred)
  partition := (v, lo, hi) => (
    pivot := vPred.(lo)
    lsub := (i) => (vPred.(i) < pivot) :: {
      true -> lsub(i + 1)
      false -> i
    }
    rsub := (j) => (vPred.(j) > pivot) :: {
      true -> rsub(j - 1)
      false -> j
    }
    (sub := (i, j) => (
      i := lsub(i)
      j := rsub(j)
      (i < j) :: {
        false -> j
        true -> (
          # inlined swap!
          tmp := v.(i)
          tmpPred := vPred.(i)
          v.(i) := v.(j)
          v.(j) := tmp
          vPred.(i) := vPred.(j)
          vPred.(j) := tmpPred

          sub(i + 1, j - 1)
        )
      }
    ))(lo, hi)
  )
  (quicksort := (v, lo, hi) => len(v) :: {
    0 -> v
    _ -> (lo < hi) :: {
      false -> v
      true -> (
        p := partition(v, lo, hi)
        quicksort(v, lo, p)
        quicksort(v, p + 1, hi)
      )
    }
  })(v, 0, len(v) - 1)
)

{
  sortBy,
  sort!: (v) => sortBy(v, (x) => x),
  sort: (v) => sort!(clone(v)),
}

std.ink

# the ink standard library

log := (val) => out(string(val) + "\n")

scan := (cb) => (
  acc := [""]
  in((evt) => evt.type :: {
    "end" -> cb(acc.0)
    "data" -> (
      acc.0 := acc.0 + slice(evt.data, 0, len(evt.data) - 1)
      false
    )
  })
)

# hexadecimal conversion utility functions
hToN := {0: 0, 1: 1, 2: 2, 3: 3, 4: 4, 5: 5, 6: 6, 7: 7, 8: 8, 9: 9, "a": 10, "b": 11, "c": 12, "d": 13, "e": 14, "f": 15}
nToH := "0123456789abcdef"

# take number, return hex string
hex := (n) => (sub := (p, acc) => p < 16 :: {
  true -> nToH.(p) + acc
  false -> sub(floor(p / 16), nToH.(p % 16) + acc)
})(floor(n), "")

# take hex string, return number
xeh := (s) => (
  # i is the num of places from the left, 0-indexed
  max := len(s)
  (sub := (i, acc) => i :: {
    max -> acc
    _ -> sub(i + 1, acc * 16 + hToN.(s.(i)))
  })(0, 0)
)

# find minimum in list
min := (numbers) => reduce(numbers, (acc, n) => n < acc :: {
  true -> n
  false -> acc
}, numbers.0)

# find maximum in list
max := (numbers) => reduce(numbers, (acc, n) => n > acc :: {
  true -> n
  false -> acc
}, numbers.0)

# like Python"s range(), but no optional arguments
range := (start, end, step) => (
  span := end - start
  sub := (i, v, acc) => (v - start) / span < 1 :: {
    true -> (
      acc.(i) := v
      sub(i + 1, v + step, acc)
    )
    false -> acc
  }

  # preempt potential infinite loops
  (end - start) / step > 0 :: {
    true -> sub(0, start, [])
    false -> []
  }
)

# clamp start and end numbers to ranges, such that start < end. Utility used in slice
clamp := (start, end, min, max) => (
  start := (start < min :: {
    true -> min
    false -> start
  })
  end := (end < min :: {
    true -> min
    false -> end
  })
  end := (end > max :: {
    true -> max
    false -> end
  })
  start := (start > end :: {
    true -> end
    false -> start
  })

  {start, end}
)

# get a substring of a given string, or sublist of a given list
slice := (s, start, end) => (
  # bounds checks
  x := clamp(start, end, 0, len(s))
  start := x.start
  max := x.end - start

  (sub := (i, acc) => i :: {
    max -> acc
    _ -> sub(i + 1, acc.(i) := s.(start + i))
  })(0, type(s) :: {
    "string" -> ""
    "list" -> []
  })
)

# join one list to the end of another, return the original first list
append := (base, child) => (
  baseLength := len(base)
  childLength := len(child)
  (sub := (i) => i :: {
    childLength -> base
    _ -> (
      base.(baseLength + i) := child.(i)
      sub(i + 1)
    )
  })(0)
)

# join one list to the end of another, return the third list
join := (base, child) => append(clone(base), child)

# clone a composite value
clone := (x) => type(x) :: {
  "string" -> "" + x
  "composite" -> reduce(keys(x), (acc, k) => acc.(k) := x.(k), {})
  "list" -> reduce(keys(x), (acc, k) => acc.(k) := x.(k), [])
  _ -> x
}

# tail recursive numeric list -> string converter
stringList := (list) => "[" + cat(map(list, string), ", ") + "]"

# tail recursive reversing a list
reverse := (list) => (sub := (acc, i, j) => j :: {
  0 -> acc.(i) := list.0
  _ -> sub(acc.(i) := list.(j), i + 1, j - 1)
})([], 0, len(list) - 1)

# tail recursive map
map := (list, f) => reduce(list, (l, item, i) => l.(i) := f(item, i), [])

# tail recursive filter
filter := (list, f) => reduce(list, (l, item, i) => f(item, i) :: {
  true -> l.len(l) := item
  _ -> l
}, [])

# tail recursive reduce
reduce := (list, f, acc) => (
  max := len(list)
  (sub := (i, acc) => i :: {
    max -> acc
    _ -> sub(i + 1, f(acc, list.(i), i))
  })(0, acc)
)

# tail recursive reduce from list end
reduceBack := (list, f, acc) => (sub := (i, acc) => i :: {
  ~1 -> acc
  _ -> sub(i - 1, f(acc, list.(i), i))
})(len(list) - 1, acc)

# flatten by depth 1
flatten := (list) => reduce(list, append, [])

# true iff some items in list are true
some := (list) => reduce(list, (acc, x) => acc | x, false)

# true iff every item in list is true
every := (list) => reduce(list, (acc, x) => acc & x, true)

# concatenate (join) a list of strings into a string
cat := (list, joiner) => max := len(list) :: {
  0 -> ""
  _ -> (sub := (i, acc) => i :: {
    max -> acc
    _ -> sub(i + 1, acc.len(acc) := joiner + list.(i))
  })(1, clone(list.0))
}

# for-each loop over a list
each := (list, f) => (
  max := len(list)
  (sub := (i) => i :: {
    max -> ()
    _ -> (
      f(list.(i), i)
      sub(i + 1)
    )
  })(0)
)

# parallel for-each loop over a list
peach := (list, f) => (
  par(map(list, (item, i) => () => f(item, i)))
)

# encode string buffer into a number list
encode := (str) => (
  max := len(str)
  (sub := (i, acc) => i :: {
    max -> acc
    _ -> sub(i + 1, acc.(i) := point(str.(i)))
  })(0, [])
)

# decode number list into an ascii string
decode := (data) => reduce(data, (acc, cp) => acc.len(acc) := char(cp), "")

# utility for reading an entire file
readFile := (path, cb) => (
  BufSize := 4096 # bytes
  (sub := (offset, acc) => (evt := read(path, offset, BufSize), evt.type :: {
    "error" -> cb(())
    "data" -> (
      dataLen := len(evt.data)
      dataLen == BufSize :: {
        true -> sub(offset + dataLen, acc.len(acc) := evt.data)
        false -> cb(acc.len(acc) := evt.data)
      }
    )
  }))(0, "")
)

# utility for writing an entire file
# it"s not buffered, because it"s simpler, but may cause jank later
# we"ll address that if/when it becomes a performance issue
writeFile := (path, data, cb) => delete(path, (evt) => evt.type :: {
  # write() by itself will not truncate files that are too long,
  # so we delete the file and re-write. Not efficient, but writeFile
  # is not meant for large files
  "end" -> write(path, 0, data).type :: {
    "error" -> cb(())
    "end" -> cb(true)
  }
  _ -> cb(())
})

# template formatting with {{ key }} constructs
format := (raw, values) => (
  # parser state
  state := {
    # current position in raw
    idx: 0
    # parser internal state:
    # 0 -> normal
    # 1 -> seen one {
    # 2 -> seen two {
    # 3 -> seen a valid }
    which: 0
    # buffer for currently reading key
    key: ""
    # result build-up buffer
    buf: ""
  }

  # helper function for appending to state.buf
  append := (c) => state.buf := state.buf + c

  # read next token, update state
  readNext := () => (
    c := raw.(state.idx)

    state.which :: {
      0 -> c :: {
        "{" -> state.which := 1
        _ -> append(c)
      }
      1 -> c :: {
        "{" -> state.which := 2
        # if it turns out that earlier brace was not
        # a part of a format expansion, just backtrack
        _ -> (
          append("{" + c)
          state.which := 0
        )
      }
      2 -> c :: {
        "}" -> (
          # insert key value
          state.buf := state.buf + string(values.(state.key))
          state.key := ""
          state.which := 3
        )
        # ignore spaces in keys -- not allowed
        " " -> ()
        _ -> state.key := state.key + c
      }
      3 -> c :: {
        "}" -> state.which := 0
        # ignore invalid inputs -- treat them as nonexistent
        _ -> ()
      }
    }

    state.idx := state.idx + 1
  )

  # main recursive sub-loop
  max := len(raw)
  (sub := () => state.idx < max :: {
    true -> (
      readNext()
      sub()
    )
    false -> state.buf
  })()
)

pipe := (x, fs) => reduce(fs, (a, f, _) => f(a), x)

{
  log
  scan
  hToN
  nToH
  hex
  xeh
  min
  max
  range
  clamp
  slice
  append
  join
  clone
  stringList
  reverse
  map
  filter
  reduce
  reduceBack
  flatten
  some
  every
  cat
  each
  peach
  encode
  decode
  readFile
  writeFile
  format
  pipe
}

str.ink

# standard string library

{map, slice, reduce, reduceBack} := import("std.ink")

# checking if a given character is of a type
checkRange := (lo, hi) => (c) => (
  p := point(c)
  lo < p & p < hi
)
upper? := checkRange(point("A") - 1, point("Z") + 1)
lower? := checkRange(point("a") - 1, point("z") + 1)
digit? := checkRange(point("0") - 1, point("9") + 1)
letter? := (c) => upper?(c) | lower?(c)

# is the char a whitespace?
ws? := (c) => point(c) :: {
  32 -> true # space
  10 -> true # newline
  9 -> true # hard tab
  13 -> true # carriage return
  _ -> false
}

# hasPrefix? checks if a string begins with the given prefix substring
hasPrefix? := (s, prefix) => reduce(prefix, (acc, c, i) => acc & (s.(i) == c), true)

# hasSuffix? checks if a string ends with the given suffix substring
hasSuffix? := (s, suffix) => (
  diff := len(s) - len(suffix)
  reduce(suffix, (acc, c, i) => acc & (s.(i + diff) == c), true)
)

# mostly used for internal bookkeeping, matchesAt? reports if a string contains
# the given substring at the given index idx.
matchesAt? := (s, substring, idx) => (
  max := len(substring)
  (sub := (i) => i :: {
  	max -> true
  	_ -> s.(idx + i) :: {
  		(substring.(i)) -> sub(i + 1)
  		_ -> false
  	}
  })(0)
)

# index is indexOf() for ink strings
index := (s, substring) => (
  max := len(s) - 1
  (sub := (i) => matchesAt?(s, substring, i) :: {
  	true -> i
  	false -> i < max :: {
  		true -> sub(i + 1)
  		false -> ~1
  	}
  })(0)
)

# contains? checks if a string contains the given substring
contains? := (s, substring) => index(s, substring) > ~1

# transforms given string to lowercase
lower := (s) => reduce(s, (acc, c, i) => upper?(c) :: {
  true -> acc.(i) := char(point(c) + 32)
  false -> acc.(i) := c
}, "")

# transforms given string to uppercase
upper := (s) => reduce(s, (acc, c, i) => lower?(c) :: {
  true -> acc.(i) := char(point(c) - 32)
  false -> acc.(i) := c
}, "")

# primitive "title-case" transformation, uppercases first letter
# and lowercases the rest.
title := (s) => (
  lowered := lower(s)
  lowered.0 := upper(lowered.0)
)

replaceNonEmpty := (s, old, new) => (
  lold := len(old)
  lnew := len(new)
  (sub := (acc, i) => matchesAt?(acc, old, i) :: {
  	true -> sub(
  		slice(acc, 0, i) + new + slice(acc, i + lold, len(acc))
  		i + lnew
  	)
  	false -> i < len(acc) :: {
  		true -> sub(acc, i + 1)
  		false -> acc
  	}
  })(s, 0)
)

# replace all occurrences of old substring with new substring in a string
replace := (s, old, new) => old :: {
  "" -> s
  _ -> replaceNonEmpty(s, old, new)
}

splitNonEmpty := (s, delim) => (
  coll := []
  ldelim := len(delim)
  (sub := (acc, i, last) => matchesAt?(acc, delim, i) :: {
  	true -> (
  		coll.len(coll) := slice(acc, last, i)
  		sub(acc, i + ldelim, i + ldelim)
  	)
  	false -> i < len(acc) :: {
  		true -> sub(acc, i + 1, last)
  		false -> coll.len(coll) := slice(acc, last, len(acc))
  	}
  })(s, 0, 0)
)

# split given string into a list of substrings, splitting by the delimiter
split := (s, delim) => delim :: {
  "" -> map(s, (c) => c)
  _ -> splitNonEmpty(s, delim)
}

trimPrefixNonEmpty := (s, prefix) => (
  max := len(s)
  lpref := len(prefix)
  idx := (sub := (i) => i < max :: {
  	true -> matchesAt?(s, prefix, i) :: {
  		true -> sub(i + lpref)
  		false -> i
  	}
  	false -> i
  })(0)
  slice(s, idx, len(s))
)

# trim string from start until it does not begin with prefix.
# trimPrefix is more efficient than repeated application of
# hasPrefix? because it minimizes copying.
trimPrefix := (s, prefix) => prefix :: {
  "" -> s
  _ -> trimPrefixNonEmpty(s, prefix)
}

trimSuffixNonEmpty := (s, suffix) => (
  lsuf := len(suffix)
  idx := (sub := (i) => i > ~1 :: {
  	true -> matchesAt?(s, suffix, i - lsuf) :: {
  		true -> sub(i - lsuf)
  		false -> i
  	}
  	false -> i
  })(len(s))
  slice(s, 0, idx)
)

# trim string from end until it does not end with suffix.
# trimSuffix is more efficient than repeated application of
# hasSuffix? because it minimizes copying.
trimSuffix := (s, suffix) => suffix :: {
  "" -> s
  _ -> trimSuffixNonEmpty(s, suffix)
}

# trim string from both start and end with substring ss
trim := (s, ss) => trimPrefix(trimSuffix(s, ss), ss)

{
  upper?
  lower?
  digit?
  letter?
  ws?
  hasPrefix?
  hasSuffix?
  matchesAt?
  index
  contains?
  lower
  upper
  title
  replaceNonEmpty
  replace
  splitNonEmpty
  split
  trimPrefixNonEmpty
  trimPrefix
  trimSuffixNonEmpty
  trimSuffix
  trim
}

suite.ink

# ink standard test suite tools

{log, each, format} := import("std.ink")

# suite constructor
(label) => (
  # suite data store
  s := {
  	all: 0
  	passed: 0
  	msgs: []
  }

  # mark sections of a test suite with human labels
  mark := (label) => s.msgs.len(s.msgs) := "- " + label

  # signal end of test suite, print out results
  end := () => (
  	log(f("suite: {{ label }}", {label}))
  	each(s.msgs, (m) => log("  " + m))
  	s.passed :: {
  		s.all -> log(f("ALL {{ passed }} / {{ all }} PASSED", s))
  		_ -> (
  			log(f("PARTIAL: {{ passed }} / {{ all }} PASSED", s))
  			exit(1)
  		)
  	}
  )

  # log a passed test
  onSuccess := () => (
  	s.all := s.all + 1
  	s.passed := s.passed + 1
  )

  # log a failed test
  onFail := (msg) => (
  	s.all := s.all + 1
  	s.msgs.len(s.msgs) := msg
  )

  # perform a new test case
  indent := "        "
  test := (label, result, expected) => result :: {
  	expected -> onSuccess()
  	_ -> (
  		msg := f("  * {{ label }}
{{ indent }}got {{ result }}
{{ indent }}exp {{ expected }}", {
  			label,
  			result,
  			expected,
  			indent,
  		})
  		onFail(msg)
  	)
  }

  # expose API functions
  {
  	mark
  	test
  	end
  }
)