# The Brzozowski Variations.
#
# A worked example of ECL programming, serving to demonstrate some of the
# language`s features.
#
# Brzozowski derivatives are an elegant (if inefficient) way to implement
# simple regular expressions. The algorithm introduces the elements of the
# *language* of regular expressions (implemented here in the module `regex`),
# and a procedure of repeated *derivation* with respect to some string, in
# order to evaluate whether the regular expression matches the string.
#
# For more examples, see the rest of this repo.

### module regex
# Modules provide namespacing for bindings. The public bindings on the module
# can then be invoked with `module-name.name`.
(: "Constructors for each expression in the language.")
(
 `test-support (expect) importp

 ### set empty
 # `set` binds names to values, which are put on the stack when the name is
 # evaluated.
 # The literal `{k v}` constructs a dictionary with the key ``k` associated with
 # the value ``v`. Dictionary literals don't evaluate their contents, so `type`
 # and `empty` are both literal symbols.
 # When not included inside of a quoting structure like a dictionary literal, a
 # symbol is evaluated when it's pushed to the stack. To push a symbol without
 # evaluating it, we quote it with `` ` ``.
 # Thus, the word `set` consumes a value and a symbol from the stack, and binds
 # the symbol to the value.
 {type empty} `empty set

 ### set epsilon
 {type epsilon} `epsilon set

 ### defp type
 # `def` and `defp` also binds names to values -- but a name bound with `def`
 # unquotes the list to which it was bound when it's evaluated, pushing its
 # elements onto the stack. Thus, binding a program with `def` is equivalent to
 # defining a function.
 # `defp` (which is only meaningful inside of a module) is just like def, but
 # the resulting binding is private; it can't be accessed from outside the
 # module.
 # Lists of words, like the one this line binds to `type`, are called
 # "quotations".
 (`type swap dict.associate) `type defp

 ### defp assoc
 (rolldown put) `assoc defp

 ### def char
 (`char type `value assoc) `char def

 ### def star
 (`star type `value assoc) `star def

 ### def union
 (`union type `right assoc `left assoc) `union def

 ### def concat
 (`concat type `right assoc `left assoc) `concat def

 ### test char
 # Tests are first-class, and tied to modules. This allows us to
 # write tests against module logic even if we don't want to expose that logic
 # publicly.
 # The ECL cli can start a test session with `ecl test`.
 # We have seen quotations consumed by `def`; quotations are also
 # extremely commonly used where another language would reach for a lambda, or
 # anonymous function. Here `expect` consumes a list of quotations, each of
 # which will be evaluated against `\c char`, and will raise an exception if
 # any of them evaluate to 0 (false).
 # The syntax `\c` constructs a char value, one of the primitive datatypes in
 # ECL.
 (\c char
  # Both `[]` and `()` construct lists, including quotations.
  [(`type at `char match?)
   (`value at \c match?)] expect) `char test

 ### test concat
 (\x char \y char concat
  [(`type at `concat match?)
   ([`left `value] at-path \x match?)
   ([`right `value] at-path \y match?)] expect) `concat test

 # `@defm` takes a quoted program and uses it to construct a module, evaluating
 # each binding in the context of the namespace which is passed as a symbol.
 # The `@` convention indicates that this word evaluates in a new unit---that
 # is, a separate "stack transaction" inside the interpreter, isolated from the
 # evaluation context of its surroundings. If an error occurs, the stack is
 # restored to its state before the unit began executing.
) `regex @defm

### module brzo
# ECL strings are naturally multi-line, and don't need escaping or
# triple-quotes. Docstrings are automatically reflowed when displayed via the
# reflection words.
(: "An implementation of regular expressions via Brzozowski derivatives. Construct a regex with the
    constructors from `regex`; then pass them and a test string to `matches?` to evaluate.")
(# `m q import` imports the names in `q` from the module `m`; `importp` does
 # the same but keeps them from leaking out of the module.
 `regex (`char `empty `epsilon `union `concat `star) importp
 `test-support (expect) importp

 ### defp left
 (`left at) `left defp

 ### defp right
 (`right at) `right defp

 ### defp val
 (`value at) `val defp

 ### def nullable?
 # `def` takes an optional value below its quotation: an annotation. This is an
 # ordinary list containing one or both of the reserved symbols `--` and `:`.
 # On the left side of `:` is the *stack effect*. This is documentation of the
 # values that it expects on the stack and the values that it leaves on the
 # stack.
 # It's also a contract for the program when it's called externally (that is,
 # outside the module); in this example, if `nullable?` leaves
 # fewer than or more than one value on the stack, the interpreter will fail
 # with a contract error.
 # On the right side of `:` is the docstring, which documents the meaning of
 # the word.
 # Above we also saw docstring-only annotations associated with modules, where
 # they perform the same function.
 (regex -- bool : "Does the regular expression contain epsilon?")
 (dup `type at
  (`empty (pop 0)
   `epsilon (pop 1)
   `char (pop 0)
   # `bi` is a combinator: a word which consumes one or more quotations and
   # then applies them.
   # The combinator `bi` consumes two quotations from the stack, applies them
   # both to the next value on the stack, and then puts the results back.
   # `case`, which this is nested inside of, also consumes a quotation and
   # evaluates it for control flow.
   `union ((left nullable?) (right nullable?) bi or)
   `concat ((left nullable?) (right nullable?) bi and)
   `star (pop 1)
   # `case` expects an obligatory 1-element "else" clause at the end of its
   # quotation.
   (pop 0)) case) `nullable? def

 ### test 'union is nullable'
 # We can use single-quotes to construct symbols with spaces in them.
 (epsilon \x char union [(nullable?)] expect) `'union is nullable' test

 ### test 'concat needs both sides nullable'
 (epsilon \x char concat [(nullable? not)] expect) `'concat needs both sides nullable' test

 ### defp dispatch
 # `intern` creates a symbol from a string, and `execute` evaluates a symbol
 # already on the operand stack by looking up its binding. Together they allow
 # us to do general-purpose metaprogramming without macros or other
 # "compile-time" logic.
 # In this case, we implement polymorphic `derive` by looking up the type of a
 # value, constructing an identifier from it, and calling that identifier.
 (regex -- s)
 (`type at chars "derive-" swap cat intern) `dispatch defp

 ### def derive
 (regex c -- regex)
 (over dispatch execute) `derive def

 ### def matches?
 (regex string -- bool)
 (swap (derive) fold nullable?) `matches? def

 ### defp derive-char
 (regex c -- regex)
 ((val) dip match? (epsilon) (empty) if) `derive-char defp

 ### defp derive-union
 (regex c -- regex)
 (((left) dip derive) ((right) dip derive) bi union) `derive-union defp

 ### defp derive-concat-base
 (concated c -- base)
 (((left) dip derive) (pop right) bi concat) `derive-concat-base defp

 ### test derive-concat-base
 (\x char \y char concat \x derive-concat-base
  [([left type] at-path `epsilon match?)
   ([right value] at-path \y match?)] expect) `derive-concat-base test

 ### defp left-nullable?
 (regex c -- bool)
 (pop left nullable?) `left-nullable? defp

 ### test left-nullable?
 (epsilon \y char concat \x [(left-nullable?)] expect) `left-nullable? test

 ### defp derive-concat
 (regex c -- regex)
 ((derive-concat-base) (left-nullable?) ((right) dip pair)
  tri
  # Many cases of combinator application are "pure" in the sense that, like the
  # applications of `bi` and `tri` above, the quotation to be applied is known
  # at read-time and constructed statically.
  # However, it's extremely common to need to compose or construct quotations
  # using both static words and values on the stack. This is analogous to
  # partial function application or currying.
  # Here we do that by collecting `(right) dip` into a `pair`, and then
  # composing it with the `derive` program with `cat`.
  # The resulting composite quotation is passed to `when`, which evaluates it
  # conditionally.
  (derive union) cat when
 ) `derive-concat defp

 ### defp derive-concat-with-locals
 # This program has been written in a very purist "pointfree" or "tacit" style,
 # which eschews the abstraction of values into named variables. ECL's
 # concatenative, combinatoric structure lends itself very well to this style.
 # At the same time, ECL does support so-called *local bindings*. names at the
 # beginning of a quotation, between the || delimeters, stand for values that
 # are consumed from the stack and then can be invoked wherever they need to be
 # used.
 # This function is equivalent to `derive-concat`, but uses local variables
 # instead of combinators. We bind the top two values on the stack to `r` (for
 # regex) and `c` (for character), and then refer to them liberally throughout
 # the body of the quotation.
 (|r c|
  r left c derive r right concat
  r left nullable?
  # It's important to note that locals don't behave like variables in languages
  # with lexical scope. `r` and `c` are "in scope" in the body of this
  # quotation, but that "scope" is not inherited by the `(derive union)`
  # quotation; referring to them there would be an error. We need to compose
  # the quotation in the same way as we do above, with `cat`.
  r right c pair (derive union) cat when) `derive-concat-with-locals defp

 ### defp derive-star
 (regex c -- regex)
 (over ((val) dip derive) dip concat) `derive-star defp

 # Quotations are just regular values on the stack, so it's straightforward to
 # bind the same program to two different names.
 `derive-epsilon `derive-empty ((pop pop empty) swap defp) both

 ### test 'matches "(x|zz)*"'
 (\x char
  \z char \z char concat
  union star
  "xxzzxzzxzzzzxx" matches? {kind test-failure} assert
 ) `'matches "(x|zz)*"' test
) `brzo @defm

### module test-support
(
 ### defp build-infra
 # Partially apply infra with a list of values (which will require swapping
 # before running the program)
 (list -- (q -- bool))
 ((swap infra) cons) `build-infra defp

 ### def expect
 # Collect the stack under the quotations, and add it to a program which takes
 # a quotation and runs it on top of that stack.
 # Then apply that program to each quotation, resulting in a list of the
 # results of each assertion program.
 (... qs --)
 ((stack) dip swap build-infra each
  # Look for any failed assertions.
  raze (min) fold1 {kind test-failure} assert) `expect def
) `test-support @defm