Module:User:Pi zero/Wikilisp

From Wikinews, the free news source you can write!
Jump to navigation Jump to search
[edit] Documentation

This module supports simple but flexible and fairly powerful operations on strings and numbers. It is meant to bring the supported operations within reach of ordinary wiki contributors, by using expressions embedded in wiki markup, and by minimizing the syntactic red tape involved.

This is a test version of the module; the release version is Module:Wikilisp.

Call the module like this:

{{evalx|sequence|test-eval=User:Pi zero/Wikilisp|...}}

or

{{#invoke:User:Pi zero/Wikilisp|rep|sequence|...}}

where sequence is a series of s-expressions, and there may be additional arguments thereafter (the "|..."). The s-expressions are evaluated, one at a time from left to right, and the result of evaluating the last of them is returned as the expansion of the module-call.

Although this module can be useful for tricky small-scale tasks, it can also do hefty transformations of the entire content of a wiki page, because the entire content of a wiki page is a string.

Current version: X0.19 (November 4, 2019)

S-expressions

The main kinds of values are numbers, strings (that is, unicode text), booleans (true and false), symbols (names for things), and lists.

Numbers, strings, booleans

Numbers and strings are kept separate form each other: 6 is different from "6". Evaluating a number or string results in that number or string, unchanged. The result of the module-call, if a simple value (rather than a list, as discussed below), is usually a number or string, unless the module call has an error in it, or is being debugged.

A numeric literal is a series of digits, with an optional decimal point (.), optional sign at the front (+ or -), and optional E notation.

A string literal may be delimited either by double-quotes (") or single-quotes ('), and may contain any characters except the delimiter. If a string needs to involve both single- and double-quotes, the easiest approach is to make the string an additional parameter to the module call; though there is also fully general advanced string syntax.

The boolean values, true and false, usually result from some logical test and are fed as operands into some other operation; so they are usually neither written explicitly into an input expression, nor written as part of an output expression. The boolean values are represented as true and false.

Symbols

Any input-text sequence that doesn't represent a string literal or numeric literal, and doesn't contain any whitespace or parentheses or backslash or semicolon, names a symbol. Also, any backslash (\) that isn't inside a string literal names a symbol (the backslash symbol).

A symbol is evaluated by looking it up in the environment. For most (though not all) purposes, there's just one, global environment, defining the standard functions provided for use in expressions. There are advanced situations where you might alter the global environment, or even do some things in a local environment; but this module is really meant to provide powerful, flexible standard functions so you can almost always do the things you want to do without resorting to complicated techniques like that. When you do end up doing such things, it's probably time to think about what even better tools would make them even more rarely needed.

Lists

A list is a sequence of values. It is represented by a set of parentheses, with the values between them, separated by whitespace. A set of parentheses with nothing (but perhaps whitespace) between them represents the empty list.

When evaluating a non-empty list (the empty list evaluates to itself), the first element of the list is the operator and any additional elements are operands. The operator is evaluated first, and what happens thereafter depends on what the operator evaluated to. It must evaluate to a function (if not, that's an error). A few special functions act on their operands directly, without evaluating the operands first; for all other functions, the operands are evaluated, and the results of those evaluations are passed to the function.

Comments

A semicolon in an input expression, not inside a string literal, marks a comment: the interpreter ignores all characters from the semicolon to the end of the line it is on.

Functions

The interpreter is meant to be a simple device for filling in gaps in wiki-markup-based functionality; it is not meant to replace other wiki-markup facilities, and especially not to provide all functionality for template internals. It should not be capable of arbitrary (Turing-powerful) computation. It should provide a small, highly versatile set of functions affording succinct expression of valuable functionality not otherwise well-supported by wiki-markup. These constraints give its choice of supported functions a somewhat different character from those of a general-purpose programming language.

Background stuff

These functions do mundane tasks, filling in the gaps around the powerful tools that do the heavy lifting.

  • Function list returns a list of its operands. (list (+ 1 1) (- 3 2)) would evaluate to (2 1), (list) to ().
  • The basic arithmetic functions are + - * / ^. Subtraction and division require at least two operands; the first operand is acted on by all of the others, so (- 7 1 2) would evaluate to 4, and (/ 12 2 3) would evaluate to 2. Exponentiation requires exactly two operands; (^ 9 0.5) would evaluate to 3.
  • Function + also concatenates strings or lists, and combines booleans by logical conjunction. (+ "a" "bc" "d") would evaluate to "abcd", (+ (list 1) () (list 2 3)) to (1 2 3), (+ true true false) to false. This only works if the function is given at least one argument, so it knows what type to return; with no arguments, it just assumes it's doing numeric addition: (+) evaluates to 0.
  • Simple arithmetic functionsabs ceil floor each take a single number operand, and return respectively its absolute value, the smallest integer not less than it (its ceiling), and the greatest integer not greater than it (its floor). Thus, (abs -2.3) would evaluate to 2.3, (ceil -2.3) to -2, (floor -2.3) to -3; while (abs 4), (ceil 4), and (floor 4) would each evaluate to 4.
  • The numeric and string comparison functions are:  lt? (less than),  gt? (greater than),  le? (less than or equal),  ge? (greater than or equal). Each function takes zero or more operands, and checks that every pair of consecutive operands have the named relation. Thus, (le? 2 2 3) would evaluate to true, (gt? 3 2 2) would be false because 2 is not greater than 2, (lt? "def" "abc") would be false because "def" is not alphabetically before "abc".
  • A general comparison function equal? determines whether all of its operands are (superficially) the same. Technically, it determines whether all of its operands would appear the same if they were output. There are some weird situations in which values that aren't really the same might "look" equal, but as long as you stick to numbers, strings, booleans, and lists, such situations won't happen.
  • Each of functions number? string? boolean? list? checks that all of its operands have the named type. So, (number? (+ 2 3)) would evaluate to true, as would (number?), while (string? ()) would evaluate to false. There are a few other types of values, and they have functions to check for them too, but ordinarily you shouldn't need to check for them (they're "advanced" features).
  • Functions to-number and to-string take one operand and convert it either way between a number and a string representation of a number. If the operand of to-number does not represent a number, it returns the empty list.
  • Function nth takes two or more operands; first a list, then an integer or integers. With one integer, it returns the nth element of the list. (nth (list 5 7 11) 2) would evaluate to 7. With multiple integers n, m, etc., it takes takes the nth element of the list, then expects that to be a list and takes the mth element of that, and so on.
  • Function not? takes a single boolean operand, and returns true if the operand is false, false if the operand is true. The corresponding tools and? and or? are special functions (below).
  • Function length takes a single operand, which can be either a string or a list, and returns its length, as an integer: for a string, this is the number of unicode codepoints, for a list, the number of items on the list. (length ()) would evaluate to 0.
  • Functions trim, lc, lcfirst, uc, ucfirst, to-entity each take a single operand, either a string or a list of strings. Given a string, trim returns the string with leading and trailing whitespace removed; lc with all letters converted to lower-case, uc to upper-case; lcfirst with the first character converted to lower-case, ucfirst to upper case; to-entity converts the first character of the string to a numeric html entity reference, or if the string is empty returns the string. Given a list of strings, each function applies its operation to each string on the list, and returns a list of the results. (uc (list "abc" "def")) would evaluate to ("ABC" "DEF"). (to-entity "ABC") would evaluate to "A" (which would appear as "A"); (to-entity "") would evaluate to "".
  • Function write takes a single operand, and produces its output string representation. This is how the operand would appear if it were part of a larger result of computation, such as a list. If the operand isn't a string, it appears the same way if it is the entire result of computation as if it is embedded in some larger result; however, a string result of computation is output directly, rather than formatted with delimiters. If a value (barring oddball things like functions and patterns) is meant to be output from one evaluation and input to another, and may be a string, write gives it the proper output format. For example, "foo""bar" represents a string of length seven with one double-quote character in it, while (write "foo""bar") would evaluate to a string of length ten with four double-quote characters in it; so {{evalx|"foo""bar"}} would expand to foo"bar, while {{evalx|(write "foo""bar")}} would expand to "foo""bar".
  • Functions urlencode, anchorencode, fullurl, and canonicalurl provide substantially the magic words of the same names, per mw:Help:Magic words. Each takes one or, in some cases, two string operands. Some examples: (urlencode "fo'o bar") would evaluate to "fo%27o+bar", (urlencode "fo'o bar" "path") to "fo%27o%20bar", (urlencode "fo'o bar" "wiki") to "fo%27o_bar"; (anchorencode "fo'o bar") to "fo'o_bar"; (fullurl "foo bar") to "//en.wikinews.org/wiki/Foo_bar"; (canonicalurl "foo bar" "quux") to "h‍ttps://en.wikinews.org/w/index.php?title=Foo_bar&quux".
  • Function pattern takes a string, taken to be a pattern (in the Scribuntu sense), and returns a pattern object, a separate data type usable in some string-search functions.
  • Function split takes two strings, and splits the first string into a list of its substrings separated by the second string. (split "abba" "b") would evaluate to ("a" "" "a"). Alternatively, the second string may be a pattern rather than a string; (split "foobar" (pattern "[ao]")) would evaluate to ("f" "" "b" "r"). split also has more general forms described in the next section.
  • Function join takes a list of strings and a string, and concatenates the strings from the list separated by the latter string. (join (list "a" "b") ",") would evaluate to "a,b". join also has more general forms described in the next section.
  • Functions get-substring and get-sublist take a string or list, and one or two integers, and return the substring/sublist starting at the element with the first index (counting from 1), and continuing through the element with the second index if any. (get-substring "abc" 2 2) would evaluate to "b". (get-sublist (list 1 2 3) 2) would evaluate to (2 3). get-substring also has more general forms described in the next section.
  • Functions set-substring and set-sublist take four operands: a base string/list, two integers describing a segment of the base to be replaced (start/end indices, counting from 1), and a string/list to splice into that segment. A new string/list is returned with the indicated splice. (set-substring "foobar" 3 5 "z") would evaluate to "fozr". The second index is included in the segment; to splice between two characters of the base, the second index should be one less than the first: (set-substring "ab" 2 1 "123") would evaluate to "a123b". set-substring also has more general forms described in the next section.
  • Function find takes two operands, the first a target string or list in which to search, and returns a list of where matches occur in the target. With a list, the second operand is a function, which is applied to each element of the list and must return a boolean; each matching position is an index into the list (counting from 1). With a string, the second operand is either a string or pattern, and each matching position is a list of start/end indices (counting from 1). (find (list 2 "b" 2) number?) would evaluate to (1 3). (find "foobar" "o")) would evaluate to ((2 2) (3 3)).
  • Function member? usually takes two operands, the second of which is a list, and returns true if any member of the list is equal to the first operand (per function equal?, above), otherwise returns false. If given just one operand, member? returns a function that takes a list as operand and returns true or false depending on whether any element of the list is equal to the operand passed to member?. (member? 2 (list 1 2 3)) would evaluate to true, as would ((member? 2) (list 1 2 3)).
  • Function apply takes a function and a list, and calls the function with the operands on the list. (apply + (list 1 2 3)) would evaluate to 6.
  • Function curry takes a function and one or more additional operands, and returns a function that takes zero or more operands, and calls the earlier operand function with all the operands together, both the earlier ones and the later ones. ((curry + 1 2 3) 4 5 6) would evaluate to 21. ((curry + 1 2 3)) would evaluate to 6.

Special functions, whose operands are not automatically evaluated:

  • Special function and? can be used in two different ways. Given operands that evaluate to booleans, it returns true if all the operands evaluate to true, false if one of them evaluates to false; if one of them evaluates to false, it doesn't evaluate later operands. Given operands that evaluate to functions, it evaluates them all and returns a function that passes all its operands to each of those functions, expecting each of them to return a boolean; again, it returns true if they all return true, or stops and returns false if one of them returns false. ((and? number? le?) 2 5 11) would evaluate to true, because (number? 2 5 11) and (le? 2 5 11) evaluate to true. ((and? number? le?) "foo") would evaluate to false, because (number? "foo") evaluates to false.
  • Special function or? is like and?, with change of form: if all are false, returns false; if any is true, stops and returns true. ((or? string? ge?) 2 5 11) would evaluate to false, because (string? 2 5 11) and (ge? 2 5 11) evaluate to false. ((or? string? le?) "foo") would evaluate to true, because (string? "foo") evaluates to true.
  • Special function if takes three operands; as a special function, its operands are not automatically evaluated. It evaluates its first operand, the result of which must be boolean, and then evaluates the second or third operand depending on whether the result from the first was true or false, and returns the result of the latter evaluation. So (if (ge? 3 9) 3 9) and (if (ge? 9 3) 9 3) would both evaluate to 9.
  • Special function \ creates a function. It ordinarily takes two operands; the first is a symbol, which is not evaluated and is the name of the parameter to the new function; the second is the body of the new function. When the function is called, its operand is evaluated, and the parameter is locally bound to the result of this evaluation; then the body of the function is evaluated locally, with the parameter bound to the function argument, and the result of this evaluation of the body is the result of the function call. For example, ((\x (* x x)) (+ 2 3)) would evaluate to 25.
  • Special function let creates a temporary name for something. It takes at least one (usually two or more) operands; the first operand is a list of a symbol and an expression. The expression is evaluated, and the result becomes the temporary meaning of the symbol; the remaining operands are evaluated, from left to right, in the local environment so constructed, and the result of the last evaluation is returned (or if there was only the one operand, the empty list is returned). For example, (let (x 3) (* x x)) would evaluate to 9, while (let (x 2) (let (y 3) (* x y))) would evaluate to 6.
  • Special function define modifies the current environment (whereas let creates a new environment for temporary use). It takes two operands; the first is a symbol. It evaluates its second operand, and then binds its first operand to the result in the environment. For example, evaluating (define x (+ 3 4)) would modify the environment so that x would evaluate to 7; thus, {{evalx|(define x (+ 3 4)) (* x x)}} would expand to 49.
  • Special function sequence evaluates its operands, in order from left to right, and returns the result of the last evaluation. Given no operands, it returns the empty list. Handy for conditionally doing a series of things for effect, such as in (if (gt? x 10) (sequence (define y (+ y 1)) (define x (- x 10)) true) false) which would return true or false and might also change the local values of x and y. The same thing could be accomplished using functions list and nth, or just list if you're just going to throw out the result anyway; but besides saving a left of nesting when you do want the result, the name "sequence" makes it clearer what you're doing.

Powerful stuff

These functions do the heavy lifting.

  • Function get-arg retrieves arguments to the module call. It takes one operand, identifying the argument to retrieve; this may be an integer or a string. Argument 1 is the sequence of s-expressions; thus, {{evalx|'foobar' (get-arg 1)}} would expand to  "'foobar' (get-arg 1)", while {{#invoke:User:Pi zero/Wikilisp|rep|"foobar" (get-arg "foobar")|foobar=quux}} would expand to "quux". Function get-arg-expr also retrieves arguments, but instead of returning an argument as a string, it attempts to interpret the argument as an s-expression which it returns unevaluated. If the argument is not a valid s-expression, the function returns the empty list. This is handy for doing further computation on a data structure that was output from an earlier call to the interpreter, as perhaps in an earlier step of a dialog. {{evalx|(get-arg-expr 2)|(* 2 3)}} would expand to  (* 2 3). Function get-args retrieves a list of the names of all arguments to the module call.
    If the module is invoked through alternative Lua function trep rather than rep, wikilisp functions get-arg and get-arg-expr access arguments of the template that invokes the module, instead of arguments of the invocation itself. Template {{evalx}} does this.
  • Function parse takes one operand, which must be a text string and is interpreted as raw wiki markup (before template expansion). The function returns a data structure describing the positions, within the text string, of wikilinks, template calls, and template parameters; and, within each such item, the positions of the parts of the item (which are separated from each other by the pipe character, "|"). Other tools can then use this data structure to locate particular kinds of structures within the wiki markup, and transform them in various ways.
    The data structure is a list of "item" data structures; accessor functions can recover the string form of each item, the number of parts, the string form of each part, and a list of items within each part.
    • Function get-parts takes one operand, an item descriptor as provided by parse, and returns a list of its parts. Function get-items takes one operand, a part descriptor as provided by parse, and returns a list of items within it.
  • Function filter at its simplest takes two operands: a data structure such as produced by function parse, and a predicate to be applied to the entries in the structure for links, calls, and parameters. It returns a pared-down data structure describing only those page elements that match the predicate. Additional operands are additional predicates that must also be satisfied, as with special function and?.
    If the predicate(s) reject an item, but accept some items within one of the rejected item's parts, the accepted items are promoted to the level of the rejected item. For example, suppose a page contains a call to {{xambox}}, and within the text message passed to the xambox are some calls to {{w}}. If the page is parsed and filtered for calls to {{w}}, the calls within the xambox will end up at the top level of the filtered data structure.
    • Functions link? call? and param? are predicates determining whether their operands are item data structures describing, respectively, wikilinks, template calls, and template parameters.
    Function filter isn't designed for selecting some members of an ordinary list, but that can be done by building a new list out of small lists, where each small list either contains a particular element of the original list or is empty. For example, given a list of numbers ls, one could select the ones strictly less than 10 with expression (apply (curry + ()) (map (\x (if (lt? x 10) (list x) ())) ls)). (Note the trick of currying + with the empty list before applying it; otherwise, if ls happened to be empty, + would be applied to the empty list, producing a number instead of a list.)
  • Function split can take more general forms of its first operand, and can take either or both of two additional operands, beyond the string and string-or-pattern as in the previous section.
    • There may be a second string-or-pattern operand; instead of listing substrings separated by a single string-or-pattern, the function then lists substrings delimited by the two strings-or-patterns. For example, (split "a(b)c(d)e" "(" ")") would evaluate to ("b" "d"). The delimiters are assumed to be potentially nesting, and at each point in the string the leftmost left-delimiter is chosen that has a matching right-delimiter. For example, (split "(a(b(c)e)d(f(g(h)i)j" "(" ")") would evaluate to ("b(c)e" "g(h)i").
    • There may be a final list operand, of 1–3 elements that could be the second-and-later operands to split; if this is present, instead of returning a list of substrings from the aforementioned operation, split recursively splits each of those substrings using this new set of second-and-later operands, and returns a list of the results of these splits. For example, (split "a(b,c;d,e)f(g,h;i,j)k" "(" ")" (list ";" (list ","))) would evaluate to ((("b" "c") ("d" "e")) (("g" "h") ("i" "j"))).
    • The first operand, rather than simply a string, can in general be a tree of strings; that is, either a string or a list whose elements are themselves trees of strings. The string operation specified by all the later operands is then applied recursively to each element of the tree. For example, (split (list (list "a(b,c)d") () "e(f,)g") "(" ")" (list ",")) would evaluate to (((("b" "c")))()(("f" ""))).
  • Function join can take more general forms of its first operand, and can take either or both of two additional operands, beyond the list-of-strings and string as in the previous section.
    • There may be a second string operand; then each of the listed strings is delimited by the two strings. For example, (join (list "1" "2") "{" "}") would evaluate to "{1}{2}".
    • The first operand, rather than simply a list of strings, can in general be a nested list of strings; that is, either a list of strings or a list whose elements are themselves nested lists of strings. The operation specified by the one or two string operands is then applied recursively to each element of the nested list. For example, (join (list (list "a" "b") (list "c" "d")) ",") would evaluate to ("a,b" "c,d").
    • There may be a final list operand, of 1–3 elements that could be the second-and-later operands to join; if this is present, join first operates on its first operand using the one or two string operands, then recursively operates on the result using the finally-listed set of operands. For example, (join (list (list "a" "b") (list "c" "d")) "," (list "{" "}")) would evaluate to "{a,b}{c,d}". Thus join can restore nestings of separators and delimiters removed by split; for example, (join (split "a{b}c, d{e}f" (pattern ",%s*") (list "{" "}")) "{" "}" (list ",")) would evaluate to "{b},{e}".
  • Function get-substring can take a descriptor specifying a segment of the string, instead of integer indices as in the previous section. Three kinds of descriptors are accepted: an item descriptor, which is an element of a list returned by parse or get-items; a part descriptor, which is an element of a list returned by get-parts; or a list of two integers, which are the 1-based indices of the starting and ending character of the substring within the string. The resulting substring is returned. For example, (get-substring "foobar" (list 3 5)) would evaluate to "oba". Alternatively, the second operand can be a list of segment descriptors, and a list of substrings is returned; (get-substring "foobar" (list (list 2 2) (list 4 5))) would evaluate to ("o" "ba").
  • Function set-substring can take a segment-descriptor (as just described for get-substring) instead of integer indices for where to splice as in the previous section. Alternatively, it can take a list of such segment-descriptors, and a list of strings; the segments must be in order from left to right. (set-substring "foobar" (list 3 5) "12345") would evaluate to "fo12345r", (set-substring "abcd" (list (list 2 2) (list 4 3)) (list "123" "456")) to "a123c456d".
  • Function get-coords takes a segment-descriptor (as just described for get-substring) and returns a list of two integers, the 1-based indices fo the starting and ending character of the segment. This is useful for decoding item descriptors and part descriptors so that the coordinates can be manipulated directly for general purposes. For example, (map get-coords (parse "a [[b]] [[c]] d")) would evaluate to ((3 7) (9 13)).
  • Function map takes a function and one or more lists. It calls the function repeatedly, with one operand from each of the lists, and returns a list of the results. Usually it is used with just one list; for example, (map (\x (* x x)) (list 1 2 3)) would evaluate to (1 4 9). With multiple lists, (map * (list 2 3) (list 5 7)) would evaluate to (10 21). If some of the lists are longer than others, map stops when any of the lists runs out; for example, (map list (list 1 2) (list 3) (list 4 5 6)) would evaluate to ((1 3 4)).
  • Function merge takes a function and one or more lists. The function should be a binary predicate, for ordering elements of the lists. Each list is assumed already sorted by the predicate (i.e., the predicate would return true on any two elements of the same list in their order in the list). The function merges the lists into a single list sorted by the predicate. If there is only one list, it is simply returned. For example, (merge lt? (list 1 3 5) (list 2 4 6)) would evaluate to (1 2 3 4 5 6). This isn't meant to be used with a very large number of lists; it slows down as the square of the number of lists.
  • Function transformer takes up to four optional operands, and generates a map-like function for acting on a tree, that is, a nested list. The resulting function takes three operands: a function to apply to leaf nodes of the tree, a function to apply to parent nodes of the tree, and a tree. In the simplest case, with no optional operands, if the tree is not a list then the leaf-function is applied to it and the result returned; while if the tree is a list, each element of the list is recursively transformed and the parent-function is applied to a list of the results. For example, ((transformer) (\x (* x x)) (\x x) (list 2 (list 3 4) 5)) would evaluate to (4 (9 16) 25), ((transformer) (\x (* x x)) (\x (apply + x)) (list 2 (list 3 4) 5)) to 54.
  • The last optional operand is a positive integer, n. The first n elements of each parent-node list are left alone rather than recursively operated on. For example, ((transformer 2) (\x (* x x)) (\x x) (list 2 3 4 5)) would evaluate to (2 3 16 25).
  • The first optional operand is a predicate. When the tree is a list, the predicate is applied to it, and if the result is false the tree is treated as a leaf instead of a parent, applying the leaf-function to it instead of recursing and passing a resultant list to the parent-function. For example, ((transformer (\x (gt? (length x) 1))) (\x "x") (\x x) (list (list 1 2) (list 3) (list 4 5))) would evaluate to (("x" "x") "x" ("x" "x")).
  • Between these, the second and third optional operands, which must occur together, are a basis value and a successor function, used to generate an extra, depth operand for the leaf/parent functions: at the top-level node of the tree, this value is the basis, and at each level further down the tree, the value results from applying the successor function to the value used at the level above. The depth operand is passed to the leaf/parent function as its first operand, before the tree-node operand. For example, ((transformer 2 (\x (+ x 1))) (\(n t) n) (\(n t) t) (list "a" (list "b" "c") "d")) would evaluate to (3 (4 4) 3). If the predicate operand is also provided, it receives only the tree-node, not the depth.

Advanced stuff

These things may help you better understand the inner workings of the interpreter, and occasionally help you do some unusual things that the more mundane features don't handle cleanly. When you start actively using these exotica to do unusual things, it may be time to look for a way to amplify the ordinary tools so it won't be necessary to resort to these; but that may be a very difficult design problem, and meanwhile these things are available to take up the slack.

  • Special function \ can create functions that take different numbers of arguments, and evaluate a sequence of expressions. For different numbers of arguments, instead of a symbol for the first operand, use a list of symbols; the list may be empty, so the function takes no arguments. To evaluate a sequence of expressions, just specify all of them after the parameter-list. When the function is called, the number of arguments to the call must be the same as the number of parameters; all the parameters are locally bound to the corresponding arguments, and the second and later operands to \ are evaluated in this local environment from left to right. The result of the last of these evaluations is the result of the function call, or if \ was given only one operand, the result of the function call is the empty list.
An esoteric point: The local environment, in which the function's sequence of expressions are evaluated, is a child of the environment where \ is called (technically, this is called lexical scope). So when a local environment needs to look up a symbol that isn't locally bound, this occurs where \ was called rather than where the created function is called. For example, (((\x (\y (+ (* x x) (* y y)))) 2) 3) would evaluate to 13.
  • Function fn? checks whether all the values passed to it are ordinary functions; function op? checks whether all the values passed to it are special functions. (fn? if) would evaluate to false, since if is not an ordinary function. (op? +) would evaluate to false since + is not a special function.
  • When an ordinary function is displayed as output, it is shown as <[op: name]>, where name is the name of the function. For example, {{evalx|length}} would expand to <[op: length]>. The angle-brackets mean that the operands to the function call are automatically evaluated; underneath is a special function whose operands are the results of evaluating the operands to the ordinary function call. Evaluating (length (+ 1 2)) would not produce an error until after the operand has been evaluated to 3, at which point the special function underlying length would discover it doesn't know what to do with an integer operand, producing error message <error: bad operand to [op: length]: expected list or string, got 3>.
When special function \ creates a function, it doesn't give it a name. {{evalx|(\x (* x x))}} would expand to <[op]>. However, the first time an anonymous function is given a name in an environment, that name is attached to the function, and the function is known by that name thereafter. So, {{evalx|(define f (\x (* x x))) f}} would expand to <[op: f]>.
  • There is a built-in limit on how deeply calls to \-defined functions can be nested. At the current writing, the limit is 4. That is, (let (g (\f (\x (f (f x))))) ((g (\x (+ 1 x))) 0)) would evaluate to 2, (let (g (\f (\x (f (f x))))) ((g (g (\x (+ 1 x)))) 0)) to 4, and (let (g (\f (\x (f (f x))))) ((g (g (g (\x (+ 1 x))))) 0)) to 8, but (let (g (\f (\x (f (f x))))) ((g (g (g (g (\x (+ 1 x)))))) 0)) would produce <error: exceeded maximum call-nesting depth (4)>.
  • If you really need to embed a double-quote in a string literal delimited by double-quotes, use two double-quotes inside the literal. "" is the empty string; """" is a string of length one, containing a single double-quote. There is no analogous way to embed a single-quote in a string literal delimited by single-quotes.
  • Function wikilisp-version provides a string describing the current version of the module. (list (wikilisp-version)) currently evaluates to ( "X0.19 (November 4, 2019)" ).

Index of functions

Module tests

These aren't exhaustive. They aspire to exercise all of the code in the module at least once (both branches of an if, etc.), though there would be merit to deskchecking all the code to determine what parts of it have been overlooked.

local export = {}

local wikilispversion = "X0.19 (November 4, 2019)"

--[[ some basic abstractions ]]

local function stype( x ) -- type of sexpr
	local t = type( x )
	if t == "table" then t = x.type end
	return t
end

local function seterr( x, ... )
	if type(x) ~= "table" then
		return seterr( {}, x, ... )
	else
		x.type = "error"
		x.msg = mw.ustring.format( ... )
		return x
	end
end

--[[ parse text to a sequence of sexprs ]]

local function tok3( ls, t )
	-- tokenize lua string t, with no string literals comments or parens;
	--   append to ls
	local p1,p2 = mw.ustring.find( t, "[^%s]+" )
	while p1 ~= nil do
		local t1 = mw.ustring.sub(t, p1, p2)
		local n1 = tonumber(t1)
		if n1 ~= nil then
			ls[1 + #ls] = n1
		elseif t1 == "true" then
			ls[1 + #ls] = true
		elseif t1 == "false" then
			ls[1 + #ls] = false
		else
			ls[1 + #ls] = {
				type = "symbol",
				name = t1
			}
		end
		t = mw.ustring.sub(t, (p2 + 1))
		p1,p2 = mw.ustring.find( t, "[^%s]+" )
	end
end

local function tok2( ls, t )
	-- tokenize lua string t, with no string literals or comments; append to ls
	local p1 = mw.ustring.find( t, "[()\\]" )
	while p1 ~= nil do
		tok3( ls, mw.ustring.sub(t, 1, (p1 - 1)) )
		ls[1 + #ls] = { type = mw.ustring.sub(t, p1, p1) }
		if ls[#ls].type == "\\" then
			ls[#ls].name = ls[#ls].type
			ls[#ls].type = "symbol"
		end
		t = mw.ustring.sub(t, (p1 + 1))
		p1 = mw.ustring.find( t, "[()\\]" )
	end
	tok3( ls, t )
end

local function tok1( ls, t )
	-- tokenize lua string t, thru first string literal or comment; append to ls
	-- if not finished, append untokenized remainder string and return true
	local p0 = mw.ustring.find( t, ';' )
	local p1 = mw.ustring.find( t, '"' )
	local p2 = mw.ustring.find( t, "'" )
	if (p0 ~= nil) and (((p1 == nil) or (p0 < p1)) and
						((p2 == nil) or (p0 < p2))) then
		-- process a comment
		tok2( ls, mw.ustring.sub( t, 1, (p0 - 1) ) )
		p1 = mw.ustring.find( t, '\n', (p0 + 1) )
		if p1 == nil then
			return false
		else
			ls[1 + #ls] = mw.ustring.sub( t, (p1 + 1) )
			return true
		end
	elseif (p1 ~= nil) and ((p2 == nil) or (p1 < p2)) then
		-- process a string literal starting with double-quote
		p2 = p1 + 1
		while true do
			p2 = mw.ustring.find( t, '"', p2 )
			if p2 == nil then
				seterr(ls, 'mismatched string-literal delimiter (")')
				return false
			elseif (p2 < mw.ustring.len( t )) and
				(mw.ustring.codepoint( t, (p2 + 1) ) == 34)
			then
				p2 = (p2 + 2)
			else
				tok2( ls, mw.ustring.sub( t, 1, (p1 - 1) ) )
				ls[1 + #ls] = mw.ustring.gsub(
					mw.ustring.sub( t, (p1 + 1), (p2 - 1) ),
					'""', '"') -- inverse operation is at write_sexpr
				ls[1 + #ls] = mw.ustring.sub( t, (p2 + 1) )
				return true
			end
		end
	elseif p2 ~= nil then
		-- process a string literal starting with single-quote
		-- side benefit: precludes Lisp shorthand for "suppress eval"
		p1 = p2
		p2 = mw.ustring.find( t, "'", (p1 + 1) )
		if p2 == nil then
			seterr(ls, "mismatched string-literal delimiter (')")
			return false
		else
			tok2( ls, mw.ustring.sub( t, 1, (p1 - 1) ) )
			ls[1 + #ls] = mw.ustring.sub( t, (p1 + 1), (p2 - 1) )
			ls[1 + #ls] = mw.ustring.sub( t, (p2 + 1) )
			return true
		end
	else
		tok2( ls, t )
		return false
	end
end

local function parse_next( x1, p1, x2 )
	-- parse one sexpr from token list x1 position p1, append sexpr to p2
	-- return new value for p1
	if stype(x1[p1]) == ")" then
		seterr(x2, "unmatched right-paren")
		return 1 + #x1
	elseif stype(x1[p1]) ~= "(" then
		x2[1 + #x2] = x1[p1]
		return p1 + 1
	else
		p1 = p1 + 1
		local x3 = { type = "list" }
		x2[1 + #x2] = x3
		while p1 <= #x1 do
			if stype(x1[p1]) == ")" then
				return p1 + 1
			end
			p1 = parse_next( x1, p1, x3 )
		end
		seterr(x2, "unmatched left-paren")
		return p1
	end
end

local function parse_sexpr( x1 )
	-- x1 is an error or a list of tokens
	if x1.type ~= "list" then
		return x1
	else
		local p1 = 1 --next item to read from x1
		local x2 = { type = "list" }
		while p1 <= #x1 do
			p1 = parse_next( x1, p1, x2 )
		end
		return x2
	end
end

local function text_to_sexpr( t )
	local ls = { type = "list" }
	while tok1( ls, t ) do
		t = ls[#ls]
		ls[#ls] = nil
	end
	ls = parse_sexpr( ls )
	return ls
end

--[[ write/display a sexpr ]]

local function write_sexpr( x )
	if type(x) == "number" then
		return tostring( x )
	elseif type(x) == "string" then
		return mw.ustring.format('"%s"', mw.ustring.gsub( x, '"', '""' )) -- inverse operation is at tok1
	elseif type(x) == "boolean" then
		if x then return "true" else return "false" end
	elseif type(x) ~= "table" then
		return mw.ustring.format("&lt;unrecognized internal type: %s&gt;", type(x))
	elseif x.type == "symbol" then
		return x.name
	elseif x.type == "fn" then
		return mw.ustring.format("&lt;%s&gt;", write_sexpr( x.comb ))
	elseif x.type == "op" then
		if x.name ~= nil then
			return mw.ustring.format("[op: %s]", x.name)
		else
			return "[op]"
		end
	elseif x.type == "list" then
		local r = {}
		r[1] = "("
		for k = 1, #x do
			r[k+1] = write_sexpr( x[k] )
		end
		r[#r + 1] = ")"
		return table.concat(r, " ")
	elseif x.type == "error" then
		return mw.ustring.format("&lt;error: %s&gt;", x.msg)
	elseif x.type == "pattern" then
		return mw.ustring.format('&lt;pattern: "%s"&gt;', x.pat)
	elseif x.type ~= nil then
		return mw.ustring.format("&lt;unrecognized type: %s&gt;", x.type)
	else
		return "&lt;missing type&gt;"
	end
end

local function display_sexpr( x )
	if stype(x) == "string" then
		return x
	else
		return write_sexpr( x )
	end
end

--[[ evaluation tools ]]

local maxdepth = 4 -- maximum call-nesting depth

local combine

local function eval( x, env, depth )
	if type(x) ~= "table" then -- literal
		return x
	elseif x.type == "symbol" then
		local v = env[x.name]
		if v == nil then
			return seterr("undefined symbol: %s", x.name)
		else
			return v
		end
	elseif x.type ~= "list" then -- literal
		return x
	elseif #x == 0 then -- empty list
		return x
	else -- combination
		local c = eval( x[1], env, depth )
		if stype(c) == "error" then return c end
		local ls = { type = "list" }
		for k = 2, #x do
			ls[k - 1] = x[k]
		end
		return combine( c, ls, env, depth )
	end
end

combine = function( c, ls, env, depth )
	while stype(c) == "fn" do
		local ls2 = { type = "list" }
		for k = 1, #ls do
			ls2[k] = eval( ls[k], env, depth )
			if stype(ls2[k]) == "error" then return ls2[k] end
		end
		c = c.comb
		ls = ls2
	end
	if stype(c) ~= "op" then
		return seterr("called object is not a combiner: %s", write_sexpr(c))
	elseif (c.shallow ~= nil) then
		return c.op(ls, env, depth)
	elseif (depth == nil) or (depth < 1) then
		if maxdepth > 1 then
			return seterr(
				"exceeded maximum call-nesting depth (%i)",
				maxdepth)
		else
			return seterr("exceeded maximum call-nesting depth")
		end
	else
		return c.op(ls, env, (depth - 1))
	end
end

local function eval_seq( ls, env, depth )
	-- ls must be an error or a list
	if ls.type == "error" then return ls end
	if #ls == 0 then return ls end
	for k = 1, (#ls - 1) do
		local x = eval( ls[k], env, depth )
		if stype(x) == "error" then return x end
	end
	return eval( ls[#ls], env, depth )
end

local function eval_all( ls, env, depth, cutoff )
	-- ls must be an error or a list
	if ls.type == "error" then return ls end
	local ls2 = { type="list" }
	for k = 1, #ls do
		ls2[k] = eval( ls[k], env, depth )
		if stype(ls2[k]) == "error" then return ls2[k] end
		if (cutoff ~= nil) and cutoff(ls2[k]) then return ls2 end
	end
	return ls2
end

local function combine_all( ops, args, env, depth, cutoff )
	-- ops must be a list; args must be an error or a list
	if args.type == "error" then return args end
	local ls2 = { type="list" }
	for k = 1, #ops do
		ls2[k] = combine( ops[k], args, env, depth )
		if stype(ls2[k]) == "error" then return ls2[k] end
		if (cutoff ~= nil) and cutoff(ls2[k]) then return ls2 end
	end
	return ls2
end

--[[ generic combiner constructors ]]

local function make_op( f, nm, sh )
	return {
		type = "op",
		op = f,
		name = nm,
		shallow = sh
	}
end

local function checktype( t, o, k ) -- types list, operands list, index
	if #t == 0 then return "" end
	o = o[k] -- particular operand
	if k > #t then k = #t end
	t = t[k] -- particular type
	-- t should now be a string or internal function
	if type(t) == "string" then
		if stype(o) == t then t = "" end -- clear if no error
	else
		t = t(o) -- assume internal function works correctly
	end
	-- t should now be type name if error, empty string if okay
	return t
end

local function type_err( cname, tname, x )
	-- combiner name, type name(s), operand
	-- type name may be a string or an array of strings
	local where = ""
	if cname ~= nil then where = " to [op: " .. cname .. "]" end
	if type(tname) == "table" then
		if #tname == 0 then tname = "[unknown]"
		else
			for k = 1, #tname do
				while tname[k] == "" do
					for j = (k + 1), #tname do tname[j - 1] = tname[j] end
					tname[#tname] = nil
				end
				if tname[k] ~= nil then
					for j = (k + 1), #tname do
						if tname[k] == tname[j] then tname[j] = "" end
					end
				end
			end
			if #tname == 1 then tname = tname[1]
			else
				tname[#tname] = "or " .. tname[#tname]
				if #tname == 2
				then tname = table.concat( tname, " " )
				else tname = table.concat( tname, ", " )
				end
			end
		end
	end
	local what = write_sexpr(x)
	if #what > 64 then what = stype(x) end
	return seterr(
		"bad operand%s: expected %s, got %s", where, tname, what)
end

local function typed_op( ... )
	-- alternating type (string or function) and op (table or function)
	-- strong recommendation: first op should be a table
	local ls0 = { ... }
	local n0 = select( '#', ... )
	local opname, shallow
	if type(ls0[2]) == "table" then
		opname = ls0[2].name
		shallow = ls0[2].shallow
	end
	local f = function(ls, env, depth)
		if #ls == 0 then
			local op = ls0[2]
			if type(op) == "table" then op = op.op end
			return op( ls, env, depth )
		end
		local ek = 1 -- operand number of accumulated error type names
		local enames = {} -- list of failed types for ls[ek]
		for j = 1, n0, 2 do
			local types = ls0[j]
			local op = ls0[j + 1]
			if type(op) == "table" then op = op.op end
			local t = ""
			for k = 1, #ls do
				if #t == 0 then
					t = checktype( types, ls, k )
					if #t > 0 then
						if k > ek then
							ek = k
							enames = { t }
						elseif k == ek then
							enames[1 + #enames] = t
						end
					end
				end
			end
			if #t == 0 then return op( ls, env, depth ) end
		end
		return type_err( opname, enames, ls[ek] )
	end
	return make_op( f, opname, shallow )
end

local function nary_op( c, n, m )
	local f = function(ls, env, depth)
		if n < 0 then
			if #ls < -n then
				local where = ""
				if c.name ~= nil then where = " to [op: " .. c.name .. "]" end
				return seterr(
					"too few operands%s: expected at least %i, got %i",
					where, -n, #ls)
			end
		elseif m == nil then
			if #ls ~= n then
				local where = ""
				if c.name ~= nil then where = " to [op: " .. c.name .. "]" end
				return seterr(
					"wrong number of operands%s: expected %i, got %i",
					where, n, #ls)
			end
		else
			if #ls < n then
				local where = ""
				if c.name ~= nil then where = " to [op: " .. c.name .. "]" end
				return seterr(
					"too few operands%s: expected at least %i, got %i",
					where, n, #ls)
			elseif #ls > m then
				local where = ""
				if c.name ~= nil then where = " to [op: " .. c.name .. "]" end
				return seterr(
					"too many operands%s: expected at most %i, got %i",
					where, m, #ls)
			end
		end
		return c.op( ls, env, depth )
	end
	return make_op( f, c.name, c.shallow )
end

local function binary_pred( test, nm )
	return make_op(function (ls)
			for k = 2, #ls do
				if not test(ls[k - 1], ls[k]) then
					return false
				end
			end
			return true
		end, nm, true)
end

local function unary_pred( test, nm )
	return make_op(function (ls)
			for k = 1, #ls do
				if not test(ls[k]) then
					return false
				end
			end
			return true
		end, nm, true)
end

local function wrap( c )
	return {
		type = "fn",
		comb = c
	}
end

--[[ wiki parsing stuff
	entry:  (char-code  (first-pos  last-pos  left-index))
	        (descriptor  (first-pos  last-pos  left-index)  entry  entry  ...)
	item entries contain part entries, part entries contain item entries
	left-index is removed at end of parse
]]

local lsquare,rsquare, lcurly,rcurly, pipe = 91,93, 123,125, 124

local function wikileft(e) -- is entry a left-delimiter?
	return ((e[1] == lsquare) or (e[1] == lcurly)) and (e[2][1] ~= e[2][2])
end

local function wikilen(e) -- how long is this entry?
	return 1 + e[2][2] - e[2][1]
end

local function wikisub( m, d ) -- parse, descriptor
	local k2 = #m          -- index of right delimiter
	local k1 = m[k2][2][3] -- index of left delimiter
	local p = { type = "list", "part", { type = "list" } } -- first part
	p[2][1] = (m[k1][2][2] + 1) -- start of first part
	local e = { -- entry containing parts
		type = "list",
		d,
		{ type = "list",
		  (m[k1][2][2] - (m[k2][2][2] - m[k2][2][1])),
		  m[k2][2][2],
		  k1
		},
		p
	}
	for k = (k1 + 1), (k2 - 1) do
		if type(m[k][1]) ~= "number" then
			m[k][2][3] = nil
			p[1 + #p] = m[k]
		elseif m[k][1] == pipe then
			p[2][2] = (m[k][2][1] - 1) -- end of current part
			p = { type = "list", "part", { type = "list" } } -- next part
			p[2][1] = (m[k][2][2] + 1) -- start of this part
			e[1 + #e] = p -- add to list of parts
		end
		m[k] = nil
	end
	p[2][2] = (m[k2][2][1] - 1) -- end of last part
	m[k2] = nil
	m[k1][2][2] = (e[2][1] - 1)
	if (m[k1][2][1] > m[k1][2][2]) then
		e[2][3] = m[k1][2][3]
		m[k1] = nil
	end
	m[1 + #m] = e
end

local function parse_wiki( ls )
	local s = ls[1]                             -- string to parse
	local m = { type = "list" }                 -- result of parse
	local k = mw.ustring.find( s, "[%[%]{}|]" ) -- position in string
	while k ~= nil do
		local c = mw.ustring.codepoint(s,k)
		if #m == 0 then
			if (c == lsquare) or (c == lcurly) then
				m[1] = {type="list", c, {type="list", k, k, 0}}
			end
		elseif (k == (m[#m][2][2] + 1)) and (c == m[#m][1]) and (c ~= pipe) then
			m[#m][2][2] = k
			if m[#m][2][3] > 0 then
				local e2 = m[#m]
				local e1 = m[e2[2][3]]
				if (e2[1] == rcurly) and (e1[1] == lcurly) and
					(wikilen(e2) == 3) and (wikilen(e1) > 2)
				then
					wikisub( m, "param" )
				elseif (e2[1] == rsquare) and (e1[1] == lsquare) and
					(wikilen(e2) == 2) and (wikilen(e1) > 1)
				then
					wikisub( m, "link" )
				end
			end
		else
			if m[#m][2][3] > 0 then
				local e2 = m[#m]
				local e1 = m[e2[2][3]]
				if (e2[1] == rcurly) and (e1[1] == lcurly) and
					(wikilen(e2) == 2) and (wikilen(e1) > 1)
				then
					wikisub( m, "call" )
				end
			end
			m[1 + #m] = {type="list", c, {type="list", k, k}}
			if wikileft(m[#m - 1]) then
				m[#m][2][3] = (#m - 1)
			else
				m[#m][2][3] = m[#m - 1][2][3]
			end
		end
		k = mw.ustring.find( s, "[%[%]{}|]", (k + 1) )
	end
	if #m == 0 then return m end
	if m[#m][2][3] > 0 then
		local e2 = m[#m]
		local e1 = m[e2[2][3]]
		if (e2[1] == rcurly) and (e1[1] == lcurly) and
			(wikilen(e2) == 2) and (wikilen(e1) > 1)
		then
			wikisub( m, "call" )
		end
	end
	local m2 = { type = "list" }
	for j = 1, #m do
		if type(m[j][1]) ~= "number" then
			m[j][2][3] = nil
			m2[1 + #m2] = m[j]
		end
	end
	return m2
end

--[[ miscellaneous ]]

local function int_tc(x)
	if (type(x) ~= "number") or (x ~= math.floor(x)) then
		return "integer"
	else
		return ""
	end
end

local function posint_tc(x)
	if (type(x) ~= "number") or (x ~= math.floor(x)) or (x < 1) then
		return "positive integer"
	else
		return ""
	end
end

local function logical_and( ls ) -- for and?
	for k = 1, #ls do
		if stype(ls[k]) ~= "boolean" then
			return seterr(
				"bad operand to [op: and?]: expected boolean, got %s",
				write_sexpr(ls[k]))
		end
	end
	for k = 1, #ls do if not ls[k] then return false end end
	return true
end

local function logical_or( ls ) -- for or?
	for k = 1, #ls do
		if stype(ls[k]) ~= "boolean" then
			return seterr(
				"bad operand to [op: or?]: expected boolean, got %s",
				write_sexpr(ls[k]))
		end
	end
	for k = 1, #ls do if ls[k] then return true end end
	return false
end

local function and_fn(ls, env, depth)
	ls = eval_all( ls, env, depth,
		function (x)
			return (stype(x) == "boolean") and not x
		end)
	if stype(ls) == "error" then return ls end
	if (#ls == 0) or (stype(ls[1]) == "boolean") then
		return logical_and(ls)
	end
	local ops = { type="list" }
	for k = 1, #ls do
		if stype(ls[k]) == "fn" then ops[k] = ls[k].comb
		elseif stype(ls[k]) == "op" then ops[k] = ls[k]
		elseif k == 1 then
			return seterr(
				"bad operand to [op: and?]: expected boolean or combiner, got %s",
				write_sexpr(ls[k]))
		else
			return seterr(
				"bad operand to [op: and?]: expected combiner, got %s",
				write_sexpr(ls[k]))
		end
	end
	return wrap(make_op(function (ls, env, depth)
			ls = combine_all(ops, ls, env, depth,
				function (x)
					return (stype(x) ~= "boolean") or not x
				end)
			if ls.type == "error" then return ls end
			return logical_and(ls)
		end, "and?", true))
end

local function or_fn(ls, env, depth)
	ls = eval_all(ls, env, depth,
		function (x)
			return (stype(x) == "boolean") and x
		end)
	if stype(ls) == "error" then return ls end
	if (#ls == 0) or (stype(ls[1]) == "boolean") then
		return logical_or(ls)
	end
	local ops = { type="list" }
	for k = 1, #ls do
		if stype(ls[k]) == "fn" then ops[k] = ls[k].comb
		elseif stype(ls[k]) == "op" then ops[k] = ls[k]
		elseif k == 1 then
			return seterr(
				"bad operand to [op: or?]: expected boolean or combiner, got %s",
				write_sexpr(ls[k]))
		else
			return seterr(
				"bad operand to [op: or?]: expected combiner, got %s",
				write_sexpr(ls[k]))
		end
	end
	return wrap(make_op(function (ls, env, depth)
			ls = combine_all(ops, ls, env, depth,
				function (x)
					return (stype(x) ~= "boolean") or x
				end)
			if ls.type == "error" then return ls end
			return logical_or(ls)
		end, "or?", true))
end

local function valid_parmlist( ls ) -- for \
	if stype(ls) ~= "list" then return false end
	for k = 1, #ls do
		if stype(ls[k]) ~= "symbol" then return false end
	end
	return true
end

local function match_parmlist( parms, ls ) -- for \
	local env = {}
	for k = 1, #parms do env[parms[k].name] = ls[k] end
	return env
end

local function lambda_fn(ls, senv)
	local parms = ls[1]
	if stype(parms) == "symbol" then
		parms = { type="list", parms }
	elseif not valid_parmlist(parms) then
		return seterr(
			"bad parameter-list operand to [op: \\]: %s",
			write_sexpr(parms))
	end
	local body = { type = "list" }
	for k = 2, #ls do body[k - 1] = ls[k] end
	return wrap(nary_op(make_op(function (ls, denv, depth)
		-- denv is ignored
		local env = match_parmlist( parms, ls )
		setmetatable(env, { __index = senv })
		return eval_seq(body, env, depth)
	end), #parms))
end

local relevantFrame = mw.getCurrentFrame()

local function getarg_fn(ls)
	local args = relevantFrame.args
	local t = nil
	if stype(ls[1]) == "number" then
		t = ls[1]
	else -- must be number or string
		t = ls[1]
	end
	t = args[t]
	if t == nil then return { type = "list" } end
	return t
end

local function getargexpr_fn(ls)
	local args = relevantFrame.args
	local t = nil
	if stype(ls[1]) == "number" then
		t = ls[1]
	else -- must be number or string
		t = ls[1]
	end
	t = args[t]
	if t == nil then return { type = "list" } end
	t = text_to_sexpr(t)
	if stype(t) == "error" then return { type = "list" } end
	if #t ~= 1 then return { type = "list" } end
	return t[1]
end

local function filter_fn(ls, env, depth)
	local preds = { type = "list" }
	for k = 2, #ls do preds[k - 1] = ls[k].comb end -- predicates
	local function hof(ls, n, f, app)
		-- copy first n elements of ls, apply f to later elements
		-- if app, instead skip first n, and return result,app
		if app == nil then app = false end
		local ls2 = { type = "list" }
		if #ls <= n then
			if app then return ls2,app else return ls end
		end
		if not app then for k = 1, n do ls2[k] = ls[k] end end
		for k = (n + 1), #ls do
			local x,app2 = f(ls[k])
			if stype(x) == "error" then return x end
			if app2 == nil then app2 = false end
			if app2 then
				for j = 1, #x do ls2[1 + #ls2] = x[j] end
			else
				ls2[1 + #ls2] = x
			end
		end
		return ls2,app
	end
	local function filter_entry(entry)
		local b = combine_all(preds, {type="list", entry}, env, depth,
			function (x)
				return (stype(x) ~= "boolean") or not x
			end)
		if stype(b) == "error" then return b end
		b = logical_and(b)
		if stype(b) == "error" then return b end
		if b then
			if stype(entry) == "list" then
				return hof(entry, 2, function (part)
						return hof(part, 2, filter_entry)
					end)
			else
				return entry
			end
		else
			if stype(entry) == "list" then
				return hof(entry, 2, function (part)
						return hof(part, 2, filter_entry, true)
					end, true)
			else
				return { type = "list" }, true
			end
		end
	end
	return hof(ls[1], 0, filter_entry)
end

local function item_tc(x)
	if (stype(x) == "list") and (#x > 1) and
		(stype(x[1]) == "string") and (x[1] ~= "part") and
		(stype(x[2]) == "list") and (#x[2] == 2) and
		(int_tc(x[2][1]) == "") and (int_tc(x[2][2]) == "")
	then
		return ""
	else
		return "item"
	end
end

local function part_tc(x)
	if (stype(x) == "list") and (#x > 1) and (x[1] == "part") and
		(stype(x[2]) == "list") and (#x[2] == 2) and
		(int_tc(x[2][1]) == "") and (int_tc(x[2][2]) == "")
	then
		return ""
	else
		return "part"
	end
end

local function cd_tc(x)
	if (stype(x) == "list") and (#x > 0) then
		if stype(x[1]) == "string" then x = x[2] end
		if (x ~= nil) and (stype(x) == "list") and (#x == 2) and
			(int_tc(x[1]) == "") and (int_tc(x[2]) == "")
		then
			return ""
		end
	end
	return "coordinates descriptor"
end

local function cd_ls_tc(x)
	local ok = true
	if stype(x) ~= "list" then ok = false
	else for k = 1, #x do if cd_tc(x[k]) ~= "" then ok = false end end
	end
	if ok then return ""
	else return "list of coordinates descriptors"
	end
end

local function getsubstr_ntv(s, k1, k2) -- k1, k2 ints if provided
	if k1 == nil then return s end
	if k1 < 1 then k1 = 1 end
	if k2 ~= nil then
		if k2 >= mw.ustring.len(s) then k2 = nil end
	end
	return mw.ustring.sub( s, k1, k2 )
end

local function cd_norm(x) -- assumes cd_tc
	if stype(x[1]) == "number" then return x else return x[2] end
end

local function getsubstr_int_fn(ls)
	local s = ls[1]
	return getsubstr_ntv(s, ls[2], ls[3])
end

local function getsubstr_cd_fn(ls)
	local s = ls[1]
	local c = cd_norm(ls[2])
	return getsubstr_ntv(s, c[1], c[2])
end

local function getsubstr_ls_fn(ls)
	local s = ls[1]
	local r = { type = "list" }
	for k = 1, #ls[2] do
		r[k] = cd_norm(ls[2][k])
	end
	for k = 1, #r do r[k] = getsubstr_ntv(s, r[k][1], r[k][2]) end
	return r
end

local function setsubstr_ls(s, lsc, lss)
	-- string, array of cds, array of strings
	local n = math.min(#lsc, #lss) -- just ignore extras of either
	if n == 0 then return s end
	local function berr(...)
		return seterr("bounds violation in [op: set-substring]: %s",
			mw.ustring.format( ... ))
	end
	if lsc[1][1] < 1 then
		return berr("segment starts left of string start (%i)", lsc[1][1])
	end
	if lsc[n][2] > mw.ustring.len(s) then
		return berr("segment ends right of string end (%i, %i)",
			lsc[n][2], mw.ustring.len(s))
	end
	local r = {}
	for k = 1, n do
		if lsc[k][1] > (lsc[k][2] + 1) then
			return berr("segment starts right of its own end (%i, %i)",
				lsc[k][1], lsc[k][2])
		end
		r[2 * k] = lss[k]
	end
	r[1] = mw.ustring.sub(s, 1, (lsc[1][1] - 1))
	r[1 + (2 * n)] = mw.ustring.sub(s, (lsc[n][2] + 1))
	for k = 2, n do
		if lsc[k - 1][2] >= lsc[k][1] then
			return berr("segment ends right of next segment start (%i, %i)",
				lsc[k - 1][2], lsc[k][1])
		end
		r[(2 * k) - 1] = mw.ustring.sub(s,
			(lsc[k - 1][2] + 1),
			(lsc[k][1] - 1))
	end
	return table.concat(r)
end

local function str_ls_tc(x)
	local ok = true
	if stype(x) ~= "list" then ok = false
	else for k = 1, #x do if stype(x[k]) ~= "string" then ok = false end end
	end
	if ok then return ""
	else return "list of strings"
	end
end

local function getsublist_fn(ls)
	local n1 = ls[2]
	local n2 = ls[3]
	local ls = ls[1]
	local x = { type = "list" }
	if n1 < 1 then n1 = 1 end
	if n2 == nil then n2 = #ls elseif n2 > #ls then ns = #ls end
	for k = n1, n2 do x[1 + #x] = ls[k] end
	return x
end

local function setsublist_fn(ls)
	local base = ls[1]
	local n1 = ls[2] - 1
	local n2 = ls[3] + 1
	local seg = ls[4]
	if n1 < 0 then n1 = 0 end
	if n2 <= n1 then n2 = n1 + 1 end
	local r = { type = "list" }
	for k = 1, n1 do r[k] = base[k] end
	for k = 1, #seg do r[1 + #r] = seg[k] end
	for k = n2, #base do r[1 + #r] = base[k] end
	return r
end

local function findprd_fn(ls, env, depth)
	local x = ls[1]
	local p = ls[2].comb
	local x2 = { type = "list" }
	for k = 1, #x do
		local q = combine( p, { type="list", x[k] }, env, depth )
		if stype(q) == "error" then return q end
		if stype(q) ~= "boolean" then
			return seterr(
				"bad predicate result type to [op: find]: got %s",
				stype(q))
		end
		if q then x2[1 + #x2] = k end
	end
	return x2
end

local function findstr_fn(ls)
	local s = ls[1]
	local p = ls[2]
	local x2 = { type = "list" }
	if #p == 0 then return x2 end
	local k = 1
	repeat
		local x3 = { mw.ustring.find( s, p, k, true ) }
		if #x3 == 0 then return x2 end
		x2[1 + #x2] = { type = "list", x3[1], x3[2] }
		k = 1 + x3[2]
	until false
end

local function findpat_fn(ls)
	local s = ls[1]
	local p = ls[2].pat
	local x2 = { type = "list" }
	local k = 1
	repeat
		local x3 = { mw.ustring.find( s, p, k ) }
		if #x3 == 0 then return x2 end
		x2[1 + #x2] = { type = "list", x3[1], x3[2] }
		k = 1 + x3[2]
	until false
end

local function any_tc(x) return "" end
local function none_tc(x) return "no operand here" end

local function member_fn(ls) -- 1 or 2 operands, second must be a list
	local t = write_sexpr(ls[1])
	if ls[2] ~= nil then
		ls = ls[2]
		for k = 1, #ls do
			if write_sexpr(ls[k]) == t then return true end
		end
		return false
	else
		return wrap(nary_op(typed_op({ "list" }, make_op(function(ls)
			ls = ls[1]
			for k = 1, #ls do
				if write_sexpr(ls[k]) == t then return true end
			end
			return false
		end, nil, true)), 1))
	end
end

local lang = mw.language.getContentLanguage()

local function let_tc(x)
	if (stype(x) == "list") and (#x == 2) and (stype(x[1]) == "symbol")
	then return ""
	else return "symbol-value binding"
	end
end

local function sorp_tc(x)
	if (stype(x) == "string") or (stype(x) == "pattern")
	then return ""
	else return "string or pattern"
	end
end

local function split_tc(x)
	if (stype(x) == "list") and (#x >= 1) and (sorp_tc(x[1]) == "") and
		((#x == 1) or
		 ((#x == 2) and ((sorp_tc(x[2]) == "") or (split_tc(x[2]) == ""))) or
		 ((#x == 3) and (sorp_tc(x[2]) == "") and (split_tc(x[3]) == "")))
	then
		return ""
	else
		return "valid string-split descriptor"
	end
end

local function strnest_tc(x)
	if stype(x) == "string" then return ""
	elseif stype(x) == "list" then
		for k = 1, #x do
			local msg = strnest_tc(x[k])
			if msg ~= "" then return msg end
		end
		return ""
	end
	return "string or tree of strings"
end

local function splitsep_fn(s, p)
	local x
	if (stype(p) == "string")
	then x = mw.text.split( s, p, true )
	else x = mw.text.split( s, p.pat )
	end
	x.type = "list"
	return x
end

local function splitdelim_fn(s, lt, rt)
	local lp = (stype(lt) == "string")
	local rp = (stype(rt) == "string")
	if not lp then lt = lt.pat end
	if not rp then rt = rt.pat end
	local snarf -- find next unmatched right-delimiter
	snarf = function (k)
		repeat
			local xl = { mw.ustring.find( s, lt, k, lp ) }
			local xr = { mw.ustring.find( s, rt, k, rp ) }
			if #xr == 0 then return xr end
			if #xl == 0 then return xr end
			if xr[1] <= xl[1] then return xr end
			xr = snarf(xl[2] + 1)
			if #xr == 0 then return xr end
			k = (xr[2] + 1)
		until false
	end
	local results = { type = "list" }
	local k = 1 -- leftmost character of interest
	repeat
		local xl = { mw.ustring.find( s, lt, k, lp ) }
		if #xl == 0 then return results end
		k = xl[2] + 1
		local xr = snarf(k)
		if #xr > 0 then
			results[1 + #results] = mw.ustring.sub( s, k, (xr[1] - 1) )
			k = xr[2] + 1
		end
	until false
end

local function splitrec_fn(s, rc)
	local ls
	if (#rc > 1) and (stype(rc[2]) ~= "list") then
		ls = splitdelim_fn(s, rc[1], rc[2])
	else
		ls = splitsep_fn(s, rc[1])
	end
	ls.type = "list"
	rc = rc[#rc]
	if (stype(rc) == "list") then
		for k = 1, #ls do
			ls[k] = splitrec_fn(ls[k], rc)
		end
	end
	return ls
end

local function splitnest_fn(s, rc)
	if stype(s) == "string" then return splitrec_fn(s, rc) end
	local result = { type="list" }
	for k = 1, #s do
		result[k] = splitnest_fn(s[k], rc)
		if stype(result[k]) == "error" then return result[k] end
	end
	return result
end

local function split_fn(ls)
	local rc = { type = "list" }
	for k = 2, #ls do rc[k - 1] = ls[k] end
	return splitnest_fn(ls[1], rc)
end

local function join_tc(x)
	if (stype(x) == "list") and (#x >= 1) and (stype(x[1]) == "string") and
		((#x == 1) or
		 ((#x == 2) and ((stype(x[2]) == "string") or (join_tc(x[2]) == ""))) or
		 ((#x == 3) and (stype(x[2]) == "string") and (join_tc(x[3]) == "")))
	then
		return ""
	else
		return "valid string-join descriptor"
	end
end

local function neststr_tc(x)
	if stype(x) == "list" then
		for k = 1, #x do
			if stype(x[k]) ~= "string" then
				local msg = neststr_tc(x[k])
				if msg ~= "" then return msg end
			end
		end
		return ""
	end
	return "tree of strings"
end

local function joinsep_fn(t, s)
	if #t == 0 then return "" end
	if stype(t[1]) == "string" then
		for k = 2, #t do if stype(t[k]) ~= "string" then
			return seterr("bad target for [op: join]: uneven tree depth")
		end end
		return table.concat( t, s )
	end
	for k = 2, #t do if stype(t[k]) == "string" then
		return seterr("bad target for [op: join]: uneven tree depth")
	end end
	local result = { type = "list" }
	for k = 1, #t do
		result[k] = joinsep_fn(t[k], s)
		if stype(result[k]) == "error" then return result[k] end
	end
	return result
end

local function joindelim_fn(t, lf, rg)
	if #t == 0 then return "" end
	if stype(t[1]) == "string" then
		for k = 2, #t do if stype(t[k]) ~= "string" then
			return seterr("bad target for [op: join]: uneven tree depth")
		end end
		return lf .. table.concat( t, (rg .. lf) ) .. rg
	end
	for k = 2, #t do if stype(t[k]) == "string" then
		return seterr("bad target for [op: join]: uneven tree depth")
	end end
	local result = { type = "list" }
	for k = 1, #t do
		result[k] = joindelim_fn(t[k], lf, rg)
		if stype(result[k]) == "error" then return result[k] end
	end
	return result
end

local function joinnest_fn(t, rc)
	if stype(t) == "error" then return t end
	if stype(t) == "string" then
		return seterr("bad target for [op: join]: tree not deep enough")
	end
	if #rc == 1 then
		return joinsep_fn(t, rc[1])
	elseif #rc == 3 then
		return joinnest_fn(joindelim_fn(t, rc[1], rc[2]), rc[3])
	elseif stype(rc[2]) == "string" then
		return joindelim_fn(t, rc[1], rc[2])
	else
		return joinnest_fn(joinsep_fn(t, rc[1]), rc[2])
	end
end

local function join_fn(ls)
	local rc = { type = "list" }
	for k = 2, #ls do rc[k - 1] = ls[k] end
	return joinnest_fn(ls[1], rc)
end

local function xformer_fn(pred, basis, succ, n)
	return wrap(nary_op(typed_op({ "fn", "fn", any_tc },
		make_op(function (ls, denv, depth)
			local leaf = ls[1]
			local parent = ls[2]
			local data = ls[3]
			local function xform(basis, data)
				local recurse = false
				if stype(data) == "list" then
					if stype(pred) ~= "fn" then
						recurse = true
					else
						recurse = combine( pred.comb, { type="list", data }, env, depth )
						if stype(recurse) ~= "boolean" then
							if stype(recurse) == "error" then return recurse end
							return seterr(
								"bad predicate result type to [op transform]: %s",
								stype(recurse))
						end
					end
				end
				local comb
				if recurse then
					local b2
					if stype(succ) == "fn"
					then b2 = combine( succ.comb, { type="list", basis }, env, depth )
					else b2 = basis
					end
					local d2 = { type="list" }
					for k = 1, #data do
						if k <= n then
							d2[k] = data[k]
						else
							d2[k] = xform(b2, data[k])
							if stype(d2[k]) == "error" then return d2[k] end
						end
					end
					data = d2
					comb = parent.comb
				else
					comb = leaf.comb
				end
				if stype(succ) == "fn"
				then data = { type="list", basis, data }
				else data = { type="list",        data }
				end
				return combine( comb, data, env, depth )
			end
			return xform(basis, data)
		end, "transform", true)), 3))
end

--[[ standard environment ]]

local ground_env = {
	list = wrap(make_op(function (ls) return ls end, "list", true)),
	["+"] = wrap(typed_op(
		{ "number" }, make_op(function (ls)
			local sum = 0
			for k = 1, #ls do sum = sum + ls[k] end
			return sum
		end, "add", true),
		{ "string" }, function (ls)
			local s = {}
			for k = 1, #ls do s[k] = ls[k] end
			return table.concat(s)
		end,
		{ "boolean" }, function (ls)
			local sum = true
			for k = 1, #ls do sum = sum and ls[k] end
			return sum
		end,
		{ "list" }, function (ls)
			local x = { type = "list" }
			for j = 1, #ls do
				for k = 1, #ls[j] do
					x[1 + #x] = ls[j][k]
				end
			end
			return x
		end)),
	["*"] = wrap(typed_op({ "number" }, make_op(function (ls)
			local product = 1
			for k = 1, #ls do product = product * ls[k] end
			return product
		end, "multiply", true))),
	["-"] = wrap(nary_op(typed_op({ "number" }, make_op(function (ls)
			local result = ls[1]
			for k = 2, #ls do result = result - ls[k] end
			return result
		end, "subtract", true)), -2)),
	["/"] = wrap(nary_op(typed_op({ "number" }, make_op(function (ls)
			local result = ls[1]
			for k = 2, #ls do result = result / ls[k] end
			return result
		end, "divide", true)), -2)),
	["^"] = wrap(nary_op(typed_op({ "number" }, make_op(function  (ls)
			return ls[1] ^ ls[2]
		end, "exponentiation", true)), 2)),
	["\\"] = nary_op(make_op(lambda_fn, "\\", true), -1),
	abs = wrap(nary_op(typed_op({ "number" }, make_op(function (ls)
			return math.abs(ls[1])
		end, "abs", true)), 1)),
	anchorencode = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			return mw.uri.anchorEncode( ls[1] )
		end, "anchorencode", true)), 1)),
	["and?"] = make_op(and_fn, "and?", true),
	apply = wrap(nary_op(typed_op(
		{ "fn", "list" }, make_op(function (ls, env, depth)
			return combine(ls[1].comb, ls[2], env, depth)
		end, "apply", true)), 2)),
	["boolean?"] = wrap(unary_pred(function (x)
			return stype(x) == "boolean"
		end, "boolean?")),
	["call?"] = wrap(unary_pred(function (x)
			return (stype(x) == "list") and (#x > 0) and
				(stype(x[1]) == "string") and (x[1] == "call")
		end, "call?")),
	canonicalurl = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			if #ls == 1
			then return tostring( mw.uri.canonicalUrl( ls[1] ) )
			else return tostring( mw.uri.canonicalUrl( ls[1], ls[2] ) )
			end
		end, "canonicalurl", true)), 1, 2)),
	ceil = wrap(nary_op(typed_op({ "number" }, make_op(function (ls)
			return math.ceil(ls[1])
		end, "ceil", true)), 1)),
	curry = wrap(nary_op(typed_op(
		{ "fn", any_tc }, make_op(function (ls1, env, depth)
			return wrap(make_op(function (ls2, env, depth)
					local ls3 = { type = "list" }
					for k = 2, #ls1 do ls3[k - 1] = ls1[k] end
					for k = 1, #ls2 do ls3[k + #ls1 - 1] = ls2[k] end
					return combine(ls1[1].comb, ls3, env, depth)
				end, nil, true))
		end, "curry", true)), -2)),
	define = nary_op(make_op(function (ls, env, depth)
			if stype(ls[1]) ~= "symbol" then
				return seterr(
					"bad definiend to [op: define]: expected symbol, got %s",
					write_sexpr(ls[1]))
			end
			local x = eval(ls[2], env, depth)
			if stype(x) == "error" then return x end
			env[ls[1].name] = x
			while stype(x) == "fn" do x = x.comb end
			if stype(x) == "op" and x.name == nil then x.name = ls[1].name end
			return { type = "list" }
		end, "define", true), 2),
	["equal?"] = wrap(make_op(function (ls)
			if #ls >= 2 then
				local t = write_sexpr(ls[1])
				for k = 2, #ls do
					if write_sexpr(ls[k]) ~= t then
						return false
					end
				end
			end
			return true
		end, "equal?", true)),
	filter = wrap(nary_op(typed_op({ "list", "fn" }, make_op(filter_fn,
		"filter", true)), -1)),
	find = wrap(nary_op(typed_op(
		{ "list", "fn" }, make_op(findprd_fn, "find", true),
		{ "string", "string" }, findstr_fn,
		{ "string", "pattern" }, findpat_fn
		), 2)),
	floor = wrap(nary_op(typed_op({ "number" }, make_op(function (ls)
			return math.floor(ls[1])
		end, "floor", true)), 1)),
	["fn?"] = wrap(unary_pred(function (x)
			return stype(x) == "fn"
		end, "fn?")),
	fullurl = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			if #ls == 1
			then return tostring( mw.uri.fullUrl( ls[1] ) )
			else return tostring( mw.uri.fullUrl( ls[1], ls[2] ) )
			end
		end, "fullurl", true)), 1, 2)),
	["ge?"] = wrap(typed_op(
		{ "number" }, binary_pred(function (x1, x2) return x1 >= x2 end, "ge?"),
		{ "string" }, binary_pred(function (x1, x2) return x1 >= x2 end))),
	['get-arg'] = wrap(nary_op(typed_op(
		{ "number" }, make_op(getarg_fn, "get-arg", true),
		{ "string" }, getarg_fn), 1)),
	['get-arg-expr'] = wrap(nary_op(typed_op(
		{ "number" }, make_op(getargexpr_fn, "get-arg-expr", true),
		{ "string" }, getargexpr_fn), 1)),
	['get-args'] = nary_op(make_op(function ()
			local ls = { type = "list" }
			for v, k in pairs( relevantFrame.args ) do
				ls[1 + #ls] = v
			end
			return ls
		end, "get-args"), 0),
	['get-coords'] = wrap(nary_op(typed_op({ cd_tc },make_op(function (ls)
			ls = ls[1]
			if stype(ls[1]) == "string" then ls = ls[2] end
			return { type="list", ls[1], ls[2] }
		end, "get-coords", true)), 1)),
	["get-items"] = wrap(nary_op(typed_op({ part_tc }, make_op(function (ls)
			ls = ls[1]
			local ls2 = { type="list" }
			for k = 3, #ls do ls2[k - 2] = ls[k] end
			return ls2
		end, "get-items", true)), 1)),
	["get-parts"] = wrap(nary_op(typed_op({ item_tc }, make_op(function (ls)
			ls = ls[1]
			local ls2 = { type="list" }
			for k = 3, #ls do ls2[k - 2] = ls[k] end
			return ls2
		end, "get-parts", true)), 1)),
	["get-sublist"] = wrap(nary_op(typed_op(
		{ "list", int_tc },
		make_op(getsublist_fn, "get-sublist", true)), 2, 3)),
	["get-substring"] = wrap(typed_op(
		{ "string", int_tc },
		nary_op(make_op(getsubstr_int_fn, "get-substring", true), 2, 3),
		{ "string", cd_tc },
		nary_op(make_op(getsubstr_cd_fn, "get-substring", true), 2),
		{ "string", cd_ls_tc },
		nary_op(make_op(getsubstr_ls_fn, "get-substring", true), 2))),
	["gt?"] = wrap(typed_op(
		{ "number" }, binary_pred(function (x1, x2) return x1 > x2 end, "gt?"),
		{ "string" }, binary_pred(function (x1, x2) return x1 > x2 end))),
	["if"] = nary_op(make_op(function (ls, env, depth)
			local test = eval(ls[1], env, depth)
			if stype(test) == "error" then return test end
			if stype(test) ~= "boolean" then
				return seterr(
					"bad test-result in [op: if]: %s",
					write_sexpr(test))
			elseif test then
				return eval(ls[2], env, depth)
			else
				return eval(ls[3], env, depth)
			end
		end, "if", true), 3),
	join = wrap(typed_op(
		{ neststr_tc, "string", join_tc },
		nary_op(make_op(join_fn, "join", true), 2, 3),
		{ neststr_tc, "string", "string", join_tc },
		nary_op(make_op(join_fn, "split", true), 3, 4))),
	lc = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			return lang:lc(ls[1])
		end, "lc", true),
		{ str_ls_tc }, function (ls)
			ls = ls[1]
			local r = { type = "list" }
			for k = 1, #ls do r[k] = lang:lc(ls[k]) end
			return r
		end), 1)),
	lcfirst = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			return lang:lcfirst(ls[1])
		end, "lcfirst", true),
		{ str_ls_tc }, function (ls)
			ls = ls[1]
			local r = { type = "list" }
			for k = 1, #ls do r[k] = lang:lcfirst(ls[k]) end
			return r
		end), 1)),
	["le?"] = wrap(typed_op(
		{ "number" }, binary_pred(function (x1, x2) return x1 <= x2 end, "le?"),
		{ "string" }, binary_pred(function (x1, x2) return x1 <= x2 end))),
	length = wrap(nary_op(typed_op(
		{ "list" }, make_op(function (ls)
			return #ls[1]
		end, "length", true),
		{ "string" }, function (ls)
			return mw.ustring.len( ls[1] )
		end), 1)),
	let = nary_op(typed_op({ let_tc, any_tc }, make_op(function (ls, env, depth)
			local p = ls[1][1]
			local v = eval( ls[1][2], env, depth )
			if stype(v) == "error" then return v end
			local body = { type = "list" }
			for k = 2, #ls do body[k - 1] = ls[k] end
			local e = {}
			e[p.name] = v
			setmetatable(e, { __index = env})
			return eval_seq(body, e, depth)
		end, "let", true)), -1),
	["link?"] = wrap(unary_pred(function (x)
			return (stype(x) == "list") and (#x > 0) and
				(stype(x[1]) == "string") and (x[1] == "link")
		end, "link?")),
	["list?"] = wrap(unary_pred(function (x)
			return stype(x) == "list"
		end, "list?")),
	["lt?"] = wrap(typed_op(
		{ "number" }, binary_pred(function (x1, x2) return x1 < x2 end, "lt?"),
		{ "string" }, binary_pred(function (x1, x2) return x1 < x2 end))),
	map = wrap(nary_op(typed_op({ "fn", "list" }, make_op(
		function (ls, env, depth)
			local n = #ls[2]
			for k = 3, #ls do if #ls[k] < n then n = #ls[k] end end
			local x = { type = "list" }
			for j = 1, n do
				local x2 = { type = "list" }
				for k = 2, #ls do x2[k - 1] = ls[k][j] end
				x[j] = combine( ls[1].comb, x2, env, depth )
				if stype(x[j]) == "error" then return x[j] end
			end
			return x
		end, "map", true)), -2)),
	["member?"] = wrap(nary_op(typed_op(
		{ any_tc, "list" }, make_op(member_fn, "member?", true)), 1, 2)),
	merge = wrap(nary_op(typed_op({ "fn", "list" }, make_op(
		function (ls, env, depth)
			local ks = {}
			for k = 2, #ls do ks[k] = 1 end
			local result = { type = "list" }
			while true do
				local j = nil
				for k = 2, #ls do
					if ks[k] <= #ls[k] then
						if j == nil then j = k else
							local x = combine( ls[1].comb,
								{ ls[k][ks[k]], ls[j][ks[j]] }, env, depth )
							if stype(x) == "error" then return x end
							if x then j = k end
						end
					end
				end
				if j == nil then return result else
					result[#result + 1] = ls[j][ks[j]]
					ks[j] = ks[j] + 1
				end
			end
		end, "merge", true)), -2)),
	["not?"] = wrap(nary_op(typed_op({ "boolean" }, make_op(function (ls)
			return not ls[1]
		end, "not?", true)), 1)),
	nth = wrap(nary_op(typed_op({ "list", posint_tc }, make_op(function (ls)
			local x = ls[1]
			for k = 2, #ls do
				local n = ls[k]
				if #x < n then
					return seterr(
						"bad index to [op: nth]: asked for %i, list length is %i",
						n, #x)
				end
				x = x[n]
				if (k < #ls) and (stype(x) ~= "list") then
					return seterr("bad multi-index to [op: nth]: tree too shallow")
				end
			end
			return x
		end, "nth", true)), -2)),
	["number?"] = wrap(unary_pred(function (x)
			return stype(x) == "number"
		end, "number?")),
	["op?"] = wrap(unary_pred(function (x)
			return stype(x) == "op"
		end, "op?")),
	["or?"] = make_op(or_fn, "or?", true),
	["param?"] = wrap(unary_pred(function (x)
			return (stype(x) == "list") and (#x > 0) and
				(stype(x[1]) == "string") and (x[1] == "param")
		end, "param?")),
	parse = wrap(nary_op(typed_op({ "string" }, make_op(parse_wiki,
		"parse", true)), 1)),
	pattern = wrap(nary_op(typed_op({ "string" }, make_op(function (ls)
			local p = ls[1]
			if #p == 0 then p = "[^%z%Z]" end -- disable null pattern
			return { type="pattern", pat=p }
		end, "pattern", true)), 1)),
	sequence = make_op(function (ls, env, depth)
			return eval_seq(ls, env, depth)
		end, "sequence", true),
	["set-sublist"] = wrap(nary_op(typed_op(
		{ "list", int_tc, int_tc, "list" },
		make_op(setsublist_fn, "set-sublist", true)), 4)),
	["set-substring"] = wrap(typed_op(
		{ "string", int_tc, int_tc, "string" },
		nary_op(make_op(function (ls)
				return setsubstr_ls(ls[1], { { ls[2], ls[3] } }, { ls[4] })
			end, "set-substring", true), 4),
		{ "string", cd_tc, "string" },
		nary_op(make_op(function (ls)
				return setsubstr_ls(ls[1], { cd_norm(ls[2]) }, { ls[3] })
			end, "set-substring", true), 3),
		{ "string", cd_ls_tc, str_ls_tc },
		nary_op(make_op(function (ls)
				local lsc = {}
				for k = 1, #ls[2] do lsc[k] = cd_norm(ls[2][k]) end
				return setsubstr_ls(ls[1], lsc, ls[3])
			end, "set-substring", true), 3)
		)),
	split = wrap(typed_op(
		{ strnest_tc, sorp_tc, split_tc },
		nary_op(make_op(split_fn, "split", true), 2, 3),
		{ strnest_tc, sorp_tc, sorp_tc, split_tc },
		nary_op(make_op(split_fn, "split", true), 3, 4))),
	["string?"] = wrap(unary_pred(function (x)
			return stype(x) == "string"
		end, "string?")),
	["symbol?"] = wrap(unary_pred(function (x)
			return stype(x) == "symbol"
		end, "symbol?")),
	["to-entity"] = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			local s = ls[1]
			if #s == 0 then return s end
			return "&#" .. mw.ustring.codepoint(s, 1) .. ";"
		end, "to-entity", true),
		{ str_ls_tc }, function (ls)
			ls = ls[1]
			local r = { type = "list" }
			for k = 1, #ls do
				local s = ls[k]
				if #s == 0 then r[k] = s
				else r[k] = "&#" .. mw.ustring.codepoint(s, 1) .. ";"
				end
			end
			return r
		end), 1)),
	["to-number"] = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			local n = tonumber(ls[1])
			if n == nil then return { type="list" } else return n end
		end, "to-number", true)), 1)),
	["to-string"] = wrap(nary_op(typed_op(
		{ "number" }, make_op(function (ls)
			return write_sexpr(ls[1])
		end, "to-string", true)),1)),
	transformer = wrap(typed_op(
		{ none_tc },
		make_op(function (ls, env, depth)
				return xformer_fn(    0,     0,     0,     0)
			end, "transformer", true),
		{ "fn", none_tc },
		make_op(function (ls, env, depth)
				return xformer_fn(ls[1],     0,     0,     0)
			end, "transformer", true),
		{ posint_tc, none_tc },
		make_op(function (ls, env, depth)
				return xformer_fn(    0,     0,     0, ls[1])
			end, "transformer", true),
		{ any_tc, "fn", none_tc },
		nary_op(make_op(function (ls, env, depth)
				return xformer_fn(    0, ls[1], ls[2],     0)
			end, "transformer", true), -2),
		{ "fn", posint_tc, none_tc },
		make_op(function (ls, env, depth)
				return xformer_fn(ls[1],     0,     0, ls[2])
			end, "transformer", true),
		{ "fn", any_tc, "fn", none_tc },
		nary_op(make_op(function (ls, env, depth)
				return xformer_fn(ls[1], ls[2], ls[3],     0)
			end, "transformer", true), -3),
		{ any_tc, "fn", posint_tc, none_tc },
		make_op(function (ls, env, depth)
				return xformer_fn(    0, ls[1], ls[2], ls[3])
			end, "transformer", true),
		{ "fn", any_tc, "fn", posint_tc, none_tc },
		make_op(function (ls, env, depth)
				return xformer_fn(ls[1], ls[2], ls[3], ls[4])
			end, "transformer", true)
		)),
	trim = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			return mw.text.trim(ls[1])
		end, "trim", true),
		{ str_ls_tc }, function (ls)
			ls = ls[1]
			local r = { type = "list" }
			for k = 1, #ls do r[k] = mw.text.trim(ls[k]) end
			return r
		end), 1)),
	uc = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			return lang:uc(ls[1])
		end, "uc", true),
		{ str_ls_tc }, function (ls)
			ls = ls[1]
			local r = { type = "list" }
			for k = 1, #ls do r[k] = lang:uc(ls[k]) end
			return r
		end), 1)),
	ucfirst = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			return lang:ucfirst(ls[1])
		end, "ucfirst", true),
		{ str_ls_tc }, function (ls)
			ls = ls[1]
			local r = { type = "list" }
			for k = 1, #ls do r[k] = lang:ucfirst(ls[k]) end
			return r
		end), 1)),
	urlencode = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			if #ls == 1 then ls[2] = 'QUERY' end
			return mw.uri.encode( ls[1], ls[2] )
		end, "urlencode", true)), 1, 2)),
	["wikilisp-version"] = wrap(nary_op(make_op(function (ls)
			return wikilispversion
		end, "wikilisp-version", true), 0)),
	write = wrap(nary_op(make_op(function (ls)
			return write_sexpr(ls[1])
		end, "write", true), 1))
}

local function make_standard_env()
	local standard_env = {}
	setmetatable(standard_env, { __index = ground_env})
	return standard_env
end

--[[ read-eval-print]]

function export.rep( frame )
	local t = frame.args[1]
	if t == nil then t = "" end
	return display_sexpr(
		eval_seq(
			text_to_sexpr(t),
			make_standard_env(),
			maxdepth))
end

function export.trep( frame )
	relevantFrame = frame:getParent()
	return export.rep(frame)
end

return export