Module:User:Pi zero/Wikilisp
This module is used on over 9000 pages. Changes to this module may cause some server load, and mistakes will be visible on many pages. Please carefully test any edits before making them, and avoid making unnecessary edits. |
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 functions
abs
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
andto-string
take one operand and convert it either way between a number and a string representation of a number. If the operand ofto-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 toolsand?
andor?
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 tofoo"bar
, while{{evalx|(write "foo""bar")}}
would expand to"foo""bar"
.
- Functions
urlencode
,anchorencode
,fullurl
, andcanonicalurl
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 "https://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
andget-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
andset-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 functionequal?
, 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 tomember?
.(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 likeand?
, 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 (whereaslet
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 thatx
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 functionslist
andnth
, or justlist
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". Functionget-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). Functionget-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 thanrep
, wikilisp functionsget-arg
andget-arg-expr
access arguments of the template that invokes the module, instead of arguments of the invocation itself. Template {{evalx}} does this.
- If the module is invoked through alternative Lua function
- 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 byparse
, and returns a list of its parts. Functionget-items
takes one operand, a part descriptor as provided byparse
, and returns a list of items within it.
- Function
- 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
filter
at its simplest takes two operands: a data structure such as produced by functionparse
, 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 functionand?
.- 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?
andparam?
are predicates determining whether their operands are item data structures describing, respectively, wikilinks, template calls, and template parameters.
- Functions
- 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 numbersls
, 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 ofcurry
ing+
with the empty list beforeapply
ing it; otherwise, ifls
happened to be empty,+
would be applied to the empty list, producing a number instead of a list.)
- 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.
- 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" ""))).
- 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,
- 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}". Thusjoin
can restore nestings of separators and delimiters removed bysplit
; for example,(join (split "a{b}c, d{e}f" (pattern ",%s*") (list "{" "}")) "{" "}" (list ","))
would evaluate to "{b},{e}".
- There may be a second string operand; then each of the listed strings is delimited by the two strings. For example,
- 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 byparse
orget-items
; a part descriptor, which is an element of a list returned byget-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 amap
-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.
- 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,
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; functionop?
checks whether all the values passed to it are special functions.(fn? if)
would evaluate to false, sinceif
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 underlyinglength
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("<unrecognized internal type: %s>", type(x))
elseif x.type == "symbol" then
return x.name
elseif x.type == "fn" then
return mw.ustring.format("<%s>", 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("<error: %s>", x.msg)
elseif x.type == "pattern" then
return mw.ustring.format('<pattern: "%s">', x.pat)
elseif x.type ~= nil then
return mw.ustring.format("<unrecognized type: %s>", x.type)
else
return "<missing type>"
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