ink std to import

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)
)

sort! := v => sortBy(v, x => x)

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

std.ink

# the ink standard library

log := val => out(string(val) + '
')

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: start
    end: 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' -> ''
    'composite' -> []
  })
)

# 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), {})
  _ -> 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) => read(path, offset, BufSize, evt => 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, evt => evt.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: log
  scan: scan
  hToN: hToN
  nToH: nToH
  hex: hex
  xeh: xeh
  min: min
  max: max
  range: range
  clamp: clamp
  slice: slice
  append: append
  join: join
  clone: clone
  stringList: stringList
  reverse: reverse
  map: map
  filter: filter
  reduce: reduce
  reduceBack: reduceBack
  flatten: flatten
  some: some
  every: every
  cat: cat
  each: each
  peach: peach
  encode: encode
  decode: decode
  readFile: readFile
  writeFile: writeFile
  format: format
  pipe: 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?: upper?
  lower?: lower?
  digit?: digit?
  letter?: letter?
  ws?: ws?
  hasPrefix?: hasPrefix?
  hasSuffix?: hasSuffix?
  matchesAt?: matchesAt?
  index: index
  contains?: contains?
  lower: lower
  upper: upper
  title: title
  replaceNonEmpty: replaceNonEmpty
  replace: replace
  splitNonEmpty: splitNonEmpty
  split: split
  trimPrefixNonEmpty: trimPrefixNonEmpty
  trimPrefix: trimPrefix
  trimSuffixNonEmpty: trimSuffixNonEmpty
  trimSuffix: trimSuffix
  trim: 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: 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: label
  			result: result
  			expected: expected
  			indent: indent
  		})
  		onFail(msg)
  	)
  }

  # expose API functions
  {
  	mark: mark
  	test: test
  	end: end
  }
)