A note about the syntax coloring: purple keywords denote directives of the TXR pattern language. Green keywords denote built in functions, operators and variables in TXR Lisp. (This color scheme is not up-to-date in a few examples.)
@(do (defun y (f) [(op @1 @1) (lambda (y) [f (op [y y])])]) (defun fac (f) (lambda (n) (if (zerop n) 1 (* n [f (- n 1)]))))) @(bind f4 @[[y fac] 4])
f4="24"
The following TXR program imlements a complete, working parser for the JSON data interchange notation. The objects in the notation are changed into native TXR objects. JSON arrays become TXR vectors, JSON string-value association objects become TXR hash tables, JSON numbers become TXR floating-point numbers, etc. TXR's text pattern language can drill right down to this kind of detailed lexical analysis and grammar parsing task, and yet remain convenient and easy to use for ad-hoc text scanning.
@; @; A JSON value is a string, number, associative object, keyword or array. @; @(define value (v))@\ @(cases)@\ @(string v)@(or)@(num v)@(or)@(object v)@(or)@\ @(keyword v)@(or)@(array v)@\ @(end)@\ @(end) @; @; Pattern function for matching whitespace @; @(define ws)@/[\n\t ]*/@(end) @; @; Pattern function for matching a JSON string, with all the @; escape sequences. @; @(define string (s))@\ @(local hex)@\ @(ws)@\ "@(coll :gap 0 :vars (s))@\ @(cases)@\ \"@(bind s """)@(or)@\ \\@(bind s "\\\\")@(or)@\ \/@(bind s "\\/")@(or)@\ \b@(bind s "")@(or)@\ \f@(bind s "")@(or)@\ \n@(bind s " ")@(or)@\ \r@(bind s " ")@(or)@\ \t@(bind s "	")@(or)@\ \u@{hex /[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]/}@\ @(bind s `&#x@hex;`)@(or)@\ @{s /[^"\\]*/}@(filter :to_html s)@\ @(end)@\ @(until)"@\ @(end)"@\ @(ws)@\ @(cat s "")@\ @(filter :from_html s)@\ @(end) @; @; Pattern function for recognizing a number. @; @(define num (n))@\ @(local tok)@\ @(ws)@{tok /-?[0-9]+((\.[0-9]+)?([Ee][+\-]?[0-9]+)?)?/}@(ws)@\ @(bind n @(flo-str tok))@\ @(end) @; @; Recognize the JSON keyword true, false and null, turning @; them into TXR Lisp keywords @; @(define keyword (k))@\ @(local tok)@\ @(all)@(ws)@{tok /true|false|null/}@(trailer)@/[^A-Za-z0-9_]/@(end)@(ws)@\ @(bind k @(intern tok *keyword-package*))@\ @(end) @; @; Recognize an object: a collection of string/value pairs, @; turning them into an equal-based hash table @; @(define object (v))@\ @(local p e pair)@\ @(ws){@(ws)@(coll :gap 0 :vars (pair))@\ @(string p):@(value e)@/,?/@\ @(bind pair (p e))@\ @(until)}@\ @(end)}@(ws)@\ @(bind v @(progn '#H((:equal-based) ,*pair)))@\ @(end) @; @; Recognize an array. @; @(define array (v))@\ @(local e)@\ @(ws)[@(ws)@(coll :gap 0 :vars (e))@(value e)@/,?/@(until)]@(end)]@(ws)@\ @(bind v @(progn '#(,*e)))@\ @(end) @; @; Now parse the input as a JSON object @; @(freeform) @(maybe)@(value ast)@(end)@badsyntax @; @; Output resulting abstract syntax tree. @; @(do (format t "AST: ~s\n\n" ast) (format t "Unmatched junk: ~s\n" badsyntax))
[
"JSON Test Pattern pass1",
{"object with 1 member":["array with 1 element"]},
{},
[],
-42,
true,
false,
null,
{
"integer": 1234567890,
"real": -9876.543210,
"e": 0.123456789e-12,
"E": 1.234567890E+34,
"": 23456789012E66,
"zero": 0,
"one": 1,
"space": " ",
"quote": "\"",
"backslash": "\\",
"controls": "\b\f\n\r\t",
"slash": "/ & \/",
"alpha": "abcdefghijklmnopqrstuvwyz",
"ALPHA": "ABCDEFGHIJKLMNOPQRSTUVWYZ",
"digit": "0123456789",
"0123456789": "digit",
"special": "`1~!@#$%^&*()_+-={':[,]}|;.</>?",
"hex": "\u0123\u4567\u89AB\uCDEF\uabcd\uef4A",
"true": true,
"false": false,
"null": null,
"array":[ ],
"object":{ },
"address": "50 St. James Street",
"url": "http://www.JSON.org/",
"comment": "// /* <!-- --",
"# -- --> */": " ",
" s p a c e d " :[1,2 , 3
,
4 , 5 , 6 ,7 ],"compact":[1,2,3,4,5,6,7],
"jsontext": "{\"object with 1 member\":[\"array with 1 element\"]}",
"quotes": "" \u0022 %22 0x22 034 "",
"\/\\\"\uCAFE\uBABE\uAB98\uFCDE\ubcda\uef4A\b\f\n\r\t`1~!@#$%^&*()_+-=[]{}|;:',./<>?"
: "A key can be any string"
},
0.5 ,98.6
,
99.44
,
1066,
1e1,
0.1e1,
1e-1,
1e00,2e+00,2e-00
,"rosebud"]
AST: #("JSON Test Pattern pass1" #H((:equal-based) ("object with 1 member"
#("array with 1 element"))) #H((:equal-based)) #() -42.0 :true :false :null
#H((:equal-based) ("" 2.3456789012e+76) ("digit" "0123456789")
("\\/\\\\\"쫾몾ꮘﳞ볚\b\f\n\r\t`1~!@#$%^&*()_+-=[]{}|;:',./<>?" "A key can be
any string") ("null" :null) ("one" 1.0) ("E" 1.23456789e+34) ("special"
"`1~!@#$%^&*()_+-={':[,]}|;.</>?") ("e" 1.23456789e-13) ("comment" "// /* <!--
--") ("# -- --> */" " ") ("real" -9876.54321) ("backslash" "\\\\") ("array"
#()) ("url" "http://www.JSON.org/") ("zero" 0.0) ("false" :false) ("space" " ")
("slash" "/ & \\/") ("address" "50 St. James Street") ("compact" #(1.0 2.0 3.0
4.0 5.0 6.0 7.0)) ("object" #H((:equal-based))) ("quote" "\"") ("jsontext"
"{\"object with 1 member\":[\"array with 1 element\"]}") ("true" :true)
("integer" 1234567890.0) ("ALPHA" "ABCDEFGHIJKLMNOPQRSTUVWYZ") ("quotes" ""
\" %22 0x22 034 "") ("hex" "ģ䕧覫췯ꯍ") ("0123456789" "digit") ("controls"
"\b\f\n\r\t") ("alpha" "abcdefghijklmnopqrstuvwyz") (" s p a c e d " #(1.0 2.0
3.0 4.0 5.0 6.0 7.0))) 0.5 98.6 99.44 1066.0 10.0 1.0 0.1 1.0 2.0 2.0
"rosebud")
Unmatched junk: ""
The following is an implementation of the simple recursive depth-first-search
maze generation algorithm. Cells in the maze are represented as coordinate
pairs, constructed using the x..y notation, which is equivalent to
(cons x y). These pairs are used as indexes into hashes which
thereby simulate two dimensional arrays.
The vi hash keeps
track of which cells have been visited, and inside make-maze it
is initialized such that there is a border of visited cells outside of the
boundary of the maze. This simplifies the code, which does not have to bother
checking the edge and corner cases when computing which unvisited cells are
adjacent to a given cell.
The pa (path) hash
associates a cell with the adjacent cells that are reachable because a wall was
removed. pa is carefully maintained so that it is reflexive: if it
is possible to go from cell A to adjacent cell B, then the converse must be the
case. This pa hash is the final representation of the maze,
traversed by the maze printing function to produce the textual representation.
The code could be somewhat smaller if instead of this abstract representation
of connectivity, the maze generation simply worked with a
textual representation.
@(bind (width height) (15 15)) @(do (defvar *r* (make-random-state nil)) (defun scramble (list) (let ((out ())) (each ((item list)) (let ((r (random *r* (+ 1 (length out))))) (set [out r..r] (list item)))) out)) (defun make-maze-rec (w h vi pa cu) (set [vi cu] t) (let* ((x (car cu)) (y (cdr cu)) (adj (list (- x 1)..y (+ x 1)..y x..(- y 1) x..(+ y 1)))) (each ((ne (scramble adj))) (cond ((not [vi ne]) (push ne [pa cu]) (push cu [pa ne]) (make-maze-rec w h vi pa ne)))))) (defun make-maze (w h) (let ((vi (hash :equal-based)) (pa (hash :equal-based))) (each ((x (range -1 w))) (set [vi x..-1] t) (set [vi x..h] t)) (each ((y (range* 0 h))) (set [vi -1..y] t) (set [vi w..y] t)) (make-maze-rec w h vi pa 0..0) pa)) (defun print-tops (pa w j) (each ((i (range* 0 w))) (if (memqual i..(- j 1) [pa i..j]) (format t "+ ") (format t "+----"))) (format t "+\n")) (defun print-sides (pa w j) (let ((str "")) (each ((i (range* 0 w))) (if (memqual (- i 1)..j [pa i..j]) (set str `@str `) (set str `@str| `))) (format t "~a|\n~a|\n" str str))) (defun print-maze (pa w h) (each ((j (range* 0 h))) (print-tops pa w j) (print-sides pa w j)) (print-tops pa w h))) @;; @(bind m @(make-maze width height)) @(do (print-maze m width height))
+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+ | | | | | | | | | | | | +----+ + + + + +----+----+----+----+ +----+----+ + + | | | | | | | | | | | | | | | | + +----+----+----+ +----+----+ + + +----+ +----+----+ + | | | | | | | | | | | | | | +----+----+----+ + + +----+----+----+----+ +----+ +----+ + | | | | | | | | | | | | | | | | + +----+ +----+ +----+ + +----+----+----+ +----+ + + | | | | | | | | | | | | | | | | + +----+----+ +----+----+ +----+ +----+ +----+----+ + + | | | | | | | | | | | | | | | | | | | | + + + +----+ +----+----+ +----+ +----+ + +----+ + | | | | | | | | | | | | | | | | | | + +----+----+----+ + + +----+ +----+----+ + + +----+ | | | | | | | | | | | | | | | | | | | | + + +----+----+----+ +----+ +----+----+ + + + + + | | | | | | | | | | | | | | | | +----+----+ +----+----+----+ +----+----+----+----+ + +----+ + | | | | | | | | | | | | | | + +----+----+ +----+----+----+ +----+ +----+ + + +----+ | | | | | | | | | | | | | | + +----+----+----+----+----+----+----+ +----+ +----+ +----+ + | | | | | | | | | | | | | | | | | | +----+ +----+----+ + + + +----+ + + +----+ + + | | | | | | | | | | | | | | | | | | + +----+----+ + +----+----+----+ +----+----+ + +----+----+ | | | | | | | | | | | | | | | | | | +----+----+----+----+----+ + + +----+----+ + + +----+ + | | | | | | | | +----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+
@(do (defun 100-doors () (let ((doors (vector 100))) (each ((i (range 0 99))) (each ((j (range i 99 (+ i 1)))) (flip [doors j]))) doors)) (each ((counter (range 1)) (door (list-vector (100-doors)))) (format t "door ~a is ~a\n" counter (if door "open" "closed"))))
@(next :list @[mapcar* tostring (range 99 -1)]) @(collect) @number @ (trailer) @number_less_1 @ (cases) @ (bind number "1") @ (output) 1 bottle of beer one the wall 1 bottle of beer @ (end) @ (or) @ (output) @number bottles of beer one the wall @number bottles of beer @ (end) @ (end) @ (cases) @ (bind number "0") @ (output) Go to the store and get some more, 99 bottles of beer on the wall! @ (end) @ (or) @ (output) Take one down and pass it around @number_less_1 bottles of beer on the wall @ (end) @ (end) @(end)
@(collect) @ (coll)@{item /[^$]+/}@(end) @(end) @; nc = number of columns @; pi = padded items (data with row lengths equalized with empty strings) @; cw = vector of max column widths @; ce = center padding @(bind nc @[apply max [mapcar length item]]) @(bind pi @(mapcar (op append @1 (repeat '("") (- nc (length @1)))) item)) @(bind cw @(vector-list (mapcar (op apply max [mapcar length @1]) ;; matrix transpose trick cols become rows: [apply mapcar [cons list pi]]))) @(bind ns "") @(output) @ (repeat) @ (rep :counter i)@{pi @[cw i]} @(end) @ (end) @ (repeat) @ (rep :counter i)@{pi @(- [cw i])} @(end) @ (end) @ (repeat) @ (rep :counter i)@\ @{ns @(trunc (- [cw i] (length pi)) 2)}@\ @{pi @(- [cw i] (trunc (- [cw i] (length pi)) 2))} @(end) @ (end) @(end)
Given$a$text$file$of$many$lines,$where$fields$within$a$line$ are$delineated$by$a$single$'dollar'$character,$write$a$program that$aligns$each$column$of$fields$by$ensuring$that$words$in$each$ column$are$separated$by$at$least$one$space. Further,$allow$for$each$word$in$a$column$to$be$either$left$ justified,$right$justified,$or$center$justified$within$its$column.
$ txr align-columns.txr align-columns.dat
Given a text file of many lines, where fields within a line
are delineated by a single 'dollar' character, write a program
that aligns each column of fields by ensuring that words in each
column are separated by at least one space.
Further, allow for each word in a column to be either left
justified, right justified, or center justified within its column.
Given a text file of many lines, where fields within a line
are delineated by a single 'dollar' character, write a program
that aligns each column of fields by ensuring that words in each
column are separated by at least one space.
Further, allow for each word in a column to be either left
justified, right justified, or center justified within its column.
Given a text file of many lines, where fields within a line
are delineated by a single 'dollar' character, write a program
that aligns each column of fields by ensuring that words in each
column are separated by at least one space.
Further, allow for each word in a column to be either left
justified, right justified, or center justified within its column.
@(define first_last (first last whole)) @ (all) @(skip :greedy)@{last 1} @ (and) @{first 1}@(skip) @ (and) @whole @ (end) @(end) @(next "amb/set1") @(skip) @(first_last fi1 la1 w1) @(next "amb/set2") @(skip) @(first_last la1 la2 w2) @(next "amb/set3") @(skip) @(first_last la2 la3 w3) @(next "amb/set4") @(skip) @(first_last la3 la4 w4) @(output) @w1 @w2 @w3 @w4 @(end)
$ cat amb/set1 the that a $ cat amb/set2 frog elephant thing $ cat amb/set3 walked treaded grows $ cat amb/set4 slowly quickly
$ txr amb.txr that thing grows slowly
@(do (defun mapvec (vec fun) (each ((i (range* 0 (length vec)))) [fun [vec i]])) (mapvec #(1 2 3 4 5 6 7 8 9 10) (op format t "~a\n")))
1 2 3 4 5 6 7 8 9 10
@(next :string @(tostring (expt 5 4 3 2))) @(all) @/62060698786608744707[0-9]*92256259918212890625/ @ (and) @{first 20}@(skip :greedy)@{last 20} @ (and) @whole @ (bind ndigits @(length whole)) @ (forget whole) @(end)
first="62060698786608744707" last="92256259918212890625" ndigits="183231"
@(next :args) @(define space)@/ */@(end) @(define mulop (nod))@\ @(local op)@\ @(space)@\ @(cases)@\ @{op /[*]/}@(bind nod @(intern op *user-package*))@\ @(or)@\ @{op /\//}@(bind (nod) @(list 'trunc))@\ @(end)@\ @(space)@\ @(end) @(define addop (nod))@\ @(local op)@(space)@{op /[+\-]/}@(space)@\ @(bind nod @(intern op *user-package*))@\ @(end) @(define number (nod))@\ @(local n)@(space)@{n /[0-9]+/}@(space)@\ @(bind nod @(int-str n 10))@\ @(end) @(define factor (nod))@(cases)(@(expr nod))@(or)@(number nod)@(end)@(end) @(define term (nod))@\ @(local op nod1 nod2)@\ @(cases)@\ @(factor nod1)@\ @(cases)@(mulop op)@(term nod2)@(bind nod (op nod1 nod2))@\ @(or)@(bind nod nod1)@\ @(end)@\ @(or)@\ @(addop op)@(factor nod1)@\ @(bind nod (op nod1))@\ @(end)@\ @(end) @(define expr (nod))@\ @(local op nod1 nod2)@\ @(term nod1)@\ @(cases)@(addop op)@(expr nod2)@(bind nod (op nod1 nod2))@\ @(or)@(bind nod nod1)@\ @(end)@\ @(end) @(cases) @ {source (expr e)} @ (output) source: @source AST: @(format nil "~s" e) value: @(eval e nil) @ (end) @(or) @ (maybe)@(expr e)@(end)@bad @ (output) erroneous suffix "@bad" @ (end) @(end)
$ txr expr-ast.txr '3 + 3/4 * (2 + 2) + (4*4)' source: 3 + 3/4 * (2 + 2) + (4*4) AST: (+ 3 (+ (trunc 3 (* 4 (+ 2 2))) (* 4 4))) value: 19
TXR has two kinds of aggregate objects for sequences: lists and arrays. There is some syntactic sugar to manipulate them in the same way.
In the pattern matching language, there are no list literals. A list like ("a" "b" "c") is actually being evaluated, as can be seen in a directive such as @(bind (a b) (c "d")) where (c "d") is a list consisting of the value of variable c and the string "d". This is subject to destructuring and the two values are assigned to the variables a and b
In TXR Lisp, there are literal lists introduced by a quote '(1 2 3 4). Vectors look like this: #(1 2 3 4).
Lists can be implicitly produced using pattern matching. Lists and vectors can be constructed using the functions of TXR Lisp. (vector 3) creates a vector of length three, whose elements are initialized to nil. (list 1 2 3) constructs the list (1 2 3).
The [] notation performs positional indexing on lists and arrays, which are both zero-based (element zero is the first element). Negative indices work from the tail of the list, whereby -1 denotes the last element of a sequence which has at least one element. Out of bounds access to arrays throws exceptions, but out of bounds access to lists produces nil. Out-of-bounds assignments are not permitted for either data type.
(defvar list (list 1 2 3)) ;;; (1 2 3) (defvar vec (vector-list list)) ;;; make vector #(1 2 3) from list [vector 0] ;;; yields 1 [list 0] ;;; yields 1 [vector -1] ;;; yields 3 [list 5] ;;; yields nil [list -50] ;;; yields nil [vector 50] ;;; error (set [vector 2] 4) ;;; changes vector to #(1 2 4). (set [vector 3] 0) ;;; error (set [list 3] 0) ;;; error
Array range notation (slices) are supported, for both arrays and lists. An array range is a pair object denoted a .. b,
which is a syntactic sugar for (cons a b). Therefore, a range constitutes a single argument in the bracket notation (allowing for straightforward future extension to multi-dimensional arrays indexing and slicing).
[vector 0..t] ;;; yield all of vector: t means "one position past last element" [vector nil..nil] ;;; another way [vector 1 3] ;;; yields #(2 3) (set [vector 0 2] '(a b)) ;;; changes vector to #(a b 3) (set [vector 0 2] #(1 2)) ;;; changes vector to #(1 2 3) (set [list 0 1] nil) ;;; changes list to #(2 3), deleting 1. (set [list t t] '(4 5)) ;;; changes list to #(2 3 4 5), appending (4 5) (set [vector 1 2] '(0 0)) ;;; changes vector to #(1 0 0 3), replacing 2 with 0 0
In the TXR pattern language, there is an array indexing and slicing notation supported in output variables.
The following assumes that variable a holds a list.
@(output) here is a[0] left-adjusted in a 10 character field: @{a[0] 10}. here are a[1] through a[3] joined with a colon, right-adjusted in a 20 character field: @{a[1..4] ":" -20} @(end)
A complete program which turns comma-separated into tab-separated, where the first and last field from each line are exchanged:
@(collect) @line @(bind f @(split-str line ",")) @(output) @{f[-1]}@\t@{f[1..-1] "\t"}@\t@{f[0]} @(end) @(end)
The [] notation also works with strings, including ranges and assignment to ranges.
Hash tables can be indexed also, and the notation is meaningful for functions: [fun args ...] means the same thing as (call fun args ...), providing a Lisp-1 flavor within a Lisp-2 dialect.
#H prefix introduces a hash literal in TXR Lisp, which is
exploited in the example below. If such a hash literal is evaluated more than
once (like in a loop or function), it yields the same object which had been
constructed at program parse time, and so insert or delete operation on
that hash gives rise to self-modifying code.
Hashes can be constructed at run time using the make-hash function
or the simpler hash interface.
TXR Lisp also allows quasiquoting over the hash literal notation. If a hash is
produced by quasiquote substitution, that is not a true literal but a syntactic
sugar for a run-time hash construction which resembles a literal. Quasiquoting
is the best way to turn a list of pairs into a hash table; e.g.
'#H(nil ,*list-of-pairs ,*other-pairs (hard-coded-entry 42))
@(do (defvar *h* #H(nil (a 1) (b 2) (c 3))) (dohash (k v *h*) (format t "~a -> ~a\n" k v)))
$ txr hash.txr c -> 3 b -> 2 a -> 1
@;;; @;;; parenthesis matcher @;;; @(define paren)@(maybe)[@(coll)@(paren)@(until)]@(end)]@(end)@(end) @;;; @;;; random generation @;;; @(do (defvar r (make-random-state nil)) (defun shuffle (list) (let* ((vec (vector-list list)) (len (length vec))) (each ((i (range* 0 len))) (let ((j (random r len)) (temp [vec i])) (set [vec i] [vec j]) (set [vec j] temp))) (list-vector vec))) (defun generate-1 (count) (let (chars) (each ((i (range* 0 count))) (set [chars t..t] '(#\[ #\]))) (cat-str (shuffle chars) ""))) (defun generate-list (num count) (collect-each ((i (range* 0 num))) (generate-1 count)))) @;;; @;;; main @;;; @(next :list @(generate-list 22 6)) @(output) INPUT MATCHED REST @(end) @ (collect) @ (all) @parens @ (and) @{matched (paren)}@mismatched @ (end) @ (output) @{parens 15} @{matched 15} @{mismatched 15} @ (end) @(end)
INPUT MATCHED REST ]][]][][][[[ ]][]][][][[[ ]]][[][[[]][ ]]][[][[[]][ ]][][[[[]]][ ]][][[[[]]][ [][[]][[][]] [] [[]][[][]] [[]]][][]][[ [[]] ][][]][[ ][][[[][[]]] ][][[[][[]]] ]]][[[[[]][] ]]][[[[[]][] ][][]]][[[[] ][][]]][[[[] []]][][][][[ [] ]][][][][[ [[][]]][[][] [[][]] ][[][] [[]][[][][]] [[]] [[][][]] [[]]][[[]]][ [[]] ][[[]]][ [[[[]]][]]][ [[[[]]][]] ][ [[][[]][]]][ [[][[]][]] ][ [[]][]][[][] [[]] []][[][] ]]][]]][[[[[ ]]][]]][[[[[ ][]]]][[[][[ ][]]]][[[][[ [[][][]][[]] [[][][]] [[]] ]][[[[][[]]] ]][[[[][[]]] ][]][[][][[] ][]][[][][[] ][]]][][[[][ ][]]][][[[][ ][[]]][[[]][ ][[]]][[[]][
@(next :args) @(cases) @{key /[0-9]+/} @text @(or) @ (throw error "specify <key-num> <text>") @(end) @(do (defvar k (int-str key 10))) @(bind enc-dec @(collect-each ((i (range 0 25))) (let* ((p (tostringp (+ #\a i))) (e (tostringp (+ #\a (mod (+ i k) 26)))) (P (upcase-str p)) (E (upcase-str e))) '(((,p ,e) (,P ,E)) ((,e ,p) (,E ,P)))))) @(deffilter enc . @(mappend (fun first) enc-dec)) @(deffilter dec . @(mappend (fun second) enc-dec)) @(output) encoded: @{text :filter enc} decoded: @{text :filter dec} @(end)
$ txr caesar.txr 12 'Hello, world!' encoded: Tqxxa, iadxp! decoded: Vszzc, kcfzr! $ txr caesar.txr 12 'Vszzc, kcfzr!' encoded: Hello, world! decoded: Jgnnq, yqtnf!
@line @(cases) @ line @ (output) second line is the same as first line @ (end) @(or) @ (skip)@line @ (output) first line is a suffix of the second line @ (end) @(or) @ line@(skip) @ (output) first line is a suffix of the second line @ (end) @(or) @ prefix@line@(skip) @ (output) first line is embedded in the second line at position @(length prefix) @ (end) @(or) @ (output) first line is not found in the second line @ (end) @(end)
$ txr cmatch.txr - 123 01234 first line is embedded in the second line at position 1 $ txr cmatch.txr - 123 0123 first line is a suffix of the second line
@(next :args) @(collect) @arg @(end) @(output) My args are: {@(rep)@arg, @(last)@arg@(end)} @(end)
$ txr args.txr
My args are: {}
$ txr args.txr 1
My args are: {1}
$ txr args.txr 1 2 3
My args are: {1, 2, 3}
@# old-style comment to end of line @; new-style comment to end of line @(bind a ; comment within expression "foo")
In TXR, most directives are conditionals, because they specify some kind of match. Given some directive D, the underlying logic in the language is, roughtly, "if D does not match at the current position in the input, then fail, otherwise the input advances according to the semantics of D".
An easy analogy to regular expressions may be drawn. The regex /abc/ means something like "if a doesn't match, then fail, otherwise consume a character and if b doesn't match, then fail, otherwise consume another character and if c doesn't match, then fail otherwise consume another character and succeed." The expressive power comes from, in part, not having to write all these decisions and book-keeping.
The interesting conditional-like structures in TXR are the parallel directives, which apply separate clauses to the same input, and then integrate the results in various ways.
For instance the choose construct will select, from among those clauses which match successfully, the one which maximizes or minimizes the length of an extracted variable binding:
@(choose :shortest x)
@x:@y
@(or)
@x<--@y
@(or)
@x+@y
@(end)
Suppose the input is something which can match all three patterns in different ways:
foo<--bar:baz+xyzzy
The outcome will be:
x="foo" y="bar:baz+xyzzy"
because this match minimizes the length of x. If we change this to :longest x, we get:
x="foo<--bar:baz" y="xyzzy"
The cases, all and none directives most resemble control structures because they have short-circuiting behavior. For instance:
@(all)
@x:y@
@z<-@w
@(and)
@(output)
We have a match: (x, y, z, w) = (@x, @y, @z, @w).
@(end)
@(end)
If any subclause fails to match, then all stops processing subsequent clauses. There are subtleties though, because an earlier clause can produce variable bindings which are visible to later clauses. If previously bound variable is bound again, it must be to an identical piece of text:
@# match a line which contains some piece of text x
@# after the rightmost occurence of : such that the same piece
@# of text also occurs at the start of the line preceded by -->
@(all)
@*junk:@x
@(and)
-->@x@/.*/
@(end)
$ echo "-->asdfhjig:asdf" | txr weird.txr - junk="-->asdfhjig" x="asdf" $ echo "-->assfhjig:asdf" | txr weird.txr - false $
@(next :args) @(do (defun count-occurrences (haystack needle) (for* ((occurrences 0) (old-pos 0) (new-pos (search-str haystack needle old-pos nil))) (new-pos occurrences) ((inc occurrences) (set old-pos (+ new-pos (length needle))) (set new-pos (search-str haystack needle old-pos nil)))))) @ndl @hay @(output) @(count-occurrences hay ndl) occurrences(s) of @ndl inside @hay @(end)
$ txr count-occurrences.txr "baba" "babababa" 2 occurence(s) of baba inside babababa $ txr count-occurrences.txr "cat" "catapultcatalog" 2 occurence(s) of cat inside catapultcatalog
@(collect) @char,@speech @(end) @(output :filter :to_html) <table> @ (repeat) <tr> <td>@char</td> <td>@speech</td> </tr> @ (end) </table> @(end)
Character,Speech The multitude,The messiah! Show us the messiah! Brians mother,<angry>Now you listen here! He's not the messiah; he's a very naughty boy! Now go away!</angry> The multitude,Who are you? Brians mother,I'm his mother; that's who! The multitude,Behold his mother! Behold his mother!
$ txr csv.txr csv.txt
<table>
<tr>
<td>Character</td>
<td>Speech</td>
</tr>
<tr>
<td>The multitude</td>
<td>The messiah! Show us the messiah!</td>
</tr>
<tr>
<td>Brians mother</td>
<td><angry>Now you listen here! He's not the messiah; he's a very naughty boy! Now go away!</angry></td>
</tr>
<tr>
<td>The multitude</td>
<td>Who are you?</td>
</tr>
<tr>
<td>Brians mother</td>
<td>I'm his mother; that's who!</td>
</tr>
<tr>
<td>The multitude</td>
<td>Behold his mother! Behold his mother!</td>
</tr>
</table>
@(bind a "")
If a is unbound, a binding is created, containing the empty
string. If a is already bound, bind succeeds if
a contains the empty string, and the pattern matching continues at
the next directive. Or else a failure occurs, triggering backtracking behavior.
@(do (defvar *a* "") (if (equal *a* "") (format t "empty string\n")) (set *a* "nonempty") (if (zerop (length *a*)) (format t "guess what?\n")))
TXR can treat the environment vector as text stream:
@(next :env) @(collect) @VAR=@VAL @(end)
The gather directive is useful for extracting multiple items of data from an unordered stream of this kind (not only the environment vector):
@(next :env) @(gather) HOME=@home USER=@user PATH=@path @(end)
What if some of the variables might not exist? Gather has some discipline for that. The following means that three variables are required (the gather construct fails if they are not found), but shell is optional with a default value of /bin/sh if it is not extracted from the data:
@(next :env) @(gather :vars (home user path (shell "/bin/sh"))) HOME=@home USER=@user PATH=@path SHELL=@shell @(end)
On POSIX, environment variables, which are extracted using extern char **environ are assumed to contain UTF-8. On Windows, the GetEnvironmentStringsW function is used to obtain the environment vector as wide character data.
@(defex gorilla ape primate) @(defex monkey primate) @(defex human primate) @(collect) @ (try) @ (cases) gorilla @name @ (throw gorilla name) @ (or) monkey @name @ (throw monkey name) @ (or) human @name @ (throw human name) @ (end)@#cases @ (catch primate (name)) @kind @name @ (output) we have a primate @name of kind @kind @ (end)@#output @ (end)@#try @(end)@#collect
# [TTY] denotes console input; [OUT] denotes output $ txr primates.txr - [TTY]human Harry [TTY]gorilla Gordon [OUT]we have a primate Harry of kind human [TTY]monkey Mike [OUT]we have a primate Gordon of kind gorilla [TTY][Ctrl-D/EOF] [OUT]we have a primate Mike of kind monkey
@(defex u0) @(defex u1) @(define baz (x)) @ (cases) @ (bind x "0") @ (throw u0 "text0") @ (or) @ (bind x "1") @ (throw u1 "text1") @ (end) @(end) @(define bar (x)) @ (baz x) @(end) @(define foo ()) @ (next `!echo "0\n1\n"`) @ (collect) @num @ (try) @ (bar num) @ (catch u0 (arg)) @ (output) caught u0: @arg @ (end) @ (end) @ (end) @(end) @(foo)
$ txr except.txr caught u0: text0 txr: unhandled exception of type u1: txr: ((t . "text1")) Aborted
@(define path (path))@\ @(local x y)@\ @(cases)@\ (@(path x))@(path y)@(bind path `(@x)@y`)@\ @(or)@\ @{x /[.,;'!?][^ \t\f\v]/}@(path y)@(bind path `@x@y`)@\ @(or)@\ @{x /[^ .,;'!?()\t\f\v]/}@(path y)@(bind path `@x@y`)@\ @(or)@\ @(bind path "")@\ @(end)@\ @(end) @(define url (url))@\ @(local proto domain path)@\ @{proto /[A-Za-z]+/}://@{domain /[^ \/\t\f\v]+/}@\ @(cases)/@(path path)@\ @(bind url `@proto://@domain/@path`)@\ @(or)@\ @(bind url `@proto://@domain`)@\ @(end)@\ @(end) @(collect) @ (all) @line @ (and) @ (coll)@(url url)@(end)@(flatten url) @ (end) @(end) @(output) LINE URLS ---------------------- @ (repeat) @line @ (repeat) @url @ (end) @ (end) @(end)
Blah blah http://en.wikipedia.org/wiki/Erich_Kästner_(camera_designer). (Handled by http://mediawiki.org/). Confuse the parser: http://en.wikipedia.org/wiki/-) ftp://domain.name/path(balanced_brackets)/foo.html ftp://domain.name/path(balanced_brackets)/ending.in.dot. ftp://domain.name/path(unbalanced_brackets/ending.in.dot. leading junk ftp://domain.name/path/embedded?punct/uation. leading junk ftp://domain.name/dangling_close_paren)
$ txr url.txr url-data
LINE
URLS
----------------------
Blah blah http://en.wikipedia.org/wiki/Erich_Kästner_(camera_designer). (Handled by http://mediawiki.org/).
http://en.wikipedia.org/wiki/Erich_Kästner_(camera_designer)
http://mediawiki.org/
Confuse the parser: http://en.wikipedia.org/wiki/-)
http://en.wikipedia.org/wiki/-
ftp://domain.name/path(balanced_brackets)/foo.html
ftp://domain.name/path(balanced_brackets)/foo.html
ftp://domain.name/path(balanced_brackets)/ending.in.dot.
ftp://domain.name/path(balanced_brackets)/ending.in.dot
ftp://domain.name/path(unbalanced_brackets/ending.in.dot.
ftp://domain.name/path
leading junk ftp://domain.name/path/embedded?punct/uation.
ftp://domain.name/path/embedded?punct/uation
leading junk ftp://domain.name/dangling_close_paren)
ftp://domain.name/dangling_close_paren
@(bind foo ((1) 2 ((3 4) 5) ((())) (((6))) 7 8 ())) @(bind bar foo) @(flatten bar)
$ txr -a 5 flatten.txr # show variable bindings in array notation to depth 5 foo[0][0]="1" foo[1]="2" foo[2][0][0]="3" foo[2][0][1]="4" foo[2][1]="5" foo[4][0][0][0]="6" foo[5]="7" foo[6]="8" bar[0]="1" bar[1]="2" bar[2]="3" bar[3]="4" bar[4]="5" bar[5]="6" bar[6]="7" bar[7]="8"
In TXR, there are pattern functions which are predicates that perform pattern matching and variable capture. A call to this type of function call can specify unbound variables. If the function succeeds, it can establish bindings for those variables.
Here is how to make a pattern function that multiplies, and call it. To multiply the numbers, we break out of the pattern language and invoke Lisp evaluation: @(* a b).
@(define multiply (a b out)) @(bind out @(* a b)) @(end) @(multiply 3 4 result)
$ txr multiply.txr result="12"
In the embedded Lisp dialect, it is possible to write an ordinary function that returns a value:
@(do (defun mult (a b) (* a b)) (format t "3 * 4 = ~a\n" (mult 3 4)))
$ txr multiply2.txr 3 * 4 = 12
@(next :args) @(collect) @file @(next `@file`) @(freeform) @(coll :gap 0)@notmatch@{match /Goodbye, London!/}@(end)@*tail@/\n/ @(output `@file.tmp`) @(rep)@{notmatch}Hello, New York!@(end)@tail @(end) @(next `!mv @file.tmp @file`) @(output) @(end) @(end)
$ cat foo.txt aaaGoodbye, London!aaa Goodbye, London! $ cat bar.txt aaaGoodbye, London!aaa Goodbye, London! $ txr replace-files.txr foo.txt bar.txt $ cat foo.txt aaaHello, New York!aaa Hello, New York! $ cat bar.txt aaaHello, New York!aaa Hello, New York!
@(bind g @(gcd (expt 2 123) (expt 6 49)))
g="562949953421312"
@(do (defun hailstone (n) (cons n (gen (not (eq n 1)) (set n (if (evenp n) (trunc n 2) (+ (* 3 n) 1))))))) @(next :list @[mapcar* tostring (hailstone 27)]) 27 82 41 124 @(skip) 8 4 2 1 @(eof) @(do (let ((max 0) maxi) (each* ((i (range 1 99999)) (h [mapcar hailstone i]) (len [mapcar* length h])) (if (> len max) (progn (set max len) (set maxi i)))) (format t "longest sequence is ~a for n = ~a\n" max maxi)))
$ txr -l hailstone.txr longest sequence is 351 for n = 77031
@(do (defun hash-from-two (vec1 vec2 . hash-args) (let ((table (hash . hash-args))) (each ((i (range* 0 (length vec1)))) (set [table [vec1 i]] [vec2 i])) table))) @(bind hash @(hash-from-two #(a b c) #(1 2 3))) @(bind (keys vals) @(let (k v) (dohash (key val hash (list k v)) (push key k) (push val v))))
$ txr rosetta/hash-from-two.txr hash="#<hash: 175bc40>" keys[0]="a" keys[1]="b" keys[2]="c" vals[0]="1" vals[1]="2" vals[2]="3"
$ txr -c '@(do (format t "Hello, world!"))' Hello, world!$
#!/usr/bin/txr -f @(maybe) @(bind USER "Unknown User") @(or) @(bind MB "???") @(end) @(output) Dear @USER Your are over your disk quota by @MB megabytes. The Computer @(end)
$ ./quota.txr -DMB=20 Dear Unknown User Your are over your disk quota by 20 megabytes. The Computer $ ./quota.txr -DUSER=Bob Dear Bob Your are over your disk quota by ??? megabytes. The Computer $ ./quota.txr -DUSER=Bob -DMB=15 Dear Bob Your are over your disk quota by 15 megabytes. The Computer
@(bind a @(let ((counter 0)) (mapcar (op list (inc counter)) '(a b c) '(t r s)))) @(output) @ (repeat) @ (rep)@a:@(last)@a@(end) @ (end) @(end)
1:a:t 2:b:r 3:c:s
@(do (defun inc-num-str (str-in) (let ((len (length str-in)) (str (copy-str str-in))) (for ((i (- len 1))) ((>= i 0) `1@str`) ((dec i)) (if (<= (inc [str i]) #\9) (return str) (set [str i] #\0)))))) @(bind a @(inc-num-str "9999")) @(bind b @(inc-num-str "1234"))
$ txr incnum.txr a="10000" b="1235"
@(defex cat animal) @(defex lab dog animal) @(defex collie dog)
@(do (defvar h (hash :equal-based))) @(collect :vars ()) @(coll :vars ())@\ @{letter /[A-Za-z]/}@(filter :upcase letter)@\ @(do (inc [h letter 0]))@\ @(end) @(end) @(do (dohash (key value h) (format t "~a: ~a\n" key value)))
$ txr letterfreq.txr /usr/share/dict/words A: 64123 B: 15524 C: 31569 [ ... abridged ... ] X: 2124 Y: 12507 Z: 3238
$ txr -c '@(bind a ("a" "b" "c")) @(bind b ("A" "B" "C")) @(bind c ("1" "2" "3")) @(output) @ (repeat) @a@b@c @ (end) @(end)' aA1 bB2 cC3
@(do (defun luhn (num) (for ((i 1) (sum 0)) ((not (zerop num)) (zerop (mod sum 10))) ((inc i) (set num (trunc num 10))) (let ((dig (mod num 10))) (if (oddp i) (inc sum dig) (let ((dig2 (* 2 dig))) (inc sum (+ (trunc dig2 10) (mod dig2 10))))))))) @(collect :vars nil) @{ccnumber /[0-9]+/} @(output) @ccnumber -> @(if (luhn (int-str ccnumber 10)) "good" "bad") @(end) @(end)
$ txr luhn.txr luhn.txt 49927398716 -> good 49927398717 -> bad 1234567812345678 -> bad 1234567812345670 -> good
@(bind result @(exptmod 2988348162058574136915891421498819466320163312926952423791023078876139 2351399303373464486466122544523690094744975233415544072992656881240319 (expt 10 40)))
$ txr rosetta/modexp.txr result="1527229998585248450016808958343740453059"
@(next :args) @(coll :gap 0)@(choose :shortest tok)@\ @tok@{sep /==/}@\ @(or)@\ @tok@{sep /!=/}@\ @(or)@\ @tok@{sep /=/}@\ @(end)@(end)@tail @(output) @(rep)"@tok" {@sep} @(end)"@tail" @(end)
$ txr multisplit.txr 'a!===b=!=c'
"a" {!=} "" {==} "b" {=} "" {!=} "c"
$ txr multisplit.txr 'a!===!==!=!==b'
"a" {!=} "" {==} "" {!=} "" {=} "" {!=} "" {!=} "" {=} "b"
$ txr multisplit.txr ''
""
$ txr multisplit.txr 'a'
"a"
$ txr multisplit.txr 'a='
"a" {=} ""
$ txr multisplit.txr '='
"" {=} ""
$ txr multisplit.txr '=='
"" {==} ""
$ txr multisplit.txr '==='
"" {==} "" {=} ""
@(do (defun m (n) (if (zerop n) 0 (- n (f (m (- n 1)))))) (defun f (n) (if (zerop n) 1 (- n (m (f (- n 1)))))) (each ((n (range 0 15))) (format t "f(~s) = ~s; m(~s) = ~s\n" n (f n) n (m n))))
f(0) = 1; m(0) = 0 f(1) = 1; m(1) = 0 f(2) = 2; m(2) = 1 f(3) = 2; m(3) = 2 f(4) = 3; m(4) = 2 f(5) = 3; m(5) = 3 f(6) = 4; m(6) = 4 f(7) = 5; m(7) = 4 f(8) = 5; m(8) = 5 f(9) = 6; m(9) = 6 f(10) = 6; m(10) = 6 f(11) = 7; m(11) = 7 f(12) = 8; m(12) = 7 f(13) = 8; m(13) = 8 f(14) = 9; m(14) = 9 f(15) = 9; m(15) = 9
@(bind my64 "QChuZXh0IDphcmdzKQpAZmlsZW5hbWUKQChuZXh0IGAhc2VkIC1uIC1lICcyLCRwJyBAZmlsZW5hbWUgfCBiYXNlNjRgKQpAKGZyZWVmb3JtICIiKQpAaW42NApAKG5leHQgYEBmaWxlbmFtZWApCkBmaXJzdGxpbmUKQChjYXNlcykKQCAgKGJpbmQgZmlyc3RsaW5lIGBAQChiaW5kIG15NjQgIkBteTY0IilgKQpAICAoYmluZCBpbjY0IG15NjQpCkAgIChiaW5kIHJlc3VsdCAiMSIpCkAob3IpCkAgIChiaW5kIHJlc3VsdCAiMCIpCkAoZW5kKQpAKG91dHB1dCkKQHJlc3VsdApAKGVuZCkK") @(next :args) @filename @(next `!sed -n -e '2,$p' @filename | base64`) @(freeform "") @in64 @(next `@filename`) @firstline @(cases) @ (bind firstline `@@(bind my64 "@my64")`) @ (bind in64 my64) @ (bind result "1") @(or) @ (bind result "0") @(end) @(output) @result @(end)
$ txr narcissist.txr narcissist.txr 1
@(deffilter abbr ("IK" "I know an old lady who swallowed a") ("SW" "She swallowed the") ("SS" "she swallowed") ("CA" "to catch the") ("XX" "Perhaps she'll die") ("C" "cow") ("G" "goat") ("D" "dog") ("T" "cat") ("R" "bird") ("S " "spider ") ("F" "fly")) @(bind lastverse ("IK C" "I don't know how SS the C" "SW C CA G" "SW G CA D" "SW D CA T" "SW T CA R" "SW R CA S" "SW S CA F" "But I don't know why SS that F" "XX" "" "IK horse" "She's alive and well of course!")) @(bind animal_line ("G: Opened her throat and down went the G!" "D: What a hog to swallow a D!" "T: Imagine that! She swallowed a T!" "R: How absurd to swallow a R!" "S: That wriggled and jiggled and tickled inside her" "F: But I don't know why SS the F")) @(define expand_backwards (song lengthened_song done)) @ (local line2 line3 verse rest animal previous_animal previous_animal_verse) @ (next :list song) @ (cases) IK @animal @line2 SW @animal CA @previous_animal @ (maybe) But @(skip)F @ (end) @ (collect) @ verse @ (until) @ (end) @ (collect) @ rest @ (end) @ (next :list animal_line) @ (skip) @previous_animal: @previous_animal_verse @ (output :into lengthened_song) IK @previous_animal @previous_animal_verse @ (repeat) @ verse @ (end) @ (repeat) @ song @ (end) @ (end) @ (bind done nil) @ (or) IK @(skip) @line2 XX @ (bind lengthened_song song) @ (bind done t) @ (end) @(end) @(define expand_song (in out)) @ (local lengthened done) @ (expand_backwards in lengthened done) @ (cases) @ (bind done nil) @ (expand_song lengthened out) @ (or) @ (bind out lengthened) @ (end) @(end) @(expand_song lastverse song) @(output :filter abbr) @ (repeat) @song @ (end) @(end)
@/.*[Aa].*&.*[Bb].*&.*[Cc].*&.*[Dd].*& \ .*[Ee].*&.*[Ff].*&.*[Gg].*&.*[Hh].*& \ .*[Ii].*&.*[Jj].*&.*[Kk].*&.*[Ll].*& \ .*[Mm].*&.*[Nn].*&.*[Oo].*&.*[Pp].*& \ .*[Qq].*&.*[Rr].*&.*[Ss].*&.*[Tt].*& \ .*[Uu].*&.*[Vv].*&.*[Ww].*&.*[Xx].*& \ .*[Yy].*&.*[Zz].*/
$ echo "The quick brown fox jumped over the lazy dog." | txr is-pangram.txr - false $ echo "The quick brown fox jumped over the lazy dogs." | txr is-pangram.txr - $ echo $? # successful termination, no output. 0
@(do (defun randelem (vec) (vecref vec (random nil (length vec))))) @(bind x @(randelem #("a" "b" "c" "d")))
x="b"
@(next :args) @(do (defun power-set (s) (reduce-right (lambda (item ps) (append (mapcar (lambda (e) (cons item e)) ps) ps)) s '(()) nil))) @(collect :vars (arg)) @arg @(end) @(bind pset @(power-set arg)) @(output) @ (repeat) {@{pset ", "}} @ (end) @(end)
$ txr -l rosetta/power-set.txr 1 2 3
{1, 2, 3}
{1, 2}
{1, 3}
{1}
{2, 3}
{2}
{3}
{}
@(next :args) @(do (defun factor (n) (if (> n 1) (for ((max-d (sqrt n)) (d 2)) (t) ((set d (if (evenp d) (+ d 1) (+ d 2)))) (cond ((> d max-d) (return (list n))) ((zerop (mod n d)) (return (cons d (factor (trunc n d)))))))))) @{num /[0-9]+/} @(bind factors @(factor (int-str num 10))) @(output) @num -> {@{factors ", "}} @(end)
$ txr factor.txr 1139423842450982345
1139423842450982345 -> {5, 19, 37, 12782467, 25359769}
$ txr factor.txr 1
1 -> {}
$ txr factor.txr 2
2 -> {2}
$ txr factor.txr 3
3 -> {3}
$ txr factor.txr 2
2 -> {2}
$ txr factor.txr 3
3 -> {3}
$ txr factor.txr 4
4 -> {2, 2}
$ txr factor.txr 5
5 -> {5}
$ txr factor.txr 6
6 -> {2, 3}
@(deffilter me ("ME" "@(bind me "ME") @(output) @@(deffilter me ("ME" "@{me :filter me}")) @{me :filter (me :from_html)} @(end)")) @(bind me "ME") @(output) @@(deffilter me ("ME" "@{me :filter me}")) @{me :filter (me :from_html)} @(end)
@(collect) @ (cases) #@/.*/ @ (or) ;@/.*/ @ (or) @{IDENT /[A-Z_][A-Z_0-9]+/}@/ */ @(bind VAL ("true")) @ (or) @{IDENT /[A-Z_][A-Z_0-9]+/}@(coll)@/ */@{VAL /[^,]+/}@/ */@(end) @ (or) @{IDENT /[A-Z_][A-Z_0-9]+/}@(coll)@/ */@{VAL /[^, ]+/}@/,? */@(end) @(flatten VAL) @ (or) @/ */ @ (or) @ (throw error "bad configuration syntax") @ (end) @(end) @(output) @ (repeat) @IDENT = @(rep)@VAL, @(first){ @VAL, @(last)@VAL };@(single)@VAL;@(end) @ (end) @(end)
# This is a configuration file in standard configuration file format # # Lines begininning with a hash or a semicolon are ignored by the application # program. Blank lines are also ignored by the application program. # The first word on each non comment line is the configuration option. # Remaining words or numbers on the line are configuration parameter # data fields. # Note that configuration option names are not case sensitive. However, # configuration parameter data is case sensitive and the lettercase must # be preserved. # This is a favourite fruit FaVOURITEFRUIT banana # This is a boolean that should be set NEEDSPEELING # This boolean is commented out ; SEEDSREMOVED # How many bananas we have NuMBEROFBANANAS 48 # Option with list OTHER_FAVORITES apple, pear, kwai muk, grapefruit
FAVOURITEFRUIT = banana;
NEEDSPEELING = true;
NUMBEROFBANANAS = 48;
OTHER_FAVORITES = { apple, pear, kwai muk, grapefruit };
@(skip nil 7) @line
@(next "foo.txt") @(freeform) @LINE
TXR features regular expressions in the pattern language. For instance
the syntax @/fo+/ is a directive which means match the regular
expression fo+ (f followed by one or more o's) at the current
position. Variable binding matches can also use regular expressions.
For instance @{a /fo+/} means match the regular expression,
and bind the matching text with variable a.
The following performs stream editing similar to sed -e s/foo/bar/g.
The output section uses a TXR Lisp expression to do the substitution.
@(collect :vars ()) @line @(output) @(regsub line #/foo/ "bar") @(end) @(end)
@(define func (x y z)) @ (bind w "discarded") @ (bind (x y z) ("a" "b" "c")) @(end)
@(deffilter rot13 ("a" "n") ("b" "o") ("c" "p") ("d" "q") ("e" "r") ("f" "s") ("g" "t") ("h" "u") ("i" "v") ("j" "w") ("k" "x") ("l" "y") ("m" "z") ("n" "a") ("o" "b") ("p" "c") ("q" "d") ("r" "e") ("s" "f") ("t" "g") ("u" "h") ("v" "i") ("w" "j") ("x" "k") ("y" "l") ("z" "m") ("A" "N") ("B" "O") ("C" "P") ("D" "Q") ("E" "R") ("F" "S") ("G" "T") ("H" "U") ("I" "V") ("J" "W") ("K" "X") ("L" "Y") ("M" "Z") ("N" "A") ("O" "B") ("P" "C") ("Q" "D") ("R" "E") ("S" "F") ("T" "G") ("U" "H") ("V" "I") ("W" "J") ("X" "K") ("Y" "L") ("Z" "M")) @(collect :vars ()) @line @ (output :filter rot13) @line @ (end) @(end)
@(maybe)@# perhaps this subclause suceeds or not @ (block foo) @ (bind a "a") @ (accept foo) @(end) @(bind b "b")
a="a" b="b"
#!/usr/bin/txr @(next :args) @(cases) @TO @SUBJ @ (maybe) @CC @ (or) @ (bind CC "") @ (end) @(or) @ (throw error "must specify at least To and Subject") @(end) @(next "-") @(collect) @BODY @(end) @(output `!mail -s "@SUBJ" -c "@CC" "@TO"`) @(repeat) @BODY @(end) . @(end)
$ ./sendmail.txr linux-kernel@vger.kernel.org "Patch to rewrite scheduler #378" Here we go again ... [Ctrl-D] $
$ echo 123-456-7890 | txr -c '@a-@b-@c' - a="123" b="456" c="7890"
@(define a (x out)) @ (output) a (@x) called @ (end) @ (bind out x) @(end) @(define b (x out)) @ (output) b (@x) called @ (end) @ (bind out x) @(end) @(define short_circuit_demo (i j)) @ (output) a(@i) and b(@j): @ (end) @ (maybe) @ (a i "1") @ (b j "1") @ (end) @ (output) a(@i) or b(@j): @ (end) @ (cases) @ (a i "1") @ (or) @ (b j "1") @ (or) @ (accept) @ (end) @(end) @(short_circuit_demo "0" "0") @(short_circuit_demo "0" "1") @(short_circuit_demo "1" "0") @(short_circuit_demo "1" "1")
$ txr short-circuit-bool.txr a(0) and b(0): a (0) called a(0) or b(0): a (0) called b (0) called a(0) and b(1): a (0) called a(0) or b(1): a (0) called b (1) called a(1) and b(0): a (1) called b (0) called a(1) or b(0): a (1) called a(1) and b(1): a (1) called b (1) called a(1) or b(1): a (1) called
@(next :args) @### @# soundex-related filters @### @(deffilter remdbl ("AA" "A") ("BB" "B") ("CC" "C") ("DD" "D") ("EE" "E") ("FF" "F") ("GG" "G") ("HH" "H") ("II" "I") ("JJ" "J") ("KK" "K") ("LL" "L") ("MM" "M") ("NN" "N") ("OO" "O") ("PP" "P") ("QQ" "Q") ("RR" "R") ("SS" "S") ("TT" "T") ("UU" "U") ("VV" "V") ("WW" "W") ("XX" "X") ("YY" "Y") ("ZZ" "Z")) @(deffilter code ("B" "F" "P" "V" "1") ("C" "G" "J" "K" "Q" "S" "X" "Z" "2") ("D" "T" "3") ("L" "4") ("M" "N" "5") ("R" "6") ("A" "E" "I" "O" "U" "Y" "0") ("H" "W" "")) @(deffilter squeeze ("11" "111" "1111" "11111" "1") ("22" "222" "2222" "22222" "2") ("33" "333" "3333" "33333" "3") ("44" "444" "4444" "44444" "4") ("55" "555" "5555" "55555" "5") ("66" "666" "6666" "66666" "6")) @(bind prefix ("VAN" "CON" "DE" "DI" "LA" "LE")) @(deffilter remzero ("0" "")) @### @# soundex function @### @(define soundex (in out)) @ (local nodouble letters remainder first rest coded) @ (next :string in) @ (coll)@{letters /[A-Za-z]+/}@(end) @ (cat letters "") @ (output :into nodouble :filter (:upcase remdbl)) @letters @ (end) @ (next :list nodouble) @ (maybe) @prefix@remainder @ (output :into nodouble) @nodouble @remainder @ (end) @ (end) @ (next :list nodouble) @ (collect) @{first 1}@rest @ (output :filter (code squeeze remzero) :into coded) @{rest}000 @ (end) @ (next :list coded) @{digits 3}@(skip) @ (end) @ (output :into out) @ (rep):@first@digits@(first)@first@digits@(end) @ (end) @ (cat out) @(end) @### @# process arguments and list soundex codes @### @(collect :vars ()) @input @ (output :filter (:fun soundex)) @input @ (end) @(end) @### @# compare first and second argument under soundex @### @(bind (first_arg second_arg . rest_args) input) @(cases) @ (bind first_arg second_arg :filter (:fun soundex)) @ (output) "@first_arg" and "@second_arg" match under soundex @ (end) @(end)
$ txr soundex.txr example soundex Lloyd lee guttierez o\'hara vandeusen dimeola E251 E251 S532 L300 L000 G362 O600 V532:D250 D540:M400 "example" and "egsampul" match under soundex
@(next :args) @(do (defun get-code (c) (cond ((memq c '(#\B #\F #\P #\V)) #\1) ((memq c '(#\C #\G #\J #\K #\Q #\S #\X #\Z)) #\2) ((memq c '(#\D #\T)) #\3) ((eq c #\L) #\4) ((memq c '(#\M #\N)) #\5) ((eq c #\R) #\6))) (defun soundex (s) (if (zerop (length s)) "" (let* ((su (upcase-str s)) (o [su 0])) (each* ((i (range* 1 (length su))) (cg (mapcar* (op get-code [su @1]) i)) (cp (cons #\Z cg))) (if (and cg (not (eql cg cp))) (set o `@o@cg`))) [`@{o}000` 0..4])))) @(collect) @arg @ (output) @arg -> @(soundex arg) @ (end) @(end)
$ ./txr soundex-lisp.txr soundex sowndex soundex -> S532 sowndex -> S532
(set ...) is a Lisp syntax which corresponds to
the regex [...] notation. Inside this syntax, single characters
like [abc] are represented using character objects as
in (set #\a #\b #\c). Ranges like [a-zA-Z] are
written as dotted pairs (cons cells): (set (#\a . #\z) (#\A . #\Z)).
@(next :args) @arg1 @arg2 @(do (defun strip-chars (str chars) (let* ((regex-source '(set ,*(list-str chars))) (regex (regex-compile regex-source))) (regsub regex "" str)))) @(bind result @(strip-chars arg1 arg2))
$ txr strip.txr "she was a soul stripper. she stole my heart." "aei" arg1="she was a soul stripper. she stole my heart." arg2="aei" result="sh ws soul strppr. sh stol my hrt."
@(define trim_left (in out)) @ (next :list in) @/[ \t]*/@out @(end) @(define trim_right (in out)) @ (local blanks middle) @ (next :list in) @ (cases) @ {blanks /[ \t]*/}@middle@/[\t ]+/ @ (bind out `@blanks@middle`) @ (or) @ out @ (end) @(end) @line_of_input @(output) trim-left: [@{line_of_input :filter (:fun trim_left)}] trim_right: [@{line_of_input :filter (:fun trim_right)}] trim_both: [@{line_of_input :filter ((:fun trim_left) (:fun trim_right))}] @(end)
$ echo "" | txr trim.txr - trim-left: [] trim_right: [] trim_both: [] $ echo "a" | txr trim.txr - trim-left: [a] trim_right: [a] trim_both: [a] $ echo " a" | txr trim.txr - trim-left: [a] trim_right: [ a] trim_both: [a] $ echo " a " | txr trim.txr - trim-left: [a ] trim_right: [ a] trim_both: [a] $ echo " a b " | txr trim.txr - trim-left: [a b ] trim_right: [ a b] trim_both: [a b]
@(next :list "Hello,How,Are,You,Today") @(coll)@{token /[^,]+/}@(end) @(cat token ".") @(output) @token @(end)
@{TITLE /[あ-ん一-耙]+/} (@ROMAJI/@ENGLISH) @(freeform) @(coll)@{STANZA /[^\n\x3000 ]+/}@(end)@/.*/
春が来た (Haru-ga Kita/Spring has Come) 春が来た 春が来た どこに来た 山に来た 里に来た 野にも来た 花が咲く 花が咲く どこに咲く 山に咲く 里に咲く 野にも咲く 鳥がなく 鳥がなく どこでなく 山でなく 里でなく 野でもなく
TITLE="春が来た" ROMAJI="Haru-ga Kita" ENGLISH="Spring has Come" STANZA[0]="春が来た" STANZA[1]="春が来た" STANZA[2]="どこに来た" STANZA[3]="山に来た" STANZA[4]="里に来た" STANZA[5]="野にも来た" STANZA[6]="花が咲く" STANZA[7]="花が咲く" STANZA[8]="どこに咲く" STANZA[9]="山に咲く" STANZA[10]="里に咲く" STANZA[11]="野にも咲く" STANZA[12]="鳥がなく" STANZA[13]="鳥がなく" STANZA[14]="どこでなく" STANZA[15]="山でなく" STANZA[16]="里でなく" STANZA[17]="野でもなく"
@(next :args) @configfile @(maybe) @ (next configfile) @ (collect :vars (config)) @config @ (end) @(end) @(collect) @ (cases) @option= @ (output :into new_opt_line :filter :upcase) ; @option @ (end) @ (or) @option=@val @ (output :into new_opt_line :filter :upcase) @option @val @ (end) @ (or) @option @ (output :into new_opt_line :filter :upcase) @option @ (end) @ (end) @ (next :var config) @ (local new_config) @ (bind new_config ()) @ (collect :vars ((opt_there ""))) @ (block) @ (cases) @ (cases) @{line /[ \t]*/} @ (or) @{line /#.*/} @ (end) @ (output :append :into new_config) @line @ (end) @ (accept) @ (or) @ (maybe) ; @opt_there @ (or) @opt_there @(skip) @ (or) @opt_there @ (or) @original_line @ (end) @ (end) @ (cases) @ (bind opt_there option :filter :upcase) @ (output :append :into new_config) @new_opt_line @ (end) @ (or) @ (output :append :into new_config) @original_line @ (end) @ (end) @ (end) @ (cases) @ (bind opt_there option :filter :upcase) @ (or) @ (output :append :into new_config) @new_opt_line @ (end) @ (end) @ (set config new_config) @(end) @(output) @ (repeat) @config @ (end) @(end)
# This is a configuration file in standard configuration file format # # Lines begininning with a hash or a semicolon are ignored by the application # program. Blank lines are also ignored by the application program. # The first word on each non comment line is the configuration option. # Remaining words or numbers on the line are configuration parameter # data fields. # Note that configuration option names are not case sensitive. However, # configuration parameter data is case sensitive and the lettercase must # be preserved. # This is a favourite fruit FaVOURITEFRUIT banana # This is a boolean that should be set NEEDSPEELING # This boolean is commented out ; SEEDSREMOVED # How many bananas we have NuMBEROFBANANAS 48
$ txr configfile.txr configfile NEEDSPEELING= seedsREMOVED NUMBEROFBANANAS=1024 NUMBEROFSTRAWBERRIES=62000 # This is a configuration file in standard configuration file format # # Lines begininning with a hash or a semicolon are ignored by the application # program. Blank lines are also ignored by the application program. # The first word on each non comment line is the configuration option. # Remaining words or numbers on the line are configuration parameter # data fields. # Note that configuration option names are not case sensitive. However, # configuration parameter data is case sensitive and the lettercase must # be preserved. # This is a favourite fruit FAVOURITEFRUIT banana # This is a boolean that should be set ; NEEDSPEELING # This boolean is commented out SEEDSREMOVED # How many bananas we have NUMBEROFBANANAS 1024 NUMBEROFSTRAWBERRIES 62000
@(cases) hey @a how are you @(or) hey @b long time no see @(end)
@(next :args) @(do (defun letter-mod26-op (func) ;; add or subtract capital letters modulo 26 (lambda (a b) (+ #\A (mod (call func (- a #\A) (- b #\A)) 26)))) (defun vig (msg key encrypt) (cat-str (mapcar (letter-mod26-op (if encrypt (fun +) (fun -))) (list-str msg) (repeat (list-str key))) ""))) @(coll)@{key /[A-Za-z]/}@(end) @(coll)@{msg /[A-Za-z]/}@(end) @(cat key "") @(filter :upcase key) @(cat msg "") @(filter :upcase msg) @(bind encoded @(vig msg key t)) @(bind decoded @(vig msg key nil)) @(bind check @(vig encoded key nil)) @(output) text: @msg key: @key enc: @encoded dec: @decoded check: @check @(end)
$ ./txr vigenere.txr 'vigenere cipher' 'Beware the Jabberwock... The jaws that... the claws that catch!' text: BEWARETHEJABBERWOCKTHEJAWSTHATTHECLAWSTHATCATCH key: VIGENERECIPHER enc: WMCEEIKLGRPIFVMEUGXXYILILZXYVBZLRGCEYAIOEKXIZGU dec: GWQWEACDCBLUXNWOIYXPQAHSHLPQFLNDRYUWUKEAWCHSNYU check: BEWARETHEJABBERWOCKTHEJAWSTHATTHECLAWSTHATCATCH
@(next `!wget -c http://tycho.usno.navy.mil/cgi-bin/timer.pl -O - 2> /dev/null`) <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final"//EN> <html> <body> <TITLE>What time is it?</TITLE> <H2> US Naval Observatory Master Clock Time</H2> <H3><PRE> @(collect :vars (MO DD HH MM SS (PM " ") TZ TZNAME)) <BR>@MO. @DD, @HH:@MM:@SS @(maybe)@{PM /PM/} @(end)@TZ@/\t+/@TZNAME @ (until) </PRE>@/.*/ @(end) </PRE></H3><P><A HREF="http://www.usno.navy.mil"> US Naval Observatory</A> </body></html> @(output) @ (repeat) @MO-@DD @HH:@MM:@SS @PM @TZ @ (end) @(end)
$ txr navytime.txr Nov-22 22:49:41 UTC Nov-22 05:49:41 PM EST Nov-22 04:49:41 PM CST Nov-22 03:49:41 PM MST Nov-22 02:49:41 PM PST Nov-22 01:49:41 PM AKST Nov-22 12:49:41 PM HAST $ txr navytime.txr Nov-22 22:49:41 UTC Nov-22 05:49:41 PM EST Nov-22 04:49:41 PM CST Nov-22 03:49:41 PM MST Nov-22 02:49:41 PM PST Nov-22 01:49:41 PM AKST Nov-22 12:49:41 PM HAST
@(next `!wget -c http://tycho.usno.navy.mil/cgi-bin/timer.pl -O - 2> /dev/null`) @(skip) <BR>@time@\ UTC@(skip) @(output) @time @(end)
<Students> @(collect :vars (NAME GENDER YEAR MONTH DAY (PET_TYPE "none") (PET_NAME ""))) @ (cases) <Student Name="@NAME" Gender="@GENDER" DateOfBirth="@YEAR-@MONTH-@DAY"@(skip) @ (or) <Student DateOfBirth="@YEAR-@MONTH-@DAY" Gender="@GENDER" Name="@NAME"@(skip) @ (end) @ (maybe) <Pet Type="@PET_TYPE" Name="@PET_NAME" /> @ (end) @(until) </Students> @(end) @(output :filter :from_html) NAME G DOB PET @ (repeat) @{NAME 12} @GENDER @YEAR-@MONTH-@DAY @PET_TYPE @PET_NAME @ (end) @(end)
<Students>
<Student Name="April" Gender="F" DateOfBirth="1989-01-02" />
<Student Name="Bob" Gender="M" DateOfBirth="1990-03-04" />
<Student Name="Chad" Gender="M" DateOfBirth="1991-05-06" />
<Student Name="Dave" Gender="M" DateOfBirth="1992-07-08">
<Pet Type="dog" Name="Rover" />
</Student>
<Student DateOfBirth="1993-09-10" Gender="F" Name="Émily" />
</Students>
$ txr students.txr students.xml NAME G DOB PET April F 1989-01-02 none Bob M 1990-03-04 none Chad M 1991-05-06 none Dave M 1992-07-08 dog Rover Émily F 1993-09-10 none
#!/usr/bin/txr -f @(next :args) @(cases) @ QUERY @ PAGE @(or) @ (throw error "specify query and page# (from zero)") @(end) @(next `!wget -O - http://search.yahoo.com/search?p=@QUERY\&b=@{PAGE}1 2> /dev/null`) @(all) @ (coll)<a id="@(skip)" class="yschttl spt" href="@URL" @/[^>]+/>@TITLE</a>@(end) @(and) @ (coll)<div class="@/abstr|sm-abs/">@ABSTR</div>@(end) @(end) @(output) @ (repeat) TITLE: @TITLE URL: @URL TEXT: @ABSTR --- @ (end) @(end)
$ ./yahoosearch.txr rosetta 0
TITLE: <b>Rosetta</b> | Partner With Our Interactive <wbr />Marketing Agency Today
URL: http://www.rosetta.com/Pages/default.aspx
TEXT: Learn about the fastest growing interactive marketing agency in the country - <b>Rosetta</b>. Our strategic marketing planning is custom built and connects you with your ...
---
TITLE: Official <b>Rosetta</b> Stone® - Learn a <wbr />Language Online - Language ...
URL: http://www.rosettastone.com/
TEXT: <b>Rosetta</b> Stone is the world's #1 language-learning software. Our comprehensive foreign language program provides language learning for individuals and language learning ...
---
TITLE: <b>Rosetta</b> (software) - Wikipedia, the <wbr />free encyclopedia
URL: http://en.wikipedia.org/wiki/Rosetta_(software)
TEXT: Rosettais a lightweight dynamic translatorfor Mac OS Xdistributed by Apple. It enabled applications compiled for the PowerPCfamily of processors to run on Apple systems that use...
---
TITLE: <b>Rosetta</b> (spacecraft) - Wikipedia, the <wbr />free encyclopedia
URL: http://en.wikipedia.org/wiki/Rosetta_space_probe
TEXT: Rosettais a robotic spacecraftof the European Space Agencyon a mission to study the comet 67P/ChuryumovâGerasimenko. <b>Rosetta </b>consists of two main elements: the <b>Rosetta </b>space probeand...
---
TITLE: Apple - Mac
URL: http://www.apple.com/mac/
TEXT: Discover the world of Mac. Check out MacBook, iMac, iLife, and more. Download QuickTime, Safari, and widgets for free.
---
TITLE: <b>Rosetta</b> | Free Music, Tour Dates, <wbr />Photos, Videos
URL: http://www.myspace.com/rosetta
TEXT: <b>Rosetta</b>'s official profile including the latest music, albums, songs, music videos and more updates.
---
TITLE: <b>Rosetta</b>
URL: http://rosettaband.com/
TEXT: Metal for astronauts. Philadelphia, since 2003. Contact us at rosettaband@gmail.com Twitter | Facebook
---
TITLE: <b>Rosetta</b>
URL: http://rosetta.jpl.nasa.gov/
TEXT: The <b>Rosetta</b> spacecraft is on its way to catch and land a robot on a comet! <b>Rosetta</b> will reach comet '67P/Churyumov-Gerasimenko' ('C-G') in 2014. The European Space Agency ...
---
TITLE: <b>Rosetta</b> : Multi-script Typography
URL: http://rosettatype.com/
TEXT: <b>Rosetta</b> is a new independent foundry with a strong focus on multi-script typography. We are committed to promote research and knowledge in that area and to support ...
---
TITLE: <b>Rosetta</b> (1999) - IMDb
URL: http://www.imdb.com/title/tt0200071/
TEXT: With Ãmilie Dequenne, Fabrizio Rongione, Anne Yernaux, Olivier Gourmet. Young and impulsive <b>Rosetta</b> lives with her alcoholic mother and, moved by despair, she will ...
---