[ { "path": "COPYING", "content": "PicoLisp Copyright (c) Software Lab. Alexander Burger\n\nPermission is hereby granted, free of charge, to any person obtaining a\ncopy of this software and associated documentation files (the\n\"Software\"), to deal in the Software without restriction, including\nwithout limitation the rights to use, copy, modify, merge, publish,\ndistribute, sublicense, and/or sell copies of the Software, and to\npermit persons to whom the Software is furnished to do so, subject to\nthe following conditions:\n\nThe above copyright notice and this permission notice shall be included\nin all copies or substantial portions of the Software.\n\nTHE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS\nOR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF\nMERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.\nIN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY\nCLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,\nTORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE\nSOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.\n" }, { "path": "INSTALL", "content": "# 23jan26 Software Lab. Alexander Burger\n\n\n PicoLisp Installation\n =====================\n\n\nPicoLisp needs a POSIX compatible system and the LLVM infrastructure. It\nsupports two installation strategies: Local and Global.\n\nFor a global installation, allowing system-wide access to the executable\nand library/documentation files, you can either install it from a\nready-made distribution, or set some symbolic links to one of the local\ninstallation directories as described below.\n\nNote that you are still free to have local installations along with a\nglobal installation, and invoke them explicitly as desired.\n\n\n Local Installation\n ------------------\n\nThe following instructions work on Debian Linux. They should be similar\non other systems (for e.g. MacOS see src/Makefile.macos).\n\n1. Install required packages\n\n $ sudo apt install binutils make clang llvm libreadline-dev libffi-dev libssl-dev pkg-config\n\n2. Unpack the tarball\n\n $ wget https://software-lab.de/pil21.tgz\n $ tar xfz pil21.tgz\n\n3. Change the directory\n\n $ cd pil21\n\n4. Compile the PicoLisp interpreter\n\n $ (cd src; make)\n\n\n Global Installation\n -------------------\n\nThe recommended way for a global installation is to use a picolisp\npackage from the OS distribution.\n\nIf that is not available, you can (as root) create symbolic links from\n/usr/lib and /usr/bin to a local installation directory:\n\n # ln -s //pil21 /usr/lib/picolisp\n # ln -s /usr/lib/picolisp/bin/picolisp /usr/bin\n # ln -s /usr/lib/picolisp/bin/pil /usr/bin\n\nFor additional access to the man pages, utilities and bash completion:\n\n # ln -s //pil21/man/man1/picolisp.1 /usr/share/man/man1\n # ln -s //pil21/man/man1/pil.1 /usr/share/man/man1\n # ln -s //pil21 /usr/share/picolisp\n # ln -s //pil21/lib/bash_completion /usr/share/bash-completion/completions/pil\n\n\n Invocation\n ----------\n\nIn a global installation, the 'pil' command should be used. You can\neither start in plain or in debug mode. The difference is that for debug\nmode the command is followed by single plus ('+') sign. The '+' must be\nthe very last argument on the command line.\n\n $ pil # Plain mode\n :\n\n $ pil + # Debug mode\n :\n\nIn both cases, the colon ':' is PicoLisp's prompt. You may enter some\nLisp expression,\n\n : (+ 1 2 3)\n -> 6\n\nTo exit the interpreter, enter\n\n : (bye)\n\nor just type Ctrl-D.\n\n\nFor a local invocation, specify a path name, e.g.\n\n $ ./pil # Plain mode\n :\n\n $ ./pil + # Debug mode\n :\n\nor\n\n $ /home/app/pil # Invoking a local installation from some other directory\n\nNote that 'pil' can also serve as a template for your own stand-alone\nscripts.\n\n\n Documentation\n -------------\n\nFor further information, please look at \"doc/index.html\". There you find\nthe PicoLisp Reference Manual (\"doc/ref.html\"), the PicoLisp tutorial\n(\"doc/tut.html\"), and the frequently asked questions (\"doc/faq.html\").\n\nAs always, the most accurate and complete documentation is the source\ncode ;-)\n\nAny feedback is welcome!\nHope you enjoy :-)\n\n--------------------------------------------------------------------------------\n\n Alexander Burger\n Software Lab. / 7fach GmbH\n Bahnhofstr. 24a, D-86462 Langweid\n abu@software-lab.de, https://www.software-lab.de, +49 8230 5060\n" }, { "path": "README", "content": "# 05nov25 Software Lab. Alexander Burger\n\n Perfection is attained\n not when there is nothing left to add\n but when there is nothing left to take away\n (Antoine de Saint-Exupery)\n\n The PicoLisp System\n ===================\n\n _PI_co Lisp is not _CO_mmon Lisp\n\nPicoLisp can be viewed from two different aspects: As a general purpose\nprogramming language, and a dedicated application server framework.\n\n\n(1) As a programming language, PicoLisp provides a 1-to-1 mapping of a\nclean and powerful Lisp derivate, to a simple and efficient virtual\nmachine. It supports persistent objects as a first class data type,\nresulting in a database system of Entity/Relation classes and a\nProlog-like query language tightly integrated into the system.\n\nThe virtual machine was designed to be\n\n Simple\n The internal data structure should be as simple as possible. Only\n one single data structure is used to build all higher level\n constructs.\n Unlimited\n There are no limits imposed upon the language due to limitations\n of the virtual machine architecture. That is, there is no upper\n bound in symbol name length, number digit counts, or data\n structure and buffer sizes, except for the total memory size of\n the host machine.\n Dynamic\n Behavior should be as dynamic as possible (\"run\"-time vs.\n \"compile\"-time). All decisions are delayed till runtime where\n possible. This involves matters like memory management, dynamic\n symbol binding, and late method binding.\n Practical\n PicoLisp is not just a toy of theoretical value. PicoLisp is used\n since 1988 in actual application development, research and\n production.\n\nThe language inherits the major advantages of classical Lisp systems\nlike\n\n * Dynamic data types and structures\n * Formal equivalence of code and data\n * Functional programming style\n * An interactive environment\n\nPicoLisp is very different from any other Lisp dialect. This is partly\ndue to the above design principles, and partly due to its long\ndevelopment history since 1984.\n\nYou can download the latest release version at\n\n https://software-lab.de/pil21.tgz\n\n\n(2) As an application server framework, PicoLisp provides for\n\n NoSQL Database Management\n Index trees\n Object local indexes\n Entity/Relation classes\n Pilog (PicoLisp Prolog) queries\n Multi-user synchronization\n DB Garbage collection\n Journaling, Replication\n User Interface\n Browser GUI\n (X)HTML/CSS\n XMLHttpRequest/JavaScript\n Application Server\n Process management\n Process family communication\n XML I/O\n Import/export\n User administration\n Internationalization\n Security\n Object linkage\n Postscript/Printing\n\nPicoLisp is not an IDE. All program development in Software Lab. is done\nusing the console, bash, vip (vi-style editor) and the Lisp interpreter.\n\nThe only type of GUI supported for applications is through a browser via\nHTML. This makes the client side completely platform independent. The\nGUI is created dynamically. Though it uses JavaScript and XMLHttpRequest\nfor speed improvements, it is fully functional also without JavaScript\nor CSS.\n\nThe GUI is deeply integrated with - and generated dynamically from - the\napplication's data model. Because the application logic runs on the\nserver, multiple users can view and modify the same database object\nwithout conflicts, everyone seeing changes done by other users on her\nscreen immediately due to the internal process and database\nsynchronization.\n\nPicoLisp is free software, and you are welcome to use and redistribute\nit under the conditions of the MIT/X11 License (see \"COPYING\").\n\nIt is based on LLVM and compiles and runs on any 64-bit POSIX system.\n\n--------------------------------------------------------------------------------\n\n Alexander Burger\n Software Lab. / 7fach GmbH\n Bahnhofstr. 24a, D-86462 Langweid\n abu@software-lab.de, http://www.software-lab.de\n" }, { "path": "bin/pil", "content": "#!/usr/bin/picolisp /usr/lib/picolisp/lib.l\n(load \"@lib/net.l\" \"@lib/misc.l\" \"@lib/btree.l\" \"@lib/db.l\" \"@lib/pilog.l\")\n\n`*Dbg\n(docs \"@doc/\")\n" }, { "path": "bin/psh", "content": "#!/usr/bin/pil\n# 06aug24 Software Lab. Alexander Burger\n\n(load \"@lib/net.l\" \"@lib/misc.l\" \"@lib/http.l\")\n\n(let Arg (opt)\n (client \"localhost\"\n (or\n (format Arg)\n (client \"localhost\" 80 (pack Arg \"/!psh\") (read)) )\n (pack (opt) \"!psh?\"\n (pw) \"&\"\n (in '(\"tty\") (line T)) \"&\"\n (sys \"TERM\") )\n (ctty (read))\n (line)\n (line) ) )\n(bye)\n" }, { "path": "bin/pty", "content": "#!/usr/bin/pil\n# 05jul24abu\n# Pseudo Terminal (PilBox)\n# pty [host] [flg]\n\n(load \"@lib/term.l\")\n\n(setq\n *Host (or (opt) \"localhost\")\n *Port 8081 ) # Sync with ~/Port in PilBox\n\n(unless (setq *Sock (connect *Host (inc *Port)))\n (bye) )\n\n(out *Sock\n (in \"~/.pty\" (echo)) # Sync with ~/.pty in PilBox\n (prinl) )\n(in *Sock (rd 2)) # Skip \"\\r\\n\"\n\n(finish (prinl))\n\n(de sendCmd @\n (udp *Host `(inc *Port)\n (cons (in \"~/.pty\" (line T)) (rest)) ) )\n\n(unless (opt)\n (task (port (+ *Port 2))\n (let? S (accept @)\n (catch '(NIL)\n (in S\n (when (= (rd) (in \"~/.pty\" (line T)))\n (let Z (tmp \"pty.zip\")\n (casq (rd)\n (+\n (apply call (rd) \"zip\" \"-r\" Z)\n (in Z (out S (echo))) )\n (-\n (out Z (echo))\n (call \"unzip\" \"-o\" Z) ) ) ) ) )\n (off *Msg) )\n (close S)\n (and *Msg (prinl @)) ) ) )\n\n(when (getTerm)\n (sendCmd\n (cons 'setTerm (sys \"TERM\") @)\n '(off *Err) )\n (de *Winch\n (sendCmd (cons 'setTerm (sys \"TERM\") (getTerm))) ) )\n\n(raw T)\n(call \"stty\" \"intr\" NIL)\n\n(task *Sock\n (in @\n (ifn (rd 1)\n (bye)\n (wr @)\n (flush) ) ) )\n\n(loop\n (and (key) (out *Sock (prin @))) )\n" }, { "path": "bin/vip", "content": "#!/usr/bin/picolisp /usr/lib/picolisp/lib.l\n# 30apr26abu\n\n(unless *Dbg\n (load \"@lib/vip.l\") )\n\n(stack 1024)\n\n(bye\n (if\n (vip~vi ## [+ | +[]] [+[]] ..\n (make\n (while (opt)\n (let (S @ L (chop S))\n (cond\n ((pre? \"+\" S)\n (link\n (cond\n ((format S) (cons @ (opt)))\n ((= \"+\" S) (cons T (opt)))\n ((get (any (cdr L)) '*Dbg 1)\n (symbols (cddr @))\n (cons (car @) (cadr @)) )\n (T (cons (cdr L) (opt))) ) ) )\n ((pre? \"-\" S) (load S))\n (T (link S)) ) ) ) ) )\n 0\n 1 ) )\n" }, { "path": "bin/watchdog", "content": "#!/usr/bin/pil\n# 13apr23 Software Lab. Alexander Burger\n# Use: bin/watchdog ..\n\n(load \"@lib/misc.l\")\n\n# *MailHost *MailPort *MailFrom *MailTo *Watch\n\n(argv *MailHost *MailPort *MailFrom . *MailTo)\n(setq *MailPort (format *MailPort))\n\n(unless (call 'test \"-p\" \"fifo/beat\")\n (call 'mkdir \"-p\" \"fifo\")\n (call 'rm \"-f\" \"fifo/beat\")\n (call 'mkfifo \"fifo/beat\") )\n\n(finish (call 'rm \"fifo/beat\"))\n\n(de *Err\n (prin (stamp))\n (space)\n (println *Watch) )\n\n(task (open \"fifo/beat\")\n (in @\n (let X (rd)\n (cond\n ((not X) (bye))\n ((num? X)\n (let? W (assoc X *Watch)\n (when (caddr W)\n (msg (car W) \" \" (stamp) \" bye\") )\n (del W '*Watch) ) )\n ((atom X) # bin/picolisp -\"out 'fifo/beat (pr '$(tty))\" -bye\n (let D (+ (* 86400 (date T)) (time T))\n (out X\n (for W *Watch\n (prinl\n (align 7 (car W))\n \" \"\n (- (cadr W) D)\n \" \"\n (or (caddr W) \"o\")\n \" \"\n (cdddr W) ) ) ) ) )\n ((assoc (car X) *Watch) # X = (Pid Tim . Any)\n (let W @ # W = (Pid Tim Flg . Any)\n (when (caddr W)\n (msg (car W) \" \" (stamp) \" resumed\") )\n (set (cdr W) (cadr X))\n (set (cddr W))\n (con (cddr W) (or (cddr X) (cdddr W))) ) )\n (T (push '*Watch (list (car X) (cadr X) NIL (cddr X)))) ) ) ) )\n\n(task -54321 54321\n (let D (+ (* 86400 (date T)) (time T))\n (for W *Watch\n (cond\n ((>= (cadr W) D))\n ((caddr W)\n (msg (car W) \" \" (stamp)\n (if (kill (car W) 15) \" killed\" \" gone\") )\n (del W '*Watch) )\n (T\n (inc (cdr W) 3600)\n (set (cddr W) T)\n (let Sub (pack \"Timeout \" (car W) \" \" (cdddr W))\n (msg (car W) \" \" (stamp))\n (unless (mail *MailHost *MailPort *MailFrom *MailTo Sub)\n (msg (cons Sub *MailTo) \" mail failed \" (stamp)) ) ) ) ) ) ) )\n\n(wait)\n" }, { "path": "doc/ChangeLog", "content": "26.4.30\n Re-introduce 'any' (for '+' arguments)\n bin/vip\n\n26.4.24\n Check 'format' before 'get' (Bruno)\n bin/vip\n\n26.4.12\n Bug in 'aux' for hooks (Andreas Rüegger)\n lib/db.l\n\n26.4.5\n Use level 2 in 'not' rule\n lib/pilog.l\n\n26.4.4\n ESC terminates '?'\n doc/ref.html\n\n26.3.31\n Call 'dbFetch' also in 'prove'\n src/subr.l\n\n26.3.29\n Minor comma\n doc/refP.html\n\n####### 26.3 #######\n26.3.26\n Remove \".\" after content and show whole week\n lib/vip/cal.rc.l\n\n26.3.21\n 'for' takes 'cnt', not 'num'\n doc/refF.html\n\n26.3.17\n Use separate '$InChar' and '$OutChar' instead of '$IoChar'\n src/glob.l\n src/io.l\n\n26.3.13\n Force 'touch *.ll' if bootstrapping\n src/Makefile\n\n26.2.28\n Show terminating \".\" after content\n lib/vip/cal.rc.l\n\n26.2.20\n Remove '+Init' from radio button in 'bagBag'\n lib/form.l\n\n26.1.23\n Fix MacOS build (Mike Pechkin, Andreas Hauser)\n INSTALL\n src/Makefile.macos\n\n26.1.19\n Restore \"Constant Data\" section from 22.5.29\n doc/native.html\n\n26.1.13\n 'iter>' for '+List' to set '*Iter+'\n lib/db.l\n Remove \"lib/android.l\" from distribution (is kept in PilBox)\n\n26.1.12\n Define PROT_READ, PROT_WRITE, MAP_SHARED and MAP_FAILED\n Define \"domainSock\" (AF_UNIX domain sockets)\n src/sysdefs.c\n\n26.1.3\n GET and POST restriction was removed jul23\n doc/httpGate.html\n\n26.1.2\n Fix alphabetic order\n doc/refC.html\n\n26.1.1\n Bug in 'dirname' for \"/\"\n lib/misc.l\n test/lib/misc.l\n\n####### 25.12 #######\n25.12.21\n Vip \":cal\" (calendar) command\n doc/viprc.sample\n New file\n lib/vip/cal.rc.l\n\n25.12.14\n Namespace specification \"ap~\" not needed\n doc/search.html\n\n25.12.11\n 'scratch' returns buffer\n lib/vip.l\n\n25.12.9\n Rename 'shift' to 'shiftN'\n Refactor 'patMatch' to (search> . +Buffer)\n lib/vip.l\n 'this' function\n src/glob.l\n src/flow.l\n doc/ref.html\n doc/refT.html\n doc/refW.html\n lib/sq.l\n lib/vip.l\n lib/simul.l\n 'keys' function\n lib/vip.l\n\n25.12.8\n Support initial key sequence in \"# VIP \" header\n lib/vip.l\n\n25.12.7\n Check for buffer-local command mappings\n lib/vip.l\n\n25.12.6\n Inherit window methods when split\n 'status>' continued\n 'drawin' function\n lib/vip.l\n\n25.12.5\n Fix 'any1' and 'any2' for 'init', 'iter' and 'scan'\n doc/refI.html\n doc/refS.html\n 'status>' method for '+Window'\n lib/vip.l\n\n25.12.4\n 'delBuf' function\n lib/vip.l\n\n25.12.3\n Check for buffer-local key mappings\n lib/vip.l\n\n25.12.1\n Revert res_init() from 25.11.29\n src/ssl.c\n\n25.11.30\n Decode \"%21\", and handle multple header values (Mansur Mamkin)\n lib/http.l\n\n25.11.29\n Reinitialize resolver before getaddrinfo()\n src/ssl.c\n\n25.11.26\n Pointer casts for bufFloat() and bufDouble()\n src/main.l\n\n25.11.22\n Typo\n loc/RU.l\n\n25.11.21\n Add (val> . +Swap/R)\n lib/form.l\n\n25.11.20\n Handle swap symbol replacement in '+Swap'\n lib/db.l\n (val> . +Swp) not needed\n lib/form.l\n\n25.11.14\n \"%\" also matches braces \"{\" and \"}\"\n lib/vip.l\n\n25.11.10\n Pointer casts for bufFloat() and bufDouble()\n src/dec.l\n src/lib.c\n\n25.11.6\n Optionally start 'lsn' listennig processes\n src/httpGate.c\n\n25.11.5\n Remove phone number\n README\n Restore 'pkg-config --cflags libffi'\n src/Makefile\n Avoid stale 'CliSock' if fork() fails\n src/httpGate.c\n Add 'stat' output to 'proc'\n lib/debug.l\n\n25.11.2\n New file\n lib/xxhash.l\n\n25.10.12\n Set initial alarm to 2 seconds\n lib/http.l\n\n25.10.10\n Extend example for 'yield' with 'env' arg\n doc/refY.html\n\n25.10.8\n Optional 'prg' argument to 'yield'\n src/flow.l\n doc/refY.html\n\n25.10.5\n Bug in 'U' unsigned integer suppport\n src/main.l\n 'i64u' type cast\n src/lib/llvm.l\n\n25.10.1\n Use just CONTEXT in 'permit'\n lib/android.l\n\n####### 25.9 #######\n25.9.28\n Import 'U'\n lib/reflect.l\n\n25.9.27\n Support 'U' unsigned integer result specification\n src/glob.l\n src/main.l\n src/pico.h\n doc/refN.html\n\n25.9.26\n Default scale 6\n lib/reflect.l\n\n25.9.25\n 'xCnt64' function\n src/main.l\n src/io.l\n\n25.9.20\n Recurse on nested structures\n Remove '*Reflect'\n lib/reflect.l\n\n25.9.19\n Use 'def' instead of 'set'\n lib/reflect.l\n\n25.9.17\n Fix comment for linked libraries\n soTest.c\n\n25.9.16\n New file\n lib/reflect.l\n\n25.9.15\n Re-arrange evaluation in 'picolisp' to preserve stdout\n src/main.l\n Recommend (load) for \"full\" library\n src/lib/so.l\n\n25.9.13\n Shared library continued\n src/Makefile\n src/main.l\n soTest.c\n\n25.9.9\n reflect() function\n src/lib/ex.l\n src/lib/so.l\n src/glob.l\n src/main.l\n doc/ref.html\n doc/refR.html\n evExe() function\n src/main.l\n src/io.l\n src/apply.l\n\n25.9.7\n Add comment for \"full\" library\n src/lib/so.l\n Use 'parse' in 'picolisp'\n src/main.l\n\n25.9.6\n Add interactive line input\n soTest.c\n Clean up\n src/Makefile\n src/dec.l\n src/main.l\n src/lib.so.c\n\n25.9.2\n New files\n src/lib.so.c\n soTest.c\n 'patch' function\n src/lib/llvm.l\n src/lib/so.l\n 'exclude' continued\n src/Makefile\n src/lib/llvm.l\n src/lib/ex.l\n src/lib/so.l\n src/main.l\n src/pico.h\n src/big.l\n src/subr.l\n\n25.8.28\n '$StkLimit' related to stack size\n src/glob.l\n src/main.l\n src/flow.l\n Call ulimStk() to set '$SysStkLimit'\n src/lib.c\n lib/ulimit.l\n Quiche mode\n src/lib/llvm.l\n src/gc.l\n src/sym.l\n src/db.l\n src/apply.l\n 'export' never worked!\n lib.l\n doc/refE.html\n\n25.8.22\n 'dlfun' instruction\n src/lib/llvm.l\n src/main.l\n\n25.8.21\n 'exclude' function\n src/lib/llvm.l\n src/lib/ex.l\n src/lib/so.l\n\n25.8.20\n '!!' function\n src/glob.l\n src/flow.l\n doc/ref.html\n doc/ref_.html\n\n25.8.15\n Save position mark on every move\n lib/vip.l\n\n25.8.13\n 'stoplisp' function\n src/main.l\n\n25.8.12\n Optionally build as shared library\n src/Makefile\n src/lib/llvm.l\n src/dec.l\n src/main.l\n src/lib.c\n src/io.l\n New files\n src/lib/ex.l\n src/lib/so.l\n\n25.7.29\n Pass 'exe' instead of 'prg' to 'event' and 'wake'\n lib/simul.l\n doc/des.html\n\n25.7.28\n Handle circular lists in 'less'\n lib.l\n\n25.7.27\n 'sq' function\n src/glob.l\n src/big.l\n test/src/big.l\n doc/ref.html\n doc/refS.html\n doc/ref_.html\n\n25.7.22\n Use 'tco' in 'gcd'\n lib/frac.l\n\n25.7.19\n Remove 'saveCoIO'\n src/flow.l\n\n25.7.15\n Allow to stop main coroutine with (co T)\n src/flow.l\n doc/refS.html\n\n25.7.5\n 'allowed' must be called before any GUI libs and/or 'allow' calls\n doc/refA.html\n\n####### 25.6 #######\n25.6.27\n 'recur' signature analog to 'tco'\n doc/refR.html\n Return cons pair with hard limit\n lib/ulimit.l\n\n25.6.26\n New file\n lib/ulimit.l\n Define RLIMIT_STACK, RLIMIT_NOFILE and RLIMIT_NPROC\n src/sysdefs.c\n\n25.6.17\n Increase '$GcCount' in 'gc' dynamically\n src/gc.l\n\n25.6.7\n Skip comments\n lib/xm.l\n\n25.6.4\n Optional 'sub?' start byte position\n src/dec.l\n src/main.l\n src/sym.l\n test/src/sym.l\n doc/refS.html\n 'flg' argument to 'group' for pre-grouped lists\n src/subr.l\n doc/refG.html\n\n25.5.30\n New file\n lib/select.l\n Deprecate 'db/x' and 'select/3' Pilog predicates, and move to \"lib/select.l\"\n lib/pilog.l\n doc/refB.html\n doc/refD.html\n doc/refF.html\n doc/refH.html\n doc/refI.html\n doc/refP.html\n doc/refR.html\n doc/refS.html\n doc/refT.html\n doc/refV.html\n doc/select.html\n Deprecate Pilog GUI functions, and move to \"lib/select.l\"\n lib/form.l\n\n25.5.25\n 'idx' in 'search' also for 'relQs'\n lib/db.l\n\n25.5.23\n Optional index argument to 'accu'\n lib.l\n test/lib.l\n doc/refA.html\n Minor tuning in 'cache' and 'once'\n lib.l\n\n25.5.22\n Keep all command lines non-unique but longer than 3 in TAB-completion\n lib/vip.l\n Optionally return reversed key-value pairs from 'enum'\n src/sym.l\n doc/refE.html\n test/src/sym.l\n\n25.5.21\n 'min' and 'max' also accept a single list argument\n src/subr.l\n test/src/subr.l\n doc/refM.html\n\n25.5.17\n Mention '@@' in the 'forall' reference\n doc/refF.html\n\n25.5.16\n 'sub?' stores substrig byte position in '@@'\n src/dec.l\n src/main.l\n src/sym.l\n test/src/sym.l\n doc/refS.html\n\n25.5.11\n Auto-init in 'inc' and 'dec'\n src/lib/llvm.l\n src/big.l\n Revert to 20 instead of 21 bits from 'hash'\n src/big.l\n test/src/big.l\n doc/refH.html\n\n25.5.10\n Print times in 'bench' also as [hh:mm]\n lib/debug.l\n doc/refB.html\n\n25.5.9\n Bug in 'attr'\n lib/xm.l\n\n25.5.8\n 'version' can also check for a required version\n src/main.l\n doc/refV.html\n Optimize 'idx' in 'search' for (+Ref +Link) and '+Joint'\n lib/db.l\n\n25.5.5\n New files\n src/Makefile.openbsd\n src/Makefile.macos\n\n25.4.24\n 'forall' also accepts an 'init' step structure\n lib/db.l\n doc/refF.html\n\n25.4.20\n Return 21 instead of 20 bits from 'hash'\n src/big.l\n test/src/big.l\n doc/refH.html\n 'idx' in 'search' *after* filtering\n lib/db.l\n\n25.4.19\n Bug in 'initSeed' for external symbols\n src/big.l\n\n25.4.18\n 'X' and 'Prg' in 'forall' private\n lib/db.l\n\n25.4.17\n Simplify 'body' and 'attr'\n lib/xm.l\n\n25.4.14\n 'forall' also accepts a 'search' query structure\n lib/db.l\n doc/refF.html\n 'idx' in 'search' only if necessary\n lib/db.l\n\n25.4.13\n Avoid catch/throw in 'step'\n lib/btree.l\n\n25.4.9\n Add 'rt' to 'pretty'\n lib.l\n Return 20 instead of 16 bits from 'hash'\n src/big.l\n test/src/big.l\n doc/refH.html\n Hash 'idx' in 'search'\n lib/db.l\n\n25.4.7\n Support 'prune' also in 'scan' and 'iter'\n lib/btree.l\n doc/refP.html\n Make 'for' on lists more gc-conservative\n src/flow.l\n\n####### 25.3 #######\n25.3.24\n Don't skip empty value in 'create' for updates\n More 'create' tuning\n lib/db.l\n\n25.3.20\n 'stdEval' must preserve '$At2'\n src/io.l\n 'rt' function\n src/glob.l\n src/main.l\n doc/ref.html\n doc/refR.html\n\n25.3.19\n Remove parallelization with 'later' from 'create'\n lib/db.l\n\n25.3.13\n KeyEvent 'keyCode' and 'charCode' are deprecated\n lib/form.js\n\n25.3.11\n \"onkeypress\" is deprecated\n lib/xhtml.l\n\n25.3.9\n Fix description of 'peek' (does not block, but returns only the next byte)\n doc/refP.html\n\n25.3.8\n Scroll page on horizontal touch movements in tables\n lib/form.js\n Cosmetics\n src/io.l\n lib/form.l\n\n25.3.7\n Move 'pagehide' handling (back/forward cache) from 'html' to 'form'\n lib/xhtml.l\n lib/form.l\n\n25.3.6\n Remove @lib/tinymce.l from distribution\n\n25.3.2\n Change type of '$NsLink' from 'i64*' to 'any'\n src/glob.l\n\n25.2.27\n Export namespace list from 'repl' via 'T' argument to 'symbols'\n src/glob.l\n src/sym.l\n src/io.l\n doc/refS.html\n\n25.2.26\n Typo\n doc/refI.html\n doc/refN.html\n Use 'any' instead of 'intern' for '+' arguments\n bin/vip\n\n25.2.21\n Move cursor left in final left scroll\n lib/vip.l\n\n25.2.17\n Scroll two steps with horizontal arrow keys\n lib/vip.l\n\n25.2.13\n 'tco' continued\n lib/lint.l\n\n25.2.9\n 'tco' continued\n src/flow.l\n lib.l\n test/src/flow.l\n\n25.2.8\n 'tco' and 'tc' tail call optimization functions\n src/glob.l\n src/flow.l\n doc/ref.html\n doc/refR.html\n doc/refT.html\n\n25.2.5\n 'if@@' function\n src/glob.l\n src/flow.l\n test/src/flow.l\n doc/ref.html\n doc/refC.html\n doc/refI.html\n\n25.2.1\n Missing 'F' argument to 'packJson'\n lib/json.l\n\n25.1.22\n Change 'permute' to use a callback function\n lib/simul.l\n\n25.1.21\n Postpone first move event for better double-click detection\n lib/canvas.js\n\n25.1.9\n Re-introduce \"array\" feature\n lib/json.l\n\n25.1.5\n Handle \"^?\"\n lib/vip.l\n Read and print decimal unicode in symbol names\n src/io.l\n lib.l\n\n25.1.4\n Wrong examples for 'eval' and 'run' offset\n doc/refE.html\n doc/refR.html\n Fix 'remark'\n lib.l\n\n####### 24.12 #######\n24.12.30\n Remove '*SesAdr' check\n lib/http.l\n lib/adm.l\n\n24.12.23\n Automatic lib configuration (Mike Pechkin)\n src/Makefile\n Reset form on 'pagehide' event to disable back/forward cache\n lib/xhtml.l\n\n24.12.22\n Reduce Cache-Control to 'no-store'\n lib/http.l\n\n24.12.17\n 'remark' continued\n lib.l\n lib/vip.l\n Typo\n doc/refT.html\n\n24.12.16\n 'remark' function to generalize REPL-comments\n src/glob.l\n src/io.l\n lib.l\n lib/vip.l\n doc/refR.html\n 'complete' reference\n doc/refC.html\n\n24.12.14\n Print namespace of symbols in REPL-comments\n src/io.l\n lib/vip.l\n\n24.12.13\n Cyan attribute for REPL-comments\n src/io.l\n 'markup' also in 'scratch'\n Print numbers as fixnum-comments also in Vip REPL\n lib/vip.l\n\n24.12.10\n New file\n lib/vip/load.l\n\n24.12.5\n Add \":wq\" as alias for \":x\"\n lib/vip.l\n\n24.12.2\n Add section about namespaces\n doc/ref.html\n doc/refE.html\n doc/refI.html\n doc/refL.html\n doc/refN.html\n doc/refP.html\n doc/refS.html\n\n24.11.23\n Example for catching errors\n doc/refC.html\n\n24.11.21\n Intern mark names into 'vip'\n lib/vip.l\n\n24.11.20\n Generalize 'llvm~fmtNum'\n Print numbers as fixnum-comments in REPL\n src/big.l\n src/io.l\n src/subr.l\n doc/rc.sample\n doc/refR.html\n doc/refS.html\n doc/ref_.html\n\n24.11.7\n Remove obsolete C-level 'lisp' descriptions\n doc/refN.html\n doc/native.html\n\n24.10.16\n Support also HOME and END keys\n lib/vip.l\n\n####### 24.9 #######\n24.9.7\n '0' for empty name in minimal symbol diagram\n doc/ref.html\n\n24.8.19\n Stop 'gps' via 'Flg' argument\n lib/android.l\n\n24.8.16\n 'pil' is obsolete\n doc/refT.html\n\n24.8.7\n Add 'L' and 'S' to private symbols\n lib/vip.l\n\n24.8.6\n Pass TERM environment variable to 'psh'\n lib/http.l\n bin/psh\n\n24.8.4\n 'wake' returns 'isHeld'\n lib/android.l\n\n24.8.3\n Fix 'gps' with two Location Listeners\n lib/android.l\n\n24.7.30\n Typo\n doc/refN.html\n\n24.7.23\n Call 'restart' as a UI thread (avoid 'java' reentrancy)\n lib/android.l\n\n24.7.15\n Cosmetics\n src/io.l\n src/ht.l\n\n24.7.10\n 'volatile' access to '$Signal'\n src/lib/llvm.l\n src/dec.l\n\n24.7.9\n 'Exe' argument to 'xName' not used\n src/main.l\n src/sym.l\n src/io.l\n src/db.l\n src/flow.l\n src/ext.l\n 'prompt' function\n src/glob.l\n src/main.l\n doc/ref.html\n doc/refP.html\n Typo\n doc/structures\n\n24.7.7\n Check for stale I/O frames in 'unwind'\n src/main.l\n\n24.7.5\n Change pbPut/pbGet to Zip transfers\n bin/pty\n Bug in 'erVar'\n lib/form.l\n Typo\n doc/refD.html\n\n24.7.4\n Mention '~' in the 'pico' reference\n doc/refP.html\n\n24.7.3\n Check for SDK_INT >= 31 in 'alarm?'\n lib/android.l\n\n24.7.2\n Adjust 'alarm' for changed numeric arguments\n lib/android.l\n\n####### 24.6 #######\n24.6.27\n Minimal delay time 1 ms in 'des'\n lib/simul.l\n Force frame buffer register through runCo()\n src/flow.l\n Re-arrange structures for alignment\n src/glob.l\n src/dec.l\n\n24.6.26\n 'otg' in coroutine structure missing\n doc/structures\n\n24.6.23\n Show terminated originator in 'yield' error\n src/flow.l\n\n24.6.22\n 'prv' in coroutine structure is obsolete\n doc/structures\n Fix 'This' upon coroutine termination\n Bug in coroutines with non-symbolic tags\n src/flow.l\n\n24.6.21\n Change 'opt' from \"-O3\" to \"-O2\"\n src/Makefile\n Generalize 'all*'\n lib.l\n dirString() function\n src/main.l\n Bug in coroutine free-list management\n src/flow.l\n\n24.6.20\n Generalize output in 'tty'\n src/main.l\n src/gc.l\n Check for terminated originator in 'yield'\n src/flow.l\n\n24.6.18\n Clear 'at' in coroutine 'unwind'\n src/main.l\n 'putCrtEnv' clean up\n src/dec.l\n src/flow.l\n\n24.6.17\n Reentrant 'co' checks\n src/flow.l\n\n24.6.16\n Thread exceptions revisited\n lib/android.l\n\n24.6.14\n 'alarm?' function\n lib/android.l\n\n24.6.13\n Call fcntlSetFl() in 'accept' if OpenBSD or FreeBSD\n lib/net.l\n\n24.6.12\n Disallow reentrant 'co' calls\n src/flow.l\n doc/ref.html\n doc/refC.html\n\n24.6.9\n Default format 72 columns\n lib/vip.l\n COPYING\n README\n INSTALL\n doc/microTemplates\n\n24.6.5\n Handle thread exceptions in 'java1'\n lib/android.l\n\n24.6.2\n Make 'dirname' and 'basename' non-destructive\n lib/misc.l\n\n24.5.30\n 'catch' stores throw/error-flag in '@@'\n src/flow.l\n test/src/flow.l\n doc/refC.html\n lib/vip.l\n lib/form.l\n\n24.5.24\n 'iter' returns 'NIL'\n doc/refI.html\n\n24.5.23\n Typo\n doc/search.html\n\n24.5.8\n Minor mismatch\n doc/faq.html\n\n24.4.4\n TAB-completion also for search commands\n lib/vip.l\n\n24.4.3\n No 'flushAll' in child process 'bye'\n src/main.l\n src/lib.c\n\n24.4.1\n 'for' instead of 'while' in 'des'\n lib/simul.l\n\n24.3.31\n Change 'sendCmd' protocol to UDP -> background task\n bin/pty\n\n####### 24.3 #######\n24.3.29\n Include lib/sysdefs in \"clean2\"\n src/Makefile\n\n24.3.28\n Ignore ESC in command mode\n lib/vip.l\n\n24.3.11\n Call (raw T) at start and (raw NIL) when done\n lib/vip.l\n\n24.3.10\n 'scale' function\n lib/svg.l\n\n24.3.5\n Bug in \"words\"\n doc/viprc.sample\n\n24.2.3\n Fix 'stack' reference\n doc/refS.html\n\n24.1.29\n Runtime relations via 'erVar' function\n lib/form.l\n\n24.1.21\n Add \"apk\" to '*Mimes'\n lib/http.l\n\n23.12.29\n Minor comment\n lib/simul.l\n\n####### 23.12 #######\n23.12.18\n requestAnimationFrame() not helpful\n lib/canvas.js\n\n23.12.13\n 'P' instead of 'N' in native call (malloc() returns pointer)\n test/src/main.l\n '*DB' is 'NIL' while no database is open\n src/glob.l\n src/main.l\n src/gc.l\n src/db.l\n doc/refD.html\n\n23.12.12\n 'server' single-shot (non-forking) mode with 'Flg' argument\n lib/http.l\n\n23.12.9\n ZERO-cache also for 'co' stopping\n src/flow.l\n\n23.12.8\n ZERO-cache and free-list for 'co' speedup\n src/glob.l\n src/dec.l\n src/main.l\n src/flow.l\n doc/ref.html\n\n23.12.6\n 'co' crashes when gc() runs in put()\n src/flow.l\n\n23.12.5\n Return 1 from ulimStk() for minimal stack address\n src/lib.c\n\n23.12.4\n Use 'key' instead of 'line' (because of GNU readline behaviour change)\n in 'more' and 'bt'\n lib/debug.l\n doc/refM.html\n doc/refB.html\n in 'select'\n lib/sq.l\n doc/refS.html\n and in 'query' (and thus also '?')\n lib/pilog.l\n doc/refQ.html\n doc/ref_.html\n\n23.12.3\n Global '$StkBrk' not needed\n src/glob.l\n src/main.l\n\n23.12.1\n Change transient \"U\" in 'bench' to private\n lib/debug.l\n\n23.11.30\n Typo\n doc/refN.html\n\n23.11.29\n Default '*Rt' off\n lib/simul.l\n doc/des.html\n Check for empty 'lst' in renderCanvas()\n lib/canvas.js\n\n23.11.28\n Transient \"U\" in 'bench'\n lib/debug.l\n\n23.11.27\n Resume all coroutines waiting for the same point in time\n lib/simul.l\n doc/des.html\n\n23.11.26\n Use '*@@' instead of '@@'\n lib/vip.l\n 'make' stores linkage cell in '@@'\n src/subr.l\n doc/refM.html\n\n23.11.22\n Simplify key loop in 'des'\n lib/simul.l\n\n23.11.19\n Fix 'help' for new reference format\n lib/debug.l\n doc/refH.html\n\n23.11.18\n Handle optional count in \":bd\"\n lib/vip.l\n Explicit symbol argument to 'new'\n src/flow.l\n doc/refN.html\n\n23.11.17\n 'sext' constexprs are deprecated (Mike Pechkin)\n src/lib/llvm.l\n\n23.11.12\n Use 'push1' instead of 'push' in 'finish'\n lib.l\n Mark end of layout in 'tracks' also with \"#\"\n lib/simul.l\n Remove @lib/compat.l from distribution\n\n23.11.7\n Fix 'cancel' call in 'alarm'\n Checks for SDK_INT >= 26 are obsolete\n lib/android.l\n\n23.11.3\n Search also for inherited indexes in 'select'\n Clean up\n lib/sq.l\n doc/refS.html\n\n23.10.31\n Handle external symbols in 'xName'\n src/main.l\n 'flg' argument to 'ext?' to check physical existence\n src/db.l\n lib/debug.l\n lib/vip.l\n\n23.10.30\n More general matching in 'search'\n lib/db.l\n Skip duplicates in 'hintQ'\n lib/form.l\n\n23.10.29\n Load @lib/sq.l at the end of @lib/db.l\n lib/db.l\n lib/pilog.l\n Keep relative file position\n lib/vip/html.l\n\n23.10.28\n Change 'hintQ' to use 'match>'\n lib/form.l\n Return 'Val' from 'match>' methods\n lib/db.l\n\n23.10.27\n Minor comment\n lib/svg.l\n Change 'dump' to use 'search'\n lib/too.l\n\n23.10.26\n Insert \"# VIP \" headers\n Fix 
 markups\n      *.html\n\n23.10.25\n   Typo\n      doc/search.html\n   Minor comments\n      src/subr.l\n      doc/refC.html\n\n23.10.24\n   Typo\n      doc/search.html\n\n23.10.23\n   Continued\n      doc/search.html\n   Add \"search.html\"\n      doc/toc.html\n   Comments\n      lib/db.l\n\n23.10.22\n   Style for 
 tags\n      doc/doc.css\n\n23.10.21\n   Documentation continued\n      doc/refS.html\n      doc/search.html\n\n23.10.20\n   New file\n      doc/search.html\n   Use (sys \"BROWSER\") if set\n      lib/vip.l\n\n23.10.19\n   Cosmetics\n      lib/vip/draw.l\n   New file\n      lib/vip/html.l\n   Check for \"# VIP \" in the first three lines\n      lib/vip.l\n\n23.10.18\n   Use inherited tree\n      lib/db.l\n\n23.10.17\n   Optional extract-function argument to 'search'\n      lib/db.l\n      doc/refS.html\n\n23.10.16\n   Bug in 'iter>' for '+Sn'\n      lib/db.l\n\n23.10.15\n   Change 'select' to use 'search'\n      lib/sq.l\n   '+DbChart' and 'hintQ' functions\n      lib/form.l\n   'search' function with 'iter>' and 'match>' methods\n      lib/db.l\n      doc/ref.html\n      doc/refC.html\n      doc/refS.html\n   New file\n      doc/search\n\n23.10.5\n   Check 'status != 200' in 'onload'\n      lib/form.js\n\n####### 23.9 #######\n23.9.27\n   Add namespace \"-ap~main\"\n      doc/select.html\n\n23.9.26\n   Cosmetics\n      lib/form.l\n\n23.9.23\n   Use '*Evt' mechanism instead of 'Busy'\n      lib/form.l\n      lib/form.js\n   Remove 'vf'\n      lib/vip.l\n\n23.9.20\n   Change global 'FormReq' to local\n      lib/form.js\n\n23.9.19\n   Optionally cache image in 'csDrawImage'\n      lib/canvas.l\n      lib/canvas.js\n\n23.9.17\n   Missing semicolon\n      lib/canvas.js\n\n23.9.13\n   Remove 'Queue' global\n      lib/form.js\n\n23.9.9\n   Remove \"form.html\" and \"app.html\", add \"des.html\"\n      doc/toc.html\n\n23.9.8\n   Don't fall back to stdin/stdout for closed files\n      src/io.l\n   Load also @lib/lint.l in 'psh'\n      lib/http.l\n\n23.9.7\n   Realtime mode 'off' in \"dining\" demo\n      doc/des.html\n\n23.9.6\n   Preserve initial 'This' in coroutines\n      src/flow.l\n      doc/ref.html\n\n23.9.5\n   Adjust LLVM version check (Mike Pechkin)\n      src/Makefile\n\n23.9.4\n   Mark 'tag' and 'prg' also in non-running coroutines\n      src/gc.l\n\n23.9.3\n   Allow reentrancy in coroutines\n      src/flow.l\n      doc/ref.html\n\n23.8.31\n   Tag checks in 'co' and 'yield'\n      src/dec.l\n      src/flow.l\n   Cosmetics\n      doc/des.html\n\n23.8.29\n   'noLint' for 'RED'\n      lib/term.l\n\n23.8.28\n   Homogenize 'input' and' 'output'\n      src/glob.l\n      src/dec.l\n      src/main.l\n      src/gc.l\n      src/io.l\n      src/flow.l\n   'null' instead of '@null' in 'table'\n      src/lib/llvm.l\n\n23.8.27\n   Set namespace for '+' argument in debug mode\n      bin/vip\n\n23.8.26\n   Handle $ErrFrames and $CtlFrames in coroutines\n      src/flow.l\n      src/dec.l\n   'yield' bug revisited\n      src/flow.l\n\n23.8.25\n   Release reference to Java object (Todd Coram)\n      lib/android.l\n\n23.8.22\n   Bug in 'yield' for nested coroutines\n      src/flow.l\n\n23.8.21\n   Move 'getSize' to lib/term.l\n      lib/term.l\n      lib/vip.l\n   'clear' function\n      lib/term.l\n\n23.8.20\n   Generalize 'attr'\n      lib/term.l\n\n23.8.15\n   Note about coroutine environments\n      doc/ref.html\n\n23.8.13\n   Clarify 'stack' reference\n      doc/refN.html\n\n23.8.12\n   Avoid 'read' in 'download'\n      lib/misc.l\n\n23.8.8\n   Search first 'priv' in 'nsp'\n      src/sym.l\n      doc/refP.html\n   Rename lisp-level functions '_xxx' to '_Xxx'\n      src/glob.l\n      src/main.l\n      src/gc.l\n      src/big.l\n      src/sym.l\n      src/io.l\n      src/db.l\n      src/apply.l\n      src/flow.l\n      src/subr.l\n\n23.8.7\n   'startForeground' with service type\n      lib/android.l\n\n23.8.6\n   Set SSL_CERT_FILE only if on mobile device\n      lib/android.l\n\n23.8.4\n   Check local variables for lower case in 'lint'\n      lib.l\n      lib/lint.l\n      lib/xhtml.l\n      lib/form.l\n      lib/svg.l\n\n23.8.3\n   Defer advancing the list pointer in 'for'\n      src/flow.l\n\n23.8.1\n   Fixes to 'native' description\n      doc/refN.html\n      doc/native.html\n   Target SDK 34 / androidx\n      lib/android.l\n\n23.7.28\n   opaque-pointers for '18 > LLVM >= 15' (Mike Pechkin)\n      src/Makefile\n\n23.7.24\n   Partially revert style simplification from 21.11.21\n      lib/form.l\n      lib/form.js\n\n23.7.23\n   New Vip commands\n      - \"gw\" View Web page\n      - \"gh\" View HTTP code\n      - \"gb\" Invoke Browser (w3m)\n   Implicit writing to 'scratch' files\n   Extend 'map+', 'map+g' and 'map+q'\n      lib/vip.l\n\n23.7.21\n   Minor clarification of @-result\n      doc/ref.html\n\n23.7.20\n   Revisit 'allow'\n      lib/svg.l\n\n23.7.19\n   Missing arg to \"getnameinfo\" in 'host'\n      lib/net.l\n\n23.7.17\n   Generalize 'def' for 'any' keys\n      src/flow.l\n      doc/refD.html\n   Don't 'allow' temporary files by default any longer\n      lib/http.l\n      lib/xhtml.l\n      lib/svg.l\n\n23.7.13\n   Bug in 'input' and 'output': Must preserve '@'\n      src/io.l\n\n23.7.10\n   Revert change from 23.7.6\n      bin/vip\n   TAB-completion also from command history\n      lib/vip.l\n\n23.7.8\n   Note about accessing symbol values in ':'\n      doc/ref_.html\n\n23.7.7\n   'all*' function\n      doc/ref.html\n   Exponent notation in 'parseJson' and 'readJson'\n      lib/json.l\n\n23.7.6\n   Use 'str' instead of direct 'intern' to handle namespaces\n      bin/vip\n\n23.7.4\n   Generalize HTTP method support\n      src/httpGate.c\n\n23.7.2\n   Deprecate 'zxing?' / 'queryIntentActivities'\n      lib/android.l\n\n####### 23.6 #######\n23.6.25\n   Print current coroutine in 'stkErr'\n      src/main.l\n\n23.6.18\n   Minor comment\n      bin/pty\n\n23.6.16\n   Minor elaboration on the 'sect' reference\n      doc/refS.html\n\n23.6.6\n   Disallow append mode (via \"+file\") in 'in' and 'load'\n      src/io.l\n      doc/refI.html\n      doc/refO.html\n\n23.6.4\n   '+' defaults to tag in debug mode\n      bin/vip\n   Accept 'any' in 'intern'\n      src/lib/llvm.l\n      src/sym.l\n      lib.l\n      test/src/sym.l\n      doc/refI.html\n      lib/form.l\n      lib/dbgc.l\n\n23.5.27\n   Global '*AlwaysAsk'\n      lib/form.l\n\n23.5.25\n   Track network functions\n      lib/simul.l\n   New file\n      doc/Tracks\n   Add more stack checks\n      src/main.l\n      src/flow.l\n\n23.5.24\n   Change stack segment safety margin from 4096 to 1024\n      src/glob.l\n      src/flow.l\n\n23.5.15\n   Remove 'Cpy' from getCrtEnv(), set 'env' and '$StkLimit' in loadCoEnv()\n      src/dec.l\n      src/main.l\n      src/flow.l\n\n23.5.7\n   Show buffer and dirty status also for long path names\n      lib/vip.l\n\n23.5.6\n   Deprecate \"ta\" abbreviation for \"tag\" command\n      lib/vip.l\n\n23.5.5\n   Fix description of left/right fork signals\n      doc/des.html\n\n23.4.28\n   Set 'home' property in '' to '*Top'\n      lib/canvas.l\n\n23.4.25\n   Wait for multiple events in 'pause'\n      lib/simul.l\n      doc/des.html\n\n23.4.24\n   Use 'idx' instead of 'rank' in '*Next'\n      lib/simul.l\n      doc/des.html\n   Bug in 'compare' for anonymous symbols\n      src/main.l\n\n23.4.22\n   New file\n      doc/des.html\n   Return max and min from 'idx' for 'T' and 'NIL' key arguments\n   Randomize 'idx' if 'flg' is '0'\n      src/sym.l\n      src/io.l\n      doc/refI.html\n   chance() function\n      src/dec.l\n      src/lib.c\n\n23.4.18\n   Needs 'symb?' instead of 'sym?' in 'repl'\n      src/io.l\n   Cache coroutines for 'yield' in ZERO-properties\n      src/main.l\n      src/flow.l\n   Clean up ZERO key handling in 'put' and 'get'\n      src/sym.l\n      src/flow.l\n   Bug in ffiPrep() for direct Lisp arguments\n      src/lib.c\n\n23.4.16\n   'private' cosmetics\n      lib/net.l\n\n23.4.13\n   'finish' function\n      lib.l\n      lib/app.l\n      lib/heartbeat.l\n      bin/pty\n      bin/watchdog\n      doc/ref.html\n      doc/refB.html\n      doc/refF.html\n      doc/refO.html\n\n23.4.5\n   Evaluate list arguments in 'select'\n      lib/sq.l\n      doc/refS.html\n\n23.4.3\n   Examples and test cases for 'ext:Base64' in 'input' and 'output'\n      test/src/ext.l\n      doc/refI.html\n      doc/refO.html\n\n####### 23.3 #######\n23.3.29\n   Make second port for pbPut/pbGet optional\n      bin/pty\n\n23.3.28\n   Suppress duplicates in 'db/[345]'\n      lib/pilog.l\n\n23.3.27\n   Fix escapes for special characters\n      lib/debug.l\n      doc/ref.html\n      doc/refB.html\n      doc/refD.html\n      doc/refE.html\n      doc/refN.html\n      doc/refM.html\n      doc/refP.html\n      doc/refR.html\n      doc/refU.html\n      doc/refX.html\n      doc/ref_.html\n      doc/tut.html\n      doc/native.html\n\n23.3.26\n   Fix various markup issues\n      lib/debug.l\n      lib/form.l\n      ref.html\n      ref?.html\n      faq.html\n      tut.html\n      native.html\n      select.html\n      httpGate.html\n   Set download link to demoApp.tgz\n      doc/select.html\n\n23.3.25\n   Undo tag argument restriction from 14feb23\n      src/flow.l\n      doc/refC.html\n      doc/refY.html\n\n23.3.19\n   Allow one \"-\" in uppercase global constants\n   Handle 'default'\n      lib/lint.l\n   'noLint' for 'null'\n      lib/android.l\n\n23.3.17\n   Repeat last shell command with \":$\"\n      lib/vip.l\n\n23.3.13\n   Support more attributes in 'serverSentEvent'\n   Force chunked transfer in 'serverSend'\n      lib/xhtml.l\n\n23.3.5\n   Typo\n      lib/vip.l\n   Restrict 'words' command to 'delimNs'\n      doc/viprc.sample\n\n23.2.27\n   Bug in 'js>' for '+Url'\n      lib/form.l\n\n23.2.22\n   Default hasbangs to /usr/bin/pil\n      bin/pty\n      bin/psh\n      bin/watchdog\n\n23.2.14\n   Tag argument to 'co' and 'yield' must be a symbol\n      src/flow.l\n      doc/refC.html\n      doc/refY.html\n\n23.2.9\n   Add \"mp4\" to '*Mimes'\n      lib/http.l\n\n####### 23.2 #######\n23.2.8\n   Check for atomic argument in 'made'\n      src/subr.l\n\n23.2.6\n   Undo cosmetics from 14jul22\n      lib/btree.l\n\n23.2.5\n   Keep 'prg' argument to 'des' private\n      lib/simul.l\n\n23.2.4\n   Allow numeric argument to 'repl'\n      src/io.l\n   Add BROWN and PURPLE\n      lib/term.l\n\n23.2.1\n   Numeric '*Rt' as speedup factor\n   Optional 'prg' argument to 'des'\n   Change '*Key' to fifo structure '*Keys'\n      lib/simul.l\n\n23.1.31\n   Optional 'var' argument to 'key'\n      src/io.l\n      doc/refK.html\n\n23.1.27\n   Optional anchor for ''\n   '' anchor function\n      lib/xhtml.l\n\n23.1.21\n   Init '*Key' in 'des'\n   Bug in 'wake'\n      lib/simul.l\n\n23.1.15\n   Handle 'onOff'\n      lib/lint.l\n\n23.1.14\n   Auto-quote 'null'\n      lib/android.l\n\n23.1.13\n   'setCooked', 'setRaw' not needed in 'main' and 'brkLoad'\n      src/main.l\n      src/flow.l\n   Call rl_deprep_terminal() in 'setCooked'\n      src/lib.c\n\n23.1.9\n   Minor cosmetics\n      src/main.l\n\n23.1.6\n   Add link to @lib/bash_completion\n      INSTALL\n\n23.1.2\n   Separate buffer for each \"$\" (shell) command call\n      lib/vip.l\n\n23.1.1\n   Clear *Complete upon backspace\n      lib/vip.l\n\n22.12.30\n   Handle destructuring function parameters\n      lib/lint.l\n\n22.12.28\n   Move 'less' to @lib.l\n      lib.l\n      lib/debug.l\n      doc/refL.html\n\n####### 22.12 #######\n22.12.21\n   Use 'less' in 'show'\n      lib.l\n      doc/refB.html\n      doc/refM.html\n      doc/tut.html\n   Minor fix indentation\n      lib/debug.l\n   'circ' for atomic mapping arguments no longer needed\n      lib/http.l\n\n22.12.20\n   Global '*Key'\n      lib/simul.l\n\n22.12.18\n   Add GREEN and BLUE\n      lib/term.l\n\n22.12.15\n   Handle destructuring function parameters in 'funq'\n      src/main.l\n\n22.12.12\n   Fix 'tword' to go to the last space\n      lib/vip.l\n\n22.12.11\n   Clear 'last' for deleted buffer\n      lib/vip.l\n   Directly call 'symbols' in 'tag'\n      lib/vip.l\n\n22.12.2\n   Add percentage display to ''\n      lib/xhtml.l\n   Commented example for LEFT and RIGHT\n      doc/viprc.sample\n\n22.12.1\n   Check for \":\" delimiter in TAB-completion\n      lib/vip.l\n\n22.11.22\n   'boss' is obsolete\n      lib/android.l\n   TAB-completion also for colon-commands\n      lib/vip.l\n\n22.11.20\n   Minor privates\n      lib/vip.l\n\n22.11.19\n   Fix 'unwind'ing coroutines\n      src/dec.l\n      src/main.l\n      src/flow.l\n   Reset screen and namespaces upon error\n      lib/vip.l\n      bin/vip\n\n22.11.18\n   'namespaces' function\n      lib/debug.l\n      doc/refN.html\n      doc/refS.html\n   Exchange also 'last', 'mark' and 'sc' in \":bx\"\n      lib/vip.l\n\n22.11.15\n   'shadows' function\n      lib/debug.l\n      doc/refS.html\n   Allow also new namespace for '-symbols'\n      lib.l\n\n22.11.14\n   Wrong 'save' / 'safe' in 'rdList'\n      src/io.l\n   Private 'queue'\n      lib/simul.l\n\n22.11.12\n   'tabs' command to replace tabs with spaces\n   'words' command to toggle between Lisp an C\n      doc/viprc.sample\n   Generalize delimiter checking\n      lib/vip.l\n\n22.11.11\n   Store 'symbols' source info after the change\n      src/sym.l\n\n22.11.10\n   'info' returns local time instead of UTC if the flag argument is zero\n      src/dec.l\n      src/main.l\n      src/lib.c\n      doc/refI.html\n      lib/vip.l\n\n22.11.9\n   Set blob symlinks in mirror destination directories\n      src/ssl.c\n\n22.11.2\n   Clear references to deleted buffer in \":bd\"\n      lib/vip.l\n\n22.10.30\n   Don't clear '@' and '@@' before (gc)\n      src/gc.l\n      doc/refG.html\n\n22.10.26\n   Passing zero to 'tell' refers to the parent process\n      src/io.l\n      src/db.l\n      doc/refT.html\n   Remove \"lib/boss.l\" from distribution\n\n22.10.21\n   Use 'delete' instead of 'replace'\n      lib/dbgc.l\n\n22.10.20\n   Minor cosmetics\n      src/main.l\n      src/subr.l\n\n22.10.17\n   Decrement 'Ms' in 'waitFd' only if not 292MY\n      src/io.l\n   Include external declaration of ppoll()\n      src/lib.c\n   Fix reference of '*CPU'.\n      doc/refC.html\n\n22.10.15\n   Avoid setting 'last' to current buffer\n      lib/vip.l\n   Call 'flush' in 'beep'\n      lib.l\n\n22.10.6\n   'able' checks in 'val>' for '+ObjVal' and '+ObjVar'\n      lib/form.l\n\n22.10.4\n   Add 'put' and 'get' to reference of '+Joint'\n      doc/refJ.html\n\n####### 22.9 #######\n22.9.29\n   Bitmask bug in \n      lib/xhtml.l\n\n22.9.24\n   Use opaque-pointers in LLVM >= 15 (Mike Pechkin)\n      src/Makefile\n\n22.9.16\n   Support partially circular lists in 'pretty' and 'view'\n   Print 'def' in 'pp' instead of 'de' for non-functions\n      lib.l\n   Simplify printing of circular lists\n      src/io.l\n\n22.9.13\n   Move \"ix.io\" to @doc/viprc.sample, added \"pb1n\"\n      lib/vip.l\n      doc/viprc.sample\n   Bug in 'server' for non-numeric arguments\n      lib/net.l\n\n22.9.9\n   Allow empty 'url' argument\n      src/ssl.c\n\n22.9.6\n   Pass FLAG_IMMUTABLE to PendingIntent\n      lib/android.l\n\n22.9.4\n   Avoid multiple auto timers\n      lib/canvas.js\n\n22.9.3\n   Pass flag 'T' for mouse/touch events\n      lib/canvas.l\n      lib/canvas.js\n\n22.9.1\n   Make 'all*' selective with 'T' or '0'\n      lib.l\n      doc/refA.html\n      lib/vip.l\n\n22.8.31\n   Change 'http' abort time to 20 minutes\n      lib/http.l\n\n22.8.30\n   '' function\n      lib/xhtml.l\n   Abort 'http' after 7 seconds\n      lib/http.l\n\n22.8.29\n   Remove stale symbolic links\n      src/ssl.c\n\n22.8.26\n   'cmd' function\n      lib/vip.l\n\n22.8.22\n   Store debug source info in 'symbols'\n      src/dec.l\n      src/sym.l\n      lib/debug.l\n      doc/refD.html\n      doc/refS.html\n\n22.8.21\n   Extend 'pool' tests\n      test/src/db.l\n      test/lib/db.l\n\n22.8.20\n   'b8+' aligns stack buffers to 8 bytes\n      src/lib/llvm.l\n      src/main.l\n      src/io.l\n      src/db.l\n      src/flow.l\n   Pad 'dbFile' and 'child' to multiples of 8\n      src/dec.l\n   Add file\n      doc/viprc.sample\n   Improve use cases\n      doc/rc.sample\n\n22.8.19\n   'gPrintf' returns void\n      src/dec.l\n   Size check in gPrintf()\n      src/lib.c\n   'save' before 'loop'\n      src/main.l\n   '$TickU' and '$TickS' are obsolete\n      src/glob.l\n\n22.8.18\n   Declare 'Tio' and 'Fsign' as \"char\" instead of \"int\"\n      src/lib.c\n   Make insensitive to endianness\n      test/src/main.l\n\n22.8.1\n   Add note on destructuring bind of function parameters\n      doc/ref.html\n\n22.7.27\n   Bug in 'extra' assuming positive pointers\n      src/flow.l\n   Display applied functions in backtraces\n      lib/debug.l\n      lib/app.l\n\n22.7.20\n   Bug in 'compare' for circular lists\n      src/main.l\n      test/src/subr.l\n\n22.7.16\n   Call 'blob+' in (clone> . +Entity)\n      lib/db.l\n\n22.7.15\n   Improve 'hex' argument verification\n      lib/misc.l\n\n22.7.14\n   Use 'skip' instead of 'line' in 'here'\n      lib/misc.l\n   Minor cosmetics\n      lib/btree.l\n\n22.7.13\n   'overview' function\n      lib/android.l\n   Go to last instead of previous buffer in \":bd\"\n      lib/vip.l\n\n22.7.12\n   Remove \"Building httpGate\"\n      doc/httpGate.html\n   '' function\n      lib/canvas.l\n\n22.7.11\n   Go to previous instead of next buffer in \":bd\"\n      lib/vip.l\n\n22.7.9\n   Correct earth mean radius to 6371 km\n      lib/gis.l\n\n22.7.8\n   'map+', 'map+g' and 'map+q' functions\n      lib/vip.l\n\n22.7.3\n   Default values in 'print>' methods\n      lib/sq.l\n\n22.7.2\n   Uncomment 'shift' import\n      src/lib/llvm.l\n   Let 'beep' return 'NIL'\n      lib.l\n      lib/vip.l\n      doc/refB.html\n\n22.6.30\n    Show blank screen in 'restart'\n      lib/android.l\n\n####### 22.6 #######\n22.6.30\n   Bug in realpath() handling\n      lib/vip.l\n\n22.6.26\n   Corrections (Christos Gitsis)\n      doc/ref.html\n      doc/refA.html\n   More fixes in local coroutine stacks\n      src/flow.l\n\n22.6.25\n   realpath() directly if directory\n      lib/vip.l\n\n22.6.24\n   Apply realpath() only to path of the file\n      lib/vip.l\n   More fixes in local coroutine stacks\n      src/flow.l\n\n22.6.23\n   Set 'org' when resuming a coroutine in 'co'\n      src/flow.l\n\n22.6.22\n   Silent exit if connect fails\n      src/ssl.c\n\n22.6.17\n   Bugs in 'sort' with 'fun' argument\n      src/subr.l\n\n22.6.15\n   Disable '*Run' in 'sync' calls\n      lib/form.l\n\n22.6.13\n   Bug in printing symbols overshadowed in 'priv'\n      src/io.l\n\n22.6.10\n   Don't lock remote symbols\n      lib/vip.l\n\n22.6.9\n   Check empty name in '+SymField'\n      lib/form.l\n\n22.6.7\n   Refined system clipboard copy\n      lib/vip.l\n\n22.6.6\n   Missing \"void *\" in '*C-Defs'\n      src/lib/llvm.l\n\n22.6.3\n   Disable form action for stale locks\n      lib/form.l\n\n22.5.31\n   Remove 'visibilitychange' event handling\n      lib/xhtml.l\n\n22.5.30\n   'h' function\n      lib/debug.l\n      doc/refH.html\n\n22.5.29\n   String arguments do no longer cause strdup(3) calls\n      doc/native.html\n\n22.5.26\n   Add 'binutils'\n      INSTALL\n   Use 'output' instead of 'pipe'\n      lib/misc.l\n   Replace control characters with backslash sequences\n      lib/misc.l\n      lib/db.l\n      lib/vip.l\n      lib/term.l\n      lib/http.l\n      lib/xhtml.l\n      lib/form.l\n      lib/canvas.l\n      lib/xm.l\n      lib/tinymce.l\n      test/src/io.l\n      test/src/sym.l\n      test/lib/misc.l\n      doc/tut.html\n      doc/refA.html\n      doc/refP.html\n      doc/form/refS.html\n      doc/app.html\n      misc/bigtest\n\n22.5.25\n   Bug in 'untrace'\n      lib/debug.l\n   Multi-line data in 'serverSend'\n      lib/xhtml.l\n   'input' and 'output' functions\n      src/glob.l\n      src/dec.l\n      src/main.l\n      src/gc.l\n      src/io.l\n      test/src/io.l\n      doc/ref.html\n      doc/refI.html\n      doc/refO.html\n\n22.5.18\n   Fix 'raw' example\n      doc/refR.html\n   Clear stdin 'tty' flag in 'pipe' child\n      src/io.l\n\n22.5.15\n   Replace \"%\" also if in command window\n      lib/vip.l\n\n22.5.13\n   Optional \"dup\" file descriptor argument to 'fd'\n      src/io.l\n      doc/refF.html\n   Use 'in' instead of 'pipe' for \"ccrypt\" call\n      lib/vip.l\n\n22.5.12\n   Fix 'dbs' example\n      doc/refD.html\n\n22.5.11\n   Use '*Uri' instead of '*Url' in 'post'\n      lib/form.l\n\n22.5.10\n   Support also PUT, PATCH and DELETE\n      src/httpGate.c\n\n22.5.6\n   Global '*Uri'\n      lib/http.l\n   Clean up '*Err'\n      lib/app.l\n\n22.5.5\n   Call 'flush' in 'tty'\n      src/dec.l\n      src/main.l\n      src/ht.l\n\n22.5.3\n   Use 'tty' in 'msg'\n      lib.l\n   Re-introduce 'visibilitychange' event handling\n      lib/xhtml.l\n\n22.5.1\n   'fun' function\n      src/glob.l\n      src/apply.l\n      test/src/apply.l\n      doc/ref.html\n      doc/refF.html\n\n22.4.30\n   Add \"epub\" mime type\n      lib/http.l\n\n22.4.26\n   Outdated example for 'lisp'\n      doc/refL.html\n\n22.4.24\n   Define PATH_MAX\n      src/sysdefs.c\n      lib/vip.l\n\n22.4.22\n   Preserve 'errno' across readline(3) calls\n      src/dec.l\n      src/io.l\n      src/lib.c\n   Word search without 'match' support\n      lib/vip.l\n\n22.4.20\n   'noLint' declarations\n      lib/xhtml.l\n      lib/svg.l\n      lib/canvas.l\n\n22.4.17\n   Don't maintain ErrFrames and CtlFrames in coroutines\n   Fix file descriptor leak when stopping coroutines\n      src/dec.l\n      src/flow.l\n\n22.4.11\n   'trail' check not needed\n      lib/app.l\n\n22.4.9\n   Collect also C-tags into @lib/map\n      src/lib/llvm.l\n      src/main.l\n      src/pico.h\n      src/lib.c\n\n22.4.8\n   Add \"-o lib.bc\"\n   Add \"clean2\" target\n      src/Makefile\n\n22.4.6\n   Optional rounding in 'lat', 'lon' and 'fmt'\n      lib/gis.l\n\n22.4.5\n   Check zero charCode in hint key events\n      lib/form.js\n\n####### 22.3 #######\n22.3.16\n   Pre-set 'home' property in 'form'\n   Conditionally unlock and enable in 'panel'\n      lib/form.l\n\n22.3.14\n   Bug in 'ps'\n      lib/svg.l\n   Local and private declarations\n      lib/xm.l\n   Escape also backslashes in ''\n      lib/gis.l\n\n22.3.13\n   Escape single quotes in '' text argument\n      lib/gis.l\n   Use 'get' instead of (cdr (asoq ..))\n      lib/xm.l\n\n22.3.8\n   Revisit tcsetpgrp() calls\n      src/dec.l\n      src/flow.l\n      lib/debug.l\n\n22.3.4\n   Plain searches without 'match' overhead\n      lib/vip.l\n\n22.2.28\n   Issues with tcsetpgrp() calls\n      src/io.l\n      src/flow.l\n\n22.2.26\n   Transient and private namespaces in catch and coroutine frames\n      src/glob.l\n      src/dec.l\n      src/main.l\n      src/gc.l\n      src/flow.l\n\n22.2.24\n   Refactor 'repl' loops\n      src/io.l\n\n22.2.23\n   Don't exit top-level REPL\n      src/main.l\n      src/io.l\n\n22.2.22\n   Print error location in 'repl'\n      lib/form.l\n   Print error location in 'evCmd'\n      lib/vip.l\n\n22.2.21\n   'height' function\n   Handle '0' and 'T' directly in 'ps'\n      lib/svg.l\n\n22.2.19\n   Handle NILs in (has> . +List)\n      lib/db.l\n   Increase stack size\n      bin/vip\n\n22.2.13\n   'move!>' method for '+Entity'\n      lib/too.l\n\n22.2.11\n   Comment for 'fill'\n      src/subr.l\n\n22.2.5\n   Remove 'dbs+'\n      lib/db.l\n      doc/ref.html\n      doc/refD.html\n   Pass '*Uuid' and arguments to RPC calls\n      lib/android.l\n\n22.2.2\n   Revisit (rel> . +Dep)\n      lib/db.l\n\n22.2.1\n   Add 'nth' to \"see also\" of 'get'\n      doc/refG.html\n\n22.1.30\n   Additional arguments to 'fish'\n      src/apply.l\n      doc/refF.html\n      test/src/apply.l\n      lib/too.l\n\n22.1.28\n   Optional third argument to 'fill'\n      src/subr.l\n      doc/refF.html\n      test/src/subr.l\n\n22.1.27\n   'wrap' also converts string to list of strings\n      lib/misc.l\n      doc/refW.html\n      test/lib/misc.l\n   'badDep' function\n      lib/too.l\n\n22.1.26\n   Bug in (rel> . +Dep)\n      lib/db.l\n\n22.1.21\n   Optional database file for 'forall'\n      lib/db.l\n      doc/refF.html\n   Inherit tags from superclasses\n      lib/vip.l\n   Refactor screen handling\n      lib/term.l\n      lib/vip.l\n\n22.1.20\n   'seq' instead of 'dbMap' in 'dangling'\n   'displaced' function\n      lib/too.l\n\n22.1.18\n   Stack check in 'apply'\n      src/apply.l\n   Discrete-Event Simulation: 'des', 'pause', 'event' and 'wake' functions\n      lib/simul.l\n\n22.1.15\n   '-debug' and '-trace' functions\n      lib/debug.l\n      doc/ref.html\n      doc/refD.html\n      doc/refT.html\n\n22.1.13\n   Change \"EMail\" to \"E-Mail\"\n      doc/form/refM.html\n\n22.1.11\n   Central Kurdish localization (Hunar Omar)\n      loc/CKB.l\n      loc/ckb\n\n22.1.10\n   Variable '*Port'\n      bin/pty\n\n22.1.8\n   Handle SIGWINCH\n      bin/pty\n   Reset readline in 'setTerm'\n      lib/term.l\n   Display namespace in 'repl'\n      lib/form.l\n\n22.1.7\n   'refObj' searches also values\n      lib/too.l\n\n22.1.6\n   Don't reset 'Busy' in ping()\n      lib/form.js\n\n22.1.4\n   Bug in 'name' for external symbols\n      src/sym.l\n\n####### 21.12 #######\n22.1.3\n   Bugs in (del> . +Entity) and (has> . +List)\n      lib/db.l\n      test/lib/db.l\n   'assoc', 'rassoc', 'asoq' and 'rasoq' accept circular lists\n      src/subr.l\n      test/src/subr.l\n\n21.12.30\n   Enable file transfers (via 'pbPut' and 'pbGet' in PilBox)\n      bin/pty\n\n21.12.29\n   Fix touch scrolling in chart tables\n      lib/form.l\n      lib/form.js\n      lib/xhtml/table\n\n21.12.27\n   '-symbols' function\n      lib.l\n      doc/ref.html\n      doc/refS.html\n\n21.12.22\n   OpenBSD patch (Frithjof Schulze)\n      src/httpGate.c\n\n21.12.20\n   Don't put single \".\" into readline history\n\n21.12.14\n   Avoid 'resolveActivity' in 'startActivityForResult'\n      lib/android.l\n\n21.12.13\n   Splice also atomic results in \"~\" read macros and 'fill'\n      src/io.l\n      src/subr.l\n      test/src/subr.l\n      doc/refF.html\n\n21.12.12\n   Bug in 'format' (llvm~fmtNum)\n      src/big.l\n   Overflow float/double to bignum\n      src/dec.l\n      src/main.l\n      src/pico.h\n      src/lib.c\n\n21.12.10\n   'native' and 'struct' not limited to C functions\n      doc/refN.html\n      doc/refS.html\n   'Str' not used in 'getWord'\n      lib/vip.l\n\n21.12.8\n   Add 'adr' to \"see also\" of 'native'\n      doc/refN.html\n\n21.12.5\n   Global '*Keys'\n   \":map\" command\n      lib/vip.l\n\n21.12.4\n   Lock, sync and commit external symbols\n      lib/vip.l\n\n21.11.30\n   'R' may be modified in 'evCmd'\n      lib/vip.l\n\n21.11.29\n   Extend 'command' with '*CmdMap'\n   Continue direct editing only with \"K\" (\"^]\" always goes to source)\n      lib/vip.l\n\n21.11.28\n   Remove '*Complete' filter\n      lib/vip.l\n\n21.11.26\n   'all*' function\n      lib.l\n      doc/refA.html\n   Refactor TAB-completion\n      lib/vip.l\n\n21.11.25\n   Search namespaces in TAB-completion\n      lib/vip.l\n\n21.11.22\n   Minor cosmetics\n      lib.css\n      lib/canvas.js\n      lib/plio.js\n      lib/gis.js\n      loc/ar\n      loc/ch\n      loc/cn\n      loc/de\n      loc/hr\n      loc/it\n      loc/ja\n      loc/tr\n\n21.11.21\n   Simplify style manipulations\n      lib/form.l\n      lib/form.js\n\n21.11.18\n   Bug in 'bagBag'\n      lib/form.l\n\n21.11.17\n   Minor cosmetics\n      lib/form.l\n   Inherit 'Dbf' in 'forall' from superclasses\n      lib/db.l\n\n21.11.16\n   Re-introduce the '====' function\n      src/glob.l\n      src/sym.l\n      test/src/sym.l\n      doc/ref_.html\n      doc/diff\n   and use it in 'locale'\n      lib/misc.l\n   Preserve transients in comma read macro\n      src/io.l\n\n21.11.15\n   Use 'fName' in 'vf'\n      lib/vip.l\n\n21.11.12\n   '+ObjVar' prefix class\n      lib/form.l\n\n21.11.11\n   Missing semicolon (Mia)\n      lib/form.js\n\n21.11.9\n   Increase escape delay from 80 to 120\n      lib/vip.l\n\n21.10.31\n   Mention Ctrl-D to terminate 'bt', 'query' and '?'\n      doc/ref.html\n      doc/refB.html\n      doc/refM.html\n      doc/refQ.html\n      doc/ref_.html\n\n21.10.30\n   Generalize cut in 'prove'\n      src/subr.l\n\n21.10.29\n   rl_initialize() not necessary\n      src/lib.c\n\n21.10.28\n   Display namespace in 'status'\n      lib/vip.l\n   Minor optimization in '*Prompt'\n      lib/debug.l\n\n21.10.27\n   'vf' (vi/find) function\n      lib/vip.l\n   Default '*Tab' to 1\n      lib/xhtml.l\n\n21.10.25\n   '*KeyMap', '*KeyMap-g' and '*KeyMap-q' globals (Erik Gustafson)\n   More transients\n      lib/vip.l\n\n21.10.18\n   Refactor (gui> . +User)\n      lib/adm.l\n      lib/user.l\n\n21.10.15\n   Mention Ctrl-D to terminate 'more'\n      doc/refM.html\n\n21.10.11\n   \"CSV\" -> \"Export CSV\" in 'csv'\n      lib/xhtml.l\n\n21.10.9\n   'pico~cells' function\n      lib/vip/draw.l\n   Minor cosmetics\n      lib/vip.l\n   Fix 'arrow' for small distances\n      lib/vip/draw.l\n\n21.10.2\n   Remove '+JsField'\n      lib/form.l\n      doc/app.html\n      doc/form/refJ.html\n   Import 'permute' from 'pico' namespace\n      lib/simul.l\n\n21.9.29\n   '+hintObj' prefix class for '+Obj' and '+ObjVal'\n      lib/form.l\n\n21.9.25\n   'rand' argument checks\n      src/big.l\n      doc/refR.html\n\n21.9.24\n   Ignore SIGINT in 'ctty' parent process\n      src/main.l\n   Forward \"^D\"\n      bin/pty\n\n21.9.23\n   Clear '*Err'\n      bin/pty\n\n21.9.20\n   Initial '$StkBrk' and '$StkLimit'\n      src/glob.l\n      src/main.l\n\n21.9.19\n   ulimStk() system call\n      src/dec.l\n      src/pico.h\n      src/lib.c\n\n21.9.17\n   Clear 'history' after argument evaluation\n      src/main.l\n\n21.9.16\n   Insert \"^M\" before \"^J\" in 'mail' body\n      lib/misc.l\n   'refObj' function\n      lib/too.l\n\n21.9.13\n   Insert \"^M\" before \"^J\" in 'mail' body\n      lib/misc.l\n   'prBase64' optional \"^M\" argument\n      lib/misc.l\n      doc/refP.html\n   Explanations for reference syntax\n      doc/ref.html\n\n21.9.10\n   \"gg\" uses *Count\n      lib/vip.l\n\n21.9.3\n   'mis>' method for '+Swap'\n      lib/db.l\n\n21.9.1\n   select() system calls are now poll()\n      doc/refK.html\n      doc/refL.html\n      doc/refR.html\n      doc/refS.html\n      doc/refW.html\n\n21.8.30\n   Typo\n      doc/refR.html\n\n21.8.28\n   Add note about 'native'\n      doc/faq.html\n   'rid' function\n      test/src/sym.l\n\n21.8.27\n   'rid' function\n      src/glob.l\n      src/sym.l\n      test/src/sym.l\n      doc/ref.html\n      doc/refC.html\n      doc/refD.html\n      doc/refF.html\n      doc/refQ.html\n      doc/refR.html\n\n21.8.26\n   Bug in 'place'\n      src/subr.l\n      test/src/subr.l\n\n21.8.25\n   Division by zero did not throw an error\n      src/big.l\n   Private declarations\n      lib/xhtml.l\n\n21.8.22\n   Default alert text color black\n      lib.css\n\n21.8.20\n   Wrong 'tty' checks for stdin/stdout\n      src/main.l\n      src/flow.l\n\n21.8.19\n   LLC and LINK variables\n      src/Makefile\n\n21.8.18\n   Strip binaries\n      src/Makefile\n   'rasoq' function\n      src/glob.l\n      src/subr.l\n      test/src/subr.l\n      doc/ref.html\n      doc/refA.html\n      doc/refR.html\n\n21.8.16\n   Add 'packJson'\n      lib/json.l\n\n21.8.14\n   Sort TAB-completion\n      lib/vip.l\n   Host option\n      bin/pty\n\n21.8.13\n   Check (sys \"SHELL\") for default shell\n      lib/vip.l\n\n21.8.12\n   Some Pilog variables private again\n      lib/pilog.l\n\n21.8.11\n   Default shell \"bash\" -> \"sh\"\n      lib/vip.l\n   Shell prefix \"$ \" -> \"!\" in 'repl'\n      lib/form.l\n\n21.8.9\n   'go', 'up', 'down', 'left' and 'right functions\n   'block' function\n      lib/vip/draw.l\n   Preset terminal attributes in setRaw()\n      src/lib.c\n\n21.8.8\n   Add files\n      lib/term.l\n      bin/pty\n\n21.8.7\n   Clean up terminal handling\n      lib/vip.l\n\n21.8.6\n   Define TIOCSWINSZ\n      src/sysdefs.c\n   Set standard I/O to a PTY with (ctty)\n      src/Makefile\n      src/dec.l\n      src/main.l\n      doc/refC.html\n\n21.8.3\n   'tty' flag also in 'inFile'\n      src/dec.l\n      src/main.l\n      src/io.l\n      src/flow.l\n\n21.7.27\n   Direct 'run' in auto-load with \"# VIP (...)\"\n      lib/vip.l\n\n21.7.26\n   Bug in reading non-ASCII characters in internal symbols\n      src/io.l\n\n21.7.25\n   'cnt' argument to 'unify'\n      src/subr.l\n      lib/pilog.l\n      doc/refU.html\n\n21.7.24\n   Signal handler in 'prove'\n      src/subr.l\n\n21.7.23\n   Pilog variables not private\n      lib/pilog.l\n   Revisit Pilog variables in Lisp expressions\n      src/subr.l\n\n21.7.22\n   Revisit private symbols in properties\n      lib/vip.l\n\n21.7.21\n   Global '*Rule' cleared in 'repl'\n      src/glob.l\n      src/io.l\n      doc/ref.html\n      doc/refB.html\n      doc/refC.html\n      doc/refR.html\n   Maintain source properties also in 'clause'\n      lib/pilog.l\n   Bind Pilog variables in Lisp expressions\n      src/subr.l\n      lib/pilog.l\n      test/src/subr.l\n      doc/ref.html\n      doc/refM.html\n      doc/refR.html\n      doc/refT.html\n   Intern private symbols also in properties\n      lib/vip.l\n   Bug in 'putSrc' for first property\n      src/flow.l\n\n21.7.18\n   Minor cosmetics\n      src/subr.l\n\n21.7.16\n   em120 and em150 styles\n      lib.css\n\n21.7.13\n   'buf' function\n      doc/ref.html\n      doc/refB.html\n\n21.7.10\n   Revisit (put> . +Swap)\n      lib/db.l\n      test/lib/db.l\n\n21.7.5\n   Fix 'clone>' for '+Swap' in '+Bag'\n      lib/db.l\n\n21.7.4\n   E/R unit tests\n      lib/test.l\n      test/src/sym.l\n      test/src/db.l\n      test/lib/db.l\n   Clean up 'has>' methods\n      lib/db.l\n      lib/tinymce.l\n   Revisit '+Bag' and '+Swap'\n      lib/db.l\n\n21.7.3\n   Support methods as \":ta msg> +Cls\"\n      lib/vip.l\n   Make 'bagBag' non-destructive\n      lib/form.l\n\n21.7.2\n   'forall' function\n      doc/ref.html\n   Add file\n      doc/rc.sample\n\n21.7.1\n   'forall' function\n      lib/db.l\n      doc/refF.html\n\n####### 21.6 #######\n21.6.30\n   '+Swp' prefix class\n      lib/form.l\n   Lazy external symbol creation in '+Swap'\n      lib/db.l\n   'has>' check in (rel> . +Joint)\n      lib/db.l\n   Keep application namespaces for background tasks in '*Ns'\n      lib/vip.l\n\n21.6.29\n   Keep application namespaces for background tasks in '*Ns'\n      lib/vip.l\n      bin/vip\n\n21.6.24\n   Minor addition\n      doc/microTemplates\n\n21.6.23\n   Micro-templates for '' and ''\n      doc/microTemplates\n\n21.6.22\n   Micro-templates for '
' and ''\n      lib/xhtml.l\n      lib/xhtml/table\n      lib/xhtml/grid\n   Add  and \n      lib/xhtml/tab\n\n21.6.21\n   Minor fix in reference for 'all'\n      doc/refA.html\n\n21.6.20\n   Micro-templates 2.0\n      lib/xhtml.l\n      lib/xhtml/\n      doc/microTemplates\n\n21.6.19\n   Wrong 'Attr' output in 'html'\n      lib/xhtml.l\n   'pack' not needed\n      lib/vip.l\n   General argument to 'any'\n      src/io.l\n      doc/refA.html\n\n21.6.18\n   Also 'flip'ped sort in 'sortButton'\n      lib/form.l\n\n21.6.17\n   'sortButton' function\n      lib/form.l\n\n21.6.16\n   Vip running in coroutine\n   Suspend with \"qz\", resume with (v)\n      lib/vip.l\n      doc/refV.html\n\n21.6.15\n   Fix terminal after 'pipe', 'in' and 'out'\n      src/io.l\n\n21.6.14\n   Minor fix indentation\n      src/flow.l\n   Restore private declarations\n      lib/xhtml.l\n   Missing '+Remote' methods\n      lib/db.l\n\n21.6.13\n   Add '\\e' to escape markups\n      src/io.l\n      doc/ref.html\n\n21.6.11\n   Optional 'put' and 'get' function arguments for '+Joint'\n      lib/db.l\n\n21.6.9\n   Revert confirm row deletion (01may21)\n      lib/form.l\n\n21.6.4\n   'ctty' 'NIL' argument is obsolete\n      src/main.l\n      doc/refC.html\n   Minor renaming\n      src/flow.l\n\n21.6.2\n   Push tag stack in \"gf\" command\n      lib/vip.l\n   Add A3 page sizes\n      lib/svg.l\n   Intern some globals for reload\n      lib/form.l\n\n21.6.1\n   'class' clears old method and var definitions\n   'var' uses 'def' instead of 'put'\n      lib.l\n      test/lib.l\n\n21.5.29\n   Set cooked terminal mode in 'repl'\n      src/io.l\n\n21.5.27\n   Revisit TAB-completion\n      lib/vip.l\n   Use 'val' for '+Swap' relations in 'set>'\n      lib/db.l\n\n21.5.25\n   Revisit TAB-completion from 'history'\n      lib/vip.l\n   Unary '+' is obsolete in '*Run' setup\n      lib.l\n\n21.5.24\n   Nesting bug in 'cells'\n      lib/vip/draw.l\n\n21.5.23\n   Maintain 'symbols' per buffer\n      lib/vip.l\n\n21.5.21\n   TAB-complete from 'history' on \": \"\n   \":v\" command\n      lib/vip.l\n\n21.5.20\n   setCooked() only if necessary\n      src/lib.c\n\n21.5.19\n   Add file\n      lib/clang.l\n\n21.5.18\n   Fix 'struct'  example\n      doc/refS.html\n\n21.5.14\n   '' vertical-aligns to top\n      lib.css\n   Optional submenu CSS class index\n      lib/xhtml.l\n      lib/xhtml/menu\n\n21.5.12\n   Add file\n      doc/microTemplates\n   Needs '*XhtmlField' in ''\n      lib/xhtml.l\n\n21.5.11\n   Don't set IPV6_V6ONLY for OpenBSD\n      lib/net.l\n\n21.5.10\n   64-bit check not needed\n      lib/adm.l\n\n21.5.6\n   Missing '+Remote' methods\n      lib/db.l\n   Missing 'mail' handshake (Mike Pechkin)\n      lib/misc.l\n\n21.5.5\n   Fix catch/throw between coroutines\n      src/dec.l\n      src/main.l\n      src/flow.l\n      doc/structures\n      doc/ref.html\n\n21.5.4\n   I/O save/restore bug in 'co' / 'yield'\n      src/main.l\n      src/flow.l\n   Minor cosmetics (collapse two 'let's)\n      src/flow.l\n   Fix docs and comments about coroutine tags\n      src/main.l\n      src/flow.l\n      doc/ref.html\n      doc/refC.html\n      doc/refS.html\n      doc/refY.html\n\n21.5.3\n   (co) returns tag of current coroutine\n      src/flow.l\n      doc/refC.html\n   'shift' function\n      src/glob.l\n      src/sym.l\n      doc/ref.html\n      doc/refS.html\n      doc/refP.html\n      test/src/sym.l\n\n21.5.1\n   Confirm row deletion also if repeated\n      lib/form.l\n\n21.4.30\n   Add file\n      doc/app.html\n\n21.4.29\n   Call 'loadCoEnv' in 'unwind'\n      src/main.l\n      src/flow.l\n   Remove coroutines from catch/throw environment\n      src/glob.l\n\n21.4.22\n   Show thousands-separator in total counts in search dialogs\n      lib/form.l\n\n21.4.21\n   File in first column of directory listings\n      lib/vip.l\n\n21.4.20\n   Bug in 'till' reading UTF-8\n      src/io.l\n\n21.4.19\n   Align SUBRs to 8 bytes\n      src/lib/llvm.l\n\n21.4.18\n   's-expr' function, evaluate with \"^E\"\n      lib/vip.l\n\n21.4.17\n   'stack' return value fix\n      src/main.l\n      doc/refS.html\n   Infinite timeout for values greater than 24 days in '*Run', 'wait' and 'key'\n   on non-Linux systems (using ppoll(2) on Linux)\n      src/lib.c\n   'stack' continued\n      src/main.l\n\n21.4.16\n   Independent size of main stack segment\n      src/glob.l\n      src/main.l\n      src/flow.l\n      doc/refS.html\n   'stack' returns unused spaces\n      src/main.l\n      doc/refS.html\n   'llvm~cons2' function\n      src/dec.l\n      src/gc.l\n   Coroutine structure 'prv'\n      doc/structures\n   Optional alignment for 'memcpy' and 'memset'\n      src/lib/llvm.l\n      src/main.l\n      src/db.l\n      src/flow.l\n\n21.4.15\n   Infinite timeout for values greater than 24 days in '*Run', 'wait' and 'key'\n   (only on systems with sizeof(int) == 4)\n      src/lib.c\n\n21.4.14\n   Skip remote replication if 'key' is empty\n      src/ssl.c\n\n21.4.13\n   Bug in '
': Header text not evaluated\n      lib/xhtml.l\n   ContextCompat 'permit' function\n      lib/android.l\n   'Str' in 'repl' private\n      lib/form.l\n\n21.4.10\n   Minor fix indentation\n      lib/vip.l\n\n21.4.9\n   Extensions to 'NIL' punning\n      doc/ref.html\n\n21.4.8\n   Support '-fun' command line arguments\n      bin/vip\n\n21.4.7\n   'enum?' function\n      src/glob.l\n      src/sym.l\n      doc/ref.html\n      doc/refE.html\n      doc/refL.html\n      test/src/sym.l\n\n21.4.4\n   Wrong external declaration\n      src/ht.l\n\n21.4.3\n   Bug in 'stem' (for -O2 or -O3)\n      src/subr.l\n\n21.4.1\n   'enum' returns cell instead of value\n      src/sym.l\n      doc/refE.html\n      test/src/sym.l\n      doc/faq.html\n   Bug in '*Term' signal handling\n      src/main.l\n\n21.3.31\n   '+Remote' entity class\n      lib/db.l\n      lib/too.l\n\n21.3.30\n   Exit '*', '/*', '/' and '%' upon zero\n      src/big.l\n\n21.3.29\n   Note about the default browser for 'doc' calls\n      man/man1/picolisp.1\n      doc/man.html\n\n21.3.26\n   'enum' with single argument returns association list\n      src/sym.l\n      doc/refE.html\n      test/src/sym.l\n\n21.3.25\n   Return 'NIL' from 'enum' if key <= 0\n      src/sym.l\n   Unit tests for 'enum'\n      test/src/sym.l\n   '*Term' signal handling (Constantine Bitensky)\n      src/glob.l\n      src/main.l\n      doc/ref.html\n      doc/refT.html\n      doc/refA.html\n      doc/refH.html\n      doc/refS.html\n      doc/refW.html\n\n21.3.24\n   'enum' function\n      src/sym.l\n\n21.3.23\n   'enum' function\n      src/glob.l\n      src/sym.l\n      doc/ref.html\n      doc/refE.html\n      doc/refH.html\n      doc/refI.html\n   'rev' function bit count argument\n      src/big.l\n      doc/refR.html\n\n21.3.21\n   'rev' function\n      src/glob.l\n      src/big.l\n      doc/ref.html\n      doc/refR.html\n      doc/refH.html\n      doc/refI.html\n      doc/ref_.html\n\n21.3.17\n   Still missing\n      lib/xm.l\n   Ukrainian and russian localization (Constantine Bitensky)\n      loc/RU.l\n      loc/uk\n      loc/ru\n\n21.3.10\n   Renamed \"UK.l\" to \"UA.l\", restored \"UK.l\" and renamed to \"GB.l\"\n   Renamed \"gr\" to \"el\" and \"jp\" to \"ja\"\n      loc/UA.l\n      loc/GB.l\n      loc/uk\n   Symbolic links\n      UK.l -> GB.l\n      gr -> el\n      jp -> ja\n\n21.3.8\n   Missing file\n      lib/xm.l\n\n21.3.7\n   Ukrainian localization (Constantine Bitensky)\n      loc/UK.l\n      loc/uk\n\n21.3.5\n   Subdirectory recursion buffer-local\n   Recurse when no trailing \"/\"\n      lib/vip.l\n\n21.3.2\n   '*Bye' cleared in children\n      src/io.l\n      lib.l\n      lib/adm.l\n      lib/app.l\n      doc/diff\n\n21.2.28\n   Missing check for 'NIL'\n      lib/vip.l\n\n21.2.26\n   Remove Access-Control-Allow-Origin header\n      lib/http.l\n\n21.2.20\n   Prefix \"@\" with \"./\" in directory listings\n   Recurse into subdirectories with \":E\"\n      lib/vip.l\n\n21.2.16\n   Case insensitive search with \"~\" prefix\n   Increase escape delay to 80 ms\n      lib/vip.l\n\n21.2.12\n   Rename file to \"area\", add \"field\"\n      lib/xhtml.l\n      lib/xhtml/area\n      lib/xhtml/field\n\n21.2.11\n   Elaborate ''\n      lib/xhtml.l\n      lib/xhtml/textarea\n\n21.2.9\n   Ignore SIGHUP for non-config calls\n      src/httpGate.c\n\n21.2.8\n   Start task in first 'heartbeat' call\n      lib/heartbeat.l\n   Touch events not needed\n      lib/xhtml/tab\n\n21.2.7\n   Variable titles in menu\n   Layout template line format\n      lib/xhtml.l\n      lib/xhtml/menu\n      lib/xhtml/layout\n\n21.2.5\n   'plio' must preserve $Ptr and $End\n      src/io.l\n   Load @lib/too.l always in 'psh'\n      lib/http.l\n\n21.2.3\n   Load @lib/sq.l in 'psh'\n      lib/http.l\n\n21.2.2\n   Optional insert string in config keys\n      src/httpGate.c\n      doc/httpGate.html\n\n21.2.1\n   Typo \".pil\" -> \"./pil\"\n      doc/httpGate.html\n\n21.1.28\n   Typo \"none\" -> \"nond\"\n      doc/tut.html\n\n21.1.25\n   Remove 'evCmd' from custom function keys\n      lib/vip.l\n\n21.1.23\n   'fish' function \"skip\" return value\n      src/apply.l\n      doc/refF.html\n      lib/vip.l\n\n21.1.22\n   em80, em90 and em100 styles\n      lib.css\n\n21.1.21\n   Stack check in 'fish'\n      src/apply.l\n\n21.1.20\n   Comment\n      lib/tinymce.l\n\n21.1.18\n   Bug in 'pack' of external symbol names\n      src/sym.l\n\n21.1.17\n   'pil' backport\n      lib/compat.l\n\n21.1.15\n   Micro-templates\n      lib/xhtml.l\n      lib/xhtml/\n   Bug in 'pass'\n      src/apply.l\n   Call 'bufString' instead of 'pathString' in 'token'\n      src/io.l\n\n21.1.14\n   Bug in 'bit?'\n      src/big.l\n\n21.1.8\n   Minor cosmetics\n      src/subr.l\n   Improved terminal reset\n      src/lib.c\n\n21.1.5\n   Debian release\n\nDec20\n   Pil21 initial version\n\n####### 21.0 #######\n"
  },
  {
    "path": "doc/Tracks",
    "content": "# VIP @lib/vip/draw.l\n# 25may23 Software Lab. Alexander Burger\n\n(label 1 1 \"Connectors:\")\n\n(cells 7 6 '(| | | . |))\n(go 1 3 \"-\")\n(right 9 \"+\")\n(down 2 \"v\")\n(go 10 8 \"+\")\n(down 8 \"v\")\n(go 28 6 \"+\")\n(up 3 \"+\")\n(right 14 \">\")\n(go 46 6 \"+\")\n(up 3 \"+\")\n(right 30 \">\")\n\n(box 7 17 13 6 \"Track\"\n   (label 1 1 \"- a\")\n   (label 10 1 \"b -\")\n   (label 2 5 \"x\")\n   (label 11 5 \"y\") )\n(go 7 18 \"+\")\n(left 4 \"+\")\n(up 11 \"+\")\n(right 3 \">\")\n(go 20 18 \"+\")\n(right 4 \">\")\n\n(cells 25 17 '(| | | . |))\n(go 28 17 \"+\")\n(up 3 \"+\")\n(left 11 \"+\")\n(down 2 \"v\")\n(go 76 22 \"-\")\n(left 48 \"+\")\n(up 2 \"\\^\")\n(go 46 19 \"+\")\n(down 6 \"+\")\n(left 45 \"<\")\n(go 64 19 \"+\")\n(down 6 \"+\")\n(left 14 \"<\")\n\n(go 70 17 \"+\")\n(up 6 \"+\")\n(left 58 \"+\")\n(up 2 \"\\^\")\n(go 52 8 \"+\")\n(down 6 \"+\")\n(left 22 \"+\")\n(down 2 \"v\")\n"
  },
  {
    "path": "doc/des.html",
    "content": "\n\n\n\n\n\nDiscrete-Event Simulation\n\n\n\nabu@software-lab.de\n\n
Discrete-Event Simulation (DES)
\n\n
(c) Software Lab. Alexander Burger\n\n
PicoLisp has a Discrete-Event\nSimulation library in \"@lib/simul.l\".\n\n
\n\n\n
\n
Implementation
\n\n
The simulated objects (often called \"Agents\") are implemented as separate coroutines. These are\ncreated the normal way with co, and the library functions\nuse yield to transfer\ncontrol between them.\n\n
Only one coroutine may be running at one point in time. All others are either\n\n
    \n
  • ready to run,\n
  • waiting for the next scheduled point in time, and/or\n
  • waiting for one or several specific signals (events).\n
\n\n
A running coroutine can suspend itself, and cause another coroutine to\nresume, by either\n\n
    \n
  • passing control to the next coroutine, or\n
  • pausing for a given amount of time and/or waiting for signals.\n
\n\n
The simulation can optionally run in realtime mode. In that case, it sleeps\nbetween the scheduled points in time, and accepts key strokes for user\ninteraction.\n\n
The library consists of five global variables and four functions.\n\n\n
\n
Global Variables
\n\n
\n\n
*Time
\n
Simulated system time since the start of the simulation. It can be in any\nunit, but should be in milliseconds if in realtime mode.
\n\n
*Ready
\n
Queue of coroutines ready to run.
\n\n
*Next
\n
idx tree of\ncoroutines pausing for a given time.
\n\n
*Rt
\n
Realtime: Either NIL (default), or 1 for wall clock speed, 2\nfor double speed etc.
\n\n
*Keys
\n
Holds possibly queued key presses (only in realtime mode).
\n\n
\n\n\n
\n
Functions
\n\n
\n\n
(des [. prg])
\n
Performs one discrete-event simulation step. It first runs all coroutines in\n*Ready until that queue is empty. Then - if *Next is\nnot empty - advances the simulation to the next point in time, and resumes all\ncorresponding coroutines. In that case, if in realtime mode, it delays execution\nas necessary, handles possible key presses, and runs prg after each\nkey.
\n\n
(pause ['cnt|sym] ..) -> any
\n
Waits for events (i.e. a time span elapsed or a signal arrived). For a\nnumeric argument, the current coroutine is scheduled in *Next for a\npoint in time after that number of time units. For symbolic arguments, the\ncurrent coroutine is queued into those symbol's event queues. In any case,\ncontrol is passed to the next coroutine.
\n\n
(event 'sym 'exe)
\n
Sends the signal sym to all coroutines waiting in that symbol's\nevent queue. As a result, these coroutines are removed from the queue and\nappended to the *Ready queue, with the optional exe to\nbe evaluated when resumed. The current coroutine continues to run.
\n\n
(wake 'sym 'exe)
\n
Wakes up another coroutine sym, by appending it to the\n*Ready queue with the optional 'exe' to be evaluated when resumed.\nThis means that if sym is currently waiting for a point in time in\n*Next, it is removed from that index (i.e. the pause is aborted).\nAlso, if sym is waiting for signals, it is removed from those event\nqueues. The current coroutine continues to run.
\n\n
\n\n\n
\n
Usage
\n\n
A typical DES program will start some coroutines and let them perform their\ninitial work until they need to pause.\n\n
That means, if a given operation in the simulation is supposed to take\ncnt time units, this coroutine calls pause with that\nnumber. Or, if it depends on some signals from another part of the program, it\nmay call pause with those symbols. In any case - as it has nothing\nelse to do - it goes to sleep.\n\n
When all of them wait for a time or signal, control is returned to the main\nprogram. All coroutines are now waiting in *Next or some signal\nevent queue (or in *Ready if they just gave up control with\n(pause)).\n\n
The main program may now check *Next and perhaps\n*Ready. If both are empty, no further events can occur, and the\nprogram may terminate.\n\n
Otherwise, it calls des to continue with the next step(s).\n\n
At any time, a coroutine or the main program may call wake, for\nexample to interrupt another coroutine and cause it to throw into some other\ncontext, or have that coroutine's pause return a special value by\nevaluating the exe argument.\n\n\n\n
\n
An Example
\n\n
Let's use DES to demonstrate the well-known Dining\nPhilosophers Problem.\n\n
 Put the following code into a file \"dining.l\".\n\n
\n
\n# 07sep23 Software Lab. Alexander Burger\n# Dining Philosophers\n# pil dining.l -dining~main +\n\n(load \"@lib/simul.l\")\n\n(symbols 'dining 'simul 'pico)\n\n(local) (*ForkA *ForkB *ForkC *ForkD *ForkE now think)\n\n(de now (Str)\n   (prinl (tim$ (* 60 *Time)) \" \" (co) \" \" Str) )\n\n(de think (Left Right)\n   (loop\n      (now \"thinking\")\n      (pause (rand 180 240))  # 3 to 4 hours\n      (now \"hungry\")\n      (while (or (val Left) (val Right))\n         (now \"waiting\")\n         (pause Left Right) )\n      (set Left (set Right (co)))\n      (now \"eating\")\n      (pause 20)  # 20 minutes\n      (set Left (set Right NIL))\n      (event Left)\n      (event Right) ) )\n\n(local) main\n\n(de main ()\n   (symbols '(dining simul pico))\n   (co 'Aristotle\n      (think '*ForkA '*ForkB) )\n   (co 'Kant\n      (think '*ForkB '*ForkC) )\n   (co 'Spinoza\n      (think '*ForkC '*ForkD) )\n   (co 'Marx\n      (think '*ForkD '*ForkE) )\n   (co 'Russell\n      (think '*ForkE '*ForkA) ) )\n
\n
\n\n
It uses five global variables *ForkA through *ForkE\nand five coroutines Aristotle, Kant,\nSpinoza, Marx and Russell. They all run\nthe same function think, with their neighboring forks as\nLeft and Right arguments.\n\n
In think, each philospher is first \"thinking\" for a random time\nbetween three and four hours. Then it gets \"hungry\", tries to pick up both\nforks, and - if at least one of the forks is in use - starts \"waiting\" for a\nleft or right fork signal from another philosopher, and checks the forks again.\n\n
Now both forks are free. The philosopher puts himself into both (it could put\nin fact any non-NIL value), then is \"eating\" for 20 minutes,\nreleases both forks by setting them to NIL, and sends a left and a\nright fork signal to the neighboring philosophers possibly waiting for the\nforks.\n\n
The simulation cannot deadlock, because both forks are picked up and released\natomically, and because coroutines waiting for fork signals are always queued\nafter the other waiting coroutines.\n\n
Sample Run
\n\n
\n$ ./pil misc/dining.l -dining~main +\n00:00 Aristotle thinking\n00:00 Kant thinking\n00:00 Spinoza thinking\n00:00 Marx thinking\n00:00 Russell thinking\ndining: (more (stack))\n(Russell . 62)\n(Marx . 62)\n(Spinoza . 62)\n(Kant . 62)\n(Aristotle . 62)\n(T . 155)\n-> NIL\ndining: *Ready\n-> NIL\ndining: (idx '*Next)\n-> ((180 . Aristotle) (194 . Marx) (198 . Russell) (201 . Spinoza) (229 . Kant))\ndining: (des)\n03:00 Aristotle hungry\n03:00 Aristotle eating\n-> NIL\ndining: (des)\n03:14 Marx hungry\n03:14 Marx eating\n-> NIL\ndining: (des)\n03:18 Russell hungry\n03:18 Russell waiting\n-> NIL\ndining: (do 10 (des))\n03:20 Aristotle thinking\n03:20 Russell waiting\n03:21 Spinoza hungry\n03:21 Spinoza waiting\n03:34 Marx thinking\n03:34 Spinoza eating\n03:34 Russell eating\n03:49 Kant hungry\n03:49 Kant waiting\n03:54 Russell thinking\n03:54 Spinoza thinking\n03:54 Kant eating\n04:14 Kant thinking\n06:27 Aristotle hungry\n06:27 Aristotle eating\n06:47 Aristotle thinking\n06:47 Marx hungry\n06:47 Marx eating\n07:07 Marx thinking\n07:40 Russell hungry\n07:40 Russell eating\n-> NIL\ndining:\n
\n\n\n\n"
  },
  {
    "path": "doc/doc.css",
    "content": "/* 22oct23 Software Lab. Alexander Burger\n * 06dec12jk\n */\n\nhtml {\n   background-color: #ddd;\n}\n\nbody {\n   margin: auto;\n   max-width: 50em;\n   border: 1px solid #bbb;\n   background-color: white;\n   padding: 2em 7% 4em 10%;\n}\n\nh5 {\n   font-size: 95%;\n   margin-bottom: 1em;\n}\n\ndt {\n   margin: 0.4em -2em 0 0;\n   font-weight: 600;\n   color: #444;\n}\n\ndd {\n   margin-top: 0.3em;\n   margin-bottom: 0.4em;\n}\n\ncode, pre {\n   color: rgb(0%,40%,0%);\n}\n\ndt code {\n   word-spacing: -0.04em;\n}\n"
  },
  {
    "path": "doc/faq.html",
    "content": "\n\n\n\n\n\nPicoLisp FAQ\n\n\n\nabu@software-lab.de\n\n
\nMonk: \"If I have nothing in my mind, what shall I do?\"
\nJoshu: \"Throw it out.\"
\nMonk: \"But if there is nothing, how can I throw it out?\"
\nJoshu: \"Well, then carry it out.\"
\n(Zen koan)
\n\n
PicoLisp Frequently Asked Questions
\n\n
(c) Software Lab. Alexander Burger\n\n
\n\n
\n
Why did you write yet another Lisp?
\n\n
Because other Lisps are not the way I'd like them to be. They concentrate on\nefficient compilation, and lost the one-to-one relationship of language and\nvirtual machine of an interpreted system, gave up power and flexibility, and\nimpose unnecessary limitations on the freedom of the programmer. Other reasons\nare the case-insensitivity and complexity of current Lisp systems.\n\n\n
\n
Who can use PicoLisp?
\n\n
PicoLisp is for programmers who want to control their programming\nenvironment, at all levels, from the application domain down to the bare metal,\nwho want to use a transparent and simple - yet universal - programming model,\nand who want to know exactly what is going on.\n\n
It does not pretend to be easy to learn. There are already plenty of\nlanguages that do so. It is not for people who don't care what's under the hood,\nwho just want to get their application running. They are better served with some\nstandard, \"safe\" black-box, which may be easier to learn, and which allegedly\nbetter protects them from their own mistakes.\n\n\n
\n
What are the advantages over other Lisp systems?
\n\n
Simplicity
\n
PicoLisp is easy to understand and adapt. There is no compiler enforcing\nspecial rules, and the interpreter is simple and straightforward. There are only\nthree data types: Numbers, symbols and lists (\"LISP\" means \"List-, Integer- and\nSymbol Processing\" after all ;-). The memory footprint is minimal, and the\ntarball size of the whole system is just a few hundred kilobytes.\n\n
A Clear Model
\n
Most other systems define the language, and leave it up to the implementation\nto follow the specifications. Therefore, language designers try to be as\nabstract and general as possible, leaving many questions and ambiguities to the\nusers of the language.\n\n
PicoLisp does the opposite. Initially, only the single-cell data structure\nwas defined, and then the structure of numbers, symbols and lists as they are\ncomposed of these cells. Everything else in the whole system follows from these\naxioms. This is documented in the chapter about The\nPicoLisp Machine in the reference manual.\n\n
Orthogonality
\n
There is only one symbolic data type, no distinction (confusion) between\nsymbols, strings, variables, special variables and identifiers.\n\n
Most data-manipulation functions operate on the values of symbols as well as\nthe CARs of cons pairs:\n\n
\n: (let (N 7  L (7 7 7)) (inc 'N) (inc (cdr L)) (cons N L))\n-> (8 7 8 7)\n
\n\n
There is only a single functional type, no \"special forms\". As there is no\ncompiler, functions can be used instead of macros. No special \"syntax\"\nconstructs are needed. This allows a completely orthogonal use of functions. For\nexample, most other Lisps do not allow calls like\n\n
\n: (mapcar if '(T NIL T NIL) (1 2 3 4) (5 6 7 8))\n-> (1 6 3 8)\n
\n\n
PicoLisp has no such restrictions. It favors the principle of \"Least\nAstonishment\".\n\n
Object System
\n
The OOP system is very powerful, because it is fully dynamic, yet extremely\nsimple:\n\n
    \n
  • In other systems you have to statically declare \"slots\". In PicoLisp,\nclasses and objects are completely dynamic, they are created and extended at\nruntime. \"Slots\" don't even exist at creation time. They spring into existence\npurely dynamically. You can add any new property or any new method to any single\nobject, at any time, regardless of its class.\n\n
  • The multiple inheritance is such that not only classes can have several\nsuperclasses, but each individual object can be of more than one class.\n\n
  • Prefix classes can surgically change the inheritance tree for any class or\nobject. They behave like Mixins in this regard.\n\n
  • Fine-control of inheritance in methods with super and extra.\n\n
\n\n
Pragmatism
\n
PicoLisp has many practical features not found in other Lisp dialects. Among\nthem are:\n\n
    \n
  • Auto-quoting of lists when the CAR is a number. Instead of '(1 2\n3) you can just write (1 2 3). This is possible because a\nnumber never makes sense as a function name, and has to be checked at runtime\nanyway.\n\n
  • The quote function returns all\nunevaluated arguments, instead of just the first one. This is both faster\n(quote does not have to take the CAR of its argument list) and\nsmaller (a single cell instead of two). For example, 'A expands to\n(quote . A) and '(A B C) expands to (quote A B\nC).\n\n
  • The symbol @ is automatically\nmaintained as a local variable, and set implicitly in certain flow- and\nlogic-functions. This makes it often unnecessary to allocate and assign local\nvariables.\n\n
  • Functional I/O is more convenient than\nexplicitly passing around file descriptors.\n\n
  • A well-defined ordinal relationship between\narbitrary data types facilitates generalized comparing and sorting.\n\n
  • Uniform handling of var locations (i.e. values of symbols and\nCARs of cons pairs).\n\n
  • The universality and usefulness of symbol properties is enforced and\nextended with implicit and explicit bindings of the symbol This in combination with the access functions\n=:, : and ::.\n\n
  • A very convenient list-building machinery, using the link, yoke, chain and made functions in the make environment.\n\n
  • The syntax of often-used functions is kept non-verbose. For example, instead\nof (let ((A 1) (B 2) C 3) ..) you write (let (A 1 B 2 C 3)\n..), or just (let A 1 ..) if there is only a single\nvariable.\n\n
  • The use of the hash (#) as a comment character is more appropriate\ntoday, and allows a clean hash-bang (#!) syntax for stand-alone\nscripts.\n\n
  • The interpreter is invoked with a simple and\nflexible syntax, where command line arguments are either files to be interpreted\nor functions to be directly executed. With that, many tasks can be performed\nwithout writing a separate script.\n\n
  • A sophisticated system of interprocess communication, file locking and\nsynchronization allows multi-user access to database applications.\n\n
  • A general and dynamic interface for Native C Calls\n(FFI).\n\n
  • A Prolog interpreter is tightly integrated into the language. Prolog\nclauses can call Lisp expressions and vice versa, and a self-adjusting\ndepth-first search predicate select can be used in database\nqueries.\n\n
\n\n
Persistent Symbols
\n
Database objects (\"external\" symbols) are a primary data type in PicoLisp.\nThey look like normal symbols to the programmer, but are managed in the database\n(fetched from, and stored to) automatically by the system. Symbol manipulation\nfunctions like set, put or get, the\ngarbage collector, and other parts of the interpreter know about them.\n\n
Application Server
\n
It is a stand-alone system (it does not depend on external programs like\nApache or MySQL) and it provides a \"live\" user interface on the client side,\nwith an application server session for each connected client. The GUI layout and\nbehavior are described with S-expressions, generated dynamically at runtime, and\ninteract directly with the database structures.\n\n
Localization
\n
Internal exclusive and full use of UTF-8 encoding, and self-translating transient symbols (strings), make it easy to\nwrite country- and language-independent applications.\n\n\n
\n
How is the performance compared to other Lisp systems?
\n\n
Despite the fact that PicoLisp is an interpreted-only system, the performance\nis quite good. Typical Lisp programs operating on list data structures are\nexecuted in (interpreted) PicoLisp at about the same speed as in (compiled)\nCMUCL, and about two or three times faster than in CLisp or Scheme48.\n\n
But in practice, speed was never a problem, even with the first versions of\nPicoLisp in 1988 on a Mac II with a 12 MHz CPU. And certain things are cleaner\nand easier to do in C (or other low-level languages) anyway. It is\nvery easy to write C functions in PicoLisp, either in the kernel,\nas shared object libraries, or even inline in the Lisp code.\n\n
PicoLisp is very space-efficient. Other Lisp systems reserve heap space twice\nas much as needed, or use rather large internal structures to store cells and\nsymbols. Each cell or minimal symbol in PicoLisp consists of only two pointers.\nNo additional tags are stored, because they are implied in the pointer\nencodings. No gaps remain in the heap during allocation, as there are only\nobjects of a single size. As a result, consing and garbage collection are very\nfast, and overall performance benefits from a better cache efficiency. Heap and\nstack grow automatically, and are limited only by hardware and operating system\nconstraints.\n\n\n
\n
What does \"interpreted\" mean?
\n\n
It means to directly execute Lisp data as program code. No transformation to\nanother representation of the code (e.g. compilation), and no structural\nmodifications of these data, takes place.\n\n
Lisp data are the \"real\" things, like numbers, symbols and lists, which can\nbe directly handled by the system. They are not the textual\nrepresentation of these structures (which is outside the Lisp realm and taken\ncare of by the reading and printing functions).\n\n
The following example builds a function and immediately calls it with two\narguments:\n\n
\n: ((list (list 'X 'Y) (list '* 'X 'Y)) 3 4)\n-> 12\n
\n\n
Note that no time is wasted to build up a lexical environment. Variable\nbindings take place dynamically during interpretation.\n\n
A PicoLisp function is able to inspect or modify itself while it is running\n(though this is rarely done in application programming). The following function\nmodifies itself by incrementing the '0' in its body:\n\n
\n(de incMe ()\n   (do 8\n      (printsp 0)\n      (inc (cdadr (cdadr incMe))) ) )\n\n: (incMe)\n0 1 2 3 4 5 6 7 -> 8\n: (incMe)\n8 9 10 11 12 13 14 15 -> 16\n
\n\n
Only an interpreted Lisp can fully support such \"Equivalence of Code and\nData\". If executable pieces of data are used frequently, like in PicoLisp's\ndynamically generated GUI, a fast interpreter is preferable over any compiler.\n\n\n
\n
Is there (or will be in the future) a compiler available?
\n\n
No. That would contradict the idea of PicoLisp's simple virtual machine\nstructure. A compiler transforms it to another (physical) machine, with the\nresult that many assumptions about the machine's behavior won't hold any more.\nBesides that, PicoLisp primitive functions evaluate their arguments\nindependently and are not suited for being called from compiled code. Finally,\nthe gain in execution speed would probably not be worth the effort. Typical\nPicoLisp applications often use single-pass code which is loaded, executed and\nthrown away; a process that would be considerably slowed down by compilation.\n\n\n
\n
Is it portable?
\n\n
Yes and No. Though we wrote and tested PicoLisp originally only on Linux, it\nnow also runs on many other POSIX systems. The first versions were even fully\nportable between DOS, SCO-Unix and Macintosh systems. But today we have Linux.\nLinux itself is very portable, and you can get access to a Linux system almost\neverywhere. So why bother?\n\n
The GUI is completely platform independent (Browser), and in the age of the\nInternet an application server does not really need to be portable.\n\n\n
\n
Is PicoLisp a web server?
\n\n
Not really, but it evolved a great deal into that direction.\n\n
Historically it was the other way round: We had a plain X11 GUI for our\napplications, and needed something platform independent. The solution was\nobvious: Browsers are installed virtually everywhere. So we developed a protocol\nwhich persuades a browser to function as a GUI front-end to our applications.\nThis is much simpler than to develop a full-blown web server.\n\n\n
\n
I cannot find the LAMBDA keyword in PicoLisp
\n\n
Because it isn't there. The reason is that it is redundant; it is equivalent\nto the quote function in any aspect, because there's no distinction\nbetween code and data in PicoLisp, and quote returns the whole\n(unevaluated) argument list. If you insist on it, you can define your own\nlambda:\n\n
\n: (def 'lambda quote)\n-> lambda\n: ((lambda (X Y) (+ X Y)) 3 4)\n-> 7\n: (mapcar (lambda (X) (+ 1 X)) (1 2 3 4 5))\n-> (2 3 4 5 6)\n
\n\n\n
\n
Why do you use dynamic variable binding?
\n\n
Dynamic binding is very powerful, because there is only one single,\ndynamically changing environment active all the time. This makes it possible\n(e.g. for program snippets, interspersed with application data and/or passed\nover the network) to access the whole application context, freely, yet in a\ndynamically controlled manner. And (shallow) dynamic binding is the fastest\nmethod for a Lisp interpreter.\n\n
Lexical binding is more limited by definition, because each environment is\ndeliberately restricted to the visible (textual) static scope within its\nestablishing form. Therefore, most Lisps with lexical binding introduce \"special\nvariables\" to support dynamic binding as well, and constructs like\nlabels to extend the scope of variables beyond a single function.\n\n
In PicoLisp, function definitions are normal symbol values. They can be\ndynamically rebound like other variables. As a useful real-world example, take\nthis little gem:\n\n
\n(de recur recurse\n   (run (cdr recurse)) )\n
\n\n
It implements anonymous recursion, by defining recur statically\nand recurse dynamically. Usually it is very cumbersome to think up\na name for a function (like the following one) which is used only in a single\nplace. But with recur and recurse you can simply\nwrite:\n\n
\n: (mapcar\n   '((N)\n      (recur (N)\n         (if (=0 N)\n            1\n            (* N (recurse (- N 1))) ) ) )\n   (1 2 3 4 5 6 7 8) )\n-> (1 2 6 24 120 720 5040 40320)\n
\n\n
Needless to say, the call to recurse does not have to reside in\nthe same function as the corresponding recur. Can you implement\nanonymous recursion so elegantly with lexical binding?\n\n\n
\n
Are there no problems caused by dynamic binding?
\n\n
You mean the funarg problem, or problems that arise when a variable\nmight be bound to itself? For that reason we have a convention in\nPicoLisp to use transient symbols (instead\nof internal symbols) or private internal symbols\n\n
    \n\n
  1. for all parameters and locals, when functional arguments or executable lists\nare passed through the current dynamic bindings\n\n
  2. for a parameter or local, when that symbol might possibly be (directly or\nindirectly) bound to itself, and the bound symbol's value is accessed in the\ndynamic context.\n\n
\n\n
This is a form of lexical scoping - though we still have dynamic\nbinding - of symbols, similar to the static keyword in\nC.\n\n
In fact, these problems are a real threat, and may lead to mysterious bugs\n(other Lisps have similar problems, e.g. with symbol capture in macros). They\ncan be avoided, however, when the above conventions are observed. As an example,\nconsider a function which doubles the value in a variable:\n\n
\n(de double (Var)\n   (set Var (* 2 (val Var))) )\n
\n\n
This works fine, as long as we call it as (double 'X), but will\nbreak if we call it as (double 'Var). Therefore, the correct\nimplementation of double should be:\n\n
\n(de double (\"Var\")\n   (set \"Var\" (* 2 (val \"Var\"))) )\n
\n\n
If double is defined that way in a separate source file, then\nthe symbol Var is locked into a private lexical context and\ncannot conflict with other symbols.\n\n
Admittedly, there are two disadvantages with this solution:\n\n
    \n\n
  1. The rules for when to use transient or private symbols are a bit\ncomplicated. Though it is safe to use them even when not necessary, it will take\nmore space then and be more difficult to debug.\n\n
  2. The string-like syntax of transient symbols as variables may look strange to\nalumni of other languages. With private symbols this is not an issue.\n\n
\n\nFortunately, these pitfalls do not occur so very often, and seem more likely in\nutilities than in production code, so that they can be easily encapsulated.\n\n\n
\n
But with dynamic binding I cannot implement closures!
\n\n
This is not true. Closures are a matter of scope, not of binding.\n\n
For a closure it is necessary to build and maintain a separate environment.\nIn a system with lexical bindings, this has to be done at each function\ncall, and for compiled code it is the most efficient strategy anyway, because it\nis done once by the compiler, and can then be accessed as stack frames at\nruntime.\n\n
For an interpreter, however, this is quite an overhead. So it should not be\ndone automatically at each and every function invocation, but only if needed.\n\n
You have several options in PicoLisp. For simple cases, you can take\nadvantage of the static scope of transient\nor private symbols. For the general case, PicoLisp has built-in functions like\nbind or job, which dynamically manage statically scoped\nenvironments.\n\n
Environments are first-class objects in PicoLisp, more flexible than\nhard-coded closures, because they can be created and manipulated independently\nfrom the code.\n\n
As an example, consider a currying function:\n\n
\n(de curry Args\n   (list (car Args)\n      (list 'list\n         (lit (cadr Args))\n         (list 'cons ''job\n            (list 'cons\n               (list 'lit (list 'env (lit (car Args))))\n               (lit (cddr Args)) ) ) ) ) )\n
\n\n
When called, it returns a function-building function which may be applied to\nsome argument:\n\n
\n: ((curry (X) (N) (* X N)) 3)\n-> ((N) (job '((X . 3)) (* X N)))\n
\n\n
or used as:\n\n
\n: (((curry (X) (N) (* X N)) 3) 4)\n-> 12\n
\n\n
In other cases, you are free to choose a shorter and faster solution. If (as\nin the example above) the curried argument is known to be immutable:\n\n
\n(de curry Args\n   (list\n      (cadr Args)\n      (list 'fill\n         (lit (cons (car Args) (cddr Args)))\n         (lit (cadr Args)) ) ) )\n
\n\n
Then the function built above will just be:\n\n
\n: ((curry (X) (N) (* X N)) 3)\n-> ((X) (* X 3))\n
\n\n
In that case, the \"environment build-up\" is reduced by a simple (lexical)\nconstant substitution with zero runtime overhead.\n\n
Note that the actual curry\nfunction is simpler and more pragmatic. It combines both strategies (to use\njob, or to substitute), deciding at runtime what kind of function\nto build.\n\n\n
\n
Do you have macros?
\n\n
Yes, there is a macro mechanism in PicoLisp, to build and immediately execute\na list of expressions. But it is seldom used. Macros are a kludge. Most things\nwhere you need macros in other Lisps are directly expressible as functions in\nPicoLisp, which (as opposed to macros) can be applied, passed around, and\ndebugged.\n\n
For example, Common Lisp's DO* macro, written as a function:\n\n
\n(de do* \"Args\"\n   (bind (mapcar car (car \"Args\"))\n      (for \"A\" (car \"Args\")\n         (set (car \"A\") (eval (cadr \"A\"))) )\n      (until (eval (caadr \"Args\"))\n         (run (cddr \"Args\"))\n         (for \"A\" (car \"Args\")\n            (and (cddr \"A\") (set (car \"A\") (run @))) ) )\n      (run (cdadr \"Args\")) ) )\n
\n\n\n
\n
Can I run threads?
\n\n
This is not possible. Threads share memory and other resources (as opposed to\nprocesses, which are better isolated from each other). Each thread has its own\nstack for private data, but PicoLisp uses dynamic binding, where the stack holds\nthe saved values instead of the current values of symbols. As a\nresult, each running thread would overwrite the symbol bindings of other\nthreads.\n\n
Instead, PicoLisp uses separate processes - and interprocess communication -\nfor parallel execution, or coroutines as a\nkind of cooperative threads running a controlled way and doing all\nnecessary housekeeping.\n\n
Another advantage of separate processes over threads: They can be distributed\nacross multiple machines, and therefore scale better.\n\n\n
\n
Why are there no strings?
\n\n
Because PicoLisp has something better: Transient symbols. They look and behave like\nstrings in any respect, but are nevertheless true symbols, with a value and a\nproperty list.\n\n
This leads to interesting opportunities. The value, for example, can point to\nother data that represent the string's translation. This is used extensively for\nlocalization. When a program calls\n\n
\n   (prinl \"Good morning!\")\n
\n\n
then changing the value of the symbol \"Good morning!\" to its\ntranslation will change the program's output at runtime.\n\n
Transient symbols are also quite memory-conservative. As they are stored in\nnormal heap cells, no additional overhead for memory management is induced. The\ncell holds the symbol's value in its CDR, and the tail in its CAR. If the string\nis not longer than 7 bytes, it fits completely into the tail, and a single cell\nsuffices. Up to 15 bytes take up two cells, 23 bytes three etc., so that long\nstrings are not very efficient (needing twice the memory on the average), but\nthis disadvantage is made up by simplicity and uniformity. And lots of extremely\nlong strings are not the common case, as they are split up anyway during\nprocessing, and stored as plain byte sequences in external files and databases.\n\n
Because transient symbols are temporarily interned (while loading the current source file), they are\nshared within the same source and occupy that space only once, even if they\noccur multiple times within the same file.\n\n\n
\n
What about arrays?
\n\n
PicoLisp has no array or vector data type. Instead, lists must be used for\nany type of sequentially arranged data.\n\n
We believe that arrays are usually overrated. Textbook wisdom tells that they\nhave a constant access time O(1) when the index is known. Many other operations\nlike splits or insertions are expensive. Access with a known (numeric) index is\nnot typical for Lisp, and even then the advantage of an array is significant\nonly if it is relatively long. Holding lots of data in long arrays, however,\nsmells quite like a program design error, and we suspect that often more\nstructured representations like trees or interconnected objects would be better.\n\n
In practice, most arrays are rather short, or the program can be designed in\nsuch a way that long arrays (or at least an indexed access) are avoided.\n\n
Using lists, on the other hand, has advantages. We have so many concerted\nfunctions that uniformly operate on lists. There is no separate data type that\nhas to be handled by the interpreter, garbage collector, I/O, database and so\non. Lists can be made circular. And lists don't cause memory fragmentation.\n\n
Still, if there is really a need to access large amounts of data with a\nnumeric index, enum can be used. It\nemulates a multidimensional - possibly sparse - array. It takes roughly 1.5 the\nspace a linear list would require, and is very fast.\n\n\n
\n
How to do floating point arithmetic?
\n\n
PicoLisp does not support real floating point numbers. You can do all kinds\nof floating point calculations by calling existing library functions via\nnative, inline-C code, and/or by\nloading the \"@lib/math.l\" library.\n\n
But PicoLisp has something even (arguably) better: Scaled fixpoint numbers, with unlimited precision.\n\n
The reasons for this design decision are manifold. Floating point numbers\nsmack of imperfection, they don't give \"exact\" results, have limited precision\nand range, and require an extra data type. It is hard to understand what really\ngoes on (How many digits of precision do we have today? Are perhaps 10-byte\nfloats used for intermediate results? How does rounding behave?).\n\n
For fixpoint support, the system must handle just integer arithmetic, I/O and\nstring conversions. The rest is under programmer's control and responsibility\n(the essence of PicoLisp).\n\n
Carefully scaled fixpoint calculations can do anything floating point can do.\n\n\n
\n
What happens when I locally bind a symbol which has a function definition?
\n\n
That's not a good idea. The next time that function gets executed within the\ndynamic context the program may crash. Therefore we have a convention to use an\nupper case first letter for locally bound symbols:\n\n
\n(de findCar (Car List)\n   (when (member Car (cdr List))\n      (list Car (car List)) ) )\n
\n\n;-)\n\n\n
\n
Would it make sense to build PicoLisp in hardware?
\n\n
At least it should be interesting. It would be a machine executing list\n(tree) structures instead of linear instruction sequences. \"Instruction\nprefetch\" would look down the CAR- and CDR-chains, and perhaps need only a\nsingle cache for both data and instructions.\n\n
Primitive functions like set, val, if\nand while, which are written in C or assembly language\nnow, would be implemented in microcode. Plus a few I/O functions for hardware\naccess. EVAL itself would be a microcode subroutine.\n\n
Only a single heap and a single stack is needed. They grow towards each\nother, and cause garbage collection if they get too close. Heap compaction is\ntrivial due to the single cell size.\n\n
There would be no assembly-language. The lowest level (above the hardware and\nmicrocode levels) are s-expressions: The machine language is Lisp.\n\n\n
\n
I get a segfault if I ...
\n\n
It is easy to produce a segfault in PicoLisp. Just set a symbol to a value\nwhich is not a function, and call it:\n\n
\n: (setq foo 1)\n-> 1\n: (foo)\nSegmentation fault\n
\n\nThere is another example in the Evaluation section of the reference manual.\n\n
PicoLisp is a pragmatic language. It doesn't check at runtime for all\npossible error conditions which won't occur during normal usage. Such errors are\nusually detected quickly at the first test run, and checking for them after that\nwould just produce runtime overhead.\n\n
Catching the segmentation violation and bus fault signals is also not a good\nidea, because the Lisp heap is most probably be damaged afterwards, possibly\ncreating further havoc if execution continues.\n\n
It is recommended to inspect the code periodically with lint. It will detect many potential errors.\nAnd, most of these errors are avoided by following the PicoLisp naming conventions.\n\n\n
\n
Where can I ask questions?
\n\n
The best place is the PicoLisp Mailing\nList (see also The Mail\nArchive), or the IRC #picolisp\nchannel on FreeNode.net.\n\n\n\n"
  },
  {
    "path": "doc/httpGate.html",
    "content": "\n\n\n\n\n\nThe 'httpGate' Proxy Server\n\n\n\nmattias@inogu.se\n\n
The 'httpGate' Proxy Server
\n\n
(c) Software Lab. Mattias Sundblad\n\n
This document describes the httpGate utility which is included\nin the PicoLisp distribution.\n\n
For basic information about the PicoLisp system please look at the PicoLisp Reference and the PicoLisp\nTutorial.\n\n
\n\n
\n
Purpose
\n\n
httpGate is a central element of the PicoLisp application server\narchitecture. Its purpose is to perform the following tasks:\n\n
    \n
  • Provide a single application entry port (e.g. 80 or 443).\n
  • Allow PicoLisp applications to run as non-root.\n
  • Start application servers on demand.\n
  • Handle HTTPS/SSL communication.\n
\n\n
Basic functionality
\n\n
A HTTP request to port 80, respectively 443, of the form\n\n
\n   http[s]://server.org/12345/path/file\n
\n\n
is forwarded to a server on localhost listening on port 12345, to ask for the\nresource \"path/file\".\n\n
If httpGate was started with a config file, and that file contains an entry\nfor \"app\", then also the following request is accepted:\n\n
\n   http[s]://server.org/app/path/file\n
\n\n
In that case, the \"app\" server process is started automatically (if it is not\nalready running) listening on port 12345, and the request is forwarded as above.\n\n
Only requests to ports >= 1024 will be forwarded. The main httpGate\nprocess then forks two child processes, one for each direction. These child\nprocesses terminate automatically if the connection is idle for more than 7\nminutes.\n\n
Running httpGate
\n\n
The simplest way to run httpGate is to start it with an explicit port\nargument:\n\n
\n   bin/httpGate 80 8080\n   bin/httpGate 443 8080 pem/www.domain.key,pem/domain.crt\n
\n\n
When started in this way, httpGate forwards requests from port 80 and 443\nrespectively to a PicoLisp application on port 8080. This form has a drawback\nthough, since it only allows for a single application to be handled. Usually,\nthere are many PicoLisp applications running on the same machine, and we need\nhttpGate to forward requests to all of them.\n\n
To handle several applications, start httpGate with a \"names\" config file:\n\n
\n      bin/httpGate 80 names\n      bin/httpGate 443 names pem/www.domain.key,pem/domain.crt\n
\n\n
httpGate needs to be started as root, but application servers should run\nunder normal user accounts. The easiest way to start httpGate automatically is\nto add lines like the ones above to '/etc/rc.local'.\n\n
Configuring httpGate
\n\n
The \"names\" config file
\n\n
The \"names\" config file contains one line per application server. Each line\nholds six whitespace separated tokens, for example:\n\n
\n   app 12345 tom /home/tom log/app ./pil app/main.l lib/app.l -main -go -wait\n
\n\n
    \n
  1. \"app\" is the name of the application, and the key to this line.\n
  2. \"12345\" is the port where this server should listen at.\n
  3. \"tom\" is the user under whose ID the server should run.\n
  4. \"/home/tom\" is the working directory where the server should start.\n
  5. \"log/app\" is a log file to redirect stdout/stderr to.\n
  6. The rest of the line \"./pil app/main.l ...\" is the command to start the application.\n
\n\n
Empty lines, and lines starting with a \"#\", are ignored. If the key in a\nconfig file record is the special name \"@\", then it denotes the default\napplication for this machine. URLs without name will be forwarded to that port.\nIf the key contains a slash followed by a string (e.g. \"app/foo\") then this\nstring is inserted in front of URLs.\n\n
Optional tokens (e.g. log files) or empty arguments to the commands must be\nwritten as single caret (^) characters to denote empty strings. Double or single\nquotes are not parsed.\n\n
If the port is zero, then a single additional token is expected which should\ndenote an URL to redirect the request to:\n\n
\n   app 0 https://domain/foo/bar\n
\n\nThis will cause httpGate to respnd with \"302 Found\" and \"Location:\nhttps://domain/foo/bar\".\n\n
Balanced names file
\n\n
If the config file contains many (hundreds or thousands) entries, then it is\nrecommended to sort it with the 'balance' utility. This may greatly accelerate\nname (key) lookup at runtime. For that, put the above config lines into a file\n\"config\". The tool 'balance' can be built - together with httpGate - with\n\n
\n   (cd src; make tools gate)\n
\n\n
The following command will create a balanced \"names\" file:\n\n
\n   cat config | bin/balance -sort > names\n
\n\n
The \"void\" file
\n\n
If the local application server cannot be connected on the requested port\n(typically because a session timed out), and a file with the name \"void\" exists\nin the current working directory (token 4 in the config line), then the contents\nof that file (normally HTML) are sent as response to the client.\n\n
Reloading the configuration
\n\n
When the config file is modified, it can be reloaded by sending SIGHUP to all\nrunning top-level httpGate processes:\n\n
\n   $ sudo pkill -HUP -P1 httpGate\n
\n\n
Another possibility is to restart httpGate(s). This is not a problem, and can\nbe done also while the server is in production.\n\n
Just kill the top level httpGate parent process. This is not harmful, because\nexisting user sessions are handled by pairs of child processes, which continue\nto run (until they terminate normally) even if their parent is stopped. Note\nthat this is different from PicoLisp DB applications, where the parent should\n*never* be hard-stopped (eg. with 'kill -9 <pid>') while child processes\nare running ('kill <pid>' is OK though, because the parent takes care of\nstopping the children).\n\n
An example for stopping and restarting a running httpGate is:\n\n
\n   (let L\n      # Build list of all httpGate parents (i.e. on 80 and 443)\n      (make\n         (in '(\"sudo\" \"pgrep\" \"-P1\" \"httpGate\")\n            (while (read)\n               (link @) ) ) )\n      # Stop them\n      (for P L\n         (call \"sudo\" \"kill\" P) )\n      # Wait until all are gone\n      (while (find '((P) (kill P 0)) L)\n         (wait 200) )\n      # Start new\n      (call \"sudo\" \"bin/httpGate\" 80 \"names\")\n      (call \"sudo\" \"bin/httpGate\" 443 \"names\" \"pem/...\") )\n
\n\n
Keep-alive and retirement
\n\n
Applications should call\n\n
\n   (retire 20)\n
\n\n
before they call 'server'. This causes the parent server process to terminate\nautomatically 20 minutes after the last child process (user session) terminated.\nIt will be started by httpGate again on demand. User sessions in turn terminate\nautomatically after 5 minutes (if nobody logged in) or 1 hour (if a user is\nlogged in), unless JavaScript is enabled in the client browser and the\napplication calls\n\n
\n   (<ping> 7)\n
\n\n
in its main 'action' function. In that case, the user session will not\nterminate until the user closes the last window or tab to this application.\n\n\n\n"
  },
  {
    "path": "doc/man.html",
    "content": "Content-type: text/html; charset=UTF-8\n\n\nMan page of PICOLISP\n\n
PICOLISP
\nSection: User Commands (1)
Updated: 
Index\nReturn to Main Contents
\n\n \n
NAME
\n\npil, picolisp - a fast, lightweight Lisp interpreter\n \n
SYNOPSIS
\n\npil\n\n[arguments ...] [-] [arguments ...] [+]\n
\n\npicolisp\n\n[arguments ...] [-] [arguments ...] [+]\n \n
DESCRIPTION
\n\nPicoLisp\n\nis a Lisp interpreter with a small memory footprint, yet relatively high\nexecution speed. It combines an elegant and powerful language with built-in\ndatabase functionality.\n
\n\npil\n\nis the startup front-end for the interpreter. It takes care of starting the\nbinary base system and loading a useful runtime environment.\n
\n\npicolisp\n\nis just the bare interpreter binary. It is usually called in stand-alone\nscripts, using the she-bang notation in the first line, passing the minimal\nenvironment in\nlib.l\n\nand loading additional files as needed:\n
\n\n
\n#!/usr/bin/picolisp /usr/lib/picolisp/lib.l\n
\n\n
\n(load "@ext.l" "myfiles/lib.l" "myfiles/foo.l")\n
\n\n
\n(do ... something ...)\n
\n\n
\n(bye)\n
\n\n \n
INVOCATION
\n\nPicoLisp\n\nhas no pre-defined command line flags; applications are free to define their\nown. Any built-in or user-level Lisp function can be invoked from the command\nline by prefixing it with a hyphen. Examples for built-in functions useful in\nthis context are\nversion\n\n(print the version number) or\nbye\n\n(exit the interpreter). Therefore, a minimal call to print the version number\nand then immediately exit the interpreter would be:\n
\n\n
\n$ pil -version -bye\n
\n\n
\n\nAny other argument (not starting with a hyphen) should be the name of a file to\nbe loaded. If the first character of a path or file name is an at-mark, it\nwill be substituted with the path to the installation directory.\n
\n\nAll arguments are evaluated from left to right, then an interactive\nread-eval-print\n\nloop is entered (with a colon as prompt).\n
\n\nA single hyphen stops the evaluation of the rest of the command line, so that\nthe remaining arguments may be processed under program control.\n
\n\nIf the very last command line argument is a single plus character, debugging\nmode is switched on at interpreter startup, before evaluating any of the command\nline arguments. A minimal interactive session is started with:\n
\n\n
\n$ pil +\n
\n\n
\n\nHere you can access the reference manual (expects the shell variable BROWSER to\nbe set, defaults to "w3m")\n
\n\n
\n: (doc)\n
\n\n
\n\nand the online documentation for most functions,\n
\n\n
\n: (doc 'vi)\n
\n\n
\n\nor directly inspect their sources:\n
\n\n
\n: (vi 'doc)\n
\n\n
\n\nThe interpreter can be terminated with\n
\n\n
\n: (bye)\n
\n\n
\n\nor by typing Ctrl-D.\n \n
FILES
\n\nRuntime files are maintained in the ~/.pil directory:\n
\n
~/.pil/tmp/<pid>/
\nProcess-local temporary directories\n
~/.pil/rc
\nLoaded after interpreter startup\n
~/.pil/viprc
\nLoaded by the Vip editor\n
\n \n
BUGS
\n\nPicoLisp\n\ndoesn't try to protect you from every possible programming error ("You asked for\nit, you got it").\n \n
AUTHOR
\n\nAlexander Burger <abu@software-lab.de>\n \n
RESOURCES
\n\nHome page:\n\nhttp://home.picolisp.com\n
\n\nDownload:\n\nhttp://www.software-lab.de/down.html\n
\n\n
\n 
Index
\n
\n
NAME
\n
SYNOPSIS
\n
DESCRIPTION
\n
INVOCATION
\n
FILES
\n
BUGS
\n
AUTHOR
\n
RESOURCES
\n
\n
\nThis document was created by\nman2html,\nusing the manual pages.
\nTime: 08:01:21 GMT, March 29, 2021\n\n\n"
  },
  {
    "path": "doc/microTemplates",
    "content": "         Micro-Templates\n\n* Each template file in the @lib/xhtml/ directory applies to one type of\n  component in the @lib/xhtml.l functions.\n\n* The template files are line oriented. One micro-template per line.\n\n* A micro-template can be continued on the following line(s) by\n  indenting these lines with space(s).\n\n* Each line has a defined meaning. Except for indented lines, no lines\n  can be added or removed.\n\n* A micro-template may contain either variables or expressions enclosed\n  by \"¦\" (broken bar character, hex \"00A6\").\n\n* An empty line is denoted by \"<>\".\n\n* \"~\" is replaced at runtime with the session ID.\n\n* At program start, all templates from @lib/xhtml/ are loaded.\n\n* The application may override one or more files in a local directory,\n  and call 'xhtml' with that path. Also more than once.\n\n* Available templates:\n\n   html\n      1. DOCTYPE\n      2. HTML start\n      3. HEAD\n      4. BODY\n      5. HTML end\n\n   table\n      1. Table start\n      2. Caption\n      3. Header row start\n      4. Header row entry\n      5. Header row end\n      6. Data row start\n      7. Data row entry\n      8. Data row end\n      9. Table end\n\n   grid\n      1. Grid start\n      2. Grid row start\n      3. Grid row entry\n      4. Grid row end\n      5. Grid end\n\n   layout\n      Variable number of lines, one per code block\n\n   menu\n      1. Menu start\n      2. Submenu start\n      3. Plain HTML\n      4. Disabled link\n      5. Enabled link\n      6. Enabled active link\n      7. Closed submenu\n      8. Open submenu start\n      9. Open submenu end\n      10. Submenu end\n      11. Menu end\n\n   tab\n      1. TABLE start\n      2. Disabled entry\n      3. Enabled entry\n      4. TABLE end\n\n   input\n      1. (Non-text) Input element\n\n   field\n      1. Text input element\n\n   area\n      1. TEXTAREA start\n      2. TEXTAREA end\n\n   select\n      1. SELECT start\n      2. OPTION\n      3. SELECT end\n\n   submit\n      1. Submit input element\n"
  },
  {
    "path": "doc/native.html",
    "content": "\n\n\n\n\n\nNative C Calls\n\n\n\nabu@software-lab.de\n\n
Native C Calls
\n\n
(c) Software Lab. Alexander Burger\n\n
This document describes how to call C functions in shared object files\n(libraries) from PicoLisp, using the built-in native function - possibly with the help of\nthe struct and lisp functions.\n\n
\n\n\n
\n
Overview
\n\n
\nnative calls a C function in a\nshared library. It tries to\n\n
    \n
  1. find a library by name\n
  2. find a function by name in the library\n
  3. convert the function's argument(s) from Lisp to C data structures\n
  4. call the function's C code\n
  5. convert the function's return value(s) from C to Lisp data structures\n
\n\n
The direct return value of native is the Lisp representation of\nthe C function's return value. Further values, returned by reference from the C\nfunction, are available in Lisp variables (symbol values).\n\n
struct is a helper function,\nwhich can be used to manipulate C data structures in memory. It may take a\nscalar (a numeric representation of a C value) to convert it to a Lisp item, or\n(more typically) a pointer to a memory area to build and extract data\nstructures. lisp allows you to install callback functions, callable\nfrom C code, written in Lisp.\n\n
%@ is a convenience function,\nsimplifying the most common use case of native.\n\n
In combination, these functions can interface PicoLisp to almost any C\nfunction.\n\n
The above steps are fully dynamic; native doesn't have (and\ndoesn't require) a priori knowledge about the library, the function or the\ninvolved data. No need to write any glue code, interfaces or include files. All\nfunctions can even be called interactively from the REPL.\n\n\n
\n
Syntax
\n\n
The arguments to native are\n\n
    \n
  1. a library\n
  2. a function\n
  3. a return value specification\n
  4. optional arguments\n
\n\n
The simplest form is a call to a function without return value and without\narguments. If we assume a library \"lib.so\", containing a function with the\nprototype\n\n
\nvoid fun(void);\n
\n\n
then we can call it as\n\n
\n(native \"lib.so\" \"fun\")\n
\n\n\n
\n
Libraries
\n\n
The first argument to native specifies the library. It is either\nthe name of a library (a symbol), or the handle of a previously\nfound library (a number).\n\n
As a special case, a transient symbol \"@\" can be passed for the\nlibrary name. It then refers to the current main program (instead of an external\nlibrary), and can be used for standard functions like \"malloc\" or\n\"free\".\nBecause this is needed so often,\n\n
\n(%@ \"fun\" ...)\n
\n\n
can be used instead of\n\n
\n(native \"@\" \"fun\" ...)\n
\n\n
native uses dlopen(3) internally to find and open\nthe library, and to obtain the handle. If the name contains a slash ('/'), then\nit is interpreted as a (relative or absolute) pathname. Otherwise, the dynamic\nlinker searches for the library according to the system's environment and\ndirectories. See the man page of dlopen(3) for further details.\n\n
If called with a symbolic argument, native automatically caches\nthe handle of the found library in the value of that symbol. The most natural\nway is to pass the library name as a transient\nsymbol (\"lib.so\" above): The initial value of a transient symbol is\nthat symbol itself, so that native receives the library name upon\nthe first call. After successfully finding and opening the library,\nnative stores the handle of that library in the value of the passed\nsymbol (\"lib.so\"). As native evaluates its arguments\nin the normal way, subsequent calls within the same transient scope will receive\nthe numeric value (the handle), and don't need to open and search the library\nagain.\n\n\n
\n
Functions
\n\n
The same rules applies to the second argument, the function. When called with\na symbol, native stores the function handle in its value, so that\nsubsequent calls evaluate to that handle, and native can directly\njump to the function.\n\n
native uses dlsym(3) internally to obtain the\nfunction pointer. See the man page of dlsym(3) for further details.\n\n
In most cases a program will call more than one function from a given\nlibrary. If we keep the code within the same transient scope (i.e. in the same\nsource file), each library will be opened - and each function searched - only\nonce.\n\n
\n(native \"lib.so\" \"fun1\")\n(native \"lib.so\" \"fun2\")\n(native \"lib.so\" \"fun3\")\n
\n\n
After \"fun1\" was called, \"lib.so\" will be open, and\nwon't be re-opened for \"fun2\" and \"fun3\". Consider\nthe definition of helper functions:\n\n
\n(de fun1 ()\n   (native \"lib.so\" \"fun1\") )\n\n(de fun2 ()\n   (native \"lib.so\" \"fun2\") )\n\n(de fun3 ()\n   (native \"lib.so\" \"fun3\") )\n
\n\n
After any one of fun1, fun2 or fun3\nwas called, the symbol \"lib.so\" will hold the library handle. And\neach function \"fun1\", \"fun2\" and \"fun3\"\nwill be searched only when called the first time.\n\n
Note that the function handle points to a structure in memory, which is\nautomatically allocated. This implies that a memory leak may occur if the\ntransient symbol holding the function handle goes out of scope (e.g. by repeated\n(re)loading the library after\nexecuting its functions).\n\n
Warning: It should be avoided to put more than one library into a single\ntransient scope if there is a chance that two different functions with the same\nname will be called in two different libraries. Because of the function handle\ncaching, the second call would otherwise (wrongly) go to the first function.\n\n\n
\n
Return Value
\n\n
The (optional) third argument to native specifies the return\nvalue. A C function can return many types of values, like integer or floating\npoint numbers, string pointers, or pointers to structures which in turn consist\nof those types, and even other structures or pointers to structures.\nnative tries to cover most of them.\n\n
As described in the result specification,\nthe third argument should consist of a pattern which tells native\nhow to extract the proper value.\n\n\n
Primitive Types
\n\n
In the simplest case, the result specification is NIL like in\nthe examples so far. This means that either the C function returns\nvoid, or that we are not interested in the value. The return value\nof native will be NIL in that case.\n\n
If the result specification is one of the symbols B,\nI or N, an integer number is returned, by interpreting\nthe result as a char (8 bit unsigned byte), int (32\nbit signed integer), or long number (64 bit signed integer),\nrespectively. Other (signed or unsigned numbers, and of different sizes) can be\nproduced from these types with logical and arithmetic operations if necessary.\n\n
If the result specification is the symbol C, the result is\ninterpreted as a 16 bit number, and a single-char transient symbol (string) is\nreturned.\n\n
A specification of S tells native to interpret the\nresult as a pointer to a C string (null terminated), and to return a transient\nsymbol (string).\n\n
If the result specification is a number, it will be used as a scale to\nconvert a returned double (if the number is positive) or\nfloat (if the number is negative) to a scaled fixpoint number.\n\n
Examples for function calls, with their corresponding C prototypes:\n\n
\n(native \"lib.so\" \"fun\" 'I)             # int fun(void);\n(native \"lib.so\" \"fun\" 'N)             # long fun(void);\n(native \"lib.so\" \"fun\" 'P)             # void *fun(void);\n(native \"lib.so\" \"fun\" 'S)             # char *fun(void);\n(native \"lib.so\" \"fun\" 1.0)            # double fun(void);\n
\n\n\n
Arrays and Structures
\n\n
If the result specification is a list, it means that the C function returned\na pointer to an array, or an arbitrary memory structure. The specification list\nshould then consist of either the above primitive specifications (symbols or\nnumbers), or of cons pairs of a primitive specification and a repeat count, to\ndenote arrays of the given type.\n\n
Examples for function calls, with their corresponding pseudo C prototypes:\n\n
\n(native \"lib.so\" \"fun\" '(I . 8))       # int *fun(void);  // 8 integers\n(native \"lib.so\" \"fun\" '(B . 16))      # unsigned char *fun(void);  // 16 bytes\n\n(native \"lib.so\" \"fun\" '(I I))         # struct {int i; int j;} *fun(void);\n(native \"lib.so\" \"fun\" '(I . 4))       # struct {int i[4];} *fun(void);\n\n(native \"lib.so\" \"fun\" '(I (B . 4)))   # struct {\n                                       #    int i;\n                                       #    unsigned char c[4];\n                                       # } *fun(void);\n\n(native \"lib.so\" \"fun\"                 # struct {\n   '(((B . 4) I) (S . 12) (N . 8)) )   #    struct {unsigned char c[4]; int i;}\n                                       #    char *names[12];\n                                       #    long num[8];\n                                       # } *fun(void);\n
\n\n
If a returned structure has an element which is a pointer to some\nother structure (i.e. not an embedded structure like in the last example above),\nthis pointer must be first obtained with a N pattern, which can\nthen be passed to struct for further\nextraction.\n\n\n
\n
Arguments
\n\n
The (optional) fourth and following arguments to native specify\nthe arguments to the C function.\n\n\n
Primitive Types
\n\n
Integer arguments (up to 64 bits, signed or unsigned char,\nshort, int or long) can be passed as they\nare: As numbers.\n\n
\n(native \"lib.so\" \"fun\" NIL 123)        # void fun(int);\n(native \"lib.so\" \"fun\" NIL 1 2 3)      # void fun(int, long, short);\n
\n\n
String arguments can be specified as symbols. native allocates\nmemory for each string on the stack, passes the pointer to the C function, and\ncleans up the stack when done.\n\n
\n(native \"lib.so\" \"fun\" NIL \"abc\")      # void fun(char*);\n(native \"lib.so\" \"fun\" NIL 3 \"def\")    # void fun(int, char*);\n
\n\n
Note that the allocated string memory is released after the return\nvalue is extracted. This allows a C function to return the argument string\npointer, perhaps after modifying the data in-place, and receive the new string\nas the return value (with the S specification).\n\n
\n(native \"lib.so\" \"fun\" 'S \"abc\")       # char *fun(char*);\n
\n\n
Also note that specifying NIL as an argument passes an empty\nstring (\"\", which also reads as NIL in PicoLisp) to the C function.\nPhysically, this is a pointer to a NULL-byte, and is not a NULL-pointer.\nBe sure to pass 0 (the number zero) if a NULL-pointer is desired.\n\n
Floating point arguments are specified as cons pairs, where the value is in\nthe CAR, and the CDR holds the fixpoint scale. If the scale is positive, the\nnumber is passed as a double, otherwise as a float.\n\n
\n(native \"lib.so\" \"fun\" NIL             # void fun(double, float);\n   (12.3 . 1.0) (4.56 . -1.0) )\n
\n\n\n
Arrays and Structures
\n\n
Composite arguments are specified as nested list structures.\nnative allocates memory for each array or structure (with\nmalloc(3)), passes the pointer to the C function, and releases the\nmemory (with free(3)) when done.\n\n
This implies that such an argument can be both an input and an output value\nto a C function (pass by reference).\n\n
The CAR of the argument specification can be NIL (then it is an\ninput-only argument). Otherwise, it should be a variable which receives the\nreturned structure data.\n\n
The CADR of the argument specification must be a cons pair with the total\nsize of the structure in its CAR. The CDR is ignored for input-only arguments,\nand should contain a result specification for\nthe output value to be stored in the variable.\n\n
For example, a minimal case is a function that takes an integer reference,\nand stores the number '123' in that location:\n\n
\nvoid fun(int *i) {\n   *i = 123;\n}\n
\n\n
We call native with a variable X in the CAR of the\nargument specification, a size of 4 (i.e. sizeof(int)), and\nI for the result specification. The stored value is then available\nin the variable X:\n\n
\n: (native \"lib.so\" \"fun\" NIL '(X (4 . I)))\n-> NIL\n: X\n-> 123\n
\n\n
The rest (CDDR) of the argument specification may contain initialization\ndata, if the C function expects input values in the structure. It should be a\nlist of initialization items, optionally with a\nfill-byte value in the CDR of the last cell.\n\n
If there are no initialization items and just the final fill-byte,\nthen the whole buffer is filled with that byte. For example, to pass a buffer of\n20 bytes, initialized to zero:\n\n
\n: (native \"lib.so\" \"fun\" NIL '(NIL (20) . 0))\n
\n\n
A buffer of 20 bytes, with the first 4 bytes initialized to 1, 2, 3, and 4,\nand the rest filled with zero:\n\n
\n: (native \"lib.so\" \"fun\" NIL '(NIL (20) 1 2 3 4 . 0))\n
\n\n
and the same, where the buffer contents are returned as a list of bytes in\nthe variable X:\n\n
\n: (native \"lib.so\" \"fun\" NIL '(X (20 B . 20) 1 2 3 4 . 0))\n
\n\n
For a more extensive example, let's use the following definitions:\n\n
\ntypedef struct value {\n   int x, y;\n   double a, b, c;\n   int z;\n   char nm[4];\n} value;\n\nvoid fun(value *val) {\n   printf(\"%d %d\\n\", val->x, val->y);\n   val->x = 3;\n   val->y = 4;\n   strcpy(val->nm, \"OK\");\n}\n
\n\n
We call this function with a structure of 40 bytes, requesting the returned\ndata in V, with two integers (I . 2), three doubles\n(100 . 3) with a scale of 2 (1.0 = 100), another integer\nI and four characters (C . 4). If the structure gets\ninitialized with two integers 7 and 6, three doubles 0.11, 0.22 and 0.33, and\nanother integer 5 while the rest of the 40 bytes is cleared to zero\n\n
\n: (native \"lib.so\" \"fun\" NIL\n   '(V (40 (I . 2) (100 . 3) I (C . 4)) -7 -6 (100 11 22 33) -5 . 0) )\n
\n\n
then it will print the integers 7 and 6, and V will contain the\nreturned list\n\n
\n((3 4) (11 22 33) 5 (\"O\" \"K\" NIL NIL))\n
\n\n
i.e. the original integer values 7 and 6 replaced with 3 and 4.\n\n
Note that the allocated structure memory is released after the return\nvalue is extracted. This allows a C function to return the argument structure\npointer, perhaps after modifying the data in-place, and receive the new\nstructure as the return value - instead of (or even in addition to) to the\ndirect return via the argument reference.\n\n\n
\n
Memory Management
\n\n
The preceding Arguments section mentions that\nnative implicitly allocates and releases memory for strings, arrays\nand structures.\n\n
Technically, this mimics automatic variables in C.\n\n
For a simple example, let's assume that we want to call read(2)\ndirectly, to fetch a 4-byte integer from a given file descriptor. This could be\ndone with the following C function:\n\n
\nint read4bytes(int fd) {\n   char buf[4];\n\n   read(fd, buf, 4);\n   return *(int*)buf;\n}\n
\n\n
buf is an automatic variable, allocated on the stack, which\ndisappears when the function returns. A corresponding native call\nwould be:\n\n
\n(%@ \"read\" 'I Fd '(Buf (4 . I)) 4)\n
\n\n
The structure argument (Buf (4 . I)) says that a space of 4\nbytes should be allocated and passed to read, then an integer\nI returned in the variable Buf (the return value of\nnative itself is the integer returned by read). The\nmemory space is released after that.\n\n
(Note that we can call %@ here, as read resides in\nthe main program.)\n\n
Instead of a single integer, we might want a list of four bytes to be\nreturned from native:\n\n
\n(%@ \"read\" 'I Fd '(Buf (4 B . 4)) 4)\n
\n\n
The difference is that we wrote (B . 4) (a list of 4 bytes)\ninstead of I (a single integer) for the result specification (see the Arrays and Structures section).\n\n
Let's see what happens if we extend this example. We'll write the four bytes\nto another file descriptor, after reading them from the first one:\n\n
\nvoid copy4bytes(int fd1, int fd2) {\n   char buf[4];\n\n   read(fd1, buf, 4);\n   write(fd2, buf, 4);\n}\n
\n\n
Again, buf is an automatic variable. It is passed to both\nread and write. A direct translation would be:\n\n
\n(%@ \"read\" 'I Fd '(Buf (4 B . 4)) 4)\n(%@ \"write\" 'I Fd2 (cons NIL (4) Buf) 4)\n
\n\n
This works as expected. read returns a list of four bytes in\nBuf. The call to cons builds the structure\n\n
\n(NIL (4) 1 2 3 4)\n
\n\n
i.e. no return variable, a four-byte memory area, filled with the four bytes\n(assuming that read returned 1, 2, 3 and 4). Then this structure is\npassed to write.\n\n
But: This solution induces quite some overhead. The four-byte buffer is\nallocated before the call to read and released after that, then\nallocated and released again for write. Also, the bytes are\nconverted to a list to be stored in Buf, then that list is extended\nfor the structure argument to write, and converted again back to\nthe raw byte array. The data in the list itself are never used.\n\n
If the above operation is to be used more than once, it is better to allocate\nthe buffer manually, use it for both reading and writing, and then release it.\nThis also avoids all intermediate list conversions.\n\n
\n(let Buf (%@ \"malloc\" 'P 4)  # Allocate memory\n   (%@ \"read\" 'I Fd Buf 4)   # (Possibly repeat this several times)\n   (%@ \"write\" 'I Fd2 Buf 4)\n   (%@ \"free\" NIL Buf) )     # Release memory\n
\n\n
To allocate such a buffer locally on the stack (just like a C function would\ndo), buf can be used. Equivalent to the\nabove is:\n\n
\n(buf Buf 4  # Allocate local memory\n   (%@ \"read\" 'I Fd Buf 4)\n   (%@ \"write\" 'I Fd2 Buf 4) )\n
\n\n\n
Fast Fourier Transform
\n\n
For a more typical example, we might call the Fast Fourier Transform using\nthe library from the FFTW package. With the\nexample code for calculating Complex One-Dimensional DFTs:\n\n
\n#include <fftw3.h>\n...\n{\n   fftw_complex *in, *out;\n   fftw_plan p;\n   ...\n   in = (fftw_complex*) fftw_malloc(sizeof(fftw_complex) * N);\n   out = (fftw_complex*) fftw_malloc(sizeof(fftw_complex) * N);\n   p = fftw_plan_dft_1d(N, in, out, FFTW_FORWARD, FFTW_ESTIMATE);\n   ...\n   fftw_execute(p); /* repeat as needed */\n   ...\n   fftw_destroy_plan(p);\n   fftw_free(in); fftw_free(out);\n}\n
\n\n
we can build the following equivalent:\n\n
\n(load \"@lib/math.l\")\n\n(de FFTW_FORWARD . -1)\n(de FFTW_ESTIMATE . 64)\n\n(de fft (Lst)\n   (let\n      (Len (length Lst)\n         In (native \"libfftw3.so\" \"fftw_malloc\" 'P (* Len 16))\n         Out (native \"libfftw3.so\" \"fftw_malloc\" 'P (* Len 16))\n         P (native \"libfftw3.so\" \"fftw_plan_dft_1d\" 'N\n            Len In Out FFTW_FORWARD FFTW_ESTIMATE ) )\n      (struct In NIL (cons 1.0 (apply append Lst)))\n      (native \"libfftw3.so\" \"fftw_execute\" NIL P)\n      (prog1\n         (struct Out (make (do Len (link (1.0 . 2)))))\n         (native \"libfftw3.so\" \"fftw_destroy_plan\" NIL P)\n         (native \"libfftw3.so\" \"fftw_free\" NIL Out)\n         (native \"libfftw3.so\" \"fftw_free\" NIL In) ) ) )\n
\n\n
This assumes that the argument list Lst is passed as a list\nof complex numbers, each as a list of two numbers for the real and imaginary\npart, like\n\n
\n(fft '((1.0 0) (1.0 0) (1.0 0) (1.0 0) (0 0) (0 0) (0 0) (0 0)))\n
\n\n
The above translation to Lisp is quite straightforward. After the two buffers\nare allocated, and a plan is created, struct is called to store the argument list\nin the In structure as a list of double numbers (according to the\n1.0 initialization item). Then\nfftw_execute is called, and struct is called again to\nretrieve the result from Out and return it from fft\nvia the prog1. Finally, all memory is\nreleased.\n\n\n
Constant Data
\n\n
If such allocated data (strings, arrays or structures passed to\nnative) are constant during the lifetime of a program, it makes\nsense to allocate them only once, before their first use. A typical candidate is\nthe format string of a printf call. Consider a function which\nprints a floating point number in scientific notation:\n\n
\n(load \"@lib/math.l\")\n\n: (de prf (Flt)\n   (%@ \"printf\" NIL \"%e\\n\" (cons Flt 1.0)) )\n-> prf\n\n: (prf (exp 12.3))\n2.196960e+05\n
\n\n
As we know that the format string \"%e\\n\" will be converted from\na Lisp symbol to a C string on each call to prf, we might as well\nperform a little optimization and delegate this conversion to the program load\ntime:\n\n
\n: (de prf (Flt)\n   (%@ \"printf\" NIL `(%@ \"strdup\" 'P \"%e\\n\") (cons Flt 1.0)) )\n-> prf\n\n: (prf (exp 12.3))\n2.196960e+05\n
\n\n
If we look at the prf function, we see that it now contains the\npointer to the allocated string memory:\n\n
\n: (pp 'prf)\n(de prf (Flt)\n   (%@ \"printf\" NIL 24662032 (cons Flt 1000000)) )\n-> prf\n
\n\n
This pointer will be used by printf directly, without any\nfurther conversion or memory management.\n\n\n
\n
Callbacks
\n\n
Sometimes it is necessary to do the reverse: Call Lisp code from C code.\n\n
This mechanism uses the Lisp-level function lisp. No C source code access is\nrequired.\n\n
lisp returns a function pointer, which can be passed to\nC functions via native. When this function pointer is\ndereferenced and called from the C code, the corresponding Lisp function\nis invoked. Only five numeric arguments and a numeric return value can\nbe used, and other data types must be handled by the Lisp function with\nstruct and memory management\noperations.\n\n
Callbacks are often used in user interface libraries, to handle key-, mouse-\nand other events. Examples can be found in \"@lib/openGl.l\". The\nfollowing function mouseFunc takes a Lisp function, installs it\nunder the tag mouseFunc (any other tag would be all right too) as a\ncallback, and passes the resulting function pointer to the OpenGL\nglutMouseFunc() function, to set it as a callback for the current\nwindow:\n\n
\n(de mouseFunc (Fun)\n   (native `*GlutLib \"glutMouseFunc\" NIL (lisp 'mouseFunc Fun)) )\n
\n\n
(The global *GlutLib holds the library\n\"/usr/lib/libglut.so\". The backquote (`) is important\nhere, so that the transient symbol with the library name (and not the global\n*GlutLib) is evaluated by native, resulting in the\nproper library handle at runtime).\n\n
A program using OpenGL may then use mouseFunc to install a\nfunction\n\n
\n(mouseFunc\n   '((Btn State X Y)\n      (do-something-with Btn State X Y) ) )\n
\n\n
so that future clicks into the window will pass the button, state and\ncoordinates to that function.\n\n\n\n"
  },
  {
    "path": "doc/rc.sample",
    "content": "# 20nov24 Software Lab. Alexander Burger\n# Copy to ~/.pil/rc\n\n(history\n   (make\n      (skip \"#\")\n      (while (line T) (link @))  # Global history\n      (while (read) (eval @))  # Initial commands\n      (when (info \".pilrc\")  # Local history and commands\n         (in @@\n            (skip \"#\")\n            (while (line T) (link @))\n            (while (read) (eval @)) ) ) ) )\n\n# Initial history\n(stack)\n(gc 1200) (dbCheck)\n(show (; *FormLst 1 2))\n(vi (; *FormLst 1 2 *Dbg 1 -1))\n(show (; *FormLst 1 2 obj))\n\n# Initial commands\n(de x ()\n   (load \"x.l\") )\n"
  },
  {
    "path": "doc/ref.html",
    "content": "\n\n\n\n\n\nPicoLisp Reference\n\n\n\nabu@software-lab.de\n\n
\nPerfection is attained
\nnot when there is nothing left to add
\nbut when there is nothing left to take away.
\n(Antoine de Saint-Exupéry)
\n\n\n
The PicoLisp Reference
\n\n
(c) Software Lab. Alexander Burger\n\n
This document describes the concepts, data types, and kernel functions of the\nPicoLisp system.\n\n
This is not a Lisp tutorial. For an introduction to Lisp, a\ntraditional Lisp book like \"Lisp\" by Winston/Horn (Addison-Wesley 1981) is\nrecommended. Note, however, that there are significant differences between\nPicoLisp and Maclisp (and even greater differences to Common Lisp).\n\n
Please take a look at the PicoLisp Tutorial for an\nexplanation of some aspects of PicoLisp, and scan through the list of Frequently Asked Questions (FAQ).\n\n
\n\n\n
\n
Introduction
\n\n
PicoLisp is the result of a language design study, trying to answer the\nquestion \"What is a minimal but useful architecture for a virtual machine?\".\nBecause opinions differ about what is meant by \"minimal\" and \"useful\", there are\nmany answers to that question, and people might consider other solutions more\n\"minimal\" or more \"useful\". But from a practical point of view, PicoLisp has\nproven to be a valuable answer to that question.\n\n
First of all, PicoLisp is a virtual machine architecture, and then a\nprogramming language. It was designed in a \"bottom up\" way, and \"bottom up\" is\nalso the most natural way to understand and to use it: Form Follows\nFunction.\n\n
PicoLisp has been used in several commercial and research programming\nprojects since 1988. Its internal structures are simple enough, allowing an\nexperienced programmer always to fully understand what's going on under the\nhood, and its language features, efficiency and extensibility make it suitable\nfor almost any practical programming task.\n\n
In a nutshell, emphasis was put on four design objectives. The PicoLisp\nsystem should be\n\n
\n\n
Simple
\n
The internal data structure should be as simple as possible. Only one single\ndata structure is used to build all higher level constructs.\n
\n\n
Unlimited
\n
There are no limits imposed upon the language due to limitations of the\nvirtual machine architecture. That is, there is no upper bound in symbol name\nlength, number digit counts, stack depth, or data structure and buffer sizes,\nexcept for the total memory size of the host machine.\n
\n\n
Dynamic
\n
Behavior should be as dynamic as possible (\"run\"-time vs. \"compile\"-time).\nAll decisions are delayed until runtime where possible. This involves matters\nlike memory management, dynamic symbol binding, and late method binding.\n
\n\n
Practical
\n
PicoLisp is not just a toy of theoretical value. It is in use since 1988 in\nactual application development, research and production.\n
\n\n
\n\n\n
\n
The PicoLisp Machine
\n\n
An important point in the PicoLisp philosophy is the knowledge about the\narchitecture and data structures of the internal machinery. The high-level\nconstructs of the programming language directly map to that machinery, making\nthe whole system both understandable and predictable.\n\n
This is similar to assembly language programming, where the programmer has\ncomplete control over the machine.\n\n\n
\n
The Cell
\n\n
The PicoLisp virtual machine is both simpler and more powerful than most\ncurrent (hardware) processors. At the lowest level, it is constructed from a\nsingle data structure called \"cell\":\n\n
\n         +-----+-----+\n         | CAR | CDR |\n         +-----+-----+\n
\n\n
A cell is a pair of 64-bit machine words, which traditionally are called CAR\nand CDR in the Lisp terminology. These words can represent either a numeric\nvalue (scalar) or the address of another cell (pointer). All higher level data\nstructures are built out of cells.\n\n
The type information of higher level data is contained in the pointers to\nthese data. Assuming the implementation on a byte-addressed physical machine,\nand the pointer size being 8 bytes, each cell has a size of 16 bytes. Therefore,\nthe pointer to a cell must point to a 16-byte boundary (a number which is a\nmultiple of 16), and its bit-representation will look like:\n\n
\n      xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx0000\n
\n\n
(the 'x' means \"don't care\"). For the individual data types, the\npointer is adjusted to point to other parts of a cell, in effect setting some of\nthe lower four bits to non-zero values. These bits are then used by the\ninterpreter to determine the data type.\n\n
In any case, bit(0) - the least significant of these bits - is reserved as a\nmark bit for garbage collection.\n\n
Initially, all cells in the memory are unused (free), and linked together to\nform a \"free list\". To create higher level data types at runtime, cells are\ntaken from that free list, and returned by the garbage collector when they are\nno longer needed. All memory management is done via that free list; there are no\nadditional buffers, string spaces or special memory areas, with two exceptions:\n\n
    \n
  • A certain fixed area of memory is set aside to contain the executable code\nand global variables of the interpreter itself, and\n\n
  • a standard push down stack for return addresses and temporary storage. Both\nare not directly accessible by the programmer.\n\n
\n\n\n
\n
Data Types
\n\n
On the virtual machine level, PicoLisp supports\n\n
    \n
  • three base data types: Numbers, Symbols and Cons Pairs (Lists),\n
  • the three scope variations of symbols: Internal, Transient and External, and\n
  • the special symbol NIL.\n
\n\n
They are all built from the single cell data structure, and all runtime data\ncannot consist of any other types than these three.\n\n
The following diagram shows the complete data type hierarchy, consisting of\nthe three base types and the symbol variations:\n\n
\n                       cell\n                        |\n            +-----------+-----------+\n            |           |           |\n         Number       Symbol       Pair\n                        |\n                        |\n   +--------+-----------+-----------+\n   |        |           |           |\n  NIL   Internal    Transient    External\n
\n\n\n
\n
Numbers
\n\n
A number can represent a signed integral value of arbitrary size. Internally,\nnumeric values of up to 60 bits are stored in \"short\" numbers,\n\n
\n      xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxS010\n
\n\ni.e. the value is directly represented in the pointer, and doesn't take any heap\nspace.\n\n
Numbers larger than that are \"big\" numbers, stored in heap cells. The CARs of\none or more cells hold the number's \"digits\" (64 bits each), with the least\nsignificant digit first, while the CDRs point to the remaining digits.\n\n
\n         Bignum\n         |\n         V\n      +-----+-----+\n      | DIG |  |  |\n      +-----+--+--+\n               |\n               V\n            +-----+-----+\n            | DIG |  |  |\n            +-----+--+--+\n                     |\n                     V\n                  +-----+-----+\n                  | DIG | CNT |\n                  +-----+-----+\n
\n\nThe CDR of the final cell holds the remaining bits in a short number.\n\n
The pointer to a big number points into the middle of the CAR, with an offset\nof 4 from the cell's start address, and the sign bit in bit(3):\n\n
\n      xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxS100\n
\n\n
Thus, a number is recognized by the interpreter when either bit(1) is\nnon-zero (a short number) or bit(2) is non-zero (a big number).\n\n\n
\n
Symbols
\n\n
A symbol is more complex than a number. Each symbol has a value, and\noptionally a name and an arbitrary number of properties. The CDR of a symbol\ncell is also called VAL, and the CAR points to the symbol's tail. As a minimum,\na symbol consists of a single cell, and has no name or properties:\n\n
\n            Symbol\n            |\n            V\n      +-----+-----+\n      | '0' | VAL |\n      +-----+-----+\n
\n\n
That is, the symbol's tail is empty (ZERO, as indicated by\n'0').\n\n
The pointer to a symbol points to the CDR of the cell, with an offset of 8\nbytes from the cell's start address. Therefore, the bit pattern of a symbol will\nbe:\n\n
\n      xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx1000\n
\n\n
Thus, a symbol is recognized by the interpreter when bit(3) is non-zero. (It\nshould also be understood that both bit(2) and bit(1) must be zero, thus\navoiding confusion with the number types.)\n\n
A property is a key-value pair, represented by a cons pair in the symbol's\ntail. This is called a \"property list\". The property list may be terminated by a\nnumber (short or big) representing the symbol's name. In the following example,\na symbol with the name \"abcdefghijklmno\" has three properties: A\nKEY/VAL pair, a cell with only a KEY, and another KEY/VAL pair.\n\n
\n            Symbol\n            |\n            V\n      +-----+-----+                                +----------+---------+\n      |  |  | VAL |                                |'hgfedcba'|'onmlkji'|\n      +--+--+-----+                                +----------+---------+\n         | tail                                       ^\n         |                                            |\n         V                                            | name\n         +-----+-----+     +-----+-----+     +-----+--+--+\n         |  |  |  ---+---> | KEY |  ---+---> |  |  |  |  |\n         +--+--+-----+     +-----+-----+     +--+--+-----+\n            |                                   |\n            V                                   V\n            +-----+-----+                       +-----+-----+\n            | VAL | KEY |                       | VAL | KEY |\n            +-----+-----+                       +-----+-----+\n
\n\n
Each property in a symbol's tail is either a symbol (like the single KEY\nabove, then it represents the boolean value T) or a cons pair with\nthe property key in its CDR and the property value in its CAR. In both cases,\nthe key should be a symbol, because searches in the property list are performed\nusing pointer comparisons.\n\n
The name of a symbol is stored as a number at the end of the tail. It\ncontains the characters of the name in UTF-8 encoding, using between one and\nseven bytes in a short number, or eight bytes in a bignum cell. The first byte\nof the first character, for example, is stored in the lowest 8 bits of the\nnumber.\n\n
All symbols have the above structure, but depending on scope and\naccessibility there are actually four types of symbols: NIL, internal, transient and external symbols.\n\n\n
\n
NIL
\n\n
NIL is a special symbol which exists exactly once in the whole\nsystem. It is used\n\n
    \n
  • as an end-of-list marker\n
  • to represent the empty list\n
  • to represent the boolean value \"false\"\n
  • to represent a string of length zero\n
  • to represent the absolute minimum\n
  • to represent end of file\n
  • to represent standard in/out\n
  • to represent the value \"Not a Number\"\n
  • as the root of all class hierarchies\n
  • as volatile property key\n
  • as \"no value\"\n
\n\n
For that, NIL has a special structure:\n\n
\n      NIL:  /\n            |\n            V\n      +-----+-----+-----+-----+\n      |'LIN'|  /  |  /  |  /  |\n      +-----+-----+-----+-----+\n
\n\n
The reason for that structure is NIL's dual nature both as a\nsymbol and as a list:\n\n
    \n
  • As a symbol, it should give NIL for its VAL, and be without\nproperties\n\n
  • For the empty list, NIL should give NIL both for\nits CAR and for its CDR\n\n
\n\n
These requirements are fulfilled by the above structure.\n\n\n
\n
Internal Symbols
\n\n
Internal symbols are all those \"normal\" symbols, as they are used for\nfunction definitions and variable names. They are \"interned\" into an index\nstructure, so that it is possible to find an internal symbol by searching for\nits name.\n\n
There cannot be two different symbols with the same name in the same\nnamespace.\n\n
Initially, a new internal symbol's VAL is NIL.\n\n\n
\n
Transient Symbols
\n\n
Transient symbols are only interned into an index structure for a certain\ntime (e.g. while reading the current source file), and are released after that.\nThat means, a transient symbol cannot be accessed then by its name, and there\nmay be several transient symbols in the system having the same name.\n\n
Transient symbols are used\n\n
    \n
  • as text strings\n\n
  • as identifiers with a limited access scope (like, for example,\nstatic identifiers in the C language family)\n\n
  • as anonymous, dynamically created objects (without a name)\n\n
\n\n
Initially, a new transient symbol's VAL is that symbol itself.\n\n
A transient symbol without a name can be created with the box or new functions.\n\n\n
\n
External Symbols
\n\n
External symbols reside in a database file (or other resources, see *Ext), and are loaded into memory - and written\nback to the file - dynamically as needed, and transparently to the programmer.\nThey are kept in memory (\"cached\") as long as they are accessible (\"referred\nto\") from other parts of the program, or when they were modified but not yet\nwritten to the database file (by commit).\n\n
The interpreter recognizes external symbols internally by an additional tag\nbit in the tail structure.\n\n
There cannot be two different external symbols with the same name. External\nsymbols are maintained in index structures while they are loaded into memory,\nand have their external location (disk file and block offset) directly coded\ninto their names (more details here).\n\n
Initially, a new external symbol's VAL is NIL, unless otherwise\nspecified at creation time.\n\n\n
\n
Lists
\n\n
A list is a sequence of one or more cells (cons pairs), holding numbers,\nsymbols, or cons pairs.\n\n
\n      |\n      V\n      +-----+-----+\n      | any |  |  |\n      +-----+--+--+\n               |\n               V\n               +-----+-----+\n               | any |  |  |\n               +-----+--+--+\n                        |\n                        V\n                        ...\n
\n\n
Lists are used in PicoLisp to implement composite data structures like\narrays, trees, stacks or queues.\n\n
In contrast to lists, numbers and symbols are collectively called \"Atoms\".\n\n
Typically, the CDR of each cell in a list points to the following cell,\nexcept for the last cell which points to NIL. If, however, the CDR of\nthe last cell points to an atom, that cell is called a \"dotted pair\" (because of\nits I/O syntax with a dot '.' between the two values).\n\n\n
\n
Memory Management
\n\n
The PicoLisp interpreter has complete knowledge of all data in the system,\ndue to the type information associated with every pointer. Therefore, an\nefficient garbage collector mechanism can easily be implemented. PicoLisp\nemploys a simple but fast mark-and-sweep garbage collector.\n\n
As the collection process is very fast (in the order of milliseconds per\nmegabyte), it was not necessary to develop more complicated, time-consuming and\nerror-prone garbage collection algorithms (e.g. incremental collection). A\ncompacting garbage collector is also not necessary, because the single cell data\ntype cannot cause heap fragmentation.\n\n\n
\n
Programming Environment
\n\n
Lisp was chosen as the programming language, because of its clear and simple\nstructure.\n\n
In some previous versions, a Forth-like syntax was also implemented on top of\na similar virtual machine (Lifo). Though that language was more flexible and\nexpressive, the traditional Lisp syntax proved easier to handle, and the virtual\nmachine can be kept considerably simpler.\n\nPicoLisp inherits the major advantages of classical Lisp systems like\n\n
    \n
  • Dynamic data types and structures\n
  • Formal equivalence of code and data\n
  • Functional programming style\n
  • An interactive environment\n
\n\n
In the following, some concepts and peculiarities of the PicoLisp language\nand environment are described.\n\n\n
\n
Installation
\n\n
PicoLisp supports two installation strategies: Local and Global.\n\n
Normally, if you didn't build PicoLisp yourself but installed it with your\noperating system's package manager, you will have a global installation. This\nallows system-wide access to the executable and library/documentation files.\n\n
To get a local installation, you can directly download the PicoLisp tarball,\nand follow the instructions in the INSTALL file.\n\n
A local installation will not interfere in any way with the world outside its\ndirectory. There is no need to touch any system locations, and you don't have to\nbe root to install it. Many different versions - or local modifications - of\nPicoLisp can co-exist on a single machine.\n\n
Note that you are still free to have local installations along with a global\ninstallation, and invoke them explicitly as desired.\n\n
Most examples in the following apply to a global installation.\n\n\n
\n
Invocation
\n\n
When PicoLisp is invoked from the command line, an arbitrary number of\narguments may follow the command name.\n\n
By default, each argument is the name of a file to be executed by the\ninterpreter. If, however, the argument's first character is a hyphen\n'-', then the rest of that argument is taken as a Lisp function\ncall (without the surrounding parentheses), and a hyphen by itself as an\nargument stops evaluation of the rest of the command line (it may be processed\nlater using the argv and opt functions). This whole mechanism corresponds\nto calling (load T).\n\n
A special case is if the last argument is a single '+'. This\nwill switch on debug mode (the *Dbg\nglobal variable) and discard the '+'. In that case, a file\n\"~/.pil/rc\" (if it exists) will be loaded, which can contain arbitrary statements\nand definitions (e.g. to initialize the readline(3) history).\n\n
As a convention, PicoLisp source files have the extension \".l\".\n\n
Note that the PicoLisp executable itself does not expect or accept any\ncommand line flags or options (except the '+', see above). They are\nreserved for application programs.\n\n
The simplest and shortest invocation of PicoLisp does nothing, and exits\nimmediately by calling bye:\n\n
\n$ picolisp -bye\n$\n
\n\n
In interactive mode, the PicoLisp interpreter (see load) will also exit when Ctrl-D\nis entered:\n\n
\n$ picolisp\n:           # Typed Ctrl-D\n$\n
\n\n
To start up the standard PicoLisp environment, several files should be\nloaded. The most commonly used things are in \"lib.l\" and in a bunch of other\nfiles, which are in turn loaded by \"ext.l\". Thus, a typical call would be:\n\n
\n$ picolisp lib.l ext.l\n
\n\n
The recommended way, however, is to call the \"pil\" shell script, which\nincludes \"lib.l\" and \"ext.l\". Given that your current project is loaded by some\nfile \"myProject.l\" and your startup function is main, your\ninvocation would look like:\n\n
\n$ pil myProject.l -main\n
\n\n
For interactive development it is recommended to enable debugging mode, to\nget readline(3) line history, single-stepping, tracing and other\ndebugging utilities.\n\n
\n$ pil myProject.l -main +\n
\n\n
This is - in a local installation - equivalent to\n\n
\n$ ./pil myProject.l -main +\n
\n\n
In any case, the directory part of the first file name supplied (normally,\nthe path to \"lib.l\" as called by 'pil') is remembered internally as the\nPicoLisp Home Directory. This path is later automatically substituted for\nany leading \"@\" character in file name arguments to I/O functions\n(see path).\n\n\n
\n
Input/Output
\n\n
In Lisp, each internal data structure has a well-defined external\nrepresentation in human-readable format. All kinds of data can be written to a\nfile, and restored later to their original form by reading that file.\n\n
For all input functions besides wr,\nrd and echo the input is assumed to be valid UTF-8,\nconsisting only of characters allowed in picolisp symbol names.\n\n
In normal operation, the PicoLisp interpreter continually executes an\ninfinite \"read-eval-print loop\". It reads one expression at a time, evaluates\nit, and prints the result to the console. Any input into the system, like data\nstructures and function definitions, is done in a consistent way no matter\nwhether it is entered at the console or read from a file.\n\n
Comments can be embedded in the input stream with the hash #\ncharacter. Everything up to the end of that line will be ignored by the reader.\n\n
\n: (* 1 2 3)  # This is a comment\n-> 6\n
\n\n
A comment spanning several lines (a block comment) may be enclosed between\n#{ and }#. Block comments may be nested.\n\n\n
Here is the I/O syntax for the individual PicoLisp data types (numbers,\nsymbols and lists) and for read-macros:\n\n\n
\n
Numbers
\n\n
A number consists of an arbitrary number of digits ('0' through\n'9'), optionally preceded by a sign character ('+' or\n'-'). Legal number input is:\n\n
\n: 7\n-> 7\n: -12345678901245678901234567890\n-> -12345678901245678901234567890\n
\n\n
Fixpoint numbers can be input by embedding a decimal point '.',\nand setting the global variable *Scl\nappropriately:\n\n
\n: *Scl\n-> 0\n\n: 123.45\n-> 123\n: 456.78\n-> 457\n\n: (setq *Scl 3)\n-> 3\n: 123.45\n-> 123450\n: 456.78\n-> 456780\n
\n\n
Thus, fixpoint input simply scales the number to an integer value\ncorresponding to the number of digits in *Scl.\n\n
Formatted output of scaled fixpoint values can be done with the format and round functions:\n\n
\n: (format 1234567890 2)\n-> \"12345678.90\"\n: (format 1234567890 2 \".\" \",\")\n-> \"12,345,678.90\"\n
\n\n\n
\n
Symbols
\n\n
The reader is able to recognize the individual symbol types from their\nsyntactic form. A symbol name should - of course - not look like a legal number\n(see above).\n\n
In general, symbol names are case-sensitive. car is not the same\nas CAR.\n\n\n
\n
NIL
\n\n
Besides the standard form, NIL is also recognized as\n(), [] or \"\".\n\n
\n: NIL\n-> NIL\n: ()\n-> NIL\n: \"\"\n-> NIL\n
\n\n
Output will always appear as NIL.\n\n\n
\n
Internal Symbols
\n\n
Internal symbol names can consist of any printable (non-whitespace)\ncharacter, except for the following meta characters:\n\n
\n   \"  '  (  )  ,  [  ]  `  { } ~\n
\n\n
It is possible, though, to include these special characters into symbol names\nby escaping them with a backslash '\\'.\n\n
The dot '.' has a dual nature. It is a meta character when\nstanding alone, denoting a dotted pair, but can otherwise\nbe used in symbol names.\n\n
As a rule, anything not recognized by the reader as another data type will be\nreturned as an internal symbol.\n\n\n
\n
Transient Symbols
\n\n
A transient symbol is anything surrounded by double quotes '\"'.\nWith that, it looks like - and can be used as - a string constant in other\nlanguages. However, it is a real symbol, and may be assigned a value or a\nfunction definition, and properties.\n\n
Initially, a transient symbol's value is that symbol itself, so that it does\nnot need to be quoted for evaluation:\n\n
\n: \"This is a string\"\n-> \"This is a string\"\n
\n\n
However, care must be taken when assigning a value to a transient symbol.\nThis may cause unexpected behavior:\n\n
\n: (setq \"This is a string\" 12345)\n-> 12345\n: \"This is a string\"\n-> 12345\n
\n\n
The name of a transient symbol can contain any character except the\nnull-byte. Control characters can be written with a preceding hat\n'^' character. A hat or a double quote character can be escaped\nwith a backslash '\\', and a backslash itself has to be escaped with\nanother backslash.\n\n
\n: \"We^Ird\\\\Str\\\"ing\"\n-> \"We^Ird\\\\Str\\\"ing\"\n: (chop @)\n-> (\"W\" \"e\" \"^I\" \"r\" \"d\" \"\\\\\" \"S\" \"t\" \"r\" \"\\\"\" \"i\" \"n\" \"g\")\n
\n\n
The combination of a backslash followed by 'b', 'e', 'n', 'r' or 't' is\nreplaced with backspace (\"^H\"), escape (\"^[\"), newline (\"^J\"), return (\"^M\") or\nTAB (\"^I\"), respectively.\n\n
\n: \"abc\\tdef\\r\"\n-> \"abc^Idef^M\"\n
\n\n
A decimal number between two backslashes can be used to specify any unicode\ncharacter directly.\n\n
\n: \"äöü\\8364\\xyz\"\n-> \"äöü€xyz\"\n
\n\n
A backslash in a transient symbol name at the end of a line discards the\nnewline, and continues the name in the next line. In that case, all leading\nspaces and tabs in that line are discarded, to allow proper source code\nindentation.\n\n
\n: \"abc\\\n   def\"\n-> \"abcdef\"\n: \"x \\\n   y \\\n   z\"\n-> \"x y z\"\n
\n\n
The index for transient symbols is local when loading a source file. With that mechanism, it\nis possible to create symbols with a local access scope, not accessible from\nother parts of the program.\n\n
A special case of transient symbols are anonymous symbols. These are\nsymbols without name (see box, box? or new). They print as a dollar sign\n($) followed by a decimal digit string (actually their machine\naddress).\n\n\n
\n
External Symbols
\n\n
External symbol names are surrounded by braces ('{' and\n'}'). The characters of the symbol's name itself identify the\nphysical location of the external object. This is the number of the database\nfile minus 1 in hax notation (i.e.\nhexadecimal/alpha notation, where '@' is zero, 'A' is\n1 and 'O' is 15 (from \"alpha\" to \"omega\")), immediately followed\n(without a hyphen) the starting block in octal ('0' through\n'7').\n\n
The database file is omitted for the first (default) file.\n\n\n
\n
Lists
\n\n
Lists are surrounded by parentheses ('(' and ')').\n\n
(A) is a list consisting of a single cell, with the symbol\nA in its CAR, and NIL in its CDR.\n\n
(A B C) is a list consisting of three cells, with the symbols\nA, B and C respectively in their CAR, and\nNIL in the last cell's CDR.\n\n
(A . B) is a \"dotted pair\", a list\nconsisting of a single cell, with the symbol A in its CAR, and\nB in its CDR.\n\n
PicoLisp has built-in support for reading and printing simple circular lists.\nIf the dot in a dotted-pair notation is immediately followed by a closing\nparenthesis, it indicates that the CDR of the last cell points back to the\nbeginning of that list.\n\n
\n: (let L '(a b c) (conc L L))\n-> (a b c .)\n: (cdr '(a b c .))\n-> (b c a .)\n: (cddddr '(a b c .))\n-> (b c a .)\n
\n\n
A similar result can be achieved with the function circ. Such lists must be used with care,\nbecause many functions won't terminate or will crash when given such a list.\n\n\n
\n
Read-Macros
\n\n
Read-macros in PicoLisp are special forms that are recognized by the reader,\nand modify its behavior. Note that they take effect immediately while reading an expression, and are not seen by the\neval in the main loop.\n\n
The most prominent read-macro in Lisp is the single quote character\n\"'\", which expands to a call of the quote function. Note that the single quote\ncharacter is also printed instead of the full function name.\n\n
\n: '(a b c)\n-> (a b c)\n: '(quote . a)\n-> 'a\n: (cons 'quote 'a)   # (quote . a)\n-> 'a\n: (list 'quote 'a)   # (quote a)\n-> '(a)\n
\n\n
A comma (,) will cause the reader to collect the following data\nitem into an idx tree in the global\nvariable *Uni, and to return a\npreviously inserted equal item if present. This makes it possible to create a\nunique list of references to data which do normally not follow the rules of\npointer equality. If the value of *Uni is T, the\ncomma read macro mechanism is disabled.\n\n
A single backquote character \"`\" will cause the reader to\nevaluate the following expression, and return the result.\n\n
\n: '(a `(+ 1 2 3) z)\n-> (a 6 z)\n
\n\n
A tilde character ~ inside a list will cause the reader to\nevaluate the following expression, and (destructively) splice the result into\nthe list.\n\n
\n: '(a b c ~(list 'd 'e 'f) g h i)\n-> (a b c d e f g h i)\n
\n\n
When a tilde character is used to separate two symbol names (without\nsurrounding whitespace), the first is taken as a namespace to look up the\nsecond.\n\n
\n: 'libA~foo  # Look up 'foo' in namespace 'libA'\n-> libA~foo  # \"foo\" is not interned in the current namespace\n
\n\n
Reading libA~foo is equivalent to switching the current\nnamespace search order to libA only (with symbols), reading the symbol\nfoo, and then switching back to the original search order.\n\n
%~foo temporarily switches the search order to the\nCDR of the current namespace list.\n\n
Brackets ('[' and ']') can be used as super\nparentheses. A closing bracket will match the innermost opening bracket, or all\ncurrently open parentheses.\n\n
\n: '(a (b (c (d]\n-> (a (b (c (d))))\n: '(a (b [c (d]))\n-> (a (b (c (d))))\n
\n\n
Finally, reading the sequence '{}' will result in a new\nanonymous symbol with value NIL, equivalent to a call to box without arguments.\n\n
\n: '({} {} {})\n-> ($177066763035351 $177066763035353 $177066763035355)\n: (mapcar val @)\n-> (NIL NIL NIL)\n
\n\n\n
\n
Namespaces
\n\n
When the reader encounters an atom that is not a number, it looks for\nit in the current namespace search order. If a symbol with that name is\nfound, it is used; otherwise, a new symbol is created and interned in\nthe current namespace.\n\n
In general, namespaces in PicoLisp have nothing to do with the values\nor definitions of symbols, but only with their scope (visibility).\nSeveral symbols with the same name may exist in different namespaces,\nand a single symbol may exist in one or many (or none at all)\nnamespaces.\n\n
At interpreter startup, only the internal pico namespace exists, along with the\nthree special built-in namespaces for transient, external,\nand private symbols.\n\n
For internal symbols, it may not always be clear which namespace(s)\nthey belong to. Depending on the search order, the same name in a given\ncode segment might refer to different physical symbols. To avoid\nambiguity, it is recommended to follow these namespace policies:\n\n
\n\n
Invariant namespace order
\n
Across different parts of a program and all loaded libraries the\nsearch order may be changed as needed, but the position of each\nnamespace relative to other namespaces should stay the same. That is,\nnamespace A should not overshadow namespace B in one context and be\novershadowed by B in another context.\n
\n\n
Scope declaration before first usage
\n
Calls to symbols,\nprivate, local or import should precede any appearance\n(not just definition!) of all involved symbols, because merely reading a\nsymbol may already intern it in the wrong namespace. 
\n\n
\n\n\n
\n
Evaluation
\n\n
PicoLisp tries to evaluate any expression encountered in the read-eval-print\nloop. Basically, it does so by applying the following three rules:\n\n
    \n
  • A number evaluates to itself.\n\n
  • A symbol evaluates to its value (VAL).\n\n
  • A list is evaluated as a function call, with the CAR as the function and the\nCDR the arguments to that function. These arguments are in turn evaluated\naccording to these three rules.\n\n
\n\n
\n: 1234\n-> 1234        # Number evaluates to itself\n: *Pid\n-> 22972       # Symbol evaluates to its VAL\n: (+ 1 2 3)\n-> 6           # List is evaluated as a function call\n
\n\n
For the third rule, however, things get a bit more involved. First - as a\nspecial case - if the CAR of the list is a number, the whole list is returned as\nit is:\n\n
\n: (1 2 3 4 5 6)\n-> (1 2 3 4 5 6)\n
\n\n
This is not really a function call, but just a convenience to avoid having to\nquote simple data lists. The interpreter needs to check it anyway, and returning\nthe list (instead of throwing an error) is a lot faster than calling the\nquote function.\n\n
Otherwise, if the CAR is a symbol or a list, PicoLisp tries to obtain an\nexecutable function from that, by either using the symbol's value, or by\nevaluating the list.\n\n
What is an executable function? Or, said in another way, what can be applied\nto a list of arguments, to result in a function call? A legal function in\nPicoLisp is\n\n
\n
either
\n
a number. When a number is used as a function, it is simply taken as\na pointer to executable code that will be called with the list of (unevaluated)\narguments as its single parameter. It is up to that code to evaluate the\narguments, or not. Some functions do not evaluate their arguments (e.g.\nquote) or evaluate only some of their arguments (e.g.\nsetq).\n
\n\n
or
\n
a lambda expression. A lambda expression is a list, whose CAR is\neither a symbol or a list of symbols, and whose CDR is a list of expressions.\nNote: In contrast to other Lisp implementations, the symbol LAMBDA itself does\nnot exist in PicoLisp but is implied from context.\n
\n\n
\n\n
A few examples should help to understand the practical consequences of these\nrules. In the most common case, the CAR will be a symbol defined as a function,\nlike the * in:\n\n
\n: (* 1 2 3)    # Call the function '*'\n-> 6\n
\n\n
Inspecting the VAL of * gives\n\n
\n: *            # Get the VAL of the symbol '*'\n-> 67318096\n
\n\n
The VAL of * is a number. In fact, it is the numeric\nrepresentation of a function pointer, i.e. a pointer to executable code. This\nis the case for all built-in functions of PicoLisp.\n\n
Other functions in turn are written as Lisp expressions:\n\n
\n: (de foo (X Y)            # Define the function 'foo'\n   (* (+ X Y) (+ X Y)) )\n-> foo\n: (foo 2 3)                # Call the function 'foo'\n-> 25\n: foo                      # Get the VAL of the symbol 'foo'\n-> ((X Y) (* (+ X Y) (+ X Y)))\n
\n\n
The VAL of foo is a list. It is the list that was assigned to\nfoo with the de function. It would be perfectly legal\nto use setq instead of de:\n\n
\n: (setq foo '((X Y) (* (+ X Y) (+ X Y))))\n-> ((X Y) (* (+ X Y) (+ X Y)))\n: (foo 2 3)\n-> 25\n
\n\n
If the VAL of foo were another symbol, that symbol's VAL would\nbe used instead to search for an executable function.\n\n
As we said above, if the CAR of the evaluated expression is not a symbol but\na list, that list is evaluated to obtain an executable function.\n\n
\n: ((intern (pack \"c\" \"a\" \"r\")) (1 2 3))\n-> 1\n
\n\n
Here, the intern function returns the symbol car\nwhose VAL is used then. It is also legal, though quite dangerous, to use the code-pointer directly:\n\n
\n: *\n-> 67318096\n: ((* 2 33659048) 1 2 3)\n-> 6\n: ((quote . 67318096) 1 2 3)\n-> 6\n: ((quote . 1234) (1 2 3))\nSegmentation fault\n
\n\n
When an executable function is defined in Lisp itself, we call it a lambda expression. A lambda expression always has a\nlist of executable expressions as its CDR. The CAR, however, must be a either a\nlist of symbols, or a single symbol, and it controls the evaluation of the\narguments to the executable function according to the following rules:\n\n
\n\n
When the CAR is a list of symbols
\n
For each of these symbols an argument is evaluated, then the symbols are\nbound simultaneously to the results. The body of the lambda expression is\nexecuted, then the VAL's of the symbols are restored to their original values.\nThis is the most common case, a fixed number of arguments is passed to the\nfunction. 
As a special case, a single-level list of symbols may be passed\ninstead of a single parameter here, resulting in a restricted form of\ndestructuring bind.\n
\n\n
Otherwise, when the CAR is the symbol @
\n
All arguments are evaluated and the results kept internally in a list. The\nbody of the lambda expression is executed, and the evaluated arguments can be\naccessed sequentially with the args,\nnext, arg and rest functions. This allows to define functions\nwith a variable number of evaluated arguments.\n
\n\n
Otherwise, when the CAR is a single symbol
\n
The symbol is bound to the whole unevaluated argument list. The body of the\nlambda expression is executed, then the symbol is restored to its original\nvalue. This allows to define functions with unevaluated arguments. Any kind of\ninterpretation and evaluation of the argument list can be done inside the\nexpression body.\n
\n\n
\n\n
In all cases, the return value is the result of the last expression in the\nbody.\n\n
\n: (de foo (X Y Z)                   # CAR is a list of symbols\n   (list X Y Z) )                   # Return a list of all arguments\n-> foo\n: (foo (+ 1 2) (+ 3 4) (+ 5 6))\n-> (3 7 11)                         # all arguments are evaluated\n
\n\n
\n: (de foo @                         # CAR is the symbol '@'\n   (list (next) (next) (next)) )    # Return the first three arguments\n-> foo\n: (foo (+ 1 2) (+ 3 4) (+ 5 6))\n-> (3 7 11)                         # all arguments are evaluated\n
\n\n
\n: (de foo X                         # CAR is a single symbol\n   X )                              # Return the argument\n-> foo\n: (foo (+ 1 2) (+ 3 4) (+ 5 6))\n-> ((+ 1 2) (+ 3 4) (+ 5 6))        # the whole unevaluated list is returned\n
\n\n
Note that these forms can also be combined. For example, to evaluate only the\nfirst two arguments, bind the results to X and Y, and\nbind all other arguments (unevaluated) to Z:\n\n
\n: (de foo (X Y . Z)                 # CAR is a list with a dotted-pair tail\n   (list X Y Z) )                   # Return a list of all arguments\n-> foo\n: (foo (+ 1 2) (+ 3 4) (+ 5 6))\n-> (3 7 ((+ 5 6)))                  # Only the first two arguments are evaluated\n
\n\n
Or, a single argument followed by a variable number of arguments:\n\n
\n: (de foo (X . @)                   # CAR is a dotted-pair with '@'\n   (println X)                      # print the first evaluated argument\n   (while (args)                    # while there are more arguments\n      (println (next)) ) )          # print the next one\n-> foo\n: (foo (+ 1 2) (+ 3 4) (+ 5 6))\n3                                   # X\n7                                   # next argument\n11                                  # and the last argument\n-> 11\n
\n\n
In general, if more than the expected number of arguments is supplied to a\nfunction, these extra arguments will be ignored. Missing arguments default to\nNIL.\n\n\n
\n
Shared Libraries
\n\n
Analogous to built-in functions (which are written in PilSrc (based on LLVM))\nin the interpreter kernel), PicoLisp functions may also be defined in shared\nobject files (called \"DLLs\" on some systems). The coding style, register usage,\nargument passing etc. follow the same rules as for normal built-in functions.\n\n
Note that this has nothing to do with external (e.g. third-party) library\nfunctions called with native.\n\n
When the interpreter encounters a symbol supposed to be called as a function,\nwithout a function definition, but with a name of the form\n\"lib:sym\", then - instead of throwing an \"undefined\"-error - it\ntries to locate a shared object file with the name lib.so and a\nfunction sym, and stores a pointer to this code in the symbol's\nvalue. From that point, this symbol lib:sym keeps that function\ndefinition, and is undistinguishable from built-in functions. Future calls to\nthis function do not require another library search.\n\n
A consequence of this lookup mechanism, however, is the fact that such\nsymbols cannot be used directly in a function-passing context (i.e.\n\"apply\" them) like\n\n
\n(apply + (1 2 3))\n(mapcar inc (1 2 3))\n
\n\n
These calls work because + and inc already have a\n(function) value at this point. Applying a shared library function like\n\n
\n(apply ext:Base64 (1 2 3))\n
\n\n
works only if ext:Base64 was either called before (and\nthus automatically received a function definition), or was fetched explicitly\nwith (getd 'ext:Base64).\n\n
Therefore, it is recommended to always apply such functions by passing the\nsymbol itself and not just the value:\n\n
\n(apply 'ext:Base64 (1 2 3))\n
\n\n\n
\n
Coroutines
\n\n
Coroutines are independent execution contexts. They may have multiple entry\nand exit points, and preserve their environment (stack, symbol bindings,\nnamespaces, catch/throw and I/O frames) between invocations.\n\n
A coroutine is identified by a tag. This tag can be passed to other\nfunctions, and (re)invoked as needed. In this regard coroutines are similar to\n\"continuations\" in other languages.\n\n
Tags may be of any type (pointer equality is used for comparison), but\nsymbolic tags are more efficient for large numbers of coroutines. They cache a\npointer to the internal data structure in a property with key zero (which is\ninaccessible with the put and get functions).\n\n
A coroutine is created by calling co.\nIts prg body will be executed, and unless yield is called at some point, the coroutine\nwill \"fall off\" at the end and disappear.\n\n
The initial value of This is bound\nand preserved in the coroutine environment.\n\n
When yield is called, control is\neither transferred back to the caller, or to some other - explicitly specified,\nand already running - coroutine.\n\n
A coroutine is stopped and disposed when\n\n
    \n
  • execution falls off the end\n\n
  • some other (co)routine calls co with\nthat tag but without a prg body\n\n
  • a throw into another (co)routine\nenvironment is executed\n\n
  • an error occurred, and error handling was entered\n\n
\n\n
Reentrant co calls are not allowed: A\ncoroutine cannot call or stop itself directly or indirectly.\n\n
Before using many coroutines, make sure you have sufficient stack space, e.g.\nby calling\n\n
\n$ ulimit -s unlimited\n
\n\n
Without that, the stack limit in Linux is typically 8 MiB.\n\n\n
\n
Interrupt
\n\n
During the evaluation of an expression, the PicoLisp interpreter can be\ninterrupted at any time by hitting Ctrl-C. It will then enter the\nbreakpoint routine, as if ! were called.\n\n
Hitting ENTER at that point will continue evaluation, while\nCtrl-D or (quit) will\nabort evaluation and return the interpreter to the top level. See also debug, e, ^ and\n*Dbg\n\n
Other interrupts may be handled by alarm, sigio, *Hup, *Winch, *Sig[12], *TStp[12] and *Term.\n\n\n
\n
Error Handling
\n\n
When a runtime error occurs, execution is stopped and an error handler is\nentered.\n\n
The error handler resets the I/O channels to the console, and displays the\nlocation (if possible) and the reason of the error, followed by an error\nmessage. That message is also stored in the global *Msg, and the location of the error in ^. If the VAL of the global *Err is non-NIL it is executed as\na prg body. If the standard input is from a terminal, a\nread-eval-print loop (with a question mark \"?\" as prompt) is\nentered (the loop is exited when an empty line is input). Then all pending\nfinally expressions are executed,\nall variable bindings restored, and all files closed. If the standard input is\nnot from a terminal, the interpreter terminates. Otherwise it is reset to its\ntop-level state.\n\n
\n: (de foo (A B) (badFoo A B))       # 'foo' calls an undefined symbol\n-> foo\n: (foo 3 4)                         # Call 'foo'\n!? (badFoo A B)                     # Error handler entered\nbadFoo -- Undefined\n? A                                 # Inspect 'A'\n-> 3\n? B                                 # Inspect 'B'\n-> 4\n?                                   # Empty line: Exit\n:\n
\n\n
Errors can be caught with catch,\nif a list of substrings of possible error messages is supplied for the first\nargument. In such a case, the matching substring (or the whole error message if\nthe substring is NIL) is returned.\n\n
An arbitrary error can be thrown explicitly with quit.\n\n\n
\n
@ Result
\n\n
In certain situations, the result of the last evaluation is stored in the VAL\nof the symbol @. This can be very convenient, because it often\nmakes the assignment to temporary variables unnecessary.\n\n
This happens in two - only superficially similar - situations:\n\n
\n\n
load
\n
In read-eval loops, the last three results which were printed at the console\nare available in @@@, @@ and @, in that\norder (i.e the latest result is in @).\n\n
\n: (+ 1 2 3)\n-> 6\n: (/ 128 4)\n-> 32\n: (- @ @@)        # Subtract the last two results\n-> 26\n
\n
\n\n
Flow functions
\n
Flow functions store the non-nil results of controlling expressions, and\nlogic functions their non-nil results, in @.\n\n
\n: (while (read) (println 'got: @))\nabc            # User input\ngot: abc       # print result\n123            # User input\ngot: 123       # print result\nNIL\n-> 123\n\n: (setq L (1 2 3 4 5 1 2 3 4 5))\n-> (1 2 3 4 5 1 2 3 4 5)\n: (and (member 3 L) (member 3 (cdr @)) (set @ 999))\n-> 999\n: L\n-> (1 2 3 4 5 1 2 999 4 5)\n
\n\n
Functions with controlling expressions are\n   case,\n   casq,\n   prog1,\n   prog2,\nand the bodies of *Run tasks.\n\n
Functions with conditional expressions are\n   and,\n   cond,\n   do,\n   for,\n   if,\n   ifn,\n   if2,\n   if@@,\n   loop,\n   nand,\n   nond,\n   nor,\n   not,\n   or,\n   state,\n   unless,\n   until,\n   when and\n   while.\n
\n\n
\n\n
@ is generally local to functions and methods, its value is\nautomatically saved upon function entry and restored at exit.\n\n\n
\n
Comparing
\n\n
In PicoLisp, it is legal to compare data items of arbitrary type. Any two\nitems are either\n\n
\n\n
Identical
\n
They are the same memory object (pointer equality). For example, two\ninternal symbols with the same name are identical. And short numbers (up to 60\nbits plus sign) are also equivalent to \"pointer\"-equal.\n
\n\n
Equal
\n
They are equal in every respect (structure equality), but need not to be\nidentical. Examples are numbers with the same value, transient symbols with the\nsame name or lists with equal elements.\n
\n\n
Or they have a well-defined ordinal relationship
\n
Numbers are comparable by their numeric value, strings by their name, and\nlists recursively by their elements (if the CAR's are equal, their CDR's are\ncompared). For differing types, the following rule applies: Numbers are less\nthan symbols, and symbols are less than lists. As special cases,\nNIL is always less than anything else, and T is always\ngreater than anything else.\n
\n\n
\n\n
To demonstrate this, sort a list of\nmixed data types:\n\n
\n: (sort '(\"abc\" T (d e f) NIL 123 DEF))\n-> (NIL 123 DEF \"abc\" (d e f) T)\n
\n\n
See also max, min, rank, <, =, >\netc.\n\n\n
\n
OO Concepts
\n\n
PicoLisp comes with built-in object oriented extensions. There seems to be a\ncommon agreement upon three criteria for object orientation:\n\n
\n
Encapsulation
\n
Code and data are encapsulated into objects, giving them both a\nbehavior and a state. Objects communicate by sending and receiving\nmessages.\n
\n\n
Inheritance
\n
Objects are organized into classes. The behavior of an object is\ninherited from its class(es) and superclass(es).\n
\n\n
Polymorphism
\n
Objects of different classes may behave differently in response to the same\nmessage. For that, classes may define different methods for each message.\n
\n\n
\n\n
PicoLisp implements both objects and classes with symbols. Object-local data\nare stored in the symbol's property list, while the code (methods) and links to\nthe superclasses are stored in the symbol's VAL (encapsulation).\n\n
In fact, there is no formal difference between objects and classes (except\nthat objects usually are anonymous symbols containing mostly local data, while\nclasses are named internal symbols with an emphasis on method definitions). At\nany time, a class may be assigned its own local data (class variables), and any\nobject can receive individual method definitions in addition to (or overriding)\nthose inherited from its (super)classes.\n\n
PicoLisp supports multiple inheritance. The VAL of each object is a (possibly\nempty) association list of message symbols and method bodies, concatenated with\na list of classes. When a message is sent to an object, it is searched in the\nobject's own method list, and then (with a left-to-right depth-first search) in\nthe tree of its classes and superclasses. The first method found is executed and\nthe search stops. The search may be explicitly continued with the extra and super functions.\n\n
Thus, which method is actually executed when a message is sent to an object\ndepends on the classes that the object is currently linked to (polymorphism). As\nthe method search is fully dynamic (late binding), an object's type (i.e. its\nclasses and method definitions) can be changed even at runtime!\n\n
While a method body is being executed, the global variable This is set to the current object, allowing\nthe use of the short-cut property functions =:, :\nand ::.\n\n\n
\n
Database
\n\n
On the lowest level, a PicoLisp database is just a collection of external symbols. They reside in a database file, and are\ndynamically swapped in and out of memory. Only one database can be open at a\ntime (pool).\n\n
In addition, further external symbols can be specified to originate from\narbitrary sources via the *Ext\nmechanism.\n\n
Whenever an external symbol's value or property list is accessed, it will be\nautomatically fetched into memory, and can then be used like any other symbol.\nModifications will be written to disk only when commit is called. Alternatively, all\nmodifications since the last call to commit can be discarded by\ncalling rollback.\n\n
Note that a property with the key NIL is a volatile\nproperty, which is held only in memory and not written to disk on\ncommit, and discarded by rollback. Volatile properties\ncan be used by applications for any kind of temporary data.\n\n\n
\n
Transactions
\n\n
In the typical case there will be multiple processes operating on the same\ndatabase. These processes should be all children of the same parent process,\nwhich takes care of synchronizing read/write operations and heap contents. Then\na database transaction is normally initiated by calling (dbSync), and closed by calling (commit 'upd). Short transactions, involving\nonly a single DB operation, are available in functions like new! and methods like put!> (by convention with an\nexclamation mark), which implicitly call (dbSync) and (commit\n'upd) themselves.\n\n
A transaction proceeds through five phases:\n\n
    \n
  1. dbSync waits to get a lock on the root object *DB. Other processes continue reading and\nwriting meanwhile.\n\n
  2. dbSync calls sync to synchronize with changes from other\nprocesses. We hold the shared lock, but other processes may continue reading.\n\n
  3. We make modifications to the internal state of external symbols with\nput>, set>, lose> etc. We -\nand also other processes - can still read the DB.\n\n
  4. We call (commit 'upd).\ncommit obtains an exclusive lock (no more read operations by other\nprocesses), writes an optional transaction log, and then all modified symbols.\nAs upd is passed to 'commit', other\nprocesses synchronize with these changes.\n\n
  5. Finally, all locks are released by 'commit'.\n\n
\n\n\n
\n
Entities / Relations
\n\n
The symbols in a database can be used to store arbitrary information\nstructures. In typical use, some symbols represent nodes of search trees, by\nholding keys, values, and links to subtrees in their VAL's. Such a search tree\nin the database is called index.\n\n
For the most part, other symbols in the database are objects derived from the\n+Entity class.\n\n
Entities depend on objects of the +relation class hierarchy.\nRelation-objects manage the property values of entities, they define the\napplication database model and are responsible for the integrity of mutual\nobject references and index trees.\n\n
Relations are stored as properties in the entity classes, their methods are\ninvoked as daemons whenever property values in an entity are changed. When\ndefining an +Entity class, relations are defined - in addition to\nthe method definitions of a normal class - with the rel function. Predefined relation classes\ninclude\n\n
    \n
  • Scalar relations like\n   
    \n   
    +Symbol
    \n   
    Symbolic data
    \n   
    +String
    \n   
    Strings (just a general case of symbols)
    \n   
    +Number
    \n   
    Integers and fixpoint numbers
    \n   
    +Date
    \n   
    Calendar date values, represented by a number
    \n   
    +Time
    \n   
    Time-of-the-day values, represented by a number
    \n   
    +Blob
    \n   
    \"Binary large objects\" stored in separate files
    \n   
    +Bool
    \n   
    T or NIL
    \n   
    \n
  • Object-to-object relations\n   
    \n   
    +Link
    \n   
    A reference to some other entity
    \n   
    +Hook
    \n   
    A reference to an entity holding object-local index trees
    \n   
    +Joint
    \n   
    A bidirectional reference to some other entity
    \n   
    \n
  • Container prefix classes like\n   
    \n   
    +List
    \n   
    A list of any of the other primitive or object relation types
    \n   
    +Bag
    \n   
    A list containing a mixture of any of the other types
    \n   
    \n
  • Index prefix classes\n   
    \n   
    +Ref
    \n   
    An index with other primitives or entities as key
    \n   
    +Key
    \n   
    A unique index with other primitives or entities as key
    \n   
    +Idx
    \n   
    A full-text index, typically for strings
    \n   
    +Fold
    \n   
    A folded text index
    \n   
    +IdxFold
    \n   
    Folded substring index
    \n   
    +Sn
    \n   
    Tolerant index, using a modified Soundex-Algorithm
    \n   
    \n
  • And a catch-all class\n   
    \n   
    +Any
    \n   
    Not specified, may be any of the above relations
    \n   
    \n
\n\n\n
\n
Pilog (PicoLisp Prolog)
\n\n
A declarative language is built on top of PicoLisp, that has the semantics of\nProlog, but uses the syntax of Lisp.\n\n
For an explanation of Prolog's declarative programming style, an introduction\nlike \"Programming in Prolog\" by Clocksin/Mellish (Springer-Verlag 1981) is\nrecommended.\n\n
Facts and rules can be declared with the be function. For example, a Prolog fact\n'likes(john,mary).' is written in Pilog as:\n\n
\n(be likes (John Mary))\n
\n\n
and a rule 'likes(john,X) :- likes(X,wine), likes(X,food).' is\nin Pilog:\n\n
\n(be likes (John @X) (likes @X wine) (likes @X food))\n
\n\n
As in Prolog, the difference between facts and rules is that the latter ones\nhave conditions, and usually contain variables.\n\n
A variable in Pilog is any symbol starting with an at-mark character\n(\"@\"), i.e. a pat?\nsymbol. The symbol @ itself can be used as an anonymous variable:\nIt will match during unification, but will not be bound to the matched values.\n\n
The cut operator of Prolog (usually written as an exclamation mark\n(!)) is the symbol T in Pilog.\n\n
An interactive query can be done with the ? function:\n\n
\n(? (likes John @X))\n
\n\n
This will print all solutions, waiting for a key after each line. If\nESC is typed, it will terminate.\n\n
Pilog can be called from Lisp and vice versa:\n\n
    \n\n
  • The interface from Lisp is via the functions goal (prepare a query from Lisp data) and\nprove (return an association list of\nsuccessful bindings), and the application level functions pilog and solve.\n\n
  • When the CAR of a Pilog clause is the symbol ^, then the CDDR\nis executed as a Lisp prg body and the result unified with the\nCADR.\n\n
  • Within such a Lisp expression in a Pilog clause, the current bindings of\nPilog variables are directly accessible in the corresponding Lisp symbol\nbindings or can be accessed with the -> function (the latter is only necessary\nto access non-top-level Pilog environments).\n\n
\n\n\n
\n
Naming Conventions
\n\n
It was necessary to introduce - and adhere to - a set of conventions for\nPicoLisp symbol names. Because all (internal) symbols have a global scope, and\neach symbol can only have either a value or function definition, it would\notherwise be very easy to introduce name conflicts. Besides this, source code\nreadability is increased when the scope of a symbol is indicated by its name.\n\n
These conventions are not hard-coded into the language, but should be so into\nthe head of the programmer. Here are the most commonly used ones:\n\n
    \n
  • Global variables start with an asterisk \"*\"\n
  • Global constants may be written all-uppercase\n
  • Functions and other global symbols start with a lower case letter\n
  • Locally bound symbols start with an upper case letter\n
  • Local functions start with an underscore \"_\"\n
  • Classes start with a plus-sign \"+\", where the first letter\n   
      \n   
    • is in lower case for abstract classes\n   
    • and in upper case for normal classes\n   
    \n
  • Methods end with a right arrow \">\"\n
  • Class variables may be indicated by an upper case letter\n
\n\n
For example, a local variable could easily overshadow a function definition:\n\n
\n: (de max-speed (car)\n   (.. (get car 'speeds) ..) )\n-> max-speed\n
\n\n
Inside the body of max-speed (and all other functions called\nduring that execution) the kernel function car is redefined to some\nother value, and will surely crash if something like (car Lst) is\nexecuted. Instead, it is safe to write:\n\n
\n: (de max-speed (Car)            # 'Car' with upper case first letter\n   (.. (get Car 'speeds) ..) )\n-> max-speed\n
\n\n
Note that there are also some strict naming rules (as opposed to the\nvoluntary conventions) that are required by the corresponding kernel\nfunctionalities, like:\n\n
    \n
  • Transient symbols are enclosed in double quotes (see Transient Symbols)\n
  • External symbols are enclosed in braces (see External\nSymbols)\n
  • Pattern-Wildcards start with an at-mark \"@\" (see match and fill)\n
  • Symbols referring to a shared library contain a colon \"lib:sym\"\n
\n\n
With that, the last of the above conventions (local functions start with an\nunderscore) is not really necessary, because true local scope can be enforced\nwith transient symbols.\n\n
The symbols T and NIL are global constants, so care\nshould be taken not to bind them to some other value by mistake:\n\n
\n(de foo (R S T)\n   ...\n
\n\n
However, lint will issue a warning\nin such a case.\n\n\n
\n
Breaking Traditions
\n\n
PicoLisp does not try very hard to be compatible with traditional Lisp\nsystems. If you are used to some other Lisp dialects, you may notice the\nfollowing differences:\n\n
\n\n
Case Sensitivity
\n
PicoLisp distinguishes between upper case and lower case characters in\nsymbol names. Thus, CAR and car are different symbols,\nwhich was not the case in traditional Lisp systems.\n
\n\n
QUOTE
\n
In traditional Lisp, the QUOTE function returns its\nfirst unevaluated argument. In PicoLisp, on the other hand,\nquote returns all (unevaluated) argument(s).\n
\n\n
LAMBDA
\n
The LAMBDA function, in some way at the heart of traditional\nLisp, is completely missing (and quote is used instead).\n
\n\n
PROG
\n
The PROG function of traditional Lisp, with its GOTO and ENTER\nfunctionality, is also missing. PicoLisp's prog function is just a\nsimple sequencer (as PROGN in some Lisps).\n
\n\n
Function/Value
\n
In PicoLisp, a symbol cannot have a value and a function definition\nat the same time. Though this is a disadvantage at first sight, it allows a\ncompletely uniform handling of functional data.\n
\n\n
\n\n\n
\n
Function Reference
\n\n
This section provides a reference manual for the kernel functions, and some\nextensions. See the thematically grouped list of indexes below.\n\n
Though PicoLisp is a dynamically typed language (resolved at runtime, as\nopposed to statically (compile-time) typed languages), many functions can only\naccept and/or return a certain set of data types. For each function, the\nexpected argument types and return values are described with the following\nabbreviations:\n\n
The primary data types:\n\n
    \n
  • num - Number\n
  • sym - Symbol\n
  • lst - List\n
\n\n
Other (derived) data types\n\n
    \n
  • any - Anything: Any data type\n
  • flg - Flag: Boolean value (NIL or non-NIL)\n
  • cnt - A count or a small number\n
  • dat - Date: Days, starting first of March of the year 0 A.D.\n
  • tim - Time: Seconds since midnight\n
  • obj - Object/Class: A symbol with methods and/or classes\n
  • var - Variable: Either a symbol or a cons pair\n
  • exe - Executable: An executable expression (eval)\n
  • prg - Prog-Body: A list of executable expressions (run)\n
  • fun - Function: Either a number (code-pointer), a symbol (message) or a list (lambda)\n
  • msg - Message: A symbol sent to an object (to invoke a method)\n
  • cls - Class: A symbol defined as an object's class\n
  • typ - Type: A list of cls symbols\n
  • pat - Pattern: A symbol whose name starts with an at-mark \"@\"\n
  • pid - Process ID: A number, the ID of a Unix process\n
  • fd - File descriptor: The number of an open file\n
  • tree - Database index tree specification\n
  • hook - Database hook object\n
\n\n
Arguments evaluated by the function in the \"normal\" way are quoted (prefixed\nwith the single quote character \"'\"). Other arguments are either\nnot evaluated, or may be evaluated depending on the context.\n\n
For example, the function setq\nevaluates every second argument (giving any kind of value), while it does\nnot evaluate the others (vars, here typically symbols). This\ncould be specified as:\n\n
\n   (setq var1 'any1 var2 'any2 ..) -> any\n
\n\n
A dotted pair notation in the argument list like (... 'any .\nprg) indicates an unevaluated list of further arguments.\n\n
Arguments in brackets '[' and ']' are optional.\n\n
\nA\nB\nC\nD\nE\nF\nG\nH\nI\nJ\nK\nL\nM\nN\nO\nP\nQ\nR\nS\nT\nU\nV\nW\nX\nY\nZ\nOther\n\n
\n\n
Symbol Functions
\n
\n   new\n   sym\n   str\n   char\n   name\n   nsp\n   sp?\n   pat?\n   fun?\n   all\n   symbols\n   -symbols\n   private\n   local\n   export\n   import\n   all*\n   intern\n   extern\n   qsym\n   loc\n   box?\n   str?\n   ext?\n   touch\n   zap\n   length\n   size\n   format\n   chop\n   pack\n   glue\n   pad\n   align\n   center\n   text\n   wrap\n   pre?\n   sub?\n   low?\n   upp?\n   lowc\n   uppc\n   fold\n   val\n   getd\n   set\n   setq\n   def\n   de\n   dm\n   recur\n   undef\n   redef\n   daemon\n   patch\n   swap\n   xchg\n   on\n   off\n   onOff\n   zero\n   one\n   default\n   expr\n   subr\n   let\n   let?\n   use\n   buf\n   accu\n   push\n   push1\n   push1q\n   pop\n   ++\n   shift\n   cut\n   del\n   queue\n   fifo\n   rid\n   enum\n   enum?\n   idx\n   lup\n   cache\n   locale\n   dirname\n   basename\n\n
\n\n
Property Access
\n
\n   put\n   get\n   prop\n   ;\n   =:\n   :\n   ::\n   putl\n   getl\n   wipe\n   meta\n\n
\n\n
Predicates
\n
\n   atom\n   pair\n   circ?\n   lst?\n   num?\n   sym?\n   flg?\n   sp?\n   pat?\n   fun?\n   box?\n   str?\n   ext?\n   bool\n   not\n   ==\n   n==\n   =\n   <>\n   =0\n   =1\n   =T\n   n0\n   nT\n   <\n   <=\n   >\n   >=\n   match\n   full\n\n
\n\n
Arithmetics
\n
\n   +\n   -\n   *\n   /\n   %\n   */\n   **\n   inc\n   dec\n   >>\n   rev\n   lt0\n   le0\n   ge0\n   gt0\n   abs\n   bit?\n   &\n   |\n   x|\n   sq\n   sqrt\n   seed\n   hash\n   rand\n   max\n   min\n   length\n   size\n   accu\n   format\n   pad\n   money\n   round\n   bin\n   oct\n   hex\n   hax\n\n
\n\n
List Processing
\n
\n   car\n   cdr\n   caar\n   cadr\n   cdar\n   cddr\n   caaar\n   caadr\n   cadar\n   caddr\n   cdaar\n   cdadr\n   cddar\n   cdddr\n   caaaar\n   caaadr\n   caadar\n   caaddr\n   cadaar\n   cadadr\n   caddar\n   cadddr\n   cdaaar\n   cdaadr\n   cdadar\n   cdaddr\n   cddaar\n   cddadr\n   cdddar\n   cddddr\n   nth\n   con\n   cons\n   conc\n   circ\n   rot\n   list\n   need\n   range\n   full\n   make\n   made\n   chain\n   link\n   yoke\n   copy\n   mix\n   append\n   delete\n   delq\n   replace\n   insert\n   remove\n   place\n   strip\n   split\n   reverse\n   flip\n   trim\n   clip\n   head\n   tail\n   stem\n   fin\n   last\n   member\n   memq\n   mmeq\n   sect\n   diff\n   index\n   offset\n   prior\n   assoc\n   rassoc\n   asoq\n   rasoq\n   flood\n   rank\n   sort\n   uniq\n   group\n   length\n   size\n   bytes\n   val\n   set\n   xchg\n   push\n   push1\n   push1q\n   pop\n   ++\n   shift\n   cut\n   queue\n   fifo\n   idx\n   balance\n   depth\n   get\n   fill\n   apply\n\n
\n\n
Control Flow
\n
\n   load\n   args\n   next\n   arg\n   rest\n   pass\n   quote\n   as\n   lit\n   eval\n   run\n   macro\n   curry\n   def\n   de\n   dm\n   recur\n   recurse\n   undef\n   box\n   new\n   type\n   isa\n   method\n   meth\n   send\n   try\n   super\n   extra\n   this\n   with\n   bind\n   job\n   let\n   let?\n   use\n   and\n   or\n   nand\n   nor\n   xor\n   bool\n   not\n   nil\n   t\n   prog\n   prog1\n   prog2\n   if\n   ifn\n   if2\n   if@@\n   when\n   unless\n   cond\n   nond\n   case\n   casq\n   state\n   while\n   until\n   loop\n   do\n   at\n   for\n   tco\n   tc\n   catch\n   throw\n   finally\n   co\n   yield\n   !\n   !!\n   e\n   $\n   call\n   ipid\n   opid\n   kill\n   quit\n   task\n   fork\n   detach\n   pipe\n   later\n   timeout\n   tasks\n   abort\n   bye\n\n
\n\n
Mapping
\n
\n   apply\n   pass\n   fun\n   maps\n   map\n   mapc\n   maplist\n   mapcar\n   mapcon\n   mapcan\n   filter\n   extract\n   seek\n   find\n   pick\n   fully\n   cnt\n   sum\n   maxi\n   mini\n   fish\n   by\n\n
\n\n
Input/Output
\n
\n   path\n   in\n   out\n   err\n   ctl\n   input\n   output\n   fd\n   tty\n   prompt\n   ipid\n   opid\n   pipe\n   any\n   sym\n   str\n   load\n   hear\n   tell\n   key\n   poll\n   peek\n   char\n   skip\n   eol\n   eof\n   from\n   till\n   line\n   format\n   scl\n   read\n   print\n   println\n   printsp\n   prin\n   prinl\n   msg\n   space\n   beep\n   tab\n   flush\n   rewind\n   ext\n   rd\n   pr\n   wr\n   wait\n   sync\n   echo\n   info\n   file\n   dir\n   open\n   close\n   port\n   listen\n   accept\n   host\n   connect\n   udp\n   script\n   once\n   finish\n   rc\n   acquire\n   release\n   tmp\n   pretty\n   pp\n   show\n   view\n   here\n   prEval\n   mail\n\n
\n\n
Object Orientation
\n
\n   *Class\n   class\n   dm\n   rel\n   var\n   var:\n   new\n   type\n   isa\n   method\n   meth\n   send\n   try\n   object\n   extend\n   super\n   extra\n   this\n   with\n   This\n   can\n   dep\n\n
\n\n
Database
\n
\n   pool\n   pool2\n   journal\n   id\n   blk\n   seq\n   lieu\n   lock\n   commit\n   rollback\n   mark\n   free\n   dbck\n   tree\n   genKey\n   genStrKey\n   useKey\n   +relation\n   +Any\n   +Bag\n   +Bool\n   +Number\n   +Date\n   +Time\n   +Symbol\n   +String\n   +Link\n   +Joint\n   +Blob\n   +Hook\n   +Hook2\n   +index\n   +Key\n   +Ref\n   +Ref2\n   +Idx\n   +Sn\n   +Fold\n   +IdxFold\n   +Aux\n   +UB\n   +Dep\n   +List\n   +Need\n   +Mis\n   +Alt\n   +Swap\n   +Entity\n   blob\n   dbSync\n   new!\n   set!\n   put!\n   inc!\n   blob!\n   upd\n   dbs\n   db:\n   db\n   aux\n   collect\n   search\n   forall\n   rel\n   request\n   request!\n   obj\n   create\n   root\n   fetch\n   store\n   count\n   leaf\n   minKey\n   maxKey\n   init\n   step\n   scan\n   iter\n   ubIter\n   prune\n   zapTree\n   chkTree\n   db/3\n   db/4\n   db/5\n   val/3\n   lst/3\n   map/3\n   isa/2\n   same/3\n   bool/3\n   range/3\n   head/3\n   fold/3\n   part/3\n   tolr/3\n   select/3\n   remote/2\n   revolve/2\n\n
\n\n
Pilog
\n
\n   prove\n   ->\n   unify\n   be\n   clause\n   repeat\n   asserta\n   assertz\n   retract\n   rules\n   goal\n   fail\n   pilog\n   solve\n   query\n   ?\n   repeat/0\n   fail/0\n   true/0\n   not/1\n   call/1\n   or/2\n   nil/1\n   equal/2\n   different/2\n   append/3\n   member/2\n   delete/3\n   permute/2\n   uniq/2\n   asserta/1\n   assertz/1\n   retract/1\n   clause/2\n   show/1\n   for/2\n   for/3\n   for/4\n   db/3\n   db/4\n   db/5\n   val/3\n   lst/3\n   map/3\n   isa/2\n   same/3\n   bool/3\n   range/3\n   head/3\n   fold/3\n   part/3\n   tolr/3\n   select/3\n   remote/2\n\n
\n\n
Debugging
\n
\n   pretty\n   pp\n   show\n   loc\n   *Dbg\n   help\n   docs\n   doc\n   more\n   less\n   what\n   who\n   can\n   dep\n   debug\n   -debug\n   d\n   unbug\n   u\n   v\n   vi\n   trace\n   -trace\n   untrace\n   traceAll\n   proc\n   hd\n   bench\n   bt\n   lint\n   lintAll\n   select\n\n
\n\n
System Functions
\n
\n   cmd\n   argv\n   opt\n   version\n   gc\n   tty\n   prompt\n   raw\n   alarm\n   sigio\n   kids\n   protect\n   heap\n   stack\n   adr\n   byte\n   env\n   trail\n   up\n   sys\n   date\n   time\n   usec\n   rt\n   stamp\n   dat$\n   $dat\n   datSym\n   datStr\n   strDat\n   expDat\n   day\n   week\n   ultimo\n   tim$\n   $tim\n   telStr\n   expTel\n   locale\n   allowed\n   allow\n   pwd\n   cd\n   chdir\n   ctty\n   info\n   dir\n   dirname\n   basename\n   errno\n   native\n   %@\n   struct\n   lisp\n   exec\n   call\n   kill\n   quit\n   task\n   fork\n   pipe\n   timeout\n   mail\n   assert\n   test\n   bye\n\n
\n\n
Globals
\n
\n   NIL\n   pico\n   *CPU\n   *OS\n   *DB\n   T\n   *Solo\n   *PPid\n   *Pid\n   @\n   @@\n   @@@\n   This\n   *Dbg\n   *Prompt\n   remark\n   complete\n   reflect\n   *Zap\n   *Scl\n   *Rule\n   *Class\n   *Dbs\n   *Run\n   *Hup\n   *Sig1\n   *Sig2\n   *TStp1\n   *TStp2\n   *Term\n   ^\n   *Err\n   *Msg\n   *Uni\n   *Adr\n   *Allow\n   *Fork\n   *Bye\n\n
\n\n
\n\n\n
\n
Download
\n\n
The PicoLisp system can be downloaded from the PicoLisp Download page.\n\n\n\n\n\n"
  },
  {
    "path": "doc/refA.html",
    "content": "\n\n\n\n\n\nA\n\n\n\n\n
A
\n\n
\n\n
*Adr
\n
A global variable holding the IP address of last recently accepted client.\nSee also listen and accept.\n\n
\n: *Adr\n-> \"127.0.0.1\"\n
\n\n
(adr 'var) -> num
\n
(adr 'num) -> var
\n
Converts, in the first form, a variable var (a symbol or a cons\npair) into num (actually an encoded pointer). This pointer can be\npassed to native or struct. The second form converts a pointer\nback into the original var. Note that this original\nvar may be garbage collected if it is not referred from other data,\ngiving unpredictable results. See also byte.\n\n
\n: (setq X (box 7))\n-> $370237372176\n: (adr X)\n-> 533244889064\n: (adr @)\n-> $370237372176\n: (val @)\n-> 7\n: (struct (adr X) 'N)\n-> 114\n$: (struct (adr X) T)\n-> 7\n
\n\n
*Allow
\n
A global variable holding allowed access patterns. If its value is\nnon-NIL, it should contain a list where the CAR is an idx tree of allowed items, and the CDR a list of\nprefix strings. See also allow,\nallowed and pre?.\n\n
\n: (allowed (\"app/\")  # Initialize\n   \"!start\" \"!stop\" \"lib.css\" \"!psh\" )\n-> NIL\n: (allow \"!myFoo\")  # additional item\n-> \"!myFoo\"\n: (allow \"myDir/\" T)  # additional prefix\n-> \"myDir/\"\n\n: *Allow\n-> ((\"!start\" (\"!psh\" (\"!myFoo\")) \"!stop\" NIL \"lib.css\") \"app/\" \"myDir/\")\n\n: (idx *Allow)  # items\n-> (\"!myFoo\" \"!psh\" \"!start\" \"!stop\" \"lib.css\")\n: (cdr *Allow)  # prefixes\n-> (\"app/\" \"myDir/\")\n
\n\n
+Alt
\n
Prefix class specifying an alternative class for a +relation. This allows indexes or other\nside effects to be maintained in a class different from the current one. See\nalso Database.\n\n
\n(class +EuOrd +Ord)                    # EU-specific order subclass\n(rel nr (+Alt +Key +Number) +XyOrd)    # Maintain the key in the +XyOrd index\n
\n\n
+Any
\n
Class for unspecified relations, a subclass of +relation. Objects of that class accept\nand maintain any type of Lisp data. Used often when there is no other suitable\nrelation class available. See also Database.\n\n
In the following example +Any is used simply for the reason that\nthere is no direct way to specify dotted pairs:\n\n
\n(rel loc (+Any))  # Locale, e.g. (\"DE\" . \"de\")\n
\n\n
+Aux
\n
Prefix class maintaining auxiliary keys for +relations, in addition to +Ref or +Idx indexes. Expects a list of auxiliary\nattributes of the same object, and combines all keys in that order into a single\nindex key. See also +UB, aux and Database.\n\n
\n(rel nr (+Ref +Number))                # Normal, non-unique index\n(rel nm (+Aux +Ref +String) (nr txt))  # Combined name/number/text index\n(rel txt (+Aux +Sn +Idx +String) (nr)) # Text/number plus tolerant text index\n
\n\n
(abort 'cnt . prg) -> any
\n
Aborts the execution of prg if it takes longer than\ncnt seconds, and returns NIL. Otherwise, the result of\nprg is returned. alarm\nis used internally, so care must be taken not to interfer with other calls to\nalarm.\n\n
\n: (abort 20 (in Sock (rd)))  # Wait maximally 20 seconds for socket data\n
\n\n
(abs 'num) -> num
\n
Returns the absolute value of the num argument.\n\n
\n: (abs -7)\n-> 7\n: (abs 7)\n-> 7\n
\n\n
(accept 'cnt) -> cnt | NIL
\n
Accepts a connection on descriptor cnt (as received by port), and returns the new socket descriptor\ncnt. The global variable *Adr is set to the IP address\nof the client. See also listen,\nconnect and *Adr.\n\n
\n: (setq *Socket\n   (accept (port 6789)) )  # Accept connection at port 6789\n-> 4\n
\n\n
(accu 'var 'any 'num ['var2])
\n
Accumulates num into a sum, using the key any in\nan association list stored in var. If var2 is given,\nit is used as an idx for faster\nlookups. See also assoc.\n\n
\n: (off Sum)\n-> NIL\n: (accu 'Sum 'a 1)\n-> (a . 1)\n: (accu 'Sum 'a 5)\n-> 6\n: (accu 'Sum 22 100)\n-> NIL\n: Sum\n-> ((22 . 100) (a . 6))\n
\n\n
(acquire 'sym) -> flg
\n
Tries to acquire the mutex represented by the file sym, by\nobtaining an exclusive lock on that file with ctl, and then trying to write the PID of the\ncurrent process into that file. It fails if the file already holds the PID of\nsome other existing process. See also release, *Pid and rc.\n\n
\n: (acquire \"sema1\")\n-> 28255\n
\n\n
(alarm 'cnt . prg) -> cnt
\n
Sets an alarm timer scheduling prg to be executed after\ncnt seconds, and returns the number of seconds remaining until any\npreviously scheduled alarm was due to be delivered. Calling (alarm\n0) will cancel an alarm. See also abort, sigio, *Hup, *Winch, *Sig[12], *TStp[12] and *Term.\n\n
\n: (prinl (tim$ (time) T)) (alarm 10 (prinl (tim$ (time) T)))\n16:36:14\n-> 0\n: 16:36:24\n\n: (alarm 10 (bye 0))\n-> 0\n$\n
\n\n
(align 'cnt 'any) -> sym
\n
(align 'lst 'any ..) -> sym
\n
Returns a transient symbol with all any arguments packed in an aligned format. In the first form,\nany will be left-aligned if cnt is negative, otherwise\nright-aligned. In the second form, all any arguments are packed\naccording to the numbers in lst. See also tab, center and wrap.\n\n
\n: (align 4 \"a\")\n-> \"   a\"\n: (align -4 12)\n-> \"12  \"\n: (align (4 4 4) \"a\" 12 \"b\")\n-> \"   a  12   b\"\n
\n\n
(all ['T | '0 | 'sym]) -> lst
\n
Returns a new list of all internal symbols\nin the current namespace search order (if called without arguments, or with\nNIL), all current transient\nsymbols (if the argument is T), all external symbols (if the argument is zero), or all\nsymbols of the given namespace sym. See also symbols and all*.\n\n
\n: (all)  # All internal symbols\n-> (inc> leaf nil inc! accept ...\n\n# Find all symbols starting with an underscore character\n: (filter '((X) (= \"_\" (car (chop X)))) (all))\n-> (_put _nacs _oct _lintq _lst _map _iter _dbg2 _getLine _led ...\n
\n\n
(all* 'any ['flg]) -> lst
\n
Returns a sorted list of all (possibly namespaced) symbols and path names\nstarting with the characters in any. If flg is\nT, only symbols, and if it is 0, only path names are\nreturned. Typically used in TAB-completion routines. See also all, symbols and intern.\n\n
\n: (all* \"map\")\n-> (\"map\" \"map/3\" \"mapc\" \"mapcan\" \"mapcar\" \"mapcon\" \"maplist\" \"maps\")\n: (all* \"llvm~BLK\")\n-> (\"llvm~BLK\" \"llvm~BLKMASK\" \"llvm~BLKSIZE\" \"llvm~BLKTAG\")\n
\n\n
(allow 'sym ['flg]) -> sym
\n
Maintains an index structure of allowed access patterns in the global\nvariable *Allow. If the value of\n*Allow is non-NIL, sym is added to the\nidx tree in the CAR of\n*Allow (if flg is NIL), or to the list of\nprefix strings (if flg is non-NIL). See also allowed.\n\n
\n: *Allow\n-> ((\"!start\" (\"!psh\") \"!stop\" NIL \"lib.css\") \"app/\")\n: (allow \"!myFoo\")  # additionally allowed item\n-> \"!myFoo\"\n: (allow \"myDir/\" T)  # additionally allowed prefix\n-> \"myDir/\"\n
\n\n
(allowed lst [sym ..])
\n
Creates an index structure of allowed access patterns in the global variable\n*Allow. lst should\nconsist of prefix strings (to be checked at runtime with pre?), and the sym arguments\nshould specify the initially allowed items. Must be called before any GUI\nlibraries and/or allow calls.\n\n
\n: (allowed (\"app/\")  # allowed prefixes\n   \"!start\" \"!stop\" \"lib.css\" \"!psh\" )  # allowed items\n-> NIL\n
\n\n
(and 'any ..) -> any
\n
Logical AND. The expressions any are evaluated from left to\nright. If NIL is encountered, NIL is returned\nimmediately. Else the result of the last expression is returned. See also\nnand, or and when.\n\n
\n: (and (= 3 3) (read))\nabc  # User input\n-> abc\n: (and (= 3 4) (read))\n-> NIL\n
\n\n
(any 'any) -> any
\n
Parses any from the argument. This is the reverse operation of\nsym. See also str, (any 'sym) is equivalent to\n(car (str 'sym)).\n\n
\n: (any \"(a b # Comment\\nc d)\")\n-> (a b c d)\n: (any \"\\\"A String\\\"\")\n-> \"A String\"\n
\n\n
(append 'lst ..) -> lst
\n
Appends all argument lists. See also conc, insert, delete and remove.\n\n
\n: (append '(a b c) (1 2 3))\n-> (a b c 1 2 3)\n: (append (1) (2) (3) 4)\n-> (1 2 3 . 4)\n
\n\n
append/3
\n
Pilog predicate that succeeds if appending the\nfirst two list arguments is equal to the third argument. See also append and member/2.\n\n
\n: (? (append @X @Y (a b c)))\n @X=NIL @Y=(a b c)\n @X=(a) @Y=(b c)\n @X=(a b) @Y=(c)\n @X=(a b c) @Y=NIL\n-> NIL\n
\n\n
(apply 'fun 'lst ['any ..]) -> any
\n
Applies fun to lst. If additional any\narguments are given, they are applied as leading elements of lst.\n(apply 'fun 'lst 'any1 'any2) is equivalent to (apply 'fun\n(cons 'any1 'any2 'lst)).\n\n
\n: (apply + (1 2 3))\n-> 6\n: (apply * (5 6) 3 4)\n-> 360\n: (apply '((X Y Z) (* X (+ Y Z))) (3 4 5))\n-> 27\n: (apply println (3 4) 1 2)\n1 2 3 4\n-> 4\n
\n\n
(arg 'cnt) -> any
\n
Can only be used inside functions with a variable number of arguments (with\n@). Returns the cnt'th remaining argument. See also\nnext, args, rest and pass.\n\n
\n: (de foo @\n   (println (arg 1) (arg 2))\n   (println (next))\n   (println (arg 1) (arg 2)) )\n-> foo\n: (foo 'a 'b 'c)\na b\na\nb c\n-> c\n
\n\n
(args) -> flg
\n
Can only be used inside functions with a variable number of arguments (with\n@). Returns T when there are more arguments to be\nfetched from the internal list. See also next, arg, rest and pass.\n\n
\n: (de foo @ (println (args)))       # Test for arguments\n-> foo\n: (foo)                             # No arguments\nNIL\n-> NIL\n: (foo NIL)                         # One argument\nT\n-> T\n: (foo 123)                         # One argument\nT\n-> T\n
\n\n
(argv [var ..] [. sym]) -> lst|sym
\n
If called without arguments, argv returns a list of strings\ncontaining all remaining command line arguments. Otherwise, the\nvar/sym arguments are subsequently bound to the command line\narguments. A hyphen \"-\" can be used to inhibit the automatic\nloading further arguments. See also cmd, Invocation and\nopt.\n\n
\n$ pil -\"println 'OK\" - abc 123 +\nOK\n: (argv)\n-> (\"abc\" \"123\")\n: (argv A B)\n-> \"123\"\n: A\n-> \"abc\"\n: B\n-> \"123\"\n: (argv . Lst)\n-> (\"abc\" \"123\")\n: Lst\n-> (\"abc\" \"123\")\n
\n\n
(as 'any1 . any2) -> any2 | NIL
\n
Returns any2 unevaluated when any1 evaluates to\nnon-NIL. Otherwise NIL is returned. (as Flg A B\nC) is equivalent to (and Flg '(A B C)). as is\ntypically used in read-macros to conditionally\nexclude sub-expressions. See also quote.\n\n
\n: (as (= 3 3) A B C)\n-> (A B C)\n\n(de foo ()\n   (doSomething)\n   ~(as (someConditio)\n      (doThis)\n      (doThat) )\n   (doMore) )\n
\n\n
(asoq 'any 'lst) -> lst
\n
Searches an association list. Returns the first element from\nlst with any as its CAR, or NIL if no\nmatch is found. == is used for\ncomparison (pointer equality). See also assoc, rasoq, get, push1q, delq, memq, mmeq and Comparing.\n\n
\n: (asoq 'a '((999 1 2 3) (b . 7) (\"ok\" \"Hello\")))\n-> NIL\n: (asoq 'b '((999 1 2 3) (b . 7) (\"ok\" \"Hello\")))\n-> (b . 7)\n
\n\n
(assert exe ..) -> prg | NIL
\n
When in debug mode (*Dbg is\nnon-NIL), assert returns a prg list which\ntests all exe conditions, and issues an error via quit if one of the results evaluates to\nNIL. Otherwise, NIL is returned. Used typically in\ncombination with the ~ tilde read-macro to insert the test code only when\nin debug mode. See also test.\n\n
\n# Start in debug mode\n$ pil +\n: (de foo (N)\n   ~(assert (>= 90 N 10))\n   (bar N) )\n-> foo\n: (pp 'foo)                      # Pretty-print 'foo'\n(de foo (N)\n   (unless (>= 90 N 10)          # Assertion code exists\n      (quit \"'assert' failed\" '(>= 90 N 10)) )\n   (bar N) )\n-> foo\n: (foo 7)                        # Try it\n(>= 90 N 10) -- Assertion failed\n?\n\n# Start in non-debug mode\n$ pil\n: (de foo (N)\n   ~(assert (>= 90 N 10))\n   (bar N) )\n-> foo\n: (pp 'foo)                      # Pretty-print 'foo'\n(de foo (N)\n   (bar N) )                     # Assertion code does not exist\n-> foo\n
\n\n
(asserta 'lst) -> lst
\n
Inserts a new Pilog fact or rule before all\nother rules. See also be, clause, assertz and retract.\n\n
\n: (be a (2))            # Define two facts\n-> a\n: (be a (3))\n-> a\n\n: (asserta '(a (1)))    # Insert new fact in front\n-> ((1))\n\n: (? (a @N))            # Query\n @N=1\n @N=2\n @N=3\n-> NIL\n
\n\n
asserta/1
\n
Pilog predicate that inserts a new fact or rule\nbefore all other rules. See also asserta, assertz/1 and retract/1.\n\n
\n: (? (asserta (a (2))))\n-> T\n: (? (asserta (a (1))))\n-> T\n: (rules 'a)\n1 (be a (1))\n2 (be a (2))\n-> a\n
\n\n
(assertz 'lst) -> lst
\n
Appends a new Pilog fact or rule behind all\nother rules. See also be, clause, asserta and retract.\n\n
\n: (be a (1))            # Define two facts\n-> a\n: (be a (2))\n-> a\n\n: (assertz '(a (3)))    # Append new fact at the end\n-> ((3))\n\n: (? (a @N))            # Query\n @N=1\n @N=2\n @N=3\n-> NIL\n
\n\n
assertz/1
\n
Pilog predicate that appends a new fact or rule\nbehind all other rules. See also assertz, asserta/1 and retract/1.\n\n
\n: (? (assertz (a (1))))\n-> T\n: (? (assertz (a (2))))\n-> T\n: (rules 'a)\n1 (be a (1))\n2 (be a (2))\n-> a\n
\n\n
(assoc 'any 'lst) -> lst
\n
Searches an association list. Returns the first element from\nlst with its CAR equal to any, or NIL if\nno match is found. See also asoq and\nrassoc.\n\n
\n: (assoc \"b\" '((999 1 2 3) (\"b\" . 7) (\"ok\" \"Hello\")))\n-> (\"b\" . 7)\n: (assoc 999 '((999 1 2 3) (\"b\" . 7) (\"ok\" \"Hello\")))\n-> (999 1 2 3)\n: (assoc 'u '((999 1 2 3) (\"b\" . 7) (\"ok\" \"Hello\")))\n-> NIL\n
\n\n
(at '(cnt1 . cnt2|NIL) . prg) -> any
\n
Increments cnt1 (destructively), and returns NIL\nwhen it is less than cnt2. Both cnt1 and\ncnt2 should be positive. Otherwise, cnt1 is reset to\nzero and prg is executed. Returns the result of prg.\nIf cnt2 is NIL, nothing is done, and NIL\nis returned immediately.\n\n
\n: (do 11 (prin \".\") (at (0 . 3) (prin \"!\")))\n...!...!...!..-> NIL\n
\n\n
(atom 'any) -> flg
\n
Returns T when the argument any is an atom (a\nnumber or a symbol). See also num?,\nsym? and pair.\n\n
\n: (atom 123)\n-> T\n: (atom 'a)\n-> T\n: (atom NIL)\n-> T\n: (atom (123))\n-> NIL\n
\n\n
(aux 'sym 'cls ['hook] 'any ..) -> sym
\n
Returns a database object of class cls, where the value for\nsym corresponds to any and the following arguments.\nsym, cls and hook should specify a\ntree for cls or one of\nits superclasses, for a relation with auxiliary keys. For multi-key accesses,\naux is similar to - but faster than - db, because it\ncan use a single tree access. See also db, collect, fetch, init, step and +Aux.\n\n
\n(class +PS +Entity)\n(rel par (+Dep +Joint) (sup) ps (+Part))        # Part\n(rel sup (+Aux +Ref +Link) (par) NIL (+Supp))   # Supplier\n...\n   (aux 'sup '+PS                               # Access PS object\n      (db 'nr '+Supp 1234)\n      (db 'nr '+Part 5678) )\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refB.html",
    "content": "\n\n\n\n\n\nB\n\n\n\n\n
B
\n\n
\n\n
*Blob
\n
A global variable holding the pathname of the database blob directory. See\nalso blob.\n\n
\n: *Blob\n-> \"blob/app/\"\n
\n\n
*Bye
\n
A global variable holding a (possibly empty) prg body, to be\nexecuted just before the termination of the PicoLisp interpreter. See also\nbye, finish and tmp.\n\n
\n: (push1 '*Bye '(call \"rm\" \"myfile.tmp\"))  # Remove a temporary file\n-> (call 'rm \"myfile.tmp\")\n
\n\n
+Bag
\n
Class for a list of arbitrary relations, a subclass of +relation. Objects of that class maintain\na list of heterogeneous relations. Typically used in combination with the\n+List prefix class, to maintain small\ntwo-dimensional tables within objects. See also Database.\n\n
\n(rel pos (+List +Bag)         # Positions\n   ((+Ref +Link) NIL (+Item))    # Item\n   ((+Number) 2)                 # Price\n   ((+Number))                   # Quantity\n   ((+String))                   # Memo text\n   ((+Number) 2) )               # Total amount\n
\n\n
+Blob
\n
Class for blob relations, a subclass of +relation. Objects of that class maintain\nblobs, as stubs in database objects pointing to actual files for arbitrary\n(often binary) data. The files themselves reside below the path specified by the\n*Blob variable. See also Database.\n\n
\n(rel jpg (+Blob))  # Picture\n
\n\n
+Bool
\n
Class for boolean relations, a subclass of +relation. Objects of that class expect\neither T or NIL as value (though, as always, only\nnon-NIL will be physically stored in objects). See also Database.\n\n
\n(rel ok (+Ref +Bool))  # Indexed flag\n
\n\n
(balance 'var 'lst ['flg])
\n
Builds a balanced binary idx tree\nin var, from the sorted list in lst. Normally, if\narbitary - or, in the worst case, ordered - data are inserted with\nidx, the tree will not be balanced. But if lst is\nproperly sorted, its contents will be inserted in an optimally balanced way. If\nflg is non-NIL, the index tree will be augmented\ninstead of being overwritten. See also Comparing and sort.\n\n
\n# Normal idx insert\n: (off I)\n-> NIL\n: (for X (1 4 2 5 3 6 7 9 8) (idx 'I X T))\n-> NIL\n: (depth I)\n-> (7 . 4)\n\n# Balanced insert\n: (balance 'I (sort (1 4 2 5 3 6 7 9 8)))\n-> NIL\n: (depth I)\n-> 4\n\n# Augment\n: (balance 'I (sort (10 40 20 50 30 60 70 90 80)) T)\n-> NIL\n: (idx 'I)\n-> (1 2 3 4 5 6 7 8 9 10 20 30 40 50 60 70 80 90)\n
\n\n
(basename 'any) -> sym
\n
Returns the filename part of a path name any. See also dirname and path.\n\n
\n: (basename \"a/b/c/d\")\n-> \"d\"\n
\n\n
(be sym . any) -> sym
\n
Declares a Pilog fact or rule for the\nsym argument, by concatenating the any argument to the\nT property of sym. Groups of declarations are\ncollected for a given sym. When sym changes, i.e. when\nit differs from the one in the previous declaration, the current group is\nconsidered to be complete and a new group is started. Later be\ndeclarations for a previously completed symbol will reset its rules, to allow\nrepeated reloading of source files.\nSee also *Rule, clause, asserta, assertz, retract, rules, goal and prove.\n\n
\n: (be likes (John Mary))\n-> likes\n: (be likes (John @X) (likes @X wine) (likes @X food))\n-> likes\n\n: (get 'likes T)\n-> (((John Mary)) ((John @X) (likes @X wine) (likes @X food)))\n\n: (rules 'likes)\n1 (be likes (John Mary))\n2 (be likes (John @X) (likes @X wine) (likes @X food))\n-> likes\n\n: (? (likes John @X))\n @X=Mary\n-> NIL\n
\n\n
(beep) -> NIL
\n
Send the bell character to the console. See also space, prin and char.\n\n
\n: (beep)\n-> NIL\n
\n\n
(bench . prg) -> any
\n
(Debug mode only) Benchmarks prg, by printing the time it took\nto execute, and returns the result. See also usec.\n\n
\n: (bench (wait 2000))\n2.003 sec\n-> NIL\n\n: (bench (wait 123456))\n[00:02] 123.557 sec\n-> NIL\n
\n\n
(bin 'num ['num]) -> sym
\n
(bin 'sym) -> num
\n
Converts a number num to a binary string, or a binary string\nsym to a number. In the first case, if the second argument is\ngiven, the result is separated by spaces into groups of such many digits. See\nalso oct, hex, hax and format.\n\n
\n: (bin 73)\n-> \"1001001\"\n: (bin \"1001001\")\n-> 73\n: (bin 1234567 4)\n-> \"1 0010 1101 0110 1000 0111\"\n
\n\n
(bind 'sym|lst . prg) -> any
\n
Binds value(s) to symbol(s). The first argument must evaluate to a symbol,\nor a list of symbols or symbol-value pairs. The values of these symbols are\nsaved (and the symbols bound to the values in the case of pairs),\nprg is executed, then the symbols are restored to their original\nvalues. During execution of prg, the values of the symbols can be\ntemporarily modified. The return value is the result of prg. See\nalso let, job and use.\n\n
\n: (setq X 123)                               # X is 123\n-> 123\n: (bind 'X (setq X \"Hello\") (println X))  # Set X to \"Hello\", print it\n\"Hello\"\n-> \"Hello\"\n: (bind '((X . 3) (Y . 4)) (println X Y) (* X Y))\n3 4\n-> 12\n: X\n-> 123                                       # X is restored to 123\n
\n\n
(bit? 'num ..) -> num | NIL
\n
Returns the first num argument when all bits which are 1 in the\nfirst argument are also 1 in all following arguments, otherwise\nNIL. When one of those arguments evaluates to NIL, it\nis returned immediately. See also &,\n| and x|.\n\n
\n: (bit? 7 15 255)\n-> 7\n: (bit? 1 3)\n-> 1\n: (bit? 1 2)\n-> NIL\n
\n\n
(blk 'fd 'cnt 'siz ['fd2]) -> lst
\n
(blk 'fd 0) -> (cnt . siz)
\n
Reads raw object data from the cnt'th block in the file open on\ndescriptor fd. Returns a cons pair of the value and property list\nof that database object, or NIL for an invalid block. If\ncnt is zero, a cons pair of the total number of blocks in the file\nand the file's block size scale factor is returned. Otherwise, siz\nshould be the block size scale factor. If fd2 is given, a read\n(shared) lock is set on that file during the read operation. See also pool, pool2, id, ctl\nand qsym.\n\n
\n: (show '{4})\n{4} (+Role)\n   usr ({15} {13} {11})\n   perm (Customer Item Order Report ..)\n   nm \"Accounting\"\n-> {4}\n: (open \"db/app/@\")\n-> 15\n: (blk 15 4 3 15)\n-> ((+Role) (({15} {13} {11}) . usr) ((Customer Item Order Report Delete) . perm) (\"Accounting\" . nm))\n
\n\n
(blob 'obj 'sym) -> sym
\n
Returns the blob file name for var in obj. See\nalso *Blob, blob! and pack.\n\n
\n: (show (db 'nr '+Item 1))\n{B1} (+Item)\n   jpg\n   pr 29900\n   inv 100\n   sup {C1}\n   nm \"Main Part\"\n   nr 1\n-> {B1}\n: (blob '{B1} 'jpg)\n-> \"blob/app/3/-/1.jpg\"\n
\n\n
(blob! 'obj 'sym 'file)
\n
Stores the contents of file in a blob. See also put!>.\n\n
\n(blob! *ID 'jpg \"picture.jpg\")\n
\n\n
(bool 'any) -> flg
\n
Returns T when the argument any is\nnon-NIL. This function is only needed when T is\nstrictly required for a \"true\" condition (Usually, any non-NIL\nvalue is considered to be \"true\"). See also flg?.\n\n
\n: (and 3 4)\n-> 4\n: (bool (and 3 4))\n-> T\n
\n\n
bool/3
\n
(Deprecated since version 25.5.30) Pilog\npredicate that succeeds if the first argument has the same truth value as the\nresult of applying the get algorithm to\nthe following arguments. Typically used as filter predicate in select/3 database queries. See also\nbool, isa/2, same/3, range/3, head/3, fold/3, part/3 and tolr/3.\n\n
\n: (? @OK T           # Find orders where the 'ok' flag is set\n   (db nr +Ord @Ord)\n   (bool @OK @Ord ok) )\n @OK=T @Ord={B7}\n-> NIL\n
\n\n
(box 'any) -> sym
\n
Creates and returns a new anonymous symbol. The initial value is set to the\nany argument. See also new\nand box?.\n\n
\n: (show (box '(A B C)))\n$134425627 (A B C)\n-> $134425627\n
\n\n
(box? 'any) -> sym | NIL
\n
Returns the argument any when it is an anonymous symbol,\notherwise NIL. See also box, str? and ext?.\n\n
\n: (box? (new))\n-> $134563468\n: (box? 123)\n-> NIL\n: (box? 'a)\n-> NIL\n: (box? NIL)\n-> NIL\n
\n\n
(bt ['flg]) -> flg
\n
(Debug mode only) Formatted stack backtrace printing (see trail) for the current point of program\nexecution. For each bind frame, the function call (reduced with less) is pretty-printed, followed by indented\nvariable-value-pairs. If flg is NIL, bt\nthen waits for a key, and terminates when ESC is pressed (like more). See also up and env.\n\n
\n: (de f (A B)\n   (let F 7\n      (g (inc A) (dec B)) ) )\n-> f\n: (de g (C D)\n   (let G 8\n      (/ C D) ) )\n-> g\n\n: (f 2 1)\n!? (/ C D)\nDiv/0\n? (bt)\n(g (inc A) (dec B))\n   C 3\n   D 0\n   G 8\n(f 2 1)\n   A 2\n   B 1\n   F 7\n-> NIL\n?\n
\n\n
(buf sym 'cnt . prg) -> any
\n
Creates a temporary local memory buffer on the stack, and binds\nsym to the pointer during the execution of prg. The\ncurrent value of sym is saved and restored appropriately. The\nreturn value is the result of prg. See also let, native, struct and %@.\n\n
\n(buf Buf BUFSIZ\n   (%@ \"read\" 'I Fd Buf BUFSIZ)\n   (%@ \"write\" 'I Fd2 Buf BUFSIZ) )\n
\n\nThis is functionally equivalent to (but more efficient than)\n\n
\n(let Buf (%@ \"malloc\" 'P BUFSIZ)\n   (%@ \"read\" 'I Fd Buf BUFSIZ)\n   (%@ \"write\" 'I Fd2 Buf BUFSIZ)\n   (%@ \"free\" NIL Buf) )\n
\n\n
(by 'fun1 'fun2 'lst ..) -> lst
\n
Applies fun1 to each element of lst. When\nadditional lst arguments are given, their elements are also passed\nto fun1. Each result of fun1 is CONSed with its\ncorresponding argument from the original lst, and collected into a\nlist which is passed to fun2. For the list returned from\nfun2, the CAR elements returned by fun1 are\n(destructively) removed from each element (\"decorate-apply-undecorate\" idiom).\n\n
\n: (let (A 1 B 2 C 3) (by val sort '(C A B)))\n-> (A B C)\n: (by '((N) (bit? 1 N)) group (3 11 6 2 9 5 4 10 12 7 8 1))\n-> ((3 11 9 5 7 1) (6 2 4 10 12 8))\n
\n\n
(bye ['cnt])
\n
Executes all pending finally\nexpressions, closes all open files, executes the VAL of the global\nvariable *Bye (should be a\nprg), flushes standard output, and then exits the PicoLisp\ninterpreter. The process return value is cnt, or 0 if the argument\nis missing or NIL.\n\n
\n: (setq *Bye '((println 'OK) (println 'bye)))\n-> ((println 'OK) (println 'bye))\n: (bye)\nOK\nbye\n$\n
\n\n
(byte 'num ['cnt]) -> cnt
\n
Returns - if the second argument is not given - a byte value (0 .. 255) from\nthe memory location pointed to by num. Otherwise cnt\nis stored in the memory location and returned. See also adr.\n\n
\n: (hex (byte (>> -4 (adr (1)))))\n-> \"12\"                             # Short number '1'\n: (hex (byte (>> -4 (adr (2)))))\n-> \"22\"                             # Short number '2'\n\n: (setq P (native \"@\" \"malloc\" 'N 8))  # Set pointer to a new buffer\n-> 25084048\n: (byte P (char \"A\"))                  # Store byte 'A'\n-> 65\n: (byte (inc P) (char \"B\"))            # Store byte 'B'\n-> 66\n: (byte (+ P 2) (char \"C\"))            # Store byte 'C'\n-> 67\n: (byte (+ P 3) 0)                     # Store null byte\n-> 0\n: (native \"@\" \"strdup\" 'S P)           # Read bytes as string\n-> \"ABC\"\n: (native \"@\" \"free\" 'N P)             # Free buffer\n-> 0\n
\n\n
(bytes 'any) -> cnt
\n
Returns the number of bytes any would occupy in encoded binary\nformat (as generated by pr). See also\nsize and length.\n\n
\n: (bytes \"abc\")\n-> 4\n: (bytes \"äbc\")\n-> 5\n: (bytes 127)\n-> 2\n: (bytes 128)\n-> 3\n: (bytes (101 (102) 103))\n-> 10\n: (bytes (101 102 103 .))\n-> 9\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refC.html",
    "content": "\n\n\n\n\n\nC\n\n\n\n\n
C
\n\n
\n\n
*CPU
\n
A global variable holding the target CPU (architecture). Typical values are\n\"aarch64\", \"x86-64\" etc. See also *OS and version.\n\n
\n: *CPU\n-> \"x86-64\"\n
\n\n
*Class
\n
A global variable holding the current class. See also OO Concepts, class, extend, dm and var and rel.\n\n
\n: (class +Test)\n-> +Test\n: *Class\n-> +Test\n
\n\n
(cache 'var 'any [. prg]) -> any
\n
Speeds up some calculations by maintaining a tree of previously calculated\nresults in an idx structure\n(\"memoization\") in var. A hash of the argument any is used\ninternally to build the index key. If no prg is given, the internal\nvar holding a previously stored value is returned (note that\nvar may have a name which is not human-readable).\n\n
\n: (de fibonacci (N)\n   (cache '(NIL) N\n      (if (>= 2 N)\n         1\n         (+ (fibonacci (dec N)) (fibonacci (- N 2))) ) ) )\n-> fibonacci\n\n: (fibonacci 22)\n-> 17711\n\n: (fibonacci 10000)\n-> 3364476487643178326662161200510754331030 ...  # (2090 digits)\n
\n\n
\n: (off C)\n-> NIL\n: (cache 'C 1234 (* 3 4))\n-> 12\n: (inc (cache 'C 1234))\n-> 13\n: (val (cache 'C 1234))\n-> 13\n
\n\n
(call 'any ..) -> flg
\n
Calls an external system command. The any arguments specify the\ncommand and its arguments. Returns T if the command was executed\nsuccessfully. The (system dependent) exit status code of the child process is\nstored in the global variable @@. See\nalso exec.\n\n
\n: (when (call 'test \"-r\" \"file.l\")  # Test if file exists and is readable\n   (load \"file.l\")  # Load it\n   (call 'rm \"file.l\") )  # Remove it\n\n: (cons (call \"sh\" \"-c\" \"kill -SEGV $$\") @@ (hex @@))\n-> (NIL 11 . \"B\")\n
\n\n
call/1
\n
Pilog predicate that succeeds if the argument\nterm can be proven.\n\n
\n: (be mapcar (@ NIL NIL))\n-> mapcar\n: (be mapcar (@P (@X . @L) (@Y . @M))\n   (call @P @X @Y)                        # Call the given predicate\n   (mapcar @P @L @M) )\n-> mapcar\n: (? (mapcar permute ((a b c) (d e f)) @X))\n @X=((a b c) (d e f))\n @X=((a b c) (d f e))\n @X=((a b c) (e d f))\n ...\n @X=((a c b) (d e f))\n @X=((a c b) (d f e))\n @X=((a c b) (e d f))\n ...\n
\n\n
(can 'msg) -> lst
\n
(Debug mode only) Returns a list of all classes that accept the message\nmsg. See also OO Concepts, class, has, dep, what and who.\n\n
\n: (can 'zap>)\n-> ((zap> . +relation) (zap> . +Blob) (zap> . +Entity))\n: (more @ pp)\n(dm (zap> . +relation) (Obj Val))\n\n(dm (zap> . +Blob) (Obj Val)\n   (and\n      Val\n      (call 'rm \"-f\" (blob Obj (: var))) ) )\n\n(dm (zap> . +Entity) NIL\n   (for X (getl This)\n      (let V (or (atom X) (pop 'X))\n         (and (meta This X) (zap> @ This V)) ) ) )\n\n-> NIL\n
\n\n
(car 'var) -> any
\n
List access: Returns the value of var if it is a symbol, or the\nfirst element if it is a list. See also cdr and c..r.\n\n
\n: (car (1 2 3 4 5 6))\n-> 1\n
\n\n
\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n(c[ad]*ar 'var) -> any
\n
(c[ad]*dr 'lst) -> any
\n
List access shortcuts. Combinations of the car and cdr functions, with up to four letters 'a' and\n'd'.\n\n
\n: (cdar '((1 . 2) . 3))\n-> 2\n
\n\n
(case 'any (any1 . prg1) (any2 . prg2) ..) -> any
\n
Multi-way branch: any is evaluated and compared to the CAR\nelements anyN of each clause. If one of them is a list,\nany is in turn compared to all elements of that list.\nT is a catch-all for any value. If a comparison succeeds,\nprgN is executed, and the result returned. Otherwise\nNIL is returned. See also casq and state .\n\n
\n: (case (char 66) (\"A\" (+ 1 2 3)) ((\"B\" \"C\") \"Bambi\") (\"D\" (* 1 2 3)))\n-> \"Bambi\"\n: (case 'b (a 1) (\"b\" 2) (b 3) (c 4))\n-> 2\n
\n\n
(casq 'any (any1 . prg1) (any2 . prg2) ..) -> any
\n
Multi-way branch: any is evaluated and compared to the CAR\nelements anyN of each clause. == is used for comparison (pointer equality). If\none of them is a list, any is in turn compared to all elements of\nthat list. T is a catch-all for any value. If a comparison\nsucceeds, prgN is executed, and the result returned. Otherwise\nNIL is returned. See also case and state.\n\n
\n: (casq 'b (a 1) (\"b\" 2) (b 3) (c 4))\n-> 3\n: (casq 'b (a 1) (\"b\" 2) ((a b c) 3) (c 4))\n-> 3\n
\n\n
(catch 'any . prg) -> any
\n
Sets up the environment for a non-local jump which may be caused by throw or by a runtime error. If\nany is an atom, it is used by throw as a jump label\n(with T being a catch-all for any label), and a throw\ncalled during the execution of prg will immediately return the\nthrown value. Otherwise, any should be a list of strings, to catch\nany error whose message contains one of these strings, and\ncatch will immediately return the matching string. If\nneither throw nor an error occurred, the result of\nprg is returned. The global variable @@ is set to T if a\nthrow or error occurred, otherwise NIL. See\nalso finally, quit, if@@ and Error Handling.\n\n
\n: (catch 'OK (println 1) (throw 'OK 999) (println 2))\n1\n-> 999\n: (catch '(\"No such file\") (in \"doesntExist\" (foo)))\n-> \"No such file\"\n
\n\n
Pattern for catching and logging errors:\n\n
\n(if@@\n   (catch '(NIL)\n      (...) )\n   (nil (msg *Msg))  # If an error was thrown, log it and return NIL\n   @ ) ) )  # else return the value returned from catch\n
\n\n
(cd 'any) -> sym
\n
Changes the current directory to any. The old directory is\nreturned on success, otherwise NIL. See also chdir, dir and pwd.\n\n
\n: (when (cd \"lib\")\n   (println (length (dir)))\n   (cd @) )\n99\n
\n\n
(cdr 'lst) -> any
\n
List access: Returns all but the first element of lst. See also\ncar and c..r.\n\n
\n: (cdr (1 2 3 4 5 6))\n-> (2 3 4 5 6)\n
\n\n
(center 'cnt|lst 'any ..) -> sym
\n
Returns a transient symbol with all any arguments packed in a centered format. Trailing blanks\nare omitted. See also align, tab and wrap.\n\n
\n: (center 4 12)\n-> \" 12\"\n: (center 4 \"a\")\n-> \" a\"\n: (center 7 \"a\")\n-> \"   a\"\n: (center (3 3 3) \"a\" \"b\" \"c\")\n-> \" a  b  c\"\n
\n\n
(chain 'any ..) -> any
\n
Concatenates (destructively) one or several new list elements\nany to the end of the list in the current make environment. This operation is efficient\nalso for long lists, because a pointer to the last element of the result list is\nmaintained. chain returns the last linked argument. See also\nlink, yoke and made.\n\n
\n: (make (chain (list 1 2 3) NIL (cons 4)) (chain (list 5 6)))\n-> (1 2 3 4 5 6)\n
\n\n
(char) -> sym
\n
(char 'cnt) -> sym
\n
(char T) -> sym
\n
(char 'sym) -> cnt
\n
When called without arguments, the next character from the current input\nstream is returned as a single-character transient symbol, or NIL\nupon end of file. When called with a number cnt, a character with\nthe corresponding unicode value is returned. As a special case, T\nis accepted to produce a byte value greater than any first byte in a UTF-8\ncharacter (used as a top value in comparisons). Otherwise, when called with a\nsymbol sym, the numeric unicode value of the first character of the\nname of that symbol is returned. See also peek, skip, key, line, till and eof.\n\n
\n: (char)                   # Read character from console\nA                          # (typed 'A' and a space/return)\n-> \"A\"\n: (char 100)               # Convert unicode to symbol\n-> \"d\"\n: (char \"d\")               # Convert symbol to unicode\n-> 100\n\n: (char T)                 # Special case\n-> # (not printable)\n\n: (char 0)\n-> NIL\n: (char NIL)\n-> 0\n
\n\n
(chdir 'any . prg) -> any
\n
Changes the current directory to any with cd during the execution of prg. Then\nthe previous directory will be restored and the result of prg\nreturned. See also dir and pwd.\n\n
\n: (pwd)\n-> \"/usr/abu/pico\"\n: (chdir \"src\" (pwd))\n-> \"/usr/abu/pico/src\"\n: (pwd)\n-> \"/usr/abu/pico\"\n
\n\n
(chkTree 'sym ['fun]) -> num
\n
Checks a database tree node (and recursively all sub-nodes) for consistency.\nReturns the total number of nodes checked. Optionally, fun is\ncalled with the key and value of each node, and should return NIL\nfor failure. See also tree and\nroot.\n\n
\n: (show *DB '+Item)\n{40} 6\n   nr (6 . {H1})\n   pr (6 . {H3})\n   sup (6 . {H2})\n   nm (67 . {I3})\n-> {40}\n: (chkTree '{H1})   # Check that node\n-> 6\n
\n\n
(chop 'any) -> lst
\n
Returns any as a list of single-character strings. If\nany is NIL or a symbol with no name, NIL\nis returned. A list argument is returned unchanged.\n\n
\n: (chop 'car)\n-> (\"c\" \"a\" \"r\")\n: (chop \"Hello\")\n-> (\"H\" \"e\" \"l\" \"l\" \"o\")\n
\n\n
(circ 'any ..) -> lst
\n
Produces a circular list of all any arguments by consing them to a list and then connecting the\nCDR of the last cell to the first cell. See also circ? and list.\n\n
\n: (circ 'a 'b 'c)\n-> (a b c .)\n
\n\n
(circ? 'any) -> any
\n
Returns the circular list tail if any is a circular list, else\nNIL. See also circ.\n\n
\n: (circ? 'a)\n-> NIL\n: (circ? (1 2 3))\n-> NIL\n: (circ? (1 . (2 3 .)))\n-> (2 3 .)\n
\n\n
(class sym . typ) -> obj
\n
Defines sym as a class with the superclass(es)\ntyp. As a side effect, the global variable *Class is set to obj. See also\nextend, dm, var,\nrel, type, isa and object.\n\n
\n: (class +A +B +C +D)\n-> +A\n: +A\n-> (+B +C +D)\n: (dm foo> (X) (bar X))\n-> foo>\n: +A\n-> ((foo> (X) (bar X)) +B +C +D)\n
\n\n
(clause '(sym . any)) -> sym
\n
Declares a Pilog fact or rule for the\nsym argument, by concatenating the any argument to the\nT property of sym. See also *Rule and be.\n\n
\n: (clause '(likes (John Mary)))\n-> likes\n: (clause '(likes (John @X) (likes @X wine) (likes @X food)))\n-> likes\n: (? (likes @X @Y))\n @X=John @Y=Mary\n-> NIL\n
\n\n
clause/2
\n
Pilog predicate that succeeds if the first\nargument is a predicate which has the second argument defined as a clause.\n\n
\n: (? (clause append ((NIL @X @X))))\n-> T\n\n: (? (clause append @C))\n @C=((NIL @X @X))\n @C=(((@A . @X) @Y (@A . @Z)) (append @X @Y @Z))\n-> NIL\n
\n\n
(clip 'lst) -> lst
\n
Returns a copy of lst with all whitespace characters or\nNIL elements removed from both sides. See also trim.\n\n
\n: (clip '(NIL 1 NIL 2 NIL))\n-> (1 NIL 2)\n: (clip '(\" \" a \" \" b \" \"))\n-> (a \" \" b)\n
\n\n
(close 'cnt) -> cnt | NIL
\n
Closes a file descriptor cnt, and returns it when successful.\nShould not be called inside an out body\nfor that descriptor. See also open,\npoll,\nlisten and connect.\n\n
\n: (close 2)                            # Close standard error\n-> 2\n
\n\n
(cmd ['any]) -> sym
\n
When called without an argument, the name of the command that invoked the\npicolisp interpreter is returned. Otherwise, the command name is set to\nany. Setting the name may not work on some operating systems. Note\nthat the new name must not be longer than the original one. See also argv, file and Invocation.\n\n
\n$ pil +\n: (cmd)\n-> \"/usr/bin/picolisp\"\n: (cmd \"!/bin/picolust\")\n-> \"!/bin/picolust\"\n: (cmd)\n-> \"!/bin/picolust\"\n
\n\n
(cnt 'fun 'lst ..) -> cnt
\n
Applies fun to each element of lst. When\nadditional lst arguments are given, their elements are also passed\nto fun. Returns the count of non-NIL values returned\nfrom fun.\n\n
\n: (cnt cdr '((1 . T) (2) (3 4) (5)))\n-> 2\n
\n\n
(co ['any [. prg]]) -> any
\n
Starts, resumes or stops a coroutine with\nthe tag given by any. If called without arguments, the tag of the\ncurrently running coroutine is returned. If prg is not given, a\ncoroutine with that tag will be stopped. Otherwise, if a coroutine running with\nthat tag is found (pointer equality is used for comparison), its execution is\nresumed. Else a new coroutine with that tag is initialized and started.\nprg will be executed until it either terminates normally, or until\nyield is called. In the latter case\nco returns, or transfers control to some other, already running,\ncoroutine. A coroutine cannot call or stop itself directly or indirectly. See\nalso stack, catch and throw.\n\n
\n: (de pythag (N)   # A generator function\n   (if (=T N)\n      (co 'rt)  # Stop\n      (co 'rt\n         (for X N\n            (for Y (range X N)\n               (for Z (range Y N)\n                  (when (= (+ (* X X) (* Y Y)) (* Z Z))\n                     (yield (list X Y Z)) ) ) ) ) ) ) )\n\n: (pythag 20)\n-> (3 4 5)\n: (pythag 20)\n-> (5 12 13)\n: (pythag 20)\n-> (6 8 10)\n\n
\n\n
(collect 'sym 'cls ['hook] ['any|beg ['end [sym|cnt ..]]])
\n
Returns a list of all database objects of class cls, where the\nvalues for the sym arguments correspond to the any\narguments, or where the values for the sym arguments are in the\nrange beg .. end. sym, cls\nand hook should specify a tree for cls or one of its\nsuperclasses. If additional sym|cnt arguments are given, the final\nvalues for the result list are obtained by applying the get algorithm. See also db, aux,\nfetch, init, step and and search.\n\n
\n: (collect 'nr '+Item)\n-> ({B1} {B2} {B3} {B4} {B5} {B6} {B8})\n: (collect 'nr '+Item 3 6 'nr)\n-> (3 4 5 6)\n: (collect 'nr '+Item 3 6 'nm)\n-> (\"Auxiliary Construction\" \"Enhancement Additive\" \"Metal Fittings\" \"Gadget Appliance\")\n: (collect 'nm '+Item \"Main Part\")\n-> ({B1})\n
\n\n
(commit ['any] [exe1] [exe2]) -> T
\n
Closes a transaction, by writing all new or modified external symbols to,\nand removing all deleted external symbols from the database. When\nany is given, it is implicitly sent (with all modified objects) via\nthe tell mechanism to all family\nmembers. If exe1 or exe2 are given, they are executed\nas pre- or post-expressions while the database is locked and protected. See also rollback.\n\n
\n: (pool \"db\")\n-> T\n: (put '{1} 'str \"Hello\")\n-> \"Hello\"\n: (commit)\n-> T\n
\n\n
(complete 'any) -> T | lst
\n
Global variable holding a (possibly empty) function, which will be\ncalled when TAB is pressed in readline(3) to complete the\ntext before the current input point. If it is NIL,\nreadline's default filename generator function is used. Otherwise, it\nshould be a function which returns the next match (if any\nis NIL), some default value (if any is\nT, meaning there is no partial word to be completed), or\ninitializes the generator with the given text and returns the first\nresult.\n\n
\n: (pp 'complete)\n(de complete (S)\n   (when S\n      (setq \"*Cmpl\"\n         (if (=T S) (list \"   \") (flip (all* S))) ) )\n   (pop '\"*Cmpl\") )\n-> complete\n
\n\n
(con 'lst 'any) -> any
\n
Connects any to the first cell of lst, by\n(destructively) storing any in the CDR of lst. See\nalso set and conc.\n\n
\n: (setq C (1 . a))\n-> (1 . a)\n: (con C '(b c d))\n-> (b c d)\n: C\n-> (1 b c d)\n
\n\n
(conc 'lst ..) -> lst
\n
Concatenates all argument lists (destructively). See also append and con.\n\n
\n: (setq  A (1 2 3)  B '(a b c))\n-> (a b c)\n: (conc A B)                        # Concatenate lists in 'A' and 'B'\n-> (1 2 3 a b c)\n: A\n-> (1 2 3 a b c)                    # Side effect: List in 'A' is modified!\n
\n\n
(cond ('any1 . prg1) ('any2 . prg2) ..) -> any
\n
Multi-way conditional: If any of the anyN conditions evaluates\nto non-NIL, prgN is executed and the result returned.\nOtherwise (all conditions evaluate to NIL), NIL is\nreturned. See also nond, if, and,\nif2 and when.\n\n
\n: (cond\n   ((= 3 4) (println 1))\n   ((= 3 3) (println 2))\n   (T (println 3)) )\n2\n-> 2\n
\n\n
(connect 'any1 'any2) -> cnt | NIL
\n
Tries to establish a TCP/IP connection to a server listening at host\nany1, port any2. any1 may be either a\nhostname or a standard internet address in numbers-and-dots/colons notation\n(IPv4/IPv6). any2 may be either a port number or a service name.\nReturns a socket descriptor cnt, or NIL if the\nconnection cannot be established. See also listen and udp.\n\n
\n: (connect \"localhost\" 4444)\n-> 3\n: (connect \"some.host.org\" \"http\")\n-> 4\n
\n\n
(cons 'any ['any ..]) -> lst
\n
Constructs a new list cell with the first argument in the CAR and the second\nargument in the CDR. If more than two arguments are given, a corresponding chain\nof cells is built. (cons 'a 'b 'c 'd) is equivalent to (cons\n'a (cons 'b (cons 'c 'd))). See also list.\n\n
\n: (cons 1 2)\n-> (1 . 2)\n: (cons 'a '(b c d))\n-> (a b c d)\n: (cons '(a b) '(c d))\n-> ((a b) c d)\n: (cons 'a 'b 'c 'd)\n-> (a b c . d)\n
\n\n
(copy 'any) -> any
\n
Copies the argument any. For lists, the top level cells are\ncopied, while atoms are returned unchanged.\n\n
\n: (=T (copy T))               # Atoms are not copied\n-> T\n: (setq L (1 2 3))\n-> (1 2 3)\n: (== L L)\n-> T\n: (== L (copy L))             # The copy is not identical to the original\n-> NIL\n: (= L (copy L))              # But the copy is equal to the original\n-> T\n
\n\n
(count 'tree) -> num
\n
Returns the number of nodes in a database tree. See also tree and root.\n\n
\n: (count (tree 'nr '+Item))\n-> 7\n
\n\n
(create 'typ 'sym 'lst . prg)
\n
Creates or updates database objects of the type\ntyp with the properties in sym and lst.\nIt handles large amounts of data, by sorting and traversing each database index\nseparately. prg is executed repeatedly - and should return a list\nof values for the properties in sym and lst - until it\nreturns NIL. If the fin of\nthe list is NIL, a new object of type typ is created,\notherwise it should be an existing object to be updated. If sym is\nnon-NIL, the first column of the input data is assigned to the\nsym property and should already be sorted. The rest of the input\ndata is assigned to the properties in lst. create\nallocates heap memory, and builds temporary files which increase disk\nrequirements while it runs. No explicit lock should be established on the database, and\nno other processes should operate on this database while it runs. When creating\nmore than a few hundred million index entries per file, it might be necessary to\nincrease the number of open files with e.g. ulimit -n 10000. See\nalso dbs, new, commit and prune.\n\n
\n# Minimal E/R model\n(class +Cls +Entity)          # Class\n(rel key (+Key +Number))      # with a unique numeric key,\n(rel num (+Ref +Number))      # an indexed number,\n(rel str (+Ref +String))      # and an indexed string\n\n(dbs\n   (0 +Cls)\n   (4 (+Cls key))             # Each index in a different file\n   (4 (+Cls num))\n   (4 (+Cls str)) )\n\n# Generating random data\n(create '(+Cls) 'key '(num str)\n   (co 'go                 # Use a coroutine as generator\n      (for Key 100000000   # Key is sorted in input\n         (yield            # Return keys, numbers and single-char strings\n            (list Key (rand) (char (rand 97 122))) ) ) ) )\n\n# Reading from a file in PLIO format\n(create '(+Cls) 'key '(num str)\n   (rd) )\n\n# Reading from a TAB-separated CSV file\n(create '(+Cls) 'key '(num str)\n   (when (split (line) \"\\t\")\n      (list\n         (format (car @))\n         (format (cadr @))\n         (pack (caddr @)) ) ) )\n\n# Direct, naive approach (without using 'create')\n# Don't try this at home! Takes forever due to disk trashing\n(prune 0)\n(gc 400 200)\n(for Key 100000000\n   (new `(db: +Cls) '(+Cls)\n      'key Key\n      'num (rand)\n      'str (char (rand 97 122)) )\n   (at (0 . 10000) (commit) (prune 7)) )\n(commit)\n(prune)\n(gc 0)\n
\n\n
(ctl 'sym . prg) -> any
\n
Waits until a write (exclusive) lock (or a read (shared) lock if the first\ncharacter of sym is \"+\") can be set on the file\nsym, then executes prg and releases the lock. If the\nfile does not exist, it will be created. When sym is\nNIL, a shared lock is tried on the current innermost I/O channel,\nand when it is T, an exclusive lock is tried instead. See also\nin, out, err and pipe.\n\n
\n$ echo 9 >count                           # Write '9' to file \"count\"\n$ pil +\n: (ctl \".ctl\"                             # Exclusive control, using \".ctl\"\n   (in \"count\"\n      (let Cnt (read)                     # Read '9'\n         (out \"count\"\n            (println (dec Cnt)) ) ) ) )   # Write '8'\n-> 8\n:\n$ cat count                               # Check \"count\"\n8\n
\n\n
(ctty 'pid) -> pid
\n
(ctty 'any) -> any | NIL
\n
Unless called with a short number, ctty changes the current TTY\ndevice to any (or just sets standard I/O to a PTY if\nany is NIL). Otherwise, the local console is prepared\nfor serving the PicoLisp process with the process ID pid. See also\nraw.\n\n
\n: (ctty \"/dev/tty\")\n-> \"/dev/tty\"\n
\n\n
(curry lst . fun) -> fun
\n
Builds a new function from the list of symbols or symbol-value pairs\nlst and the functional expression fun. Each member in\nlst that is a pat? symbol\nis substituted inside fun by its value. All other symbols in\nlst are collected into a job environment. curry is a general\nhigher-order function, not limited to strict currying (which generates only\nsingle-argument functions).\n\n
\n: (de multiplier (@X)\n   (curry (@X) (N) (* @X N)) )\n-> multiplier\n: (multiplier 7)\n-> ((N) (* 7 N))\n: ((multiplier 7) 3)\n-> 21\n\n: (def 'fiboCounter\n   (curry ((N1 . 0) (N2 . 1)) (Cnt)\n      (do Cnt\n         (println\n            (prog1\n               (+ N1 N2)\n               (setq N1 N2  N2 @) ) ) ) ) )\n-> fiboCounter\n: (pp 'fiboCounter)\n(de fiboCounter (Cnt)\n   (job '((N2 . 1) (N1 . 0))\n      (do Cnt\n         (println\n            (prog1 (+ N1 N2) (setq N1 N2 N2 @)) ) ) ) )\n-> fiboCounter\n: (fiboCounter 5)\n1\n2\n3\n5\n8\n-> 8\n: (fiboCounter 5)\n13\n21\n34\n55\n89\n-> 89\n
\n\n
(cut 'cnt 'var) -> lst
\n
Pops the first cnt elements (CAR) from the stack in\nvar. See also pop,\nrid and del.\n\n
\n: (setq S '(1 2 3 4 5 6 7 8))\n-> (1 2 3 4 5 6 7 8)\n: (cut 3 'S)\n-> (1 2 3)\n: S\n-> (4 5 6 7 8)\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refD.html",
    "content": "\n\n\n\n\n\nD\n\n\n\n\n
D
\n\n
\n\n
*DB
\n
A global variable holding the external symbol {1} (the database root) while a database is open, otherwise\nNIL. All external symbols in a database can be reached from that\nroot. Except during debugging, any explicit literal access to symbols in the\ndatabase should be avoided, because otherwise a memory leak might occur (The\ngarbage collector temporarily sets *DB to NIL and\nrestores its value after collection, thus disposing of all external symbols not\ncurrently used in the program).\n\n
\n: (show *DB)\n{1} NIL\n   +City {P}\n   +Person {3}\n-> {1}\n: (show '{P})\n{P} NIL\n   nm (566 . {AhDx})\n-> {P}\n: (show '{3})\n{3} NIL\n   tel (681376 . {Agyl})\n   nm (1461322 . {2gu7})\n-> {3}\n
\n\n
*Dbg
\n
A boolean variable indicating \"debug mode\". It can be conveniently switched\non with a trailing + command line argument (see Invocation). When non-NIL, the $ (tracing) and ! (breakpoint) functions are enabled, and the\ncurrent line number and file name will be stored in symbol properties by\nde, def, dm\nand symbols. See also debug, trace and lint.\n\n
\n: (de foo (A B) (* A B))\n-> foo\n: (trace 'foo)\n-> foo\n: (foo 3 4)\n foo : 3 4\n foo = 12\n-> 12\n: (let *Dbg NIL (foo 3 4))\n-> 12\n
\n\n
*Dbs
\n
A global variable holding a list of numbers (block size scale factors, as\nneeded by pool). It is typically set\nby dbs.\n\n
\n: *Dbs\n-> (1 2 1 0 2 3 3 3)\n
\n\n
+Date
\n
Class for calender dates (as calculated by date), a subclass of +Number. See also Database.\n\n
\n(rel dat (+Ref +Date))  # Indexed date\n
\n\n
+Dep
\n
+Joint prefix class for maintaining\ndependencies between +relations.\nExpects a list of (symbolic) attributes that depend on this relation. Whenever\nthis relations is cleared (receives a value of NIL), the dependent\nrelations will also be cleared, triggering all required side-effects. See also\nDatabase.\n\n
In the following example, the index entry for the item pointing to the\nposition (and, therefore, to the order) is cleared in case the order is deleted,\nor this position is deleted from the order:\n\n
\n(class +Pos +Entity)                # Position class\n(rel ord (+Dep +Joint)              # Order of that position\n   (itm)                               # 'itm' specifies the dependency\n   pos (+Ord) )                        # Arguments to '+Joint'\n(rel itm (+Ref +Link) NIL (+Item))  # Item depends on the order\n
\n\n
(d) -> T
\n
(Debug mode only) Inserts !\nbreakpoints into all subexpressions of the current breakpoint. Typically used\nwhen single-stepping a function or method with debug. See also u and unbug.\n\n
\n! (d)                            # Debug subexpression(s) at breakpoint\n-> T\n
\n\n
(daemon 'sym . prg) -> fun
\n
(daemon '(sym . cls) . prg) -> fun
\n
(daemon '(sym sym2 [. cls]) . prg) -> fun
\n
Inserts prg in the beginning of the function (first form), the\nmethod body of sym in cls (second form) or in the\nclass obtained by getting\nsym2 from *Class (or\ncls if given) (third form). Built-in functions (SUBRs) are\nautomatically converted to Lisp expressions. See also trace, expr, patch and redef.\n\n
\n: (de hello () (prinl \"Hello world!\"))\n-> hello\n\n: (daemon 'hello (prinl \"# This is the hello world program\"))\n-> (NIL (prinl \"# This is the hello world program\") (prinl \"Hello world!\"))\n: (hello)\n# This is the hello world program\nHello world!\n-> \"Hello world!\"\n\n: (daemon '* (msg 'Multiplying))\n-> (@ (msg 'Multiplying) (pass $134532148))\n: *\n-> (@ (msg 'Multiplying) (pass $134532148))\n: (* 1 2 3)\nMultiplying\n-> 6\n
\n\n
(dat$ 'dat ['sym]) -> sym
\n
Formats a date dat in\nISO format, with an optional delimiter character sym. See also\n$dat, tim$, datStr and datSym.\n\n
\n: (dat$ (date))\n-> \"20070601\"\n: (dat$ (date) \"-\")\n-> \"2007-06-01\"\n
\n\n
(datStr 'dat ['flg]) -> sym
\n
Formats a date according to the\ncurrent locale. If flg\nis non-NIL, the year will be formatted modulo 100. See also\ndat$, datSym, strDat, expDat, expTel and day.\n\n
\n: (datStr (date))\n-> \"2007-06-01\"\n: (locale \"DE\" \"de\")\n-> NIL\n: (datStr (date))\n-> \"01.06.2007\"\n: (datStr (date) T)\n-> \"01.06.07\"\n
\n\n
(datSym 'dat) -> sym
\n
Formats a date dat in\nsymbolic format (DDmmmYY). See also dat$ and datStr.\n\n
\n: (datSym (date))\n-> \"01jun07\"\n
\n\n
(date ['T]) -> dat
\n
(date 'dat) -> (y m d)
\n
(date 'y 'm 'd) -> dat | NIL
\n
(date '(y m d)) -> dat | NIL
\n
Calculates a (gregorian) calendar date. It is represented as a day number,\nstarting first of March of the year 0 AD. When called without arguments, the\ncurrent date is returned. When called with a T argument, the\ncurrent Coordinated Universal Time (UTC) is returned. When called with a single\nnumber dat, it is taken as a date and a list with the corresponding\nyear, month and day is returned. When called with three numbers (or a list of\nthree numbers) for the year, month and day, the corresponding date is returned\n(or NIL if they do not represent a legal date). See also time, stamp, $dat, dat$, datSym, datStr, strDat, expDat, day, week and ultimo.\n\n
\n: (date)                         # Today\n-> 730589\n: (date 2000 6 12)               # 12-06-2000\n-> 730589\n: (date 2000 22 5)               # Illegal date\n-> NIL\n: (date (date))                  # Today's year, month and day\n-> (2000 6 12)\n: (- (date) (date 2000 1 1))     # Number of days since first of January\n-> 163\n
\n\n
(day 'dat ['lst]) -> sym
\n
Returns the name of the day for a given date dat, in the language of the\ncurrent locale. If lst\nis given, it should be a list of alternative weekday names. See also week, datStr and strDat.\n\n
\n: (day (date))\n-> \"Friday\"\n: (locale \"DE\" \"de\")\n-> NIL\n: (day (date))\n-> \"Freitag\"\n: (day (date) '(\"Mo\" \"Tu\" \"We\" \"Th\" \"Fr\" \"Sa\" \"Su\"))\n-> \"Fr\"\n
\n\n
(db 'sym 'cls ['hook] 'any ['sym 'any ..]) -> sym | NIL
\n
(Deprecated since version 25.5.30) Returns a database object of\nclass cls, where the values for the sym\narguments correspond to the any arguments. If a matching\nobject cannot be found, NIL is returned. sym,\ncls and hook should specify a tree for cls or one of its\nsuperclasses. See also aux,\ncollect, request, fetch, init and step.\n\n
\n: (db 'nr '+Item 1)\n-> {B1}\n: (db 'nm '+Item \"Main Part\")\n-> {B1}\n
\n\n
db/3
\n
db/4
\n
db/5
\n
(Deprecated since version 25.5.30) Pilog database predicate that returns objects\nmatching the given key-value (and optional hook) relation. The relation\nshould be of type +index.\nFor the key pattern applies:\n\n
    \n
  • a symbol (string) returns all entries which start with that string\n
  • other atoms (numbers, external symbols) match as they are\n
  • cons pairs constitute a range, returning objects\n   
      \n   
    • in increasing order if the CDR is greater than the CAR\n   
    • in decreasing order otherwise\n   
    \n
  • other lists are matched for +Aux\nkey combinations\n
\n\n
The optional hook can be supplied as the third argument. See also select/3 and remote/2.\n\n
\n: (? (db nr +Item @Item))              # No value given\n @Item={B1}\n @Item={B2}\n @Item={B3}\n @Item={B4}\n @Item={B5}\n @Item={B6}\n-> NIL\n\n: (? (db nr +Item 2 @Item))            # Get item no. 2\n @Item={B2}\n-> NIL\n\n: (? (db nm +Item Spare @Item) (show @Item))  # Search for \"Spare..\"\n{B2} (+Item)\n   pr 1250\n   inv 100\n   sup {C2}\n   nm \"Spare Part\"\n   nr 2\n @Item={B2}\n-> NIL\n
\n\n
(db: cls ..) -> num
\n
Returns the database file number for objects of the type given by the\ncls argument(s). Needed, for example, for the creation of new objects. See also dbs.\n\n
\n: (db: +Item)\n-> 3\n
\n\n
(dbSync 'obj) -> flg
\n
Starts a database transaction, by trying to obtain a lock on the database root object *DB (or obj if given), and then\ncalling sync to synchronize with\npossible changes from other processes. When all desired modifications to\nexternal symbols are done, (commit\n'upd) should be called. See also Database.\n\n
\n(let? Obj (rd)             # Get object?\n   (dbSync)                # Yes: Start transaction\n   (put> Obj 'nm (rd))     # Update\n   (put> Obj 'nr (rd))\n   (put> Obj 'val (rd))\n   (commit 'upd) )         # Close transaction\n
\n\n
(dbck ['cnt] 'flg) -> any
\n
Performs a low-level integrity check of the current (or cnt'th)\ndatabase file, and returns NIL (or the number of blocks and symbols\nif flg is non-NIL) if everything seems correct.\nOtherwise, a string indicating an error is returned. As a side effect, possibly\nunused blocks (as there might be when a rollback is done before committing newly allocated (new) external symbols) are appended to the free\nlist.\n\n
\n: (pool \"db\")\n-> T\n: (dbck)\n-> NIL\n
\n\n
(dbs . lst)
\n
Initializes the global variable *Dbs. Each element in lst has a\nnumber in its CAR (the block size scale factor of a database file, to be stored\nin *Dbs). The CDR elements are either classes (so that objects of\nthat class are later stored in the corresponding file), or lists with a class in\nthe CARs and a list of relations in the CDRs (so that index trees for these\nrelations go into that file). See also pool.\n\n
\n(dbs\n   (3 +Role +User +Sal (+User pw))              # 512 Prevalent objects\n   (0 +Pos)                                     # A:64 Tiny objects\n   (1 +Item +Ord)                               # B:128 Small objects\n   (2 +CuSu)                                    # C:256 Normal objects\n   (2 (+Role nm) (+User nm) (+Sal nm))          # D:256 Small indexes\n   (4 (+CuSu nr plz tel mob))                   # E:1024 Normal indexes\n   (4 (+CuSu nm))                               # F:1024\n   (4 (+CuSu ort))                              # G:1024\n   (4 (+Item nr sup pr))                        # H:1024\n   (4 (+Item nm))                               # I:1024\n   (4 (+Ord nr dat cus))                        # J:1024\n   (4 (+Pos itm)) )                             # K:1024\n\n: *Dbs\n-> (3 0 1 2 2 4 4 4 4 4 4 4)\n: (get '+Item 'Dbf)\n-> (3 . 128)\n: (get '+Item 'nr 'dbf)\n-> (9 . 1024)\n
\n\n
(de sym . any) -> sym
\n
Assigns a definition to the sym argument, by setting its\nVAL to the any argument. If the symbol has already\nanother value, a \"redefined\" message is issued. When the value of the global\nvariable *Dbg is non-NIL, the current\nline number and file name (if any) are stored in the *Dbg property\nof sym. de is the standard way to define a function.\nSee also def, dm and undef.\n\n
\n: (de foo (X Y) (* X (+ X Y)))  # Define a function\n-> foo\n: (foo 3 4)\n-> 21\n\n: (de *Var . 123)  # Define a variable value\n: *Var\n-> 123\n
\n\n
(debug 'sym)
\n
(debug 'sym 'cls)
\n
(debug '(sym . cls))
\n
(Debug mode only) Inserts a !\nbreakpoint function call at the beginning and all top-level expressions of the\nfunction or method body of sym, to allow a stepwise execution.\nTyping (d) at a breakpoint will also\ndebug the current subexpression, and (e)\nwill evaluate the current subexpression. The current subexpression is stored in\nthe global variable ^. See also\nunbug, *Dbg, trace and lint.\n\n
\n: (de tst (N)                    # Define tst\n   (println (+ 3 N)) )\n-> tst\n: (debug 'tst)                   # Set breakpoints\n-> T\n: (pp 'tst)\n(de tst (N)\n   (! println (+ 3 N)) )         # Breakpoint '!'\n-> tst\n: (tst 7)                        # Execute\n(println (+ 3 N))                # Stopped at beginning of 'tst'\n! (d)                            # Debug subexpression\n-> T\n!                                # Continue\n(+ 3 N)                          # Stopped in subexpression\n! N                              # Inspect variable 'N'\n-> 7\n!                                # Continue\n10                               # Output of print statement\n-> 10                            # Done\n: (unbug 'tst)\n-> T\n: (pp 'tst)                      # Restore to original\n(de tst (N)\n   (println (+ 3 N)) )\n-> tst\n
\n\n
(-debug)
\n
(Debug mode only) Command line frontend to debug. See also -trace.\n\n
\n$ ./pil --debug tst +\n
\n\n
(dec 'num) -> num
\n
(dec 'var ['num]) -> num
\n
The first form returns the value of num decremented by 1. The\nsecond form decrements the VAL of var by 1, or by\nnum. If the first argument is NIL, it is returned\nimmediately. (dec Num) is equivalent to (- Num 1) and\n(dec 'Var) is equivalent to (set 'Var (- Var 1)). See\nalso inc and -.\n\n
\n: (dec -1)\n-> -2\n: (dec 7)\n-> 6\n: (setq N 7)\n-> 7\n: (dec 'N)\n-> 6\n: (dec 'N 3)\n-> 3\n
\n\n
(def 'sym 'any) -> sym
\n
(def 'sym1 'sym2|cnt 'any) -> sym1
\n
The first form assigns a definition to the first sym argument,\nby setting its VAL's to any. The second form defines a\nproperty value any for the first argument's sym2 key\n(or the symbol value for zero). If any of these values existed and was changed\nin the process, a \"redefined\" message is issued. When the value of the global\nvariable *Dbg is non-NIL, the current\nline number and file name (if any) are stored in the *Dbg property\nof sym. See also de and\ndm.\n\n
\n: (def 'b '((X Y) (* X (+ X Y))))\n-> b\n: (def 'b 999)\n# b redefined\n-> b\n
\n\n
(default var 'any ..) -> any
\n
Stores new values any in the var arguments only if\ntheir current values are NIL. Otherwise, their values are left\nunchanged. In any case, the last var's value is returned.\ndefault is used typically in functions to initialize optional\narguments.\n\n
\n: (de foo (A B)               # Function with two optional arguments\n   (default  A 1  B 2)        # The default values are 1 and 2\n   (list A B) )\n-> foo\n: (foo 333 444)               # Called with two arguments\n-> (333 444)\n: (foo 333)                   # Called with one arguments\n-> (333 2)\n: (foo)                       # Called without arguments\n-> (1 2)\n
\n\n
(del 'any 'var ['flg]) -> lst
\n
Deletes any from the list in the value of var, and\nreturns the remaining list. If flg is NIL and\nany is contained more than once in the value of var,\nonly the first occurrence is deleted. (del 'any 'var) is equivalent\nto (set 'var (delete 'any var)). See also delete, rid, cut and pop.\n\n
\n: (setq S '((a b c) (d e f)))\n-> ((a b c) (d e f))\n: (del '(d e f) 'S)\n-> ((a b c))\n: (del 'b S)\n-> (a c)\n
\n\n
(delete 'any 'lst ['flg]) -> lst
\n
Deletes any from lst. If flg is\nNIL and any is contained more than once in\nlst, only the first occurrence is deleted. See also delq, del, remove and insert.\n\n
\n: (delete 2 (1 2 3))\n-> (1 3)\n: (delete (3 4) '((1 2) (3 4) (5 6) (3 4)))\n-> ((1 2) (5 6) (3 4))\n
\n\n
delete/3
\n
Pilog predicate that succeeds if deleting the\nfirst argument from the list in the second argument is equal to the third\nargument. See also delete and\nmember/2.\n\n
\n: (? (delete b (a b c) @X))\n @X=(a c)\n-> NIL\n
\n\n
(delq 'any 'lst ['flg]) -> lst
\n
Deletes any from lst. If flg is\nNIL and any is contained more than once in\nlst, only the first occurrence is deleted. == is used for comparison (pointer equality). See\nalso delete, asoq, push1q, memq, mmeq and Comparing.\n\n
\n: (delq 'b '(a b c))\n-> (a c)\n: (delq (2) (1 (2) 3))\n-> (1 (2) 3)\n
\n\n
(dep 'cls) -> cls
\n
(Debug mode only) Displays the \"dependencies\" of cls, i.e. the\ntree of superclasses and the tree of subclasses. See also OO Concepts, methods, class, what, who, has and and can.\n\n
\n: (dep '+Number)           # Dependencies of '+Number'\n   +relation               # Single superclass is '+relation'\n+Number\n   +Date                   # Subclasses are '+Date' and '+Time'\n   +Time\n-> +Number\n
\n\n
(depth 'lst) -> (cnt1 . cnt2)
\n
Returns the maximal (cnt1) and the average (cnt2)\n\"depth\" of a tree structure as maintained by idx. The total number of nodes is stored in the\nglobal variable @@. See also length and size.\n\n
\n: (off X)                                    # Clear variable\n-> NIL\n: (for N (1 2 3 4 5 6 7) (idx 'X N T))       # Build a degenerated tree\n-> NIL\n: X\n-> (1 NIL 2 NIL 3 NIL 4 NIL 5 NIL 6 NIL 7)   # Only right branches\n: (depth X)\n-> (7 . 4)                                   # Depth is 7, average 4\n\n: (balance 'X (1 2 3 4 5 6 7))               # Build a balanced tree\n-> NIL\n: (depth X)\n-> (3 . 2)                                   # Depth is 3, average 2\n
\n\n
(detach) -> pid | NIL
\n
Detach the current process from its PicoLisp parent, and return the parent's\nprocess ID. This causes the parent to \"forget\" this child process (freeing\nresources like buffers and pipes), effectively disabling family IPC via tell. See also fork and kids.\n\n
\n: (unless (fork)\n   (detach)\n   (runAlone)\n   (bye) )\n
\n\n
(diff 'lst1 'lst2) -> lst
\n
Returns the difference of list arguments, all elements of lst1\nwhich are not in lst2. See also sect.\n\n
\n: (diff (1 2 3 4 5) (2 4))\n-> (1 3 5)\n: (diff (1 2 3) (1 2 3))\n-> NIL\n
\n\n
different/2
\n
Pilog predicate that succeeds if the two\narguments are different. See also equal/2.\n\n
\n: (? (different 3 4))\n-> T\n
\n\n
(dir ['any] ['flg]) -> lst
\n
Returns a list of all filenames in the directory any. Names\nstarting with a dot '.' are ignored, unless flg is\nnon-NIL. See also cd and\ninfo.\n\n
\n: (filter '((F) (tail '(. c) (chop F))) (dir \"@src/\"))\n-> (\"main.c\" \"subr.c\" \"gc.c\" \"io.c\" \"big.c\" \"sym.c\" \"tab.c\" \"flow.c\" ..\n
\n\n
(dirname 'any) -> sym
\n
Returns the directory part of a path name any. See also\nbasename and path.\n\n
\n: (dirname \"a/b/c/d\")\n-> \"a/b/c/\"\n
\n\n
(dm sym . fun|cls2) -> sym
\n
(dm (sym . cls) . fun|cls2) -> sym
\n
(dm (sym sym2 [. cls]) . fun|cls2) -> sym
\n
Defines a method for the message sym in the current class,\nimplicitly given by the value of the global variable *Class, or - in the second form - for the\nexplicitly given class cls. In the third form, the class object is\nobtained by getting sym2\nfrom *Class (or cls if\ngiven). If the method for that class existed and was changed in the process, a\n\"redefined\" message is issued. If - instead of a method fun - a\nsymbol specifying another class cls2 is given, the method from that\nclass is used (explicit inheritance). When the value of the global variable *Dbg is non-NIL, the current line number\nand file name (if any) are stored in the *Dbg property of\nsym. See also OO Concepts, de, undef, class, rel, var, method, send and try.\n\n
\n: (dm start> ()\n   (super)\n   (mapc 'start> (: fields))\n   (mapc 'start> (: arrays)) )\n\n: (dm foo> . +OtherClass)  # Explicitly inherit 'foo>' from '+OtherClass'\n
\n\n
(do 'flg|num ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
\n
Counted loop with multiple conditional exits: The body is executed at most\nnum times (or never (if the first argument is NIL), or\nan infinite number of times (if the first argument is T)). If a\nclause has NIL or T as its CAR, the clause's second\nelement is evaluated as a condition and - if the result is NIL or\nnon-NIL, respectively - the prg is executed and the\nresult returned. Otherwise (if count drops to zero), the result of the last\nexpression is returned. See also loop\nand for.\n\n
\n: (do 4 (printsp 'OK))\nOK OK OK OK -> OK\n: (do 4 (printsp 'OK) (T (= 3 3) (printsp 'done)))\nOK done -> done\n
\n\n
(doc ['sym1] ['sym2])
\n
(Debug mode only) Opens a browser, and tries to display the reference\ndocumentation for sym1. sym2 may be the name of a\nbrowser. If not given, the value of the environment variable\nBROWSER, or the w3m browser is tried. If\nsym1 is NIL, the PicoLisp\nReference manual is opened. See also Function\nReference, docs and vi.\n\n
\n: (doc '+)  # Function reference\n-> NIL\n: (doc '+relation)  # Class reference\n-> NIL\n: (doc)  # Reference manual\n-> NIL\n:  (doc 'vi \"firefox\")  # Use alternative browser\n-> NIL\n
\n\n
(docs 'any)
\n
(Debug mode only) Parses all files with names of the form \"ref@.html\" in the\ndirectory any, to set the doc property for later calls\nto doc.\n\n
\n: (docs \"@doc/\")\n-> NIL\n
\n\n
(download 'host 'src 'dst) -> any
\n
Tries to download the file src from host with\n\"@bin/ssl\", and stores it in dst. Returns non-NIL if\nsuccessful. See also ssl.\n\n
\n: (download \"de.wikipedia.org\" \"static/images/wikimedia-button.png\" \"button.png\")\n-> 0\n: (info \"button.png\")\n-> (2426 736804 . 35589)\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refE.html",
    "content": "\n\n\n\n\n\nE\n\n\n\n\n
E
\n\n
\n\n
*Err
\n
A global variable holding a (possibly empty) prg body, which\nwill be executed during error processing. See also Error Handling, *Msg and ^.\n\n
\n: (de *Err (prinl \"Fatal error!\"))\n-> *Err\n: (/ 3 0)\n!? (/ 3 0)\nDiv/0\nFatal error!\n?\n
\n\n
*Ext
\n
A global variable holding a sorted list of cons pairs. The CAR of each pair\nspecifies an external symbol offset (suitable for ext), and the CDR should be a function taking a\nsingle external symbol as an argument. This function should return a list, with\nthe value for that symbol in its CAR, and the property list (in the format used\nby getl and putl) in its CDR. The symbol will be set to\nthis value and property list upon access. Typically this function will access\nthe corresponding symbol in a remote database process. See also qsym and external symbols.\n\n
\n### On the local machine ###\n: (setq *Ext  # Define extension functions\n   (mapcar\n      '((@Host @Ext)\n         (cons @Ext\n            (curry (@Host @Ext (Sock)) (Obj)\n               (when (or Sock (setq Sock (connect @Host 4040)))\n                  (ext @Ext\n                     (out Sock (pr (cons 'qsym Obj)))\n                     (prog1\n                        (in Sock (rd))\n                        (unless @\n                           (close Sock)\n                           (off Sock) ) ) ) ) ) ) )\n      '(\"10.10.12.1\" \"10.10.12.2\" \"10.10.12.3\" \"10.10.12.4\")\n      (20 40 60 80) ) )\n\n### On the remote machines ###\n(de go ()\n   ...\n   (task (port 4040)                      # Set up background query server\n      (let? Sock (accept @)               # Accept a connection\n         (unless (fork)                   # In child process\n            (in Sock\n               (while (rd)                # Handle requests\n                  (sync)\n                  (tell)\n                  (out Sock\n                     (pr (eval @)) ) ) )\n            (bye) )                       # Exit child process\n         (close Sock) ) )\n   ...\n\n
\n\n
+Entity
\n
Base class of all database objects. See also +relation and Database.\n\n
Messages to entity objects include\n\n
\nzap> ()              # Clean up relational structures, for removal from the DB\nurl> (Tab)           # Call the GUI on that object (in optional Tab)\ngui> ()              # Generate object-specific GUI fragment\nupd> (X Old)         # Callback method when object is created/modified/deleted\nhas> (Var Val)       # Check if value is present\nrel?> (Var Val)      # Check if relations for value are correctly maintained\nput> (Var Val)       # Put a new value\nput!> (Var Val)      # Put a new value, single transaction\ndel> (Var Val)       # Delete value (also partial)\ndel!> (Var Val)      # Delete value (also partial), single transaction\ninc> (Var Val)       # Increment numeric value\ninc!> (Var Val)      # Increment numeric value, single transaction\ndec> (Var Val)       # Decrement numeric value\ndec!> (Var Val)      # Decrement numeric value, single transaction\nmis> (Var Val)       # Return error message if value or type mismatch\nlose1> (Var)         # Delete relational structures for a single attribute\nlose> (Lst)          # Delete relational structures (excluding 'Lst')\nlose!> ()            # Delete relational structures, single transaction\nkeep1> (Var)         # Restore relational structures for single attribute\nkeep> (Lst)          # Restore relational structures (excluding 'Lst')\nkeep?> (Lst)         # Test for restauration (excluding 'Lst')\nkeep!> ()            # Restore relational structures, single transaction\nset> (Val)           # Set the value (type, i.e. class list)\nset!> (Val)          # Set the value, single transaction\nclone> ()            # Object copy\nclone!> ()           # Object copy, single transaction\n
\n\n
(e . prg) -> any
\n
Used in a breakpoint. Evaluates prg in the execution\nenvironment, or the currently executed expression if prg is not\ngiven. See also debug, !, ^ and\n*Dbg.\n\n
\n: (! + 3 4)\n(+ 3 4)\n! (e)\n-> 7\n
\n\n
(echo ['cnt ['cnt]] | ['sym ..]) -> sym
\n
Reads the current input channel, and writes to the current output channel.\nIf cnt is given, only that many bytes are actually echoed. In case\nof two cnt arguments, the first one specifies the number of bytes\nto skip in the input stream. Otherwise, if one or more sym\narguments are given, the echo process stops as soon as one of the symbol's names\nis encountered in the input stream. In this case the name will be read and\nreturned, but not written. Returns non-NIL if the operation was\nsuccessfully completed. See also from.\n\n
\n: (in \"x.l\" (echo))  # Display file on console\n ..\n\n: (out \"x2.l\" (in \"x.l\" (echo)))  # Copy file \"x.l\" to \"x2.l\"\n
\n\n
(enum 'var 'cnt ['cnt ..]) -> lst
\n
(enum 'var ['flg]) -> lst
\n
Enumerates cells by maintaining a binary tree in var. The keys\nare implicit from the enumerated cnts, and the resulting tree is\nbalanced (independent from the insertion order). In the first form, the\ncorresponding cell is returned. If it does not exist yet, it is (destructively)\ninserted into the tree. If more than one cnt argument is given, the\nreturned cell is subsequently taken as the next tree to be processed. The second\nform returns an unsorted association list of all key-value pairs (or value-key\npairs if flg is non-NIL) in the tree.\nenum can be used to emulate (possibly sparse) arrays. See also\nenum?, idx and hash.\n\n
\n: (off E)\n-> NIL\n: (for (I . S) '(a b c d e f g h i j k l m n o)\n   (set (enum 'E I) S) )\n-> o\n: E\n-> (a (b (d (h) l) f (j) n) c (e (i) m) g (k) o)\n: (view E T)\n         o\n      g\n         k\n   c\n         m\n      e\n         i\na\n         n\n      f\n         j\n   b\n         l\n      d\n         h\n-> NIL\n: (enum 'E 6)\n-> (f (j) n)\n: (val (enum 'E 6))\n-> f\n: (val (enum 'E 1))\n-> a\n: (val (enum 'E 12))\n-> l\n: (enum 'E)\n-> ((8 . h) (4 . d) (12 . l) (2 . b) (10 . j) (6 . f) (14 . n) (1 . a) (9 . i) (5 . e) (13 . m) (3 . c) (11 . k) (7 . g) (15 . o))\n: (enum 'E T)\n-> ((h . 8) (d . 4) (l . 12) (b . 2) (j . 10) (f . 6) (n . 14) (a . 1) (i . 9) (e . 5) (m . 13) (c . 3) (k . 11) (g . 7) (o . 15))\n\n: (let A NIL  # 2-dimensional array\n   (for I 4\n      (for J 4\n         (set (enum 'A I J) (pack I \"-\" J)) ) )\n   (for I 4\n      (for J 4\n         (prin \" \" (val (enum 'A I J))) )\n      (prinl) ) )\n 1-1 1-2 1-3 1-4\n 2-1 2-2 2-3 2-4\n 3-1 3-2 3-3 3-4\n 4-1 4-2 4-3 4-4\n-> NIL\n
\n\n
(enum? 'lst 'cnt ['cnt ..]) -> lst | NIL
\n
Tests a binary enum tree for the\nkeys in the cnt arguments. Returns the corresponding cell, or\nNIL if not found. The tree is not modified. See also lup.\n\n
\n: (enum? E 7)\n-> (g (k) o)\n: (enum? E 16)\n-> NIL\n
\n\n
(env ['lst] | ['sym 'val] ..) -> lst
\n
Return a list of symbol-value pairs of all dynamically bound symbols if\ncalled without arguments, or of the symbols or symbol-value pairs in\nlst, or the explicitly given sym-val\narguments. See also bind, job, trail and up.\n\n
\n: (env)\n-> NIL\n: (let (A 1 B 2) (env))\n-> ((A . 1) (B . 2))\n: (let (A 1 B 2) (env '(A B)))\n-> ((B . 2) (A . 1))\n: (let (A 1 B 2) (env 'X 7 '(A B (C . 3)) 'Y 8))\n-> ((Y . 8) (C . 3) (B . 2) (A . 1) (X . 7))\n
\n\n
(eof ['flg]) -> flg
\n
Returns the end-of-file status of the current input channel. If\nflg is non-NIL, the channel's status is forced to\nend-of-file, so that the next call to eof will return\nT, and calls to char,\npeek, line, from, till, read or skip will return NIL. Note that\neof cannot be used with the binary rd function. See also eol.\n\n
\n: (in \"file\" (until (eof) (println (line T))))\n...\n
\n\n
(eol) -> flg
\n
Returns the end-of-line status of the current input channel.\nSee also eof.\n\n
\n: (make (until (prog (link (read)) (eol))))  # Read line into a list\na b c (d e f) 123\n-> (a b c (d e f) 123)\n
\n\n
equal/2
\n
Pilog predicate that succeeds if the two\narguments are equal. See also =, different/2 and member/2.\n\n
\n: (? (equal 3 4))\n-> NIL\n: (? (equal @N 7))\n @N=7\n-> NIL\n
\n\n
(err 'sym . prg) -> any
\n
Redirects the standard error stream to sym during the execution\nof prg. The current standard error stream will be saved and\nrestored appropriately. If the argument is NIL, the current output\nstream will be used. Otherwise, sym is taken as a file name (opened\nin \"append\" mode if the first character is \"+\"), where standard error is to be\nwritten to. See also in, out and ctl.\n\n
\n: (err \"/dev/null\"             # Suppress error messages\n   (call 'ls 'noSuchFile) )\n-> NIL\n
\n\n
(errno) -> cnt
\n
Returns the value of the standard I/O 'errno' variable. See also native.\n\n
\n: (in \"foo\")                           # Produce an error\n!? (in \"foo\")\n\"foo\" -- Open error: No such file or directory\n? (errno)\n-> 2                                   # Returned 'ENOENT'\n
\n\n
(eval 'any ['cnt]) -> any
\n
Evaluates any. Note that because of the standard argument\nevaluation, any is actually evaluated twice. If an offset\ncnt is given, the value of @ in the cnt'th call environment\nis used during the second evaluation. cnt should be greater than\nzero. See also run and up.\n\n
\n: (eval (list '+ 1 2 3))\n-> 6\n: (setq X 'Y  Y 7)\n-> 7\n: X\n-> Y\n: Y\n-> 7\n: (eval X)\n-> 7\n
\n\n
(exec 'any ..)
\n
Executes an external system command. The any arguments specify\nthe command and its arguments. Does not return to the caller; the current\nprocess is replaced with a new process image. See also fork and call.\n\n
\n: (pipe (exec 'echo 123 \"abc\")  # Equivalent to (in '(echo 123 \"abc\") ..)\n   (list (read) (read)) )\n-> (123 abc)\n\n(unless (fork)\n   (exec \"@bin/ssl\"  # Start replication process\n      \"10.11.12.13\" 443\n      \"app/!replica\" \"key/app\" \"fifo/app\" \"db/app/blob/\" 20 ) )\n
\n\n
(expDat 'sym) -> dat
\n
Expands a date string according to\nthe current locale (delimiter, and\norder of year, month and day). Accepts abbreviated input, without delimiter and\nwith only the day, or the day and month, or the day, month and year of current\ncentury. A single dot \".\" expands to \"today\", and a signed number to a date such\nmany days in the past or future. See also datStr, day, expTel.\n\n
\n: (date)\n-> 733133\n: (date (date))\n-> (2007 5 31)\n: (expDat \"31\")\n-> 733133\n: (expDat \"315\")\n-> 733133\n: (expDat \"3105\")\n-> 733133\n: (expDat \"31057\")\n-> 733133\n: (expDat \"310507\")\n-> 733133\n: (expDat \"2007-05-31\")\n-> 733133\n: (expDat \"7-5-31\")\n-> 733133\n\n: (locale \"DE\" \"de\")\n-> NIL\n: (expDat \"31.5\")\n-> 733133\n: (expDat \"31.5.7\")\n-> 733133\n
\n\n
(expTel 'sym) -> sym
\n
Expands a telephone number string. Multiple spaces or hyphens are coalesced.\nA leading + or 00 is removed, a leading national trunk\nprefix is replaced with the current country code. Otherwise, NIL is\nreturned. See also telStr, expDat and locale.\n\n
\n: (expTel \"+49 1234 5678-0\")\n-> \"49 1234 5678-0\"\n: (expTel \"0049 1234 5678-0\")\n-> \"49 1234 5678-0\"\n: (expTel \"01234 5678-0\")\n-> NIL\n: (locale \"DE\" \"de\")\n-> NIL\n: (expTel \"01234 5678-0\")\n-> \"49 1234 5678-0\"\n
\n\n
(export . lst) -> lst
\n
Intern all symbols in lst explicitly in the second namespace in the current search order. See also\npico, symbols, private, local, import and intern.\n\n
\n: (symbols 'myLib 'pico)\n-> (pico)\nmyLib: (export foo bar)  # Intern 'foo' and 'bar' in 'pico'\n
\n\n
(expr 'sym) -> fun
\n
Converts a built-in function (SUBR) to a Lisp-function. Useful only for\nnormal functions (i.e. functions that evaluate all arguments). See also subr.\n\n
\n: car\n-> 67313448\n: (expr 'car)\n-> (@ (pass $385260187))\n: (car (1 2 3))\n-> 1\n
\n\n
(ext 'cnt . prg) -> any
\n
During the execution of prg, all external symbols processed by rd, pr,\nplio,\nblk or udp are modified by an offset cnt\nsuitable for mapping via the *Ext\nmechanism. All external symbol's file numbers are decremented by\ncnt during output, and incremented by cnt during\ninput.\n\n
\n: (out 'a (ext 5 (pr '({A2} ({C4} . a) ({B7} . b)))))\n-> ({A2} ({C4} . a) ({B7} . b))\n\n: (in 'a (rd))\n-> ({OOOL2} ({OOON4} . a) ({OOOM7} . b))\n\n: (in 'a (ext 5 (rd)))\n-> ({A2} ({C4} . a) ({B7} . b))\n
\n\n
(ext? 'any ['flg]) -> sym | NIL
\n
Returns the argument any when it is an external symbol,\notherwise NIL. If flg is non-NIL, also\nphysical existence is checked. See also sym?, box?, str?, extern and lieu.\n\n
\n: (ext? *DB)\n-> {1}\n: (ext? 'abc)\n-> NIL\n: (ext? \"abc\")\n-> NIL\n: (ext? 123)\n-> NIL\n
\n\n
(extend cls) -> cls
\n
Extends the class cls, by storing it in the global variable\n*Class. As a consequence, all\nfollowing method, relation and class variable definitions are applied to that\nclass. See also OO Concepts, class, dm, var,\nrel, type and isa.\n\n
\n
\n\n
(extern 'sym) -> sym | NIL
\n
Creates or finds an external symbol. If a symbol with the name\nsym is already extern, it is returned. Otherwise, a new external\nsymbol is returned. NIL is returned if sym does not\nexist in the database. See also intern and ext?.\n\n
\n: (extern \"A1b\")\n-> {A1b}\n: (extern \"{A1b}\")\n-> {A1b}\n
\n\n
(extra ['any ..]) -> any
\n
Can only be used inside methods. Sends the current message to the current\nobject This, this time starting the search for a method at the\nremaining branches of the inheritance tree of the class where the current method\nwas found. See also OO Concepts, super, method, meth, send and try.\n\n
\n(dm key> (C)            # 'key>' method of the '+Uppc' class\n   (uppc (extra C)) )   # Convert 'key>' of extra classes to upper case\n
\n\n
(extract 'fun 'lst ..) -> lst
\n
Applies fun to each element of lst. When\nadditional lst arguments are given, their elements are also passed\nto fun. Returns a list of all non-NIL values returned\nby fun. (extract 'fun 'lst) is equivalent to\n(mapcar 'fun (filter 'fun 'lst)) or, for non-NIL results, to\n(mapcan '((X) (and (fun X) (cons @))) 'lst). See also filter, find, pick and mapcan.\n\n
\n: (setq A NIL  B 1  C NIL  D 2  E NIL  F 3)\n-> 3\n: (filter val '(A B C D E F))\n-> (B D F)\n: (extract val '(A B C D E F))\n-> (1 2 3)\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refF.html",
    "content": "\n\n\n\n\n\nF\n\n\n\n\n
F
\n\n
\n\n
*Fork
\n
A global variable holding a (possibly empty) prg body, to be\nexecuted after a call to fork in the\nchild process.\n\n
\n: (push '*Fork '(off *Tmp))   # Clear '*Tmp' in child process\n-> (off *Tmp)\n
\n\n
+Fold
\n
Prefix class for maintaining folded indexes to +String relations. Typically used in\ncombination with the +Ref or +Idx prefix classes. See also +IdxFold and Database.\n\n
\n(rel nm (+Fold +Idx +String))   # Item Description\n...\n(rel tel (+Fold +Ref +String))  # Phone number\n
\n\n
(fail) -> lst
\n
Constructs an empty Pilog query, i.e. a query\nthat will always fail. See also goal.\n\n
\n(dm clr> ()                # Clear query chart in search dialogs\n   (query> This (fail)) )\n
\n\n
fail/0
\n
Pilog predicate that always fails. See also\ntrue/0.\n\n
\n: (? (fail))\n-> NIL\n
\n\n
(fd ['cnt]) -> cnt
\n
Return the current file descriptor, typically of the closest in or out channel. If a second file descriptor\ncnt is given, the current file descriptor is copied to it using a\ndup2() system call. See also ipid and opid.\n\n
\n: (in \"@lib.l\" (fd))\n-> 3\n
\n\n
(fetch 'tree 'any) -> any
\n
Fetches a value for the key any from a database tree. See also\ntree and store.\n\n
\n: (fetch (tree 'nr '+Item) 2)\n-> {B2}\n
\n\n
(fifo 'var ['any ..]) -> any
\n
Implements a first-in-first-out structure using a circular list. When called\nwith any arguments, they will be concatenated to end of the\nstructure. Otherwise, the first element is removed from the structure and\nreturned. See also queue, push, pop, rid, rot and circ.\n\n
\n: (fifo 'X 1)\n-> 1\n: (fifo 'X 2 3)\n-> 3\n: X\n-> (3 1 2 .)\n: (fifo 'X)\n-> 1\n: (fifo 'X)\n-> 2\n: X\n-> (3 .)\n
\n\n
(file) -> (sym1 sym2 . num) | NIL
\n
Returns for the current input channel the path name sym1, the\nfile name sym2, and the current line number num. If\nthe current input channel is not a file, NIL is returned. See also\ninfo, in and load.\n\n
\n: (load (pack (car (file)) \"localFile.l\"))  # Load a file in same directory\n
\n\n
(fill 'any ['sym|lst]) -> any
\n
(fill 'any ['cnt|sym] 'any2) -> any
\n
Non-destructively fills a pattern any, by substituting\nsym, or all symbols in lst, or - if no second argument\nis given - each pattern symbol in any (see pat?), with its current value. @\nitself is not considered a pattern symbol here. In any case, expressions\nfollowing the symbol ^ are evaluated and the results\n(destructively) spliced into the result. In the second form, all occurrences of\nthe second argument are simply replaced by any2. In both cases,\nunmodified subexpressions are shared.\n\nSee also match.\n\n
\n: (setq  @X 1234  @Y (1 2 3 4))\n-> (1 2 3 4)\n: (fill '@X)\n-> 1234\n: (fill '(a b (c @X) ((@Y . d) e)))\n-> (a b (c 1234) (((1 2 3 4) . d) e))\n: (let X 2 (fill (1 X 3) 'X))\n-> (1 2 3)\n\n: (fill (1 ^(list 'a 'b 'c) 9))\n-> (1 a b c 9)\n: (fill (1 ^(+ 2 3) 7))\n-> (1 5 7)\n\n: (fill (1 (a (b . 2) c) 3) 'b 7)\n-> (1 (a (7 . 2) c) 3)\n: (fill (1 (a (b . 2) c) 3) 2 123)\n-> (1 (a (b . 123) c) 3)\n\n: (match '(This is @X) '(This is a pen))\n-> T\n: (fill '(Got ^ @X))\n-> (Got a pen)\n
\n\n
(filter 'fun 'lst ..) -> lst
\n
Applies fun to each element of lst. When\nadditional lst arguments are given, their elements are also passed\nto fun. Returns a list of all elements of lst where\nfun returned non-NIL. See also fish, find, pick and extract.\n\n
\n: (filter num? (1 A 2 (B) 3 CDE))\n-> (1 2 3)\n: (filter < (2 9 3 8 4 7) (5 4 3 9 9 5))\n-> (2 8 4)\n: (filter and (1 NIL 3 NIL 5) (2 3 4 5 6) (7 8 NIL 1 1))\n-> (1 5)\n: (filter and (range 1 22) '(NIL NIL T .))\n-> (3 6 9 12 15 18 21)\n
\n\n
(fin 'any) -> num|sym
\n
Returns any if it is an atom, otherwise the CDR of its last\ncell. See also last and tail.\n\n
\n: (fin 'a)\n-> a\n: (fin '(a . b))\n-> b\n: (fin '(a b . c))\n-> c\n: (fin '(a b c))\n-> NIL\n
\n\n
(finally exe . prg) -> any
\n
prg is executed, then exe is evaluated, and the\nresult of prg is returned. exe will also be evaluated\nif prg does not terminate normally due to a runtime error or a call\nto throw. See also bye, catch, quit and Error\nHandling.\n\n
\n: (finally (prinl \"Done!\")\n   (println 123)\n   (quit)\n   (println 456) )\n123\nDone!\n: (catch 'A\n   (finally (prinl \"Done!\")\n      (println 1)\n      (throw 'A 123)\n      (println 2) ) )\n1\nDone!\n-> 123\n
\n\n
(find 'fun 'lst ..) -> any
\n
Applies fun to successive elements of lst until\nnon-NIL is returned. Returns that element (and stores the\nnon-NIL value in the global variable @@), or NIL if fun did\nnot return non-NIL for any element of lst. When\nadditional lst arguments are given, their elements are also passed\nto fun. See also seek,\npick, fully and filter.\n\n
\n: (find pair (1 A 2 (B) 3 CDE))\n-> (B)\n: (find '((A B) (> A B)) (1 2 3 4 5 6) (6 5 4 3 2 1))\n-> 4\n: (find > (1 2 3 4 5 6) (6 5 4 3 2 1))  # shorter\n-> 4\n
\n\n\n
(finish . prg) -> exe
\n
Pushes the expressions in prg into the global *Bye in reverse order, to be executed just\nbefore the termination of the PicoLisp interpreter. (finish (foo)\n(bar)) is equivalent to (push '*Bye '(bar) '(foo)) See also\nbye and once.\n\n
\n: (finish (call \"rm\" \"myfile.tmp\"))  # Remove a temporary file\n-> (call 'rm \"myfile.tmp\")\n
\n\n
(fish 'fun 'any ['any2] ..) -> lst
\n
Applies fun to each element - and recursively to all sublists -\nof any. Returns a list of all items where fun returned\nnon-NIL. If any2 is non-NIL, it may be\nreturned by fun to cause the corresponding item or (sub-)list to be\nskipped. When additional any arguments are given, they are also\npassed to fun. See also seek,\n\nSee also filter.\n\n
\n: (fish atom '((a b) c (d e)))\n-> (a b c d e)\n: (fish sym? '(a -2 (1 b (-3 c 2)) 3 d -1 7))\n-> (a b c d)\n: (fish gt0 '(a -2 (1 b (-3 c 2)) 3 d -1 7))\n-> (1 2 3 7)\n: (fish < '(a -2 (1 b (-3 c 2)) 3 d -1 7) NIL 2)\n-> (-2 1 -3 -1)\n: (fish\n   '((X)\n      (if (and (pair X) (=1 (car X)))\n         \"skip\"  # Transient symbol (pointer equal)\n         (gt0 X) ) )\n   '(a -2 (1 b (-3 c 2)) 3 d -1 7)\n   \"skip\" )\n-> (3 7)\n: (fish == '(a 1 (b (3 b)) 3) NIL 'b)\n-> (b b)\n
\n\n
(flg? 'any) -> flg
\n
Returns T when the argument any is either\nNIL or T. See also bool. (flg? X) is equivalent to\n(or (not X) (=T X)).\n\n
\n: (flg? (= 3 3))\n-> T\n: (flg? (= 3 4))\n-> T\n: (flg? (+ 3 4))\n-> NIL\n
\n\n
(flip 'lst ['cnt]) -> lst
\n
Returns lst (destructively) reversed. Without the optional\ncnt argument, the whole list is flipped, otherwise only the first\ncnt elements. See also reverse and rot.\n\n
\n: (flip (1 2 3 4))         # Flip all  four elements\n-> (4 3 2 1)\n: (flip (1 2 3 4 5 6) 3)   # Flip only the first three elements\n-> (3 2 1 4 5 6)\n
\n\n
(flood 'lst1 'fun 'lst2) -> lst
\n
Implements a flooding algorithm, returning a list of flooded nodes of a\ngraph. lst1 is a list of relevant nodes, fun a\nfunction accepting a node and returning a list of connected nodes, and\nlst2 a list of seed nodes.\n\n
\n(load \"@lib/simul.l\")\n\n: (setq *Graph (1 2 3 4 5))         # For simplicity, a one-dimensional \"graph\"\n-> (1 2 3 4 5)\n\n: (simul~flood\n   (maplist prog *Graph)            # List of relevant cells\n   '((X)                            # Flood the three central cells (2 3 4)\n      (when (member (car X) (2 3))  # 2 -> 3 and 3 -> 4\n         (list (cdr X)) ) )\n   (list (cddr *Graph)) )           # Seed third (middle) cell\n-> ((3 4 5) (2 3 4 5) (4 5))        # -> Cells (3 ..) (2 ..) (4 ..)\n
\n\n
(flush) -> flg
\n
Flushes the current output stream by writing all buffered data. A call to\nflush for standard output is done automatically before a call to\nkey. Returns T when\nsuccessful. See also rewind.\n\n
\n: (flush)\n-> T\n
\n\n
(fold 'any ['cnt]) -> sym
\n
Folding to a canonical form: If any is not a symbol, it is\nreturned as it is. Otherwise, a new transient symbol with all digits and all\nletters of any, converted to lower case, is returned. If the\ncnt argument is given and non-zero, the result is truncated to that\nlength. See also lowc.\n\n
\n: (fold \" 1A 2-b/3\")\n-> \"1a2b3\"\n: (fold \" 1A 2-B/3\" 3)\n-> \"1a2\"\n
\n\n
fold/3
\n
(Deprecated since version 25.5.30) Pilog predicate that succeeds if the first\nargument, after folding it to\na canonical form, is a prefix of the folded string representation\nof the result of applying the get algorithm to the following\narguments. Typically used as filter predicate in select/3 database queries. See also\npre?, isa/2, same/3, bool/3, range/3, head/3, part/3 and tolr/3.\n\n
\n: (?\n   @Nr (1 . 5)\n   @Nm \"main\"\n   (select (@Item)\n      ((nr +Item @Nr) (nm +Item @Nm))\n      (range @Nr @Item nr)\n      (fold @Nm @Item nm) ) )\n @Nr=(1 . 5) @Nm=\"main\" @Item={B1}\n-> NIL\n
\n\n
(for sym 'cnt ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
\n
(for sym|(sym2 . sym) 'lst ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
\n
(for (sym|(sym2 . sym) 'any1 'any2 [. prg]) ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
\n
Conditional loop with local variable(s) and multiple conditional exits:
\nIn the first form, the value of sym is saved, sym is\nbound to 1, and the body is executed with increasing values up to\n(and including) cnt.
\n\nIn the second form, the value of sym is saved, sym is\nsubsequently bound to the elements of lst, and the body is executed\neach time.
\n\nIn the third form, the value of sym is saved, and sym\nis bound to any1. If sym2 is given, it is treated as a\ncounter variable, first bound to 1 and then incremented for each execution of\nthe body. While the condition any2 evaluates to\nnon-NIL, the body is repeatedly executed and, if prg\nis given, sym is re-bound to the result of its evaluation.
\n\nIf a clause has NIL or T as its CAR, the clause's\nsecond element is evaluated as a condition and - if the result is\nNIL or non-NIL, respectively - the prg is\nexecuted and the result returned. If the body is never executed,\nNIL is returned.
\n\nSee also do and loop.\n\n
\n# First form:\n: (for N 5 (printsp N))\n1 2 3 4 5 -> 5\n: (for N 5 (printsp N) (NIL (< N 3) (printsp 'enough)))\n1 2 3 enough -> enough\n: (for N 5 (T (> N 3) (printsp 'enough)) (printsp N))\n1 2 3 enough -> enough\n\n# Second form:\n: (for X (1 a 2 b) (printsp X))\n1 a 2 b -> b\n: (for (I . X) '(a b c) (println I X))\n1 a\n2 b\n3 c\n-> c\n\n# Third form:\n: (for (L (1 2 3 4 5) L) (printsp (pop 'L)))\n1 2 3 4 5 -> 5\n: (for (N 1 (>= 5 N) (inc N)) (printsp N))\n1 2 3 4 5 -> 5\n: (for ((I . L) '(a b c d e f) L (cddr L)) (println I L))\n1 (a b c d e f)\n2 (c d e f)\n3 (e f)\n-> (e f)\n
\n\n
for/2
\n
for/3
\n
for/4
\n
Pilog predicate that generates a sequence of\nnumbers. See also for and range.\n\n
\n: (? (for @I 3))\n @I=1\n @I=2\n @I=3\n-> NIL\n\n: (? (for @I 3 7))\n @I=3\n @I=4\n @I=5\n @I=6\n @I=7\n-> NIL\n\n: (? (for @I 7 3 2))\n @I=7\n @I=5\n @I=3\n-> NIL\n\n: (? (for @N T))\n @N=1\n @N=2\n @N=3\n ...\n
\n\n
(forall 'cls . prg) -> any
\n
(forall '(cnt . cls) . prg) -> any
\n
(forall 'lst . prg) -> any
\n
Runs prg on all database objects of the class cls\n(as given by the dbs definition, or\nusing the cnt'th database file instead of the dbs\ndefault), or on a lst query structure as returned by init or search. In all cases, the global variable\nThis is bound to each object (and\n@@ is bound to the key in case of\ninit). See also seq and\ncollect.\n\n
\n: (forall '+Item (println (: nr) (: nm)))\n1 \"Main Part\"\n2 \"Spare Part\"\n3 \"Auxiliary Construction\"\n4 \"Enhancement Additive\"\n5 \"Metal Fittings\"\n6 \"Gadget Appliance\"\n\n: (forall (init '(nr . +Item) 2 4)\n   (println @@ (: nr) (: nm)) )\n2 2 \"Spare Part\"\n2 3 \"Auxiliary Construction\"\n2 4 \"Enhancement Additive\"\n\n: (forall\n   (search\n      (1 . 4) '((nr +Item))\n      \"pa\" '((nm +Item)) )\n   (println (: nr) (: nm)) )\n1 \"Main Part\"\n2 \"Spare Part\"\n
\n\n
(fork) -> pid | NIL
\n
Forks a child process. Returns NIL in the child, and the\nchild's process ID pid in the parent. In the child, the\nVAL of the global variable *Fork (should be a prg) is\nexecuted. See also exec, detach, kids, pipe and tell.\n\n
\n: (unless (fork) (do 5 (println 'OK) (wait 1000)) (bye))\n-> NIL\nOK                                              # Child's output\n: OK\nOK\nOK\nOK\n
\n\n
(format 'num ['cnt ['sym1 ['sym2]]]) -> sym
\n
(format 'sym|lst ['cnt ['sym1 ['sym2]]]) -> num
\n
Converts a number num to a string, or a string\nsym|lst to a number. In both cases, optionally a precision\ncnt, a decimal-separator sym1 and a\nthousands-separator sym2 can be supplied. Returns\nNIL if the conversion is unsuccessful. See also Numbers, pad, hex, oct, bin and round.\n\n
\n: (format 123456789)                   # Integer conversion\n-> \"123456789\"\n: (format 123456789 2)                 # Fixed point\n-> \"1234567.89\"\n: (format 123456789 2 \",\")             # Comma as decimal-separator\n-> \"1234567,89\"\n: (format 123456789 2 \",\" \".\")         # and period as thousands-separator\n-> \"1.234.567,89\"\n\n: (format \"123456789\")                 # String to number\n-> 123456789\n: (format (1 \"23\" (4 5 6)))\n-> 123456\n: (format \"1234567.89\" 4)              # scaled to four digits\n-> 12345678900\n: (format \"1.234.567,89\")              # separators not recognized\n-> NIL\n: (format \"1234567,89\" 4 \",\")\n-> 12345678900\n: (format \"1.234.567,89\" 4 \",\")        # thousands-separator not recognized\n-> NIL\n: (format \"1.234.567,89\" 4 \",\" \".\")\n-> 12345678900\n
\n\n
(free 'cnt) -> (sym . lst)
\n
Returns, for the cnt'th database file, the next available\nsymbol sym (i.e. the first symbol greater than any symbol in the\ndatabase), and the list lst of free symbols. See also seq, zap and dbck.\n\n
\n: (pool \"x\")      # A new database\n-> T\n: (new T)         # Create a new symbol\n-> {2}\n: (new T)         # Create another symbol\n-> {3}\n: (commit)        # Commit changes\n-> T\n: (zap '{2})      # Delete the first symbol\n-> {2}\n: (free 1)        # Show free list\n-> ({4})          # {3} was the last symbol allocated\n: (commit)        # Commit the deletion of {2}\n-> T\n: (free 1)        # Now {2} is in the free list\n-> ({4} {2})\n
\n\n
(from 'any ..) -> sym
\n
Skips the current input channel until one of the strings any is\nfound, and starts subsequent reading from that point. The found any\nargument (or NIL if none is found) is returned. See also till and echo.\n\n
\n: (and (from \"val='\") (till \"'\" T))\ntest val='abc'\n-> \"abc\"\n
\n\n
(full 'any) -> bool
\n
Returns NIL if any is a non-empty list with at\nleast one NIL element, otherwise T. (full\nX) is equivalent to (not (memq NIL X)). See also fully.\n\n
\n: (full (1 2 3))\n-> T\n: (full (1 NIL 3))\n-> NIL\n: (full 123)\n-> T\n
\n\n
(fully 'fun 'lst ..) -> flg
\n
Applies fun to successive elements of lst, and\nreturns NIL immediately if one of the results is NIL.\nOtherwise, T is returned. When additional lst\narguments are given, their elements are also passed to fun.\n(fully foo Lst) is equivalent to (not (find '((X) (not (foo\nX))) Lst)). See also find and\nfull.\n\n
\n: (fully gt0 (1 2 3))\n-> T\n: (fully gt0 (1 -2 3))\n-> NIL\n
\n\n
(fun 'fun ['any ..]) -> any
\n
Applies fun to the any arguments. (fun foo\n'args) is equivalent to (foo 'args), and (fun (expr)\n'args) is equivalent to ((expr) 'args). See also apply and pass.\n\n
\n: (find fun '(sym? ((X) (> X 3)) num?) 'a)\n-> sym?\n: (find fun '(sym? ((X) (> X 3)) num?) 3)\n-> num?\n: (find fun '(sym? ((X) (> X 3)) num?) 4)\n-> ((X) (> X 3))\n
\n\n
(fun? 'any) -> any
\n
Returns NIL when the argument any is neither a\nnumber suitable for a code-pointer, nor a list suitable for a lambda expression\n(function). Otherwise a number is returned for a code-pointer, T\nfor a function without arguments, and a single formal parameter or a list of\nformal parameters for a function. See also getd.\n\n
\n: (fun? 1000000000)              # Might be a code pointer\n-> 1000000000\n: (fun? 10000000000000000000)    # Too big for a code pointer\n-> NIL\n: (fun? '((A B) (* A B)))        # Lambda expression\n-> (A B)\n: (fun? '((A B) (* A B) . C))    # Not a lambda expression\n-> NIL\n: (fun? '(1 2 3 4))              # Not a lambda expression\n-> NIL\n: (fun? '((A 2 B) (* A B)))      # Not a lambda expression\n-> NIL\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refG.html",
    "content": "\n\n\n\n\n\nG\n\n\n\n\n
G
\n\n
\n\n
(gc ['cnt [cnt2]]) -> cnt | NIL
\n
Forces a garbage collection. When cnt is given, so many\nmegabytes of free cells are reserved, increasing the heap size if necessary. If\ncnt is zero, all currently unused heap blocks are purged,\ndecreasing the heap size if possible. If cnt2 is given, the reserve\nsize (defaults to 1 megabyte) is set to that value. See also heap.\n\n
\n: (gc)\n-> NIL\n: (heap)\n-> 2\n: (gc 4)\n-> 4\n: (heap)\n-> 5\n
\n\n
(ge0 'any) -> num | NIL
\n
Returns num when the argument is a number and greater or equal\nzero, otherwise NIL. See also lt0, le0, gt0, =0\nand n0.\n\n
\n: (ge0 -2)\n-> NIL\n: (ge0 3)\n-> 3\n: (ge0 0)\n-> 0\n
\n\n
(genKey 'sym 'cls ['hook ['num1 ['num2]]]) -> num
\n
Generates a key for a database tree. If a minimal key num1\nand/or a maximal key num2 is given, the next free number in that\nrange is returned. Otherwise, the current maximal key plus one is returned. See\nalso useKey, genStrKey and maxKey.\n\n
\n: (maxKey (tree 'nr '+Item))\n-> 8\n: (genKey 'nr '+Item)\n-> 9\n
\n\n
(genStrKey 'sym 'sym 'cls ['hook]) -> sym
\n
Generates a unique string for a database tree, by prepending as many \"# \"\nsequences as necessary. See also genKey.\n\n
\n: (genStrKey \"ben\" 'nm '+User)\n-> \"# ben\"\n
\n\n
(get 'sym1|lst ['sym2|cnt ..]) -> any
\n
Fetches a value any from the properties of a symbol, or from a\nlist. From the first argument sym1|lst, values are retrieved in\nsuccessive steps by either extracting the value (if the next argument is zero)\nor a property from a symbol, the CDR of an asoqed element (if the next argument is a\nsymbol), the n'th element (if the next argument is a positive number) or the\nn'th CDR (if the next argument is a negative number) from a list. See also\nput, ;, : and\nnth.\n\n
\n: (put 'X 'a 1)\n-> 1\n: (get 'X 'a)\n-> 1\n: (put 'Y 'link 'X)\n-> X\n: (get 'Y 'link)\n-> X\n: (get 'Y 'link 'a)\n-> 1\n: (get '((a (b . 1) (c . 2)) (d (e . 3) (f . 4))) 'a 'b)\n-> 1\n: (get '((a (b . 1) (c . 2)) (d (e . 3) (f . 4))) 'd 'f)\n-> 4\n: (get '(X Y Z) 2)\n-> Y\n: (get '(X Y Z) 2 'link 'a)\n-> 1\n
\n\n
(getd 'any) -> fun | NIL
\n
Returns fun if any is a symbol that has a function\ndefinition, otherwise NIL. See also fun?.\n\n
\n: (getd '+)\n-> 67327232\n: (getd 'script)\n-> ((File . @) (load File))\n: (getd 1)\n-> NIL\n\n: ht:Fmt             # Initially undefined\n-> NIL\n: (getd 'ht:Fmt)     # Check shared library\n-> 8790207171188\n: ht:Fmt             # Now defined\n-> 8790207171188\n
\n\n
(getl 'sym1|lst1 ['sym2|cnt ..]) -> lst
\n
Fetches the complete property list lst from a symbol. That\nsymbol is sym1 (if no other arguments are given), or a symbol found\nby applying the get algorithm to\nsym1|lst1 and the following arguments. See also putl and maps.\n\n
\n: (put 'X 'a 1)\n-> 1\n: (put 'X 'b 2)\n-> 2\n: (put 'X 'flg T)\n-> T\n: (getl 'X)\n-> (flg (2 . b) (1 . a))\n
\n\n
(glue 'any 'lst) -> sym
\n
Builds a new transient symbol (string) by packing the any argument between\nthe individual elements of lst. See also text.\n\n
\n: (glue \",\" '(a b c d))\n-> \"a,b,c,d\"\n
\n\n
(goal '([pat 'any ..] . lst) ['sym 'any ..]) -> lst
\n
Constructs a Pilog query list from the list of\nclauses lst. The head of the argument list may consist of a\nsequence of pattern symbols (Pilog variables) and expressions, which are used\ntogether with the optional sym and any arguments to\nform an initial environment. See also prove and fail.\n\n
\n: (goal '((likes John @X)))\n-> (((1 (0) NIL ((likes John @X)) NIL T)))\n: (goal '(@X 'John (likes @X @Y)))\n-> (((1 (0) NIL ((likes @X @Y)) NIL ((0 . @X) 1 . John) T)))\n
\n\n
(group 'lst ['flg]) -> lst
\n
Builds a list of lists, by grouping all elements of lst with\nthe same CAR into a common sublist. If the list is known to be pre-grouped, a\nnon-NIL flg argument may be passed for faster\nexecution. See also Comparing, by, sort and uniq.\n\n
\n: (group '((1 . a) (1 . b) (1 . c) (2 . d) (2 . e) (2 . f)))\n-> ((1 a b c) (2 d e f))\n: (by name group '(\"x\" \"x\" \"y\" \"z\" \"x\" \"z\"))\n-> ((\"x\" \"x\" \"x\") (\"y\") (\"z\" \"z\"))\n: (by length group '(123 (1 2) \"abcd\" \"xyz\" (1 2 3 4) \"XY\"))\n-> ((123 \"xyz\") ((1 2) \"XY\") (\"abcd\" (1 2 3 4))\n
\n\n
(gt0 'any) -> num | NIL
\n
Returns num when the argument is a number and greater than\nzero, otherwise NIL. See also lt0, le0, ge0, =0\nand n0.\n\n
\n: (gt0 -2)\n-> NIL\n: (gt0 3)\n-> 3\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refH.html",
    "content": "\n\n\n\n\n\nH\n\n\n\n\n
H
\n\n
\n\n
*Hup
\n
Global variable holding a (possibly empty) prg body, which will\nbe executed when a SIGHUP signal is sent to the current process. See also\nalarm, sigio, *Winch, *Sig[12], *TStp[12] and *Term.\n\n
\n: (de *Hup (msg 'SIGHUP))\n-> *Hup\n
\n\n
+Hook
\n
Prefix class for +relations,\ntypically +Link or +Joint. In essence, this maintains an local\ndatabase in the referred object. See also Database.\n\n
\n(rel sup (+Hook +Link) (+Sup))   # Supplier\n(rel nr (+Key +Number) sup)      # Item number, unique per supplier\n(rel dsc (+Ref +String) sup)     # Item description, indexed per supplier\n
\n\n
+Hook2
\n
Prefix class for +index\nrelations. It maintains both a normal (global) index, and an object-local index\nin the corresponding +Hook object.\nSee also Database.\n\n
\n(rel nm (+Hook2 +IdxFold +String) 3 shop)       # Global and shop-local index\n
\n\n
(h) -> flg
\n
(Debug mode only) Edits the history in memory with Vip. Returns\nT if Vip was exited with \"x\" and NIL if exited with\n\"q\". See also history and vi.\n\n
\n: (h)    # Edit history\n-> T     # \"x\"\n
\n\n
(has 'any) -> lst
\n
(Debug mode only) Returns a list of all internal symbols which have the\nvalue any. See also who,\ncan, what and dep.\n\n
\n: +\n-> 270310\n: (has 270310)\n-> (+ @)\n: meth\n-> 267259\n: (has 267259)\n-> (@ js> dec> inc> upd> ele> log> chk> val> del> rel> all> url> zap> clr> str> has>\n
\n\n
(hash 'any) -> cnt
\n
Generates a 20-bit number (1-1048576) from any, suitable as a\nhash value for various purposes, like randomly balanced idx structures. See also cache, enum, rev and seed.\n\n
\n: (hash 0)\n-> 1\n: (hash 1)\n-> 723519\n: (hash \"abc\")\n-> 557424\n
\n\n
(hax 'num) -> sym
\n
(hax 'sym) -> num
\n
Converts a number num to a string in hexadecimal/alpha\nnotation, or a hexadecimal/alpha formatted string to a number. The digits are\nrepresented with '@' (zero) and the letters 'A' -\n'O' (from \"alpha\" to \"omega\"). This format is used internally for\nthe names of external symbols.\nSee also hex, bin and oct.\n\n
\n: (hax 7)\n-> \"G\"\n: (hax 16)\n-> \"A@\"\n: (hax 255)\n-> \"OO\"\n: (hax \"A\")\n-> 1\n
\n\n
(hd 'sym ['cnt]) -> NIL
\n
(Debug mode only) Displays a hexadecimal dump of the file given by\nsym, limited to cnt lines. See also proc.\n\n
\n:  (hd \"lib.l\" 4)\n00000000  23 20 32 33 64 65 63 30 39 61 62 75 0A 23 20 28  # 23dec09abu.# (\n00000010  63 29 20 53 6F 66 74 77 61 72 65 20 4C 61 62 2E  c) Software Lab.\n00000020  20 41 6C 65 78 61 6E 64 65 72 20 42 75 72 67 65   Alexander Burge\n00000030  72 0A 0A 28 64 65 20 74 61 73 6B 20 28 4B 65 79  r..(de task (Key\n-> NIL\n
\n\n
(head 'cnt|lst 'lst) -> lst
\n
Returns a new list made of the first cnt elements of\nlst. If cnt is negative, it is added to the length of\nlst. If the first argument is a lst, head\nis a predicate function returning that argument list if it is equal\nto the head of the second argument, and NIL otherwise. See also\ntail and pre?.\n\n
\n: (head 3 '(a b c d e f))\n-> (a b c)\n: (head 0 '(a b c d e f))\n-> NIL\n: (head 10 '(a b c d e f))\n-> (a b c d e f)\n: (head -2 '(a b c d e f))\n-> (a b c d)\n: (head '(a b c) '(a b c d e f))\n-> (a b c)\n
\n\n
head/3
\n
(Deprecated since version 25.5.30) Pilog predicate that succeeds if the first\n(string) argument is a prefix of the string representation of the result\nof applying the get algorithm\nto the following arguments. Typically used as filter predicate in\nselect/3 database queries.\nSee also pre?, isa/2, same/3, bool/3, range/3, fold/3, part/3 and tolr/3.\n\n
\n: (?\n   @Nm \"Muller\"\n   @Tel \"37\"\n   (select (@CuSu)\n      ((nm +CuSu @Nm) (tel +CuSu @Tel))\n      (tolr @Nm @CuSu nm)\n      (head @Tel @CuSu tel) )\n   (val @Name @CuSu nm)\n   (val @Phone @CuSu tel) )\n @Nm=\"Muller\" @Tel=\"37\" @CuSu={C3} @Name=\"Miller\" @Phone=\"37 4773 82534\"\n-> NIL\n
\n\n
(heap 'flg) -> cnt
\n
Returns the total size of the cell heap space in megabytes. If\nflg is non-NIL, the size of the currently free space\nis returned. See also stack and\ngc.\n\n
\n: (gc 4)\n-> 4\n: (heap)\n-> 5\n: (heap T)\n-> 4\n
\n\n
(hear 'cnt) -> cnt
\n
Uses the file descriptor cnt as an asynchronous command input\nchannel. Any executable list received via this channel will be executed in the\nbackground. As this mechanism is also used for inter-family communication (see\ntell), hear is usually\nonly called explicitly by a top level parent process.\n\n
\n: (call 'mkfifo \"fifo/cmd\")\n-> T\n: (hear (open \"fifo/cmd\"))\n-> 3\n
\n\n
(help 'sym ['flg]) -> sym
\n
(Debug mode only) Dumps the reference documentation for sym to\nthe current output channel. If flg is non-NIL, the\nexamples are dumped too. See also Function Reference\nand doc.\n\n
\n: (help 'car)\n========================================\n(car 'var) -> any\n\nList access: Returns the value of var if it is a symbol, or the first element if\nit is a list. See also cdr and c..r.\n\n-> car\n\n: (help 'car T)\n========================================\n(car 'var) -> any\n\nList access: Returns the value of var if it is a symbol, or the first element if\nit is a list. See also cdr and c..r.\n\n: (car (1 2 3 4 5 6))\n-> 1\n\n-> car\n
\n\n
(here ['sym]) -> sym
\n
Echoes the current input stream until sym is encountered, or\nuntil end of file. See also echo.\n\n
\n$ cat hello.l\n(html 0 \"Hello\" \"lib.css\" NIL\n   (<h2> NIL \"Hello\")\n   (here) )\n<p>Hello!</p>\n<p>This is a test.</p>\n\n$ pil @lib/http.l @lib/xhtml.l hello.l\nHTTP/1.0 200 OK\nServer: PicoLisp\nDate: Sun, 03 Jun 2007 11:41:27 GMT\nCache-Control: max-age=0\nCache-Control: no-cache\nContent-Type: text/html; charset=utf-8\n\n<!DOCTYPE html>\n<html lang=\"en\">\n<head>\n<meta name=\"viewport\" content=\"width=device-width\"/>\n<title>Hello</title>\n<link rel=\"stylesheet\" href=\"http://:/lib.css\" type=\"text/css\"/>\n</head>\n<body><h2>Hello</h2>\n<p>Hello!</p>\n<p>This is a test.</p>\n</body></html>\n
\n\n
(hex 'num ['num]) -> sym
\n
(hex 'sym) -> num
\n
Converts a number num to a hexadecimal string, or a hexadecimal\nstring sym to a number. In the first case, if the second argument\nis given, the result is separated by spaces into groups of such many digits. See\nalso bin, oct, hax and format.\n\n
\n: (hex 273)\n-> \"111\"\n: (hex \"111\")\n-> 273\n: (hex 1234567 4)\n-> \"12 D687\"\n
\n\n
(history ['lst]) -> lst
\n
When called without argument, history returns the current\nreadline(3) history. lst is a list of strings.\nOtherwise, the history is set to lst. See also Invocation.\n\n
\n: (+ 1 2 3)\n-> 6\n: (history)\n-> (\"(+ 1 2 3)\" \"(history)\")\n
\n\n
(host 'any) -> sym
\n
Returns the hostname corresponding to the given IP address. See also\n*Adr.\n\n
\n: (host \"80.190.158.9\")\n-> \"www.leo.org\"\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refI.html",
    "content": "\n\n\n\n\n\nI\n\n\n\n\n
I
\n\n
\n\n
+Idx
\n
Prefix class for maintaining non-unique full-text indexes to +String relations, a subclass of +Ref. Accepts optional arguments for the\nminimally indexed substring length (defaults to 3), and a +Hook attribute. Often used in combination\nwith the +Sn soundex index, or the\n+Fold index prefix classes. See also\nDatabase.\n\n
\n(rel nm (+Sn +Idx +String))  # Name\n
\n\n
+IdxFold
\n
Prefix class for maintaining non-unique indexes to subsequent substrings of\nthe folded individual words of\n+String relations. Accepts optional\narguments for the minimally indexed substring length (defaults to 3), and a\n+Hook attribute. See also +Idx and Database.\n\n
\n(rel nm (+IdxFold +String))            # Item Description\n
\n\n
+index
\n
Abstract base class of all database B-Tree index relations (prefix classes\nfor +relations). The class\nhierarchy includes +Key, +Ref, +Idx and +IdxFold. See also Database.\n\n
\n(isa '+index Rel)  # Check for an index relation\n
\n\n
(id 'num ['num]) -> sym
\n
(id 'sym [NIL]) -> num
\n
(id 'sym T) -> (num . num)
\n
Converts one (the internal block number) or two (file and block) numbers to\nan external symbol, or an external symbol to a number or a pair of numbers.\n\n
\n: (id 7)\n-> {7}\n: (id 1 2)\n-> {2}\n: (id '{A2})\n-> 2\n: (id '{A2} T)\n-> (2 . 2)\n
\n\n
(idx 'var 'any 'flg) -> lst
\n
(idx 'var 'any) -> lst
\n
(idx 'var) -> lst
\n
Maintains an index tree in var, and checks for the existence of\nany. If any is contained in var, the\ncorresponding subtree is returned, otherwise NIL. In the first\nform, any is destructively inserted into the tree if\nflg is non-NIL (and any was not already\nthere), or deleted from the tree if flg is NIL. If all\nelements are inserted in sorted order, the tree degenerates into a linear list.\nIn such cases, 0 may be passed for flg to randomize\nthe insertion order. The second form only checks for existence, but does not\nchange the index tree. In the third form (when called with a single\nvar argument) the contents of the tree are returned as a sorted\nlist.\n\nSee also lup, enum, hash, rev, depth, sort, balance and member.\n\n
\n: (idx 'X 'd T)                              # Insert data\n-> NIL\n: (idx 'X 2 T)\n-> NIL\n: (idx 'X '(a b c) T)\n-> NIL\n: (idx 'X 17 T)\n-> NIL\n: (idx 'X 'A T)\n-> NIL\n: (idx 'X 'd T)\n-> (d (2 NIL 17 NIL A) (a b c))              # 'd' already existed\n: (idx 'X T T)\n-> NIL\n: X                                          # View the index tree\n-> (d (2 NIL 17 NIL A) (a b c) NIL T)\n: (idx 'X 'A)                                # Check for 'A'\n-> (A)\n: (idx 'X 'B)                                # Check for 'B'\n-> NIL\n: (idx 'X)\n-> (2 17 A d (a b c) T)                      # Get list\n: (idx 'X 17 NIL)                            # Delete '17'\n-> (17 NIL A)\n: X\n-> (d (2 NIL A) (a b c) NIL T)               # View it again\n: (idx 'X)\n-> (2 A d (a b c) T)                         # '17' is deleted\n\n: (off X Y)\n-> NIL\n: (for I 9 (idx 'X I T))                     # Sorted insert order\n-> NIL\n: (for I 9 (idx 'Y I 0))                     # Randomize\n-> NIL\n: (view X T)\n                        9\n                     8\n                  7\n               6\n            5\n         4\n      3\n   2\n1\n-> NIL\n: (view Y T)\n         9\n      8\n         7\n   6\n      5\n         4\n3\n   2\n      1\n-> NIL\n
\n\n
(if 'any1 any2 . prg) -> any
\n
Conditional execution: If the condition any1 evaluates to\nnon-NIL, any2 is evaluated and returned. Otherwise,\nprg is executed and the result returned. See also ifn, cond, when and if2.\n\n
\n: (if (> 4 3) (println 'OK) (println 'Bad))\nOK\n-> OK\n: (if (> 3 4) (println 'OK) (println 'Bad))\nBad\n-> Bad\n
\n\n
(if2 'any1 'any2 any3 any4 any5 . prg) -> any
\n
Four-way conditional execution for two conditions: If both conditions\nany1 and any2 evaluate to non-NIL,\nany3 is evaluated and returned. Otherwise, any4 or\nany5 is evaluated and returned if any1 or\nany2 evaluate to non-NIL, respectively. If none of the\nconditions evaluate to non-NIL, prg is executed and\nthe result returned. See also if and\ncond.\n\n
\n: (if2 T T 'both 'first 'second 'none)\n-> both\n: (if2 T NIL 'both 'first 'second 'none)\n-> first\n: (if2 NIL T 'both 'first 'second 'none)\n-> second\n: (if2 NIL NIL 'both 'first 'second 'none)\n-> none\n
\n\n
(if@@ 'any1 any2 . prg) -> any
\n
Conditional execution: If the value of the global variable @@ is non-NIL after the evaluation\nof any1, any2 is evaluated and returned. Otherwise,\nprg is executed and the result returned. In both cases, @ will hold the value of any1. See\nalso if and if2.\n\n
\n: (de foo (N)\n   (if (lt0 N)\n      (throw 'lt0 N)\n      (sqrt N) ) )\n-> foo\n\n: (if@@ (catch 'lt0 (foo 64))\n   (msg @ \" negative\")\n   @ )\n-> 8\n\n: (if@@ (catch 'lt0 (foo -64))\n   (msg @ \" negative\")\n   @ )\n-64 negative\n-> -64\n
\n\n
(ifn 'any1 any2 . prg) -> any
\n
Conditional execution (\"If not\"): If the condition any1\nevaluates to NIL, any2 is evaluated and returned.\nOtherwise, prg is executed and the result returned. See also\nif, nor, nand, unless and nond.\n\n
\n: (ifn (= 3 4) (println 'OK) (println 'Bad))\nOK\n-> OK\n
\n\n
(import . lst) -> lst
\n
Wrapper function for intern.\nTypically used to import symbols from other namespaces, as created by symbols. lst should be\na list of symbols. See also pico, private and local and export.\n\n
\n: (import libA~foo libB~bar)\n-> (foo bar)\n
\n\n
(in 'any . prg) -> any
\n
Opens any as input channel during the execution of\nprg. The current input channel will be saved and restored\nappropriately. If the argument is NIL, standard input is used. If\nthe argument is a symbol, it is used as a file name (opened in read-only mode).\nIf it is a positive number, it is used as the descriptor of an open file. If it\nis a negative number, the saved input channel such many levels above the current\none is used. Otherwise (if it is a list), it is taken as a command with\narguments, and a pipe is opened for input. The (system dependent) exit status\ncode of the child process is stored in the global variable @@. See also out, err, fd, ipid, call, load, file, poll, pipe and ctl.\n\n
\n: (in \"a\" (list (read) (read) (read)))  # Read three items from file \"a\"\n-> (123 (a b c) def)\n\n: (in '(file \"-b\" \"--mime\" \"bin/picolisp\")  # Get the mime type\n   (line T) )\n-> \"application/x-executable; charset=binary\"\n
\n\n
(inc 'num) -> num
\n
(inc 'var ['num]) -> num
\n
The first form returns the value of num incremented by 1. The\nsecond form increments the VAL of var by 1, or by\nnum. If the first argument is NIL, it is returned\nimmediately. (inc Num) is equivalent to (+ Num 1) and\n(inc 'Var) is equivalent to (set 'Var (+ Var 1)). See\nalso dec and +.\n\n
\n: (inc 7)\n-> 8\n: (inc -1)\n-> 0\n: (zero N)\n-> 0\n: (inc 'N)\n-> 1\n: (inc 'N 7)\n-> 8\n: N\n-> 8\n\n: (setq L (1 2 3 4))\n-> (1 2 3 4)\n: (inc (cdr L))\n-> 3\n: L\n-> (1 3 3 4)\n
\n\n
(inc! 'obj 'sym ['num]) -> num
\n
Transaction wrapper function for inc. num defaults to 1. Note that\nfor incrementing a property value of an entity typically the inc!> message is used. See also\nnew!, request!, set! and put!.\n\n
\n(inc! Obj 'cnt 0)  # Incrementing a property of a non-entity object\n
\n\n
(index 'any 'lst) -> cnt | NIL
\n
Returns the cnt position of any in\nlst, or NIL if it is not found. See also offset and sub?.\n\n
\n: (index 'c '(a b c d e f))\n-> 3\n: (index '(5 6) '((1 2) (3 4) (5 6) (7 8)))\n-> 3\n
\n\n
(info 'any ['flg]) -> (cnt|flg dat . tim)
\n
Returns information about a file with the name any: The current\nsize cnt in bytes, and the modification date and time (UTC, or\nlocal time if flg is zero). For directories, T is\nreturned instead of the size, and NIL for other non-regular files.\nThe file argument itself is stored in the global variable @@). If flg is non-NIL\nand any is the name of a symbolic link, then the link itself is\nused, not the file that it refers to. See also dir, date and time.\n\n
\n$ ls -l x.l\n-rw-r--r--   1 abu      users         208 Jun 17 08:58 x.l\n$ pil +\n: (info \"x.l\")\n-> (208 730594 . 32315)\n: (stamp 730594 32315)\n-> \"2000-06-17 08:58:35\"\n
\n\n
(init 'tree ['any1] ['any2]) -> lst
\n
Initializes a structure for stepping iteratively through a database tree.\nany1 and any2 may specify a range of keys. If\nany1 is greater than any2, the traversal will be in\nopposite direction. See also tree,\nstep, iter and scan.\n\n
\n: (init (tree 'nr '+Item) 3 5)\n-> (((3 . 5) ((3 NIL . {B3}) (4 NIL . {B4}) (5 NIL . {B5}) (6 NIL . {B6}))))\n
\n\n
(input exe . prg) -> any
\n
Establishes an input stream, by redirecting the current input channel during\nthe execution of prg. The current input channel will be saved and\nrestored appropriately. exe is executed (in the context of the\noriginal input channel) whenever a character is required by read calls in\nprg, and should return a single character upon each execution. See\nalso output, in and pipe.\n\n
\n: (input \"A\" (char))\n-> \"A\"\n: (let L (chop \"(+ 2 (* 3 4))\")\n   (input (++ L) (read)) )\n-> (+ 2 (* 3 4))\n: (let L (chop \"AQIDBAUGBw==\")\n   (input (++ L)\n      (while (ext:Base64)\n         (printsp @) ) ) )\n1 2 3 4 5 6 7 -> 7\n
\n\n
(insert 'cnt 'lst 'any) -> lst
\n
Inserts any into lst at position cnt.\nThis is a non-destructive operation. See also remove, place, append, delete and replace.\n\n
\n: (insert 3 '(a b c d e) 777)\n-> (a b 777 c d e)\n: (insert 1 '(a b c d e) 777)\n-> (777 a b c d e)\n: (insert 9 '(a b c d e) 777)\n-> (a b c d e 777)\n
\n\n
(intern 'any ['nsp]) -> sym
\n
Creates or finds an internal symbol. If a symbol with the name\nany is already intern, it is returned. Otherwise, any\nis interned in the current namespace\nand returned. If nsp is non-NIL,\nany is always interned in the current namespace (if\nnsp is T) or in the given namespace, even if\nit is found in other namespaces. See also symbols, zap, import and extern.\n\n
\n: (intern \"abc\")\n-> abc\n: (intern 'car)\n-> car\n: ((intern \"car\") (1 2 3))\n-> 1\n: ((intern '(\"c\" \"a\" \"r\")) (1 2 3))\n-> 1\n
\n\n
(ipid) -> pid | NIL
\n
Returns the corresponding process ID when the current input channel is\nreading from a pipe, otherwise NIL. See also opid, in, pipe and load.\n\n
\n: (in '(ls \"-l\") (println (line T)) (kill (ipid)))\n\"total 7364\"\n-> T\n
\n\n
(isa 'cls|typ 'obj) -> obj | NIL
\n
Returns obj when it is an object that inherits from\ncls or type. See also OO\nConcepts, class, type, new and object.\n\n
\n: (isa '+Address Obj)\n-> {A17}\n: (isa '(+Male +Person) Obj)\n-> NIL\n
\n\n
isa/2
\n
(Deprecated since version 25.5.30) Pilog predicate that succeeds if the second\nargument is of the type or class given by the first argument, according\nto the isa function. Typically\nused in db/3 or select/3 database queries. See also\nsame/3, bool/3, range/3, head/3, fold/3, part/3 and tolr/3.\n\n
\n: (? (db nm +Person @Prs) (isa +Woman @Prs) (val @Nm @Prs nm))\n @Prs={A44} @Nm=\"Alexandra of Denmark\"\n @Prs={A124} @Nm=\"Alice Maud Mary\"\n @Prs={A21} @Nm=\"Anne\"\n @Prs={A57} @Nm=\"Augusta Victoria\".  # Stop\n
\n\n
(iter 'tree ['fun] ['any1] ['any2] ['flg]) -> NIL
\n
Iterates through a database tree by applying fun to all values.\nfun defaults to println. any1 and\nany2 may specify a range of keys. If any1 is greater\nthan any2, the traversal will be in opposite direction. Note that\nthe keys need not to be atomic, depending on the application's index structure.\nIf flg is non-NIL, partial keys are skipped. See also\ntree, ubIter, scan, init and step.\n\n
\n: (iter (tree 'nr '+Item))\n{B1}\n{B2}\n{B3}\n{B4}\n{B5}\n{B6}\n-> NIL\n: (iter (tree 'nr '+Item) '((This) (println (: nm))))\n\"Main Part\"\n\"Spare Part\"\n\"Auxiliary Construction\"\n\"Enhancement Additive\"\n\"Metal Fittings\"\n\"Gadget Appliance\"\n\"Testartikel\"\n-> NIL\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refJ.html",
    "content": "\n\n\n\n\n\nJ\n\n\n\n\n
J
\n\n
\n\n
+Joint
\n
Class for bidirectional object relations, a subclass of +Link. Expects a (symbolic) attribute, a list\nof classes as type of the referred\ndatabase object (of class +Entity),\nand two optional functions called when 'put'ting and/or 'get'ting a value. A\n+Joint corresponds to two +Links, where the attribute\nargument is the relation of the back-link in the referred object. See also Database.\n\n
\n(class +Ord +Entity)                   # Order class\n(rel pos (+List +Joint) ord (+Pos))    # List of positions in that order\n...\n(class +Pos +Entity)                   # Position class\n(rel ord (+Joint) pos (+Ord))          # Back-link to the parent order\n
\n\n
(job 'lst . prg) -> any
\n
Executes a job within its own environment (as specified by symbol-value\npairs in lst). The current values of all symbols are saved, the\nsymbols are bound to the values in lst, prg is\nexecuted, then the (possibly modified) symbol values are (destructively) stored\nin the environment list, and the symbols are restored to their original values.\nThe return value is the result of prg. Typically used in curried functions and *Run tasks. See also env, bind, let, use and state.\n\n
\n: (de tst ()\n   (job '((A . 0) (B . 0))\n      (println (inc 'A) (inc 'B 2)) ) )\n-> tst\n: (tst)\n1 2\n-> 2\n: (tst)\n2 4\n-> 4\n: (tst)\n3 6\n-> 6\n: (pp 'tst)\n(de tst NIL\n   (job '((A . 3) (B . 6))\n      (println (inc 'A) (inc 'B 2)) ) )\n-> tst\n
\n\n
(journal ['T] 'any ..) -> T
\n
Reads journal data from the files with the names any, and\nwrites all changes to the database. If the first argument is T, the\nreplication journal and transaction logs are disabled. See also pool.\n\n
\n: (journal \"db.log\")\n-> T\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refK.html",
    "content": "\n\n\n\n\n\nK\n\n\n\n\n
K
\n\n
\n\n
+Key
\n
Prefix class for maintaining unique indexes to +relations, a subclass of +index. Accepts an optional argument for a\n+Hook attribute. See also Database.\n\n
\n(rel nr (+Need +Key +Number))  # Mandatory, unique Customer/Supplier number\n
\n\n
(key ['cnt ['var]]) -> sym
\n
Returns the next character from standard input as a single-character\ntransient symbol. The console is set to raw mode. While waiting for a key press,\na poll(2) system call is executed for all file descriptors and\ntimers in the VAL of the global variable *Run. If cnt is\nnon-NIL, that amount of milliseconds is waited maximally, and\nNIL is returned upon timeout. Otherwise, the remaining milliseconds\nare optionally stored in var. See also raw and wait.\n\n
\n: (key)           # Wait for a key\n-> \"a\"            # 'a' pressed\n
\n\n
(kids) -> lst
\n
Returns a list of process IDs of all running child processes. See also\nfork, detach, pipe, tell, proc and kill.\n\n
\n: (unless (fork) (wait 60000) (bye))\n-> NIL\n: (unless (fork) (wait 60000) (bye))\n-> NIL\n\n: (proc 'pil)\n  PID  PPID  STARTED  SIZE %CPU WCHAN  CMD\n 2205 22853 19:45:24  1336  0.1 -      /usr/bin/picolisp /usr/lib/picolisp/lib.l /usr/bin/pil +\n 2266  2205 19:45:30  1336  0.0 -        /usr/bin/picolisp /usr/lib/picolisp/lib.l /usr/bin/pil +\n 2300  2205 19:45:33  1336  0.0 -        /usr/bin/picolisp /usr/lib/picolisp/lib.l /usr/bin/pil +\n-> T\n\n: (kids)\n-> (2300 2266)\n
\n\n
(kill 'pid ['cnt]) -> flg
\n
Sends a signal with the signal number cnt (or SIGTERM if\ncnt is not given) to the process with the ID pid.\nReturns T if successful.\n\n
\n: (kill *Pid 20)                                # Stop current process\n\n[2]+  Stopped               pil +               # Unix shell\n$ fg                                            # Job control: Foreground\npil +\n-> T                                            # 'kill' was successful\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refL.html",
    "content": "\n\n\n\n\n\nL\n\n\n\n\n
L
\n\n
\n\n
+Link
\n
Class for object relations, a subclass of +relation. Expects a list of classes as\ntype of the referred database object\n(of class +Entity). See also Database.\n\n
\n(rel sup (+Ref +Link) NIL (+CuSu))  # Supplier (class Customer/Supplier)\n
\n\n
+List
\n
Prefix class for a list of identical relations. Objects of that class\nmaintain a list of Lisp data of uniform type. See also Database.\n\n
\n(rel pos (+List +Joint) ord (+Pos))  # Positions\n(rel nm (+List +Ref +String))        # List of indexed strings\n(rel val (+Ref +List +Number))       # Indexed list of numeric values\n
\n\n
(last 'lst) -> any
\n
Returns the last element of lst. See also fin and tail.\n\n
\n: (last (1 2 3 4))\n-> 4\n: (last '((a b) c (d e f)))\n-> (d e f)\n
\n\n
(later 'var . prg) -> var
\n
Executes prg in a pipe'ed child process. The return value of\nprg will later be available in var. Note that\nlater uses pr and rd to communicate the result, so prg\nshould not write any data to standard output as a side effect.\n\n
\n: (prog1  # Parallel background calculation of square numbers\n   (mapcan '((N) (later (cons) (* N N))) (1 2 3 4))\n   (wait NIL (full @)) )\n-> (1 4 9 16)\n
\n\n
(le0 'any) -> num | NIL
\n
Returns num when the argument is a number less or equal zero,\notherwise NIL. See also lt0, ge0, gt0, =0\nand n0.\n\n
\n: (le0 -2)\n-> -2\n: (le0 0)\n-> 0\n: (le0 3)\n-> NIL\n
\n\n
(leaf 'tree) -> any
\n
Returns the first leaf (i.e. the value of the smallest key) in a database\ntree. See also tree, minKey, maxKey and step.\n\n
\n: (leaf (tree 'nr '+Item))\n-> {B1}\n: (db 'nr '+Item (minKey (tree 'nr '+Item)))\n-> {B1}\n
\n\n
(length 'any) -> cnt | T
\n
Returns the \"length\" of any. For numbers this is the number of\ndecimal digits in the value (plus 1 for negative values), for symbols it is the\nnumber of characters in the name, and for lists it is the number of cells (or\nT for circular lists). See also size and bytes.\n\n
\n: (length \"abc\")\n-> 3\n: (length \"äbc\")\n-> 3\n: (length 123)\n-> 3\n: (length (1 (2) 3))\n-> 3\n: (length (1 2 3 .))\n-> T\n
\n\n
(less 'any ['cnt]) -> any
\n
Returns a reduced form of any, where for each list and its\nsublists only the first cnt elements (default 4), possibly followed\nby .., are retained.\n\n
\n: (less '(a b c d e f))\n-> (a b c d ..)\n: (less '((a b c) ((d e f g h i) (j k l m n))))\n-> ((a b c) ((d e f ..) (j k ..)))\n: (less '((a b c) ((d e f g h i) (j k l m n))) 2)\n-> ((a b ..) ((d ..) ..))\n
\n\n
(let sym 'any . prg) -> any
\n
(let (sym|lst 'any ..) . prg) -> any
\n
Defines local variables. The value of the symbol sym - or the\nvalues of the symbols sym in the list of the second form - are\nsaved and the symbols are bound to the evaluated any arguments. The\nlst arguments in the second form may consist only of symbols and\nsublists, and match the any argument (destructuring bind).\nprg is executed, then the symbols are restored to their original\nvalues. The result of prg is returned. It is an error condition to\npass NIL as a sym argument. In destructuring patterns,\nNIL denotes a \"don't care\" position. See also let?, bind, recur, with, for, job and use.\n\n
\n: (setq  X 123  Y 456)\n-> 456\n: (let X \"Hello\" (println X))\n\"Hello\"\n-> \"Hello\"\n: (let (X \"Hello\" Y \"world\") (prinl X \" \" Y))\nHello world\n-> \"world\"\n: X\n-> 123\n: Y\n-> 456\n\n: (let (A 1  (B . C) (2 3)  D 4)\n   (list A B C D) )\n-> (1 2 (3) 4)\n\n: (let (((A . B) (C) . D) '((1 2 3) (4 5 6) 7 8 9))\n   (list A B C D) )\n-> (1 (2 3) 4 (7 8 9))\n\n: (let (((A . NIL) NIL NIL D) '((1 2 3) (4 5 6) 7 8 9))\n   (trail T) )\n-> (A 1 D 8)\n
\n\n
(let? sym 'any . prg) -> any
\n
Conditional local variable binding and execution: If any\nevaluates to NIL, NIL is returned. Otherwise, the\nvalue of the symbol sym is saved and sym is bound to\nthe evaluated any argument. prg is executed, then\nsym is restored to its original value. The result of\nprg is returned. It is an error condition to pass NIL\nas the sym argument. (let? sym 'any ..) is equivalent\nto (when 'any (let sym @ ..)). See also let, bind, job and use.\n\n
\n: (setq Lst (1 NIL 2 NIL 3))\n-> (1 NIL 2 NIL 3)\n: (let? A (pop 'Lst) (println 'A A))\nA 1\n-> 1\n: (let? A (pop 'Lst) (println 'A A))\n-> NIL\n
\n\n
(lieu 'any) -> sym | NIL
\n
Returns the argument any when it is an external symbol and\ncurrently manifest in heap space, otherwise NIL. See also ext?.\n\n
\n: (lieu *DB)\n-> {1}\n
\n\n
(line 'flg ['cnt ..]) -> lst|sym
\n
Reads a line of characters from the current input channel. End of line is\nrecognized as linefeed (hex \"0A\"), carriage return (hex \"0D\"), or the\ncombination of both. (Note that a single carriage return may not work on network\nconnections, because the character look-ahead to distinguish from\nreturn+linefeed can block the connection.) If flg is\nNIL, a list of single-character transient symbols is returned. When\ncnt arguments are given, subsequent characters of the input line\nare grouped into sublists, to allow parsing of fixed field length records. If\nflg is non-NIL, strings are returned instead of\nsingle-character lists. NIL is returned upon end of file. See also\nchar, read, till and eof.\n\n
\n: (line)\nabcdefghijkl\n-> (\"a\" \"b\" \"c\" \"d\" \"e\" \"f\" \"g\" \"h\" \"i\" \"j\" \"k\" \"l\")\n: (line T)\nabcdefghijkl\n-> \"abcdefghijkl\"\n: (line NIL 1 2 3)\nabcdefghijkl\n-> ((\"a\") (\"b\" \"c\") (\"d\" \"e\" \"f\") \"g\" \"h\" \"i\" \"j\" \"k\" \"l\")\n: (line T 1 2 3)\nabcdefghijkl\n-> (\"a\" \"bc\" \"def\" \"g\" \"h\" \"i\" \"j\" \"k\" \"l\")\n
\n\n
(link 'any ..) -> any
\n
Links one or several new elements any to the end of the list in\nthe current make environment. This\noperation is efficient also for long lists, because a pointer to the last\nelement of the list is maintained. link returns the last linked\nargument. See also yoke, chain and made.\n\n
\n: (make\n   (println (link 1))\n   (println (link 2 3)) )\n1\n3\n-> (1 2 3)\n
\n\n
(lint 'sym) -> lst
\n
(lint 'sym 'cls) -> lst
\n
(lint '(sym . cls)) -> lst
\n
(Debug mode only) Checks the function definition or file contents (in the\nfirst form), or the method body of sym (second and third form), for possible\npitfalls. Returns an association list of diagnoses, where var\nindicates improper variables, dup duplicate parameters,\ndef an undefined function, bnd an unbound variable,\nand use unused variables. See also noLint, lintAll, debug, trace and *Dbg.\n\n
\n: (de foo (R S T R)     # 'T' is an improper parameter, 'R' is duplicated\n   (let N 7             # 'N' is unused\n      (bar X Y) ) )     # 'bar' is undefined, 'X' and 'Y' are not bound\n-> foo\n: (lint 'foo)\n-> ((var T) (dup R) (def bar) (bnd Y X) (use N))\n
\n\n
(lintAll ['sym ..]) -> lst
\n
(Debug mode only) Applies lint to\nall internal symbols - and optionally\nto all files sym - and returns a list of diagnoses. See also\nnoLint.\n\n
\n: (more (lintAll \"file1.l\" \"file2.l\"))\n...\n
\n\n
(lisp 'sym ['fun]) -> num
\n
Installs under the tag sym a callback function\nfun, and returns a pointer num suitable to be passed\nto a C function via 'native'. If fun is NIL, the\ncorresponding entry is freed. Maximally 24 callback functions can be installed\nthat way. 'fun' should be a function of maximally five numbers, and should\nreturn a number. \"Numbers\" in this context are 64-bit scalars, and may not only\nrepresent integers, but also pointers or other encoded data. See also native and struct.\n\n
\n(load \"@lib/clang.l\")\n\n(clang \"ltest\" NIL\n   (cbTest (Fun) cbTest 'N Fun) )\n\nlong cbTest(int(*fun)(int,int,int,int,int)) {\n   return fun(1,2,3,4,5);\n}\n/**/\n\n: (cbTest\n   (lisp 'cbTest\n      '((A B C D E)\n         (msg (list A B C D E))\n         (* A B C D E) ) ) )\n(1 2 3 4 5)\n-> 120\n
\n\n
(list 'any ['any ..]) -> lst
\n
Returns a list of all any arguments. See also cons.\n\n
\n: (list 1 2 3 4)\n-> (1 2 3 4)\n: (list 'a (2 3) \"OK\")\n-> (a (2 3) \"OK\")\n
\n\n
lst/3
\n
Pilog predicate that returns subsequent list\nelements, after applying the get\nalgorithm to that object and the following arguments. Often used in database\nqueries. See also map/3.\n\n
\n: (? (db nr +Ord 1 @Ord) (lst @Pos @Ord pos))\n @Ord={B7} @Pos={A1}\n @Ord={B7} @Pos={A2}\n @Ord={B7} @Pos={A3}\n-> NIL\n
\n\n
(lst? 'any) -> flg
\n
Returns T when the argument any is a (possibly\nempty) list (NIL or a cons pair). See also pair.\n\n
\n: (lst? NIL)\n-> T\n: (lst? (1 . 2))\n-> T\n: (lst? (1 2 3))\n-> T\n
\n\n
(listen 'cnt1 ['cnt2]) -> cnt | NIL
\n
Listens at a socket descriptor cnt1 (as received by port) for an incoming connection, and returns\nthe new socket descriptor cnt. While waiting for a connection, a\npoll(2) system call is executed for all file descriptors and timers\nin the VAL of the global variable *Run. If cnt2 is\nnon-NIL, that amount of milliseconds is waited maximally, and\nNIL is returned upon timeout. The global variable *Adr\nis set to the IP address of the client. See also accept, connect, *Adr.\n\n
\n: (setq *Socket\n   (listen (port 6789) 60000) )  # Listen at port 6789 for max 60 seconds\n-> 4\n: *Adr\n-> \"127.0.0.1\"\n
\n\n
(lit 'any) -> any
\n
Returns the literal (i.e. quoted) value of any, by\nconsing it with the quote function if necessary. See also strip.\n\n
\n: (lit T)\n-> T\n: (lit 1)\n-> 1\n: (lit '(1))\n-> (1)\n: (lit '(a))\n-> '(a)\n
\n\n
(load 'any ..) -> any
\n
Loads all any arguments. Normally, the name of each argument is\ntaken as a file to be executed in a read-eval loop. The argument semantics are\nidentical to that of in, with the\nexception that if an argument is a symbol and its first character is a hyphen\n'-', then that argument is parsed as an executable list (without the surrounding\nparentheses). When any is T, all remaining command\nline arguments are loaded recursively. When any is\nNIL, standard input is read, a prompt is issued before each read\noperation, the results are printed to standard output (read-eval-print loop),\nand load terminates when an empty line is entered. In any case,\nload terminates upon end of file, or when NIL is read.\nThe index for transient symbols is cleared before and after the load, so that\nall transient symbols in a file have a local scope. If the namespace was\nswitched (with symbols) while\nexecuting a file, it is restored to the previous one. Returns the value of the\nlast evaluated expression. See also script, ipid, call, file, in, out\nand str.\n\n
\n: (load \"lib.l\" \"-* 1 2 3\")\n-> 6\n
\n\n
(loc 'sym 'lst) -> sym
\n
Locates in lst a transient symbol with the same name as\nsym. Allows to get hold of otherwise inaccessible symbols.\n\n
\n: (loc \"X\" curry)\n-> \"X\"\n: (== @ \"X\")\n-> NIL\n
\n\n
(local) sym|lst
\n
Intern symbols locally in the current namespace. (local) expects a\nsingle symbol or a list of symbols immediately following in the current\ninput stream. See also pico,\nsymbols, private, export, import and intern.\n\n
\n: (symbols 'myLib 'pico)\n-> (pico)\nmyLib: (local) (foo bar)\n\nmyLib: (de foo (A)  # 'foo' is local to 'myLib'\n   ...\nmyLib: (de bar (B)  # 'bar' is local to 'myLib'\n   ...\n
\n\n
(locale 'sym1 'sym2 ['sym ..])
\n
Sets the current locale to that given by the country file sym1\nand the language file sym2 (both located in the \"loc/\" directory),\nand optional application-specific directories sym. The locale\ninfluences the language, and numerical, date and other formats. See also\n*Uni, datStr, strDat, expDat, day, telStr, expTel and and money.\n\n
\n: (locale \"DE\" \"de\" \"app/loc/\")\n-> NIL\n: ,\"Yes\"\n-> \"Ja\"\n
\n\n
(lock ['sym]) -> cnt | NIL
\n
Write-locks an external symbol sym (file record locking), or\nthe whole database root file if sym is NIL. Returns\nNIL if successful, or the ID of the process currently holding the\nlock. When sym is non-NIL, the lock is released at the\nnext call to commit or rollback, otherwise only when another\ndatabase is opened with pool, or when\nthe process terminates. See also *Solo.\n\n
\n: (lock '{1})        # Lock single object\n-> NIL\n: (lock)             # Lock whole database\n-> NIL\n
\n\n
(loop ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
\n
Endless loop with multiple conditional exits: The body is executed an\nunlimited number of times. If a clause has NIL or T as\nits CAR, the clause's second element is evaluated as a condition and - if the\nresult is NIL or non-NIL, respectively - the\nprg is executed and the result returned. See also do and for.\n\n
\n: (let N 3\n   (loop\n      (prinl N)\n      (T (=0 (dec 'N)) 'done) ) )\n3\n2\n1\n-> done\n
\n\n
(low? 'any) -> sym | NIL
\n
Returns any when the argument is a string (symbol) that starts\nwith a lowercase character. See also lowc and upp?\n\n
\n: (low? \"a\")\n-> \"a\"\n: (low? \"A\")\n-> NIL\n: (low? 123)\n-> NIL\n: (low? \".\")\n-> NIL\n
\n\n
(lowc 'any) -> any
\n
Lower case conversion: If any is not a symbol, it is returned\nas it is. Otherwise, a new transient symbol with all characters of\nany, converted to lower case, is returned. See also uppc, fold and low?.\n\n
\n: (lowc 123)\n-> 123\n: (lowc \"ABC\")\n-> \"abc\"\n
\n\n
(lt0 'any) -> num | NIL
\n
Returns num when the argument is a number and less than zero,\notherwise NIL. See also le0, ge0, gt0, =0\nand n0.\n\n
\n: (lt0 -2)\n-> -2\n: (lt0 3)\n-> NIL\n
\n\n
(lup 'lst 'any) -> lst
\n
(lup 'lst 'any 'any2) -> lst
\n
Looks up any in the CAR-elements of cons pairs stored in the\nindex tree lst, as built-up by idx. In the first form, the first found cons\npair is returned, in the second form a list of all pairs whose CAR is in the\nrange any .. any2. If the tree is empty,\nNIL is returned immediately. See also enum? and assoc.\n\n
\n: (idx 'A 'a T)\n-> NIL\n: (idx 'A (1 . b) T)\n-> NIL\n: (idx 'A 123 T)\n-> NIL\n: (idx 'A (1 . a) T)\n-> NIL\n: (idx 'A (1 . c) T)\n-> NIL\n: (idx 'A (2 . d) T)\n-> NIL\n: (idx 'A)\n-> (123 a (1 . a) (1 . b) (1 . c) (2 . d))\n: (lup A 1)\n-> (1 . b)\n: (lup A 2)\n-> (2 . d)\n: (lup A 1 1)\n-> ((1 . a) (1 . b) (1 . c))\n: (lup A 1 2)\n-> ((1 . a) (1 . b) (1 . c) (2 . d))\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refM.html",
    "content": "\n\n\n\n\n\nM\n\n\n\n\n
M
\n\n
\n\n
*Msg
\n
A global variable holding the last recently issued error message. See also\nError Handling, *Err and ^.\n\n
\n: (+ 'A 2)\n!? (+ 'A 2)\nA -- Number expected\n?\n:\n: *Msg\n-> \"Number expected\"\n
\n\n
+Mis
\n
Prefix class to explicitly specify validation functions for +relations. Expects a function that takes\na value and an entity object, and returns NIL if everything is\ncorrect, or an error string. See also Database.\n\n
\n(class +Ord +Entity)            # Order class\n(rel pos (+Mis +List +Joint)    # List of positions in that order\n   ((Val Obj)\n      (when (memq NIL Val)\n         \"There are empty positions\" ) )\n   ord (+Pos) )\n
\n\n
(macro prg) -> any
\n
Substitues all pat? symbols in\nprg (using fill), and\nexecutes the result with run. Used\noccasionally to call functions which otherwise do not evaluate their arguments.\n\n
\n: (de timerMessage (@N . @Prg)\n   (setq @N (- @N))\n   (macro\n      (task @N 0 . @Prg) ) )\n-> timerMessage\n: (timerMessage 6000 (println 'Timer 6000))\n-> (-6000 0 (println 'Timer 6000))\n: (timerMessage 12000 (println 'Timer 12000))\n-> (-12000 0 (println 'Timer 12000))\n: (more *Run)\n(-12000 2616 (println 'Timer 12000))\n(-6000 2100 (println 'Timer 6000))\n-> NIL\n: Timer 6000\nTimer 12000\n...\n
\n\n
(made ['lst1 ['lst2]]) -> lst
\n
Initializes a new list value for the current make environment. All list elements already\nproduced with chain, link and yoke are discarded, and lst1 is\nused instead. Optionally, lst2 can be specified as the new linkage\ncell, otherwise the last cell of lst1 is used. When called without\narguments, made does not modify the environment. In any case, the\ncurrent list is returned.\n\n
\n: (make\n   (link 'a 'b 'c)         # Link three items\n   (println (made))        # Print current list (a b c)\n   (made (1 2 3))          # Discard it, start new with (1 2 3)\n   (link 4) )              # Link 4\n(a b c)\n-> (1 2 3 4)\n
\n\n
(mail 'any 'cnt|lst 'sym1|lst2 'sym2|lst3 'sym3 'lst4 . prg)'
\n
Sends an eMail via SMTP to a mail server at host any, port\ncnt. If the second argument is a list, it should be a structure\n(user password . port), and \"@bin/ssl\" will be called to establish\nan encrypted connection. sym1|lst2 should be the \"from\" address (or\na cons pair of \"reply-to\" and \"from\"), sym2|lst3 the \"to\"\naddress(es), and sym3 the subject. lst4 is a list of\nattachments, each one specified by three elements for path, name and mime type.\nprg generates the mail body with prEval. See also connect.\n\n
\n(mail \"localhost\" 25                               # Local mail server\n   \"a@bc.de\"                                       # \"From\" address\n   \"abu@software-lab.de\"                           # \"To\" address\n   \"Testmail\"                                      # Subject\n   (quote\n      \"img/go.png\" \"go.png\" \"image/png\"            # First attachment\n      \"img/7fach.gif\" \"7fach.gif\" \"image/gif\" )    # Second attachment\n   \"Hello,\"                                        # First line\n   NIL                                             # (empty line)\n   (prinl (pack \"This is mail #\" (+ 3 4))) )       # Third line\n
\n\n
(make .. [(made 'lst ..)] .. [(link 'any ..)] ..) -> any
\n
Initializes and executes a list-building process with the made, chain, link and yoke functions, and returns the resulting list.\nThe final linkage cell is stored in the global variable @@. For efficiency, pointers to the head and the\ntail of the list are maintained internally.\n\n
\n: (make (link 1) (link 2 3) (link 4))\n-> (1 2 3 4)\n: (make (made (1 2 3)) (link 4))\n-> (1 2 3 4)\n
\n\n
(map 'fun 'lst ..) -> lst
\n
Applies fun to lst and all successive CDRs. When\nadditional lst arguments are given, they are passed to\nfun in the same way. Returns the result of the last application.\nSee also mapc, maplist, mapcar, mapcon, mapcan and filter.\n\n
\n: (map println (1 2 3 4) '(A B C))\n(1 2 3 4) (A B C)\n(2 3 4) (B C)\n(3 4) (C)\n(4) NIL\n-> NIL\n
\n\n
map/3
\n
Pilog predicate that returns a list and\nsubsequent CDRs of that list, after applying the get algorithm to that object and the following\narguments. Often used in database queries. See also lst/3.\n\n
\n: (? (db nr +Ord 1 @Ord) (map @L @Ord pos))\n @Ord={B7} @L=({A1} {A2} {A3})\n @Ord={B7} @L=({A2} {A3})\n @Ord={B7} @L=({A3})\n-> NIL\n
\n\n
(mapc 'fun 'lst ..) -> any
\n
Applies fun to each element of lst. When\nadditional lst arguments are given, their elements are also passed\nto fun. Returns the result of the last application. See also\nmap, maplist, mapcar, mapcon, mapcan and filter.\n\n
\n: (mapc println (1 2 3 4) '(A B C))\n1 A\n2 B\n3 C\n4 NIL\n-> NIL\n
\n\n
(mapcan 'fun 'lst ..) -> lst
\n
Applies fun to each element of lst. When\nadditional lst arguments are given, their elements are also passed\nto fun. Returns a (destructively) concatenated list of all results.\nSee also map, mapc, maplist, mapcar, mapcon, filter.\n\n
\n: (mapcan reverse '((a b c) (d e f) (g h i)))\n-> (c b a f e d i h g)\n
\n\n
(mapcar 'fun 'lst ..) -> lst
\n
Applies fun to each element of lst. When\nadditional lst arguments are given, their elements are also passed\nto fun. Returns a list of all results. See also map, mapc, maplist, mapcon, mapcan and filter.\n\n
\n: (mapcar + (1 2 3) (4 5 6))\n-> (5 7 9)\n: (mapcar + (1 2 3) 5)\n-> (6 7 8)\n: (mapcar '((X Y) (+ X (* Y Y))) (1 2 3 4) (5 6 7 8))\n-> (26 38 52 68)\n
\n\n
(mapcon 'fun 'lst ..) -> lst
\n
Applies fun to lst and all successive CDRs. When\nadditional lst arguments are given, they are passed to\nfun in the same way. Returns a (destructively) concatenated list of\nall results. See also map, mapc, maplist, mapcar, mapcan and filter.\n\n
\n: (mapcon copy '(1 2 3 4 5))\n-> (1 2 3 4 5 2 3 4 5 3 4 5 4 5 5)\n
\n\n
(maplist 'fun 'lst ..) -> lst
\n
Applies fun to lst and all successive CDRs. When\nadditional lst arguments are given, they are passed to\nfun in the same way. Returns a list of all results. See also\nmap, mapc, mapcar, mapcon, mapcan and filter.\n\n
\n: (maplist cons (1 2 3) '(A B C))\n-> (((1 2 3) A B C) ((2 3) B C) ((3) C))\n
\n\n
(maps 'fun 'sym ['lst ..]) -> any
\n
Applies fun to all properties of sym. When\nadditional lst arguments are given, their elements are also passed\nto fun. Returns the result of the last application. Note that\n'maps' should only be used when the property list is not modified by\nfun. Otherwise it is better to use a loop over the result of\ngetl. See also putl.\n\n
\n: (put 'X 'a 1)\n-> 1\n: (put 'X 'b 2)\n-> 2\n: (put 'X 'flg T)\n-> T\n: (getl 'X)\n-> (flg (2 . b) (1 . a))\n: (maps println 'X '(A B))\nflg A\n(2 . b) B\n(1 . a) NIL\n-> NIL\n
\n\n
(mark 'sym|0 ['NIL | 'T | '0]) -> flg
\n
Tests, sets or resets a mark for sym in the database (for a\nsecond argument of NIL, T or 0,\nrespectively), and returns the old value. The marks are local to the current\nprocess (not stored in the database), and vanish when the process terminates. If\nthe first argument is zero, all marks are cleared.\n\n
\n: (pool \"db\")\n-> T\n: (mark '{1} T)      # Mark\n-> NIL\n: (mark '{1})        # Test\n-> T                 # -> marked\n: (mark '{1} 0)      # Unmark\n-> T\n: (mark '{1})        # Test\n-> NIL               # -> unmarked\n
\n\n
(match 'lst1 'lst2) -> flg
\n
Takes lst1 as a pattern to be matched against\nlst2, and returns T when successful. Atoms must be\nequal, and sublists must match recursively. Symbols in the pattern list with\nnames starting with an at-mark \"@\" (see pat?) are taken as wildcards. They can match\nzero, one or more elements, and are bound to the corresponding data. See also\nchop, split and fill.\n\n
\n: (match '(@A is @B) '(This is a test))\n-> T\n: @A\n-> (This)\n: @B\n-> (a test)\n: (match '(@X (d @Y) @Z) '((a b c) (d (e f) g) h i))\n-> T\n: @X\n-> ((a b c))\n: @Y\n-> ((e f) g)\n: @Z\n-> (h i)\n
\n\n
(max 'any1 'any2 ..) -> any
\n
(max 'lst) -> any
\n
Returns the largest of all any arguments, or of all elements in\nlst. See also min and Comparing.\n\n
\n: (max 2 'a 'z 9)\n-> z\n: (max (5) (2 3) 'X)\n-> (5)\n: (max (2 4 1 3))\n-> 4\n
\n\n
(maxKey 'tree ['any1 ['any2]]) -> any
\n
Returns the largest key in a database tree. If a minimal key\nany1 and/or a maximal key any2 is given, the largest\nkey from that range is returned. See also tree, leaf, minKey and genKey.\n\n
\n: (maxKey (tree 'nr '+Item))\n-> 7\n: (maxKey (tree 'nr '+Item) 3 5)\n-> 5\n
\n\n
(maxi 'fun 'lst ..) -> any
\n
Applies fun to each element of lst. When\nadditional lst arguments are given, their elements are also passed\nto fun. Returns that element from lst for which\nfun returned a maximal value (and stores the maximal value in the\nglobal variable @@). See also mini and sort.\n\n
\n: (setq A 1  B 2  C 3)\n-> 3\n: (maxi val '(A B C))\n-> C\n: (maxi                          # Symbol with largest list value\n   '((X)\n      (and (pair (val X)) (size @)) )\n   (all) )\n-> pico\n
\n\n
(member 'any 'lst) -> any
\n
Returns the tail of lst that starts with any when\nany is a member of lst, otherwise NIL.\nSee also memq, assoc and idx.\n\n
\n: (member 3 (1 2 3 4 5 6))\n-> (3 4 5 6)\n: (member 9 (1 2 3 4 5 6))\n-> NIL\n: (member '(d e f) '((a b c) (d e f) (g h i)))\n-> ((d e f) (g h i))\n
\n\n
member/2
\n
Pilog predicate that succeeds if the the first\nargument is a member of the list in the second argument. See also equal/2 and member.\n\n
\n:  (? (member @X (a b c)))\n @X=a\n @X=b\n @X=c\n-> NIL\n
\n\n
(memq 'any 'lst) -> any
\n
Returns the tail of lst that starts with any when\nany is a member of lst, otherwise NIL.\n== is used for comparison (pointer\nequality). See also member, mmeq, asoq, push1q, delq and Comparing.\n\n
\n: (memq 'c '(a b c d e f))\n-> (c d e f)\n: (memq (2) '((1) (2) (3)))\n-> NIL\n
\n\n
(meta 'obj|typ 'sym ['sym2|cnt ..]) -> any
\n
Fetches a property value any, by searching the property lists\nof the classes and superclasses of obj, or the classes in\ntyp, for the property key sym, and by applying the\nget algorithm to the following optional\narguments. See also var:.\n\n
\n: (setq A '(B))            # Be 'A' an object of class 'B'\n-> (B)\n: (put 'B 'a 123)\n-> 123\n: (meta 'A 'a)             # Fetch 'a' from 'B'\n-> 123\n
\n\n
(meth 'obj ['any ..]) -> any
\n
This function is usually not called directly, but is used by  dm as a template to initialize the\nVAL of message symbols. It searches for itself in the methods of\nobj and its classes and superclasses, and executes that method. An\nerror \"Bad message\" is issued if the search is unsuccessful. See\nalso OO Concepts, method, send and try.\n\n
\n: meth\n-> 67283504    # Value of 'meth'\n: rel>\n-> 67283504    # Value of any message\n
\n\n
(method 'msg 'obj) -> fun
\n
Returns the function body of the method that would be executed upon sending\nthe message msg to the object obj. If the message\ncannot be located in obj, its classes and superclasses,\nNIL is returned. See also OO Concepts,\nsend, try, meth, super, extra, class.\n\n
\n: (method 'mis> '+Number)\n-> ((Val Obj) (and Val (not (num? Val)) \"Numeric input expected\"))\n
\n\n
(methods 'sym) -> lst
\n
(Debug mode only) Returns a list of method specifications for the object or\nclass sym, as they are inherited from sym's classes\nand superclasses. See also OO Concepts, dep, class and can.\n\n
\n: (more (methods '+Joint))\n(keep> . +Joint)\n(lose> . +Joint)\n(rel> . +Joint)\n(mis> . +Joint)\n(T . +Joint)\n(print> . +relation)\n(zap> . +relation)\n(del> . +relation)\n(put> . +relation)\n(has> . +relation)\n(ele> . +relation)\n
\n\n
(min 'any1 'any2 ..) -> any
\n
(min 'lst) -> any
\n
Returns the smallest of all any arguments, or of all elements\nin lst. See also max and Comparing.\n\n
\n: (min 2 'a 'z 9)\n-> 2\n: (min (5) (2 3) 'X)\n-> X\n: (min (2 4 1 3))\n-> 1\n
\n\n
(minKey 'tree ['any1 ['any2]]) -> any
\n
Returns the smallest key in a database tree. If a minimal key\nany1 and/or a maximal key any2 is given, the smallest\nkey from that range is returned. See also tree, leaf, maxKey and genKey.\n\n
\n: (minKey (tree 'nr '+Item))\n-> 1\n: (minKey (tree 'nr '+Item) 3 5)\n-> 3\n
\n\n
(mini 'fun 'lst ..) -> any
\n
Applies fun to each element of lst. When\nadditional lst arguments are given, their elements are also passed\nto fun. Returns that element from lst for which\nfun returned a minimal value (and stores the minimal value in the\nglobal variable @@). See also maxi and sort.\n\n
\n: (setq A 1  B 2  C 3)\n-> 3\n: (mini val '(A B C))\n-> A\n
\n\n
(mix 'lst cnt|'any ..) -> lst
\n
Builds a list from the elements of the argument lst, as\nspecified by the following cnt|'any arguments. If such an argument\nis a positive number, the n'th element from lst is taken. If it is\na negative number, the n'th CDR. Otherwise that argument is evaluated and the\nresult is used.\n\n
\n: (mix '(a b c d) 3 4 1 2)\n-> (c d a b)\n: (mix '(a b c d) -2 1)\n-> ((c d) a)\n: (mix '(a b c d) 1 'A 4 'D)\n-> (a A d D)\n
\n\n
(mmeq 'lst 'lst) -> any
\n
Returns the tail of the second argument lst that starts with a\nmember of the first argument lst, otherwise NIL.\n== is used for comparison (pointer\nequality). See also member, memq, asoq and delq.\n\n
\n: (mmeq '(a b c) '(d e f))\n-> NIL\n: (mmeq '(a b c) '(d b x))\n-> (b x)\n
\n\n
(money 'num ['sym]) -> sym
\n
Formats a number num into a digit string with two decimal\nplaces, according to the current locale. If an additional currency name is\ngiven, it is appended (separated by a space). See also telStr, datStr and format.\n\n
\n: (money 123456789)\n-> \"1,234,567.89\"\n: (money 12345 \"EUR\")\n-> \"123.45 EUR\"\n: (locale \"DE\" \"de\")\n-> NIL\n: (money 123456789 \"EUR\")\n-> \"1.234.567,89 EUR\"\n
\n\n
(more 'lst ['fun]) -> flg
\n
(more 'cls) -> any
\n
(Debug mode only) Displays the elements of lst (first form), or\nthe type and methods of cls (second form). fun\ndefaults to println. In the second\nform, the method definitions of cls are pretty-printed with\npp. After each step, more\nwaits for a key, and terminates when ESC is pressed. In that case,\nT is returned, otherwise (when end of data is reached)\nNIL. See also query and\nshow.\n\n
\n: (more (all))                         # Display all internal symbols\n!\n$\n%\n&\n*\n-> T\n\n: (more (all) show)                    # 'show' all internal symbols\n! 27131845007\n   doc \"@doc/ref_.html\"\n   *Dbg ((1458 \"@src/flow.l\" llvm pico))\n$ 27131845049\n   doc \"@doc/ref_.html\"\n   *Dbg ((1508 \"@src/flow.l\" llvm pico))\n% -27131839417\n   doc \"@doc/ref_.html\"\n   *Dbg ((1245 \"@src/big.l\" llvm pico))\n& -27131839537\n   doc \"@doc/ref_.html\"\n   *Dbg ((1380 \"@src/big.l\" llvm pico))\n* -27131839339\n   doc \"@doc/ref_.html\"\n   *Dbg ((1174 \"@src/big.l\" llvm pico))\n...\n\n: (more '+Link)                        # Display a class\n(+relation)\n(dm mis> (Val Obj)\n   (and\n      Val\n      (nor (isa (: type) Val) (\"canQuery\" Val))\n      \"Type error\" ) )\n(dm T (Var Lst)\n   (unless (=: type (car Lst)) (quit \"No Link\" Var))\n   (super Var) )\n-> NIL\n
\n\n
(msg 'any ['any ..]) -> any
\n
Prints any with print, followed by all any\narguments (printed with prin) and a\nnewline, to standard error. The first any argument is returned.\n\n
\n: (msg (1 a 2 b 3 c) \" is a mixed \" \"list\")\n(1 a 2 b 3 c) is a mixed list\n-> (1 a 2 b 3 c)\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refN.html",
    "content": "\n\n\n\n\n\nN\n\n\n\n\n
N
\n\n
\n\n
+Need
\n
Prefix class for mandatory +relations. Note that this does not\nenforce any requirements by itself, it only returns an error message if the\nmis> message is explicitly called, e.g. by GUI functions. See\nalso Database.\n\n
\n(rel nr (+Need +Key +Number))  # Item number is mandatory\n
\n\n
+Number
\n
Class for numeric relations, a subclass of +relation. Accepts an optional argument\nfor the fixpoint scale (currently not used). See also Database.\n\n
\n(rel pr (+Number) 2)  # Price, with two decimal places\n
\n\n
(n== 'any ..) -> flg
\n
Returns T when not all any arguments are the same\n(pointer equality). (n== 'any ..) is equivalent to (not (==\n'any ..)). See also == and Comparing.\n\n
\n: (n== 'a 'a)\n-> NIL\n: (n== (1) (1))\n-> T\n
\n\n
(n0 'any) -> flg
\n
Returns T when any is not a number with value\nzero. See also =0, lt0, le0, ge0 and gt0.\n\n
\n: (n0 (- 6 3 2 1))\n-> NIL\n: (n0 'a)\n-> T\n
\n\n
(nT 'any) -> flg
\n
Returns T when any is not the symbol\nT. See also =T.\n\n
\n: (nT 0)\n-> T\n: (nT \"T\")\n-> T\n: (nT T)\n-> NIL\n
\n\n
(name 'sym) -> sym
\n
Returns a new transient symbol with the name of sym. See also\nstr, sym, symbols, zap and intern.\n\n
\n: (name 'abc)\n-> \"abc\"\n: (name \"abc\")\n-> \"abc\"\n: (name '{A17})\n-> \"A17\"\n: (name (new))\n-> NIL\n
\n\n
(namespaces ['flg]) -> lst
\n
(Debug mode only) Returns a list of all namespaces nested in the current search\norder. When flg is non-NIL, their nested tree\nis printed as a side effect. See also symbols and shadows.\n\n
\n$ pil +\n: (namespaces)\n-> (pico vip llvm priv)\n: (namespaces T)\n   pico\n      vip\n      llvm\n      priv\n-> (pico vip llvm priv)\n\n$ pty  # After starting \"steps\", \"browser\" and \"chess\" in PilBox\nchess: (namespaces T)\n   chess\n   simul\n   android\n      steps\n      browser\n   pico\n      svg\n      vip\n      gis\n      llvm\n      priv\n-> (chess simul android steps browser pico svg vip gis llvm priv)\n
\n\n
(nand 'any ..) -> flg
\n
Logical NAND. The expressions any are evaluated from left to\nright. If NIL is encountered, T is returned\nimmediately. Else NIL is returned. (nand ..) is\nequivalent to (not (and ..)). See also and, nor, unless, ifn and nond.\n\n
\n: (nand (lt0 7) (read))\n-> T\n: (nand (lt0 -7) (read))\nabc\n-> NIL\n: (nand (lt0 -7) (read))\nNIL\n-> T\n
\n\n
(native 'cnt1|sym1 'cnt2|sym2 'any 'any ..) -> any
\n
Calls a native function. The first argument should specify a shared object\nlibrary, either \"@\" (the current main program), sym1\n(a library path name), or cnt1 (a library handle obtained by a\nprevious call). The second argument should be a symbol name sym2,\nor a function handle cnt2 obtained by a previous call).\nPractically, the first two arguments will be always passed as transient symbols,\nwhich will get the library handle and function handle assigned as values to be\ncached and used in subsequent calls. The third argument any is a\nresult specification, while all following arguments are the arguments to the\nnative function. The functionality is described in detail in Native C Calls.\n\n
The result specification may either be one of the\natoms\n\n
\n   NIL   void\n   B     byte        # Byte (unsigned 8 bit)\n   C     char        # Character (UTF-8, 1-4 bytes)\n   W     short       # Word (signed 16 bit)\n   I     int         # Integer (signed 32 bit)\n   U     unsigned    # Unsigned integer (32 bit)\n   N     long        # Number (signed 64 bit)\n   P     void*       # Pointer (unsigned 64 bit)\n   S     string      # String (UTF-8)\n  -1.0   float       # Scaled fixpoint number\n  +1.0   double      # Scaled fixpoint number\n   T                 # Direct Lisp value\n
\n\n
or nested lists of these atoms with size specifications to denote arrays and\nstructures, e.g.\n\n
\n   (N . 4)        # long[4];           -> (1 2 3 4)\n   (N (C . 4))    # {long; char[4];}   -> (1234 (\"a\" \"b\" \"c\" NIL))\n   (N (B . 7))    # {long; byte[7];}   -> (1234 (1 2 3 4 5 6 7))\n
\n\n
Arguments can be\n
    \n
  • integers (up to 64-bit) or pointers, passed as numbers\n
  • strings, passed as symbols\n
  • Lisp expressions, passed as cons pairs with T in the CAR\n
  • fixpoint numbers, passed as cons pairs consisting of a the value and the\n   scale (if the scale is positive, the number is passed as a\n   double, otherwise as a float)\n
  • structures, passed as lists with\n   
      \n   
    • a variable in the CAR (to receive the returned structure data, ignored\n      when the CAR is NIL)\n   
    • a cons pair for the size and result specification in the CADR (see\n      above), and\n   
    • an optional sequence of initialization items in the\n      CDDR, where each may be\n      
        \n      
      • a positive number, stored as an unsigned byte value\n      
      • a negative number, whose absolute value is stored as an unsigned\n         integer\n      
      • a pair (num . cnt) where 'num' is stored in\n         a field of 'cnt' bytes\n      
      • a pair (sym . cnt) where 'sym' is stored as\n         a null-terminated string in a field of 'cnt' bytes\n      
      • a list (1.0 num ...) where the 'num'\n         elements (scaled fixpoint numbers) are stored as a sequence of double\n         precision floating point numbers\n      
      • a list (-1.0 num ...) where the 'num'\n         elements (scaled fixpoint numbers) are stored as a sequence of single\n         precision floating point numbers\n      
      \n      If the last CDR of the initialization sequence is a number, it is used\n      as a fill-byte value for the remaining space in the structure.\n   
    \n
\n\n
native takes care of allocating memory for strings, arrays or\nstructures, and frees that memory when done.\n\n
For NaN or negative infinity fixpoint values NIL, and for\npositive infinity T is returned.\n\n
See also %@, struct, adr, lisp and errno.\n\n
\n: (native \"@\" \"unlink\" 'I \"file\")  # Same as (%@ \"unlink\" 'I \"file\")\n-> 0\n: (native \"libcrypto.so\" \"SHA1\" '(B . 20) \"abcd\" 4 0)\n-> (129 254 139 254 135 87 108 62 203 34 66 111 142 87 132 115 130 145 122 207)\n
\n\n
(need 'cnt ['lst ['any]]) -> lst
\n
(need 'cnt ['num|sym]) -> lst
\n
Produces a list of at least cnt elements. When called without\noptional arguments, a list of cnt NIL's is returned.\nWhen lst is given, it is extended to the left (if cnt\nis positive) or (destructively) to the right (if cnt is negative)\nwith any elements. In the second form, a list of cnt\natomic values is returned. See also range.\n\n
\n: (need 5)\n-> (NIL NIL NIL NIL NIL)  # Allocate 5 cells\n: (need 5 '(a b c))\n-> (NIL NIL a b c)\n: (need -5 '(a b c))\n-> (a b c NIL NIL)\n: (need 5 '(a b c) \" \")  # String alignment\n-> (\" \" \" \" a b c)\n: (need 7 0)\n-> (0 0 0 0 0 0 0)\n: (need 5 (2 3) 1)\n-> (1 1 1 2 3)\n
\n\n
(new ['flg|num|sym] ['typ ['any ..]]) -> obj
\n
Creates and returns a new object. If the first (optional) argument is\nT or a number, the new object will be an external symbol (created\nin database file 1 if T, or in the corresponding database file if\nnum is given). If it is a symbol, it is used directly.\ntyp (a list of classes) is assigned to the VAL, and\nthe initial T message is sent with the arguments any\nto the new object. If no T message is defined for the classes in\ntyp or their superclasses, the any arguments should\nevaluate to alternating keys and values for the initialization of the new\nobject. See also box, object, class, type, isa, send and Database.\n\n
\n: (new)\n-> $134426427\n: (new T '(+Address))\n-> {A3}\n
\n\n
(new! 'typ ['any ..]) -> obj
\n
Transaction wrapper function for new. (new! '(+Cls) 'key 'val ...)\nis equivalent to (dbSync) (new (db: +Cls) '(+Cls) 'key 'val ...) (commit\n'upd). See also request!, set!, put! and inc!.\n\n
\n: (new! '(+Item)  # Create a new item\n   'nr 2                      # Item number\n   'nm \"Spare Part\"           # Description\n   'sup (db 'nr '+CuSu 2)     # Supplier\n   'inv 100                   # Inventory\n   'pr 12.50 )                # Price\n
\n\n
(next) -> any
\n
Can only be used inside functions with a variable number of arguments (with\n@). Returns the next argument from the internal list. See also\nargs, arg, rest, and pass.\n\n
\n: (de foo @ (println (next)))          # Print next argument\n-> foo\n: (foo)\nNIL\n-> NIL\n: (foo 123)\n123\n-> 123\n
\n\n
(nil . prg) -> NIL
\n
Executes prg, and returns NIL. See also t, prog,\nprog1 and prog2.\n\n
\n: (nil (println 'OK))\nOK\n-> NIL\n
\n\n
nil/1
\n
Pilog predicate expects an argument variable,\nand succeeds if that variable is bound to NIL. See also not/1.\n\n
\n: (? @X NIL (nil @X))\n @X=NIL\n-> NIL\n
\n\n
(noLint 'sym)
\n
(noLint 'sym|(sym . cls) 'sym2)
\n
(Debug mode only) Excludes the check for a function definition of\nsym (in the first form), or for variable binding and usage of\nsym2 in the function definition, file contents or method body of\nsym (second form), during calls to lint. See also lintAll.\n\n
\n: (de foo ()\n   (bar FreeVariable) )\n-> foo\n: (lint 'foo)\n-> ((def bar) (bnd FreeVariable))\n: (noLint 'bar)\n-> bar\n: (noLint 'foo 'FreeVariable)\n-> (foo . FreeVariable)\n: (lint 'foo)\n-> NIL\n
\n\n
(nond ('any1 . prg1) ('any2 . prg2) ..) -> any
\n
Negated (\"non-cond\") multi-way conditional: If any of the anyN\nconditions evaluates to NIL, prgN is executed and the\nresult returned. Otherwise (all conditions evaluate to non-NIL),\nNIL is returned. See also cond, ifn, unless, nor and nand.\n\n
\n: (nond\n   ((= 3 3) (println 1))\n   ((= 3 4) (println 2))\n   (NIL (println 3)) )\n2\n-> 2\n
\n\n
(nor 'any ..) -> flg
\n
Logical NOR. The expressions any are evaluated from left to\nright. If a non-NIL value is encountered, NIL is\nreturned immediately. Else T is returned. (nor ..) is\nequivalent to (not (or ..)). See also or, nand, unless, ifn and nond.\n\n
\n: (nor (lt0 7) (= 3 4))\n-> T\n
\n\n
(not 'any) -> flg
\n
Logical negation. Returns T if any evaluates to\nNIL.\n\n
\n: (not (== 'a 'a))\n-> NIL\n: (not (get 'a 'a))\n-> T\n
\n\n
not/1
\n
Pilog predicate that succeeds if and only if\nthe goal cannot be proven. See also nil/1, true/0 and fail/0.\n\n
\n: (? (equal 3 4))\n-> NIL\n: (? (not (equal 3 4)))\n-> T\n
\n\n
(nsp 'sym) -> sym
\n
Returns the (first) namespace\nwhere sym is found in, according to the current symbols search order. See also\npico.\n\n
\n(load \"@lib/gis.l\")\n\n: (symbols '(gis pico))\n-> (pico)\ngis: (nsp 'gis)\n-> pico\ngis: (nsp 'Zoom)\n-> gis\ngis: (nsp 'osmStat)\n-> gis\n
\n\n
(nth 'lst 'cnt ..) -> lst
\n
Returns the tail of lst starting from the cnt'th\nelement of lst. Successive cnt arguments operate on\nthe CARs of the results in the same way. (nth 'lst 2) is equivalent\nto (cdr 'lst). See also get.\n\n
\n: (nth '(a b c d) 2)\n-> (b c d)\n: (nth '(a (b c) d) 2 2)\n-> (c)\n: (cdadr '(a (b c) d))\n-> (c)\n
\n\n
(num? 'any) -> num | NIL
\n
Returns any when the argument any is a number,\notherwise NIL. See also sym?, atom and pair.\n\n
\n: (num? 123)\n-> 123\n: (num? (1 2 3))\n-> NIL\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refO.html",
    "content": "\n\n\n\n\n\nO\n\n\n\n\n
O
\n\n
\n\n
*ObjIdx
\n
Holds an idx tree of objects\ncreated by obj.\n\n
\n
\n\n
*Once
\n
Holds an idx tree of already\nloaded source locations (as returned\nby file) See also once.\n\n
\n: *Once\n-> ((\"lib/\" \"misc.l\" . 11) ((\"lib/\" \"http.l\" . 9) ((\"lib/\" \"form.l\" . 11))))\n
\n\n
*OS
\n
A global constant holding the name of the operating system. Possible values\ninclude \"Linux\", \"Android\", \"FreeBSD\",\n\"OpenBSD\", \"SunOS\", \"Darwin\" or\n\"Cygwin\". See also *CPU\nand version.\n\n
\n: *OS\n-> \"Linux\"\n
\n\n
(obj (typ sym [hook] val ..) [var1 val1 ..]) -> obj
\n
(obj typ any [var1 val1 ..]) -> obj
\n
Finds or creates a database object, and initializes additional properties\nusing the varN and valN arguments. In the first form,\na request for (typ sym [hook]\nval ..) is called, while the second form uses cache to maintain objects without unique\n+Keys by indexing *ObjIdx with the any argument.\n\n
\n: (obj ((+Item) nr 2) nm \"Spare Part\" sup `(db 'nr '+CuSu 2) inv 100 pr 1250)\n-> {B2}\n
\n\n
(object 'sym 'any ['sym2 'any2 ..]) -> obj
\n
Defines sym to be an object with the value (or type)\nany. The property list is initialized with all optionally supplied\nkey-value pairs. See also OO Concepts, new, type and isa.\n\n
\n: (object 'Obj '(+A +B +C) 'a 1 'b 2 'c 3)\n-> Obj\n: (show 'Obj)\nObj (+A +B +C)\n   c 3\n   b 2\n   a 1\n-> Obj\n
\n\n
(oct 'num ['num]) -> sym
\n
(oct 'sym) -> num
\n
Converts a number num to an octal string, or an octal string\nsym to a number. In the first case, if the second argument is\ngiven, the result is separated by spaces into groups of such many digits. See\nalso bin, hex, hax and format.\n\n
\n: (oct 73)\n-> \"111\"\n: (oct \"111\")\n-> 73\n: (oct 1234567 3)\n-> \"4 553 207\"\n
\n\n
(off var ..) -> NIL
\n
Stores NIL in all var arguments. See also on, onOff, zero and one.\n\n
\n: (off A B)\n-> NIL\n: A\n-> NIL\n: B\n-> NIL\n
\n\n
(offset 'lst1 'lst2) -> cnt | NIL
\n
Returns the cnt position of the tail list lst1 in\nlst2, or NIL if it is not found. See also index, sub? and tail.\n\n
\n: (offset '(c d e f) '(a b c d e f))\n-> 3\n: (offset '(c d e) '(a b c d e f))\n-> NIL\n
\n\n
(on var ..) -> T
\n
Stores T in all var arguments. See also off, onOff, zero and one.\n\n
\n: (on A B)\n-> T\n: A\n-> T\n: B\n-> T\n
\n\n
(once . prg) -> any
\n
Executes prg once, when the current file is loaded the first time. Subsequent loads at a\nlater time will not execute prg, and once returns\nNIL. See also *Once and\nfinish.\n\n
\n(once\n   (zero *Cnt1 *Cnt2)  # Init counters\n   (load \"file1.l\" \"file2.l\") )  # Load other files\n\n`(once T)  # Ignore next time the rest of this file\n
\n\n
(one var ..) -> 1
\n
Stores 1 in all var arguments. See also zero, on, off\nand onOff.\n\n
\n: (one A B)\n-> 1\n: A\n-> 1\n: B\n-> 1\n
\n\n
(onOff var ..) -> flg
\n
Logically negates the values of all var arguments. Returns the\nnew value of the last symbol. See also on, off,\nzero and one.\n\n
\n: (onOff A B)\n-> T\n: A\n-> T\n: B\n-> T\n: (onOff A B)\n-> NIL\n: A\n-> NIL\n: B\n-> NIL\n
\n\n
(open 'any ['flg]) -> cnt | NIL
\n
Opens the file with the name any in read/write mode (or\nread-only if flg is non-NIL), and returns a file\ndescriptor cnt (or NIL on error). A leading\n\"@\" character in any is substituted with the\nPicoLisp Home Directory, as it was remembered during interpreter startup.\nIf flg is NIL and the file does not exist, it is\ncreated. The file descriptor can be used in subsequent calls to in and out. See also close and poll.\n\n
\n: (open \"x\")\n-> 3\n
\n\n
(opid) -> pid | NIL
\n
Returns the corresponding process ID when the current output channel is\nwriting to a pipe, otherwise NIL. See also ipid and out.\n\n
\n: (out '(cat) (call 'ps \"-p\" (opid)))\n  PID TTY          TIME CMD\n 7127 pts/3    00:00:00 cat\n-> T\n
\n\n
(opt) -> sym
\n
Return the next command line argument (\"option\", as would be processed by\nload) as a string, and remove it from\nthe remaining command line arguments. See also Invocation and argv.\n\n
\n$ pil  -\"de f () (println 'opt (opt))\"  -f abc  -bye\nopt \"abc\"\n
\n\n
(or 'any ..) -> any
\n
Logical OR. The expressions any are evaluated from left to\nright. If a non-NIL value is encountered, it is returned\nimmediately. Else the result of the last expression is returned. See also\nnor, and and unless.\n\n
\n: (or (= 3 3) (read))\n-> T\n: (or (= 3 4) (read))\nabc\n-> abc\n
\n\n
or/2
\n
Pilog predicate that takes an arbitrary number\nof clauses, and succeeds if one of them can be proven. See also not/1.\n\n
\n: (?\n   (or\n      ((equal 3 @X) (equal @X 4))\n      ((equal 7 @X) (equal @X 7)) ) )\n @X=7\n-> NIL\n
\n\n
(out 'any . prg) -> any
\n
Opens any as output channel during the execution of\nprg. The current output channel will be saved and restored\nappropriately. If the argument is NIL, standard output is used. If\nthe argument is a symbol, it is used as a file name (opened in read/write-append\nmode if the first character is \"+\"). If it is a positive number, it\nis used as the descriptor of an open file. If it is a negative number, the saved\noutput channel such many levels above the current one is used. Otherwise (if it\nis a list), it is taken as a command with arguments, and a pipe is opened for\noutput. The (system dependent) exit status code of the child process is stored\nin the global variable @@. In all cases,\nflush is called when prg\nis done. See also in,  err,  fd, opid,  call, ctl, pipe,  poll,  close and load.\n\n
\n: (out \"a\" (println 123 '(a b c) 'def))  # Write one line to file \"a\"\n-> def\n: (out '(lpr) (prinl \"Hello\"))  # Send line to line printer\n-> \"Hello\"\n
\n\n
(output exe . prg) -> any
\n
Establishes an output stream, by redirecting the current output channel\nduring the execution of prg. The current output channel will be\nsaved and restored appropriately. exe is executed (in the context\nof the original output channel) whenever a character needs to be output by print\ncalls in prg. That character is passed in the global variable\n@@, and the following character in the\nstream in @@@ (single-character\nlook-ahead). See also input, out and pipe.\n\n
\n: (output (prin (uppc @@)) (prinl \"abc\"))\nABC\n-> \"abc\"\n: (output (println @@ @@@) (prin \"abc\"))\n\"a\" \"b\"\n\"b\" \"c\"\n\"c\" NIL\n-> \"abc\"\n: (pack\n   (make\n      (output (link @@)\n         (print '(+ 2 (* 3 4))) ) ) )\n-> \"(+ 2 (* 3 4))\"\n: (pack\n   (make\n      (let L (1 2 3 4 5 6 7)\n         (output (link @@)\n            (while L\n               (ext:Base64 (++ L) (++ L) (++ L)) ) ) ) ) )\n-> \"AQIDBAUGBw==\"\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refP.html",
    "content": "\n\n\n\n\n\nP\n\n\n\n\n
P
\n\n
\n\n
*PPid
\n
A global constant holding the process-id of the parent picolisp process, or\nNIL if the current process is a top level process.\n\n
\n: (println *PPid *Pid)\nNIL 5286\n\n: (unless (fork) (println *PPid *Pid) (bye))\n5286 5522\n
\n\n
*Pid
\n
A global constant holding the current process-id.\n\n
\n: *Pid\n-> 6386\n: (call \"ps\")  # Show processes\n  PID TTY          TIME CMD\n .... ...      ........ .....\n 6386 pts/1    00:00:00 pil   # <- current process\n 6388 pts/1    00:00:00 ps\n-> T\n
\n\n
*Prompt
\n
Global variable holding a (possibly empty) prg body, which is\nexecuted - and the result printed -\nevery time before a prompt is output to the console in the\n\"read-eval-print-loop\" (REPL).\n\n
\n: (de *Prompt (pack \"[\" (stamp) \"]\"))\n# *Prompt redefined\n-> *Prompt\n[2011-10-11 16:50:05]: (+ 1 2 3)\n-> 6\n[2011-10-11 16:50:11]:\n
\n\n
(pack 'any ..) -> sym
\n
Returns a transient symbol whose name is concatenated from all arguments\nany. A NIL arguments contributes nothing to the result\nstring, a number is converted to a digit string, a symbol supplies the\ncharacters of its name, and for a list its elements are taken. See also text and glue.\n\n
\n: (pack 'car \" is \" 1 '(\" symbol \" name))\n-> \"car is 1 symbol name\"\n
\n\n
(pad 'cnt 'any) -> sym
\n
Returns a transient symbol with any packed with leading '0' characters, up to a\nfield width of cnt. See also format and align.\n\n
\n: (pad 5 1)\n-> \"00001\"\n: (pad 5 123456789)\n-> \"123456789\"\n
\n\n
(pair 'any) -> any
\n
Returns any when the argument is a cons pair. See also atom, num?, sym? and lst?.\n\n
\n: (pair NIL)\n-> NIL\n: (pair (1 . 2))\n-> (1 . 2)\n: (pair (1 2 3))\n-> (1 2 3)\n
\n\n
part/3
\n
(Deprecated since version 25.5.30) Pilog predicate that succeeds if the first\nargument, after folding it to\na canonical form, is a substring of the folded string\nrepresentation of the result of applying the get algorithm to the following\narguments. Typically used as filter predicate in select/3 database queries. See also\nsub?, isa/2, same/3, bool/3, range/3, head/3, fold/3 and tolr/3.\n\n
\n: (?\n   @Nr (1 . 5)\n   @Nm \"part\"\n   (select (@Item)\n      ((nr +Item @Nr) (nm +Item @Nm))\n      (range @Nr @Item nr)\n      (part @Nm @Item nm) ) )\n @Nr=(1 . 5) @Nm=\"part\" @Item={B1}\n @Nr=(1 . 5) @Nm=\"part\" @Item={B2}\n-> NIL\n
\n\n
(pass 'fun ['any ..]) -> any
\n
Passes to fun all arguments any, and all remaining\nvariable arguments (@) as they would be returned by rest. (pass 'fun 'any) is\nequivalent to (apply 'fun (rest) 'any). See also apply.\n\n
\n: (de bar (A B . @)\n   (println 'bar A B (rest)) )\n-> bar\n: (de foo (A B . @)\n   (println 'foo A B)\n   (pass bar 1)\n   (pass bar 2) )\n-> foo\n: (foo 'a 'b 'c 'd 'e 'f)\nfoo a b\nbar 1 c (d e f)\nbar 2 c (d e f)\n-> (d e f)\n
\n\n
(pat? 'any) -> pat | NIL
\n
Returns any when the argument any is a symbol\nwhose name starts with an at-mark \"@\", otherwise NIL.\n\n
\n: (pat? '@)\n-> @\n: (pat? \"@Abc\")\n-> \"@Abc\"\n: (pat? \"ABC\")\n-> NIL\n: (pat? 123)\n-> NIL\n
\n\n
(patch 'lst 'any . prg) -> any
\n
Destructively replaces all sub-expressions of lst which\nmatch the pattern any,\nby the result of the execution of prg. See also daemon and redef.\n\n
\n: (pp 'hello)\n(de hello NIL\n   (prinl \"Hello world!\") )\n-> hello\n\n: (patch hello 'prinl 'println)\n-> NIL\n: (pp 'hello)\n(de hello NIL\n   (println \"Hello world!\") )\n-> hello\n\n: (patch hello '(prinl @S) (fill '(println \"We said: \" . @S)))\n-> NIL\n: (hello)\nWe said: Hello world!\n-> \"Hello world!\"\n
\n\n
(path 'any) -> sym
\n
Substitutes any leading \"@\" or \"~\" character in\nthe any argument with the PicoLisp or User Home\nDirectory respectively, as they were remembered during interpreter startup.\nOptionally, the name may be preceded by a \"+\" character (as used by\nin and out). This mechanism is used internally by all\nI/O functions. See also Invocation, basename and dirname.\n\n
\n$ /usr/bin/picolisp /usr/lib/picolisp/lib.l\n: (path \"a/b/c\")\n-> \"a/b/c\"\n: (path \"@a/b/c\")\n-> \"/usr/lib/picolisp/a/b/c\"\n: (path \"+@a/b/c\")\n-> \"+/usr/lib/picolisp/a/b/c\"\n
\n\n
(peek) -> sym
\n
Single character look-ahead: Returns the same character as the next call to\nchar would return. Note that if the\nnext character is a multi-byte character, only the first byte is\nreturned. See also skip.\n\n
\n$ cat a\n# Comment\nabcd\n$ pil +\n: (in \"a\" (list (peek) (char)))\n-> (\"#\" \"#\")\n
\n\n
permute/2
\n
Pilog predicate that succeeds if the second\nargument is a permutation of the list in the second argument. See also append/3.\n\n
\n: (? (permute (a b c) @X))\n @X=(a b c)\n @X=(a c b)\n @X=(b a c)\n @X=(b c a)\n @X=(c a b)\n @X=(c b a)\n-> NIL\n
\n\n
(pick 'fun 'lst ..) -> any
\n
Applies fun to successive elements of lst until\nnon-NIL is returned. Returns that value, or NIL if\nfun did not return non-NIL for any element of\nlst. When additional lst arguments are given, their\nelements are also passed to fun. (pick 'fun 'lst) is\nequivalent to (fun (find 'fun 'lst)). See also seek, find and extract.\n\n
\n: (setq A NIL  B 1  C NIL  D 2  E NIL  F 3)\n-> 3\n: (find val '(A B C D E))\n-> B\n: (pick val '(A B C D E))\n-> 1\n
\n\n
pico
\n
A global constant holding the initial (default) namespace of internal symbols. Its value\nis two cons pairs of the symbol ~ (as a marker) and two\n'idx' trees, one for symbols\nwith short names and one for symbols with long names (more than 7 bytes\nin the name). See also symbols, nsp, import and intern.\n\n
\n: (symbols)\n-> (pico)\n: (cdr pico)\n-> (rollback (*NoTrace (*CtryCode (+IdxFold) genStrKey) basename ...\n
\n\n
(pilog 'lst . prg) -> any
\n
Evaluates a Pilog query, and executes\nprg for each result set with all Pilog variables bound to their\nmatching values. See also solve,\n?, goal and prove.\n\n
\n: (pilog '((append @X @Y (a b c))) (println @X '- @Y))\nNIL - (a b c)\n(a) - (b c)\n(a b) - (c)\n(a b c) - NIL\n-> NIL\n
\n\n
(pipe exe) -> cnt
\n
(pipe exe . prg) -> any
\n
Executes exe in a fork'ed child process (which terminates\nthereafter). In the first form, pipe just returns a file descriptor\nto write to the standard input and read from the standard output of that\nprocess. In the second form, it opens the standard output of that process as\ninput channel during the execution of prg. The current input\nchannel will be saved and restored appropriately, and the (system dependent)\nexit status code of the child process is stored in the global variable @@. See also later, ipid, in and out.\n\n
\n: (pipe                                # equivalent to 'any'\n   (prinl \"(a b # Comment\\nc d)\")         # Child\n   (read) )                               # Parent\n-> (a b c d)\n\n: (pipe                                # pipe through an external program\n   (out '(tr \"[a-z]\" \"[A-Z]\")             # Child\n      (prinl \"abc def ghi\") )\n   (line T) )                             # Parent\n-> \"ABC DEF GHI\"\n\n: (setq P\n     (pipe\n        (in NIL                           # Child: Read stdin\n           (while (line T)\n              (prinl (uppc @))            # and write to stdout\n              (flush) ) ) ) )\n-> 3\n: (out P (prinl \"abc def\"))               # Parent: Send line to child\n-> \"abc def\"\n: (in P (line))                           # Parent: Read reply\n-> (\"A\" \"B\" \"C\" \" \" \"D\" \"E\" \"F\")\n
\n\n
(place 'cnt 'lst 'any) -> lst
\n
Places any into lst at position cnt.\nThis is a non-destructive operation. See also insert, remove, append, delete and replace.\n\n
\n: (place 3 '(a b c d e) 777)\n-> (a b 777 d e)\n: (place 1 '(a b c d e) 777)\n-> (777 b c d e)\n: (place 9 '(a b c d e) 777)\n-> (a b c d e 777)\n
\n\n
(plio 'num) -> any
\n
(plio 'num 'cnt 'any) -> cnt
\n
The first form returns one item stored in PLIO format at the memory location\npointed to by num. The second form stores an item any\nin a buffer of size cnt. See also byte and struct.\n\n
\n: (buf P 64\n   (plio P 64 (1 a (2 b c) d))  # Store expression\n   (plio P) )                   # Fetch it\n-> (1 a (2 b c) d)\n
\n\n
(poll 'cnt) -> cnt | NIL
\n
Checks for the availability of data for reading on the file descriptor\ncnt. See also open,\nin and close.\n\n
\n: (and (poll *Fd) (in @ (read)))  # Prevent blocking\n
\n\n
(pool ['sym1 ['lst] ['sym2] ['sym3]]) -> T
\n
Opens the file sym1 as a database file in read/write mode. If\nthe file does not exist, it is created. A currently open database is closed.\nlst is a list of block size scale factors (i.e. numbers),\ndefaulting to (2) (for a single file with a 256 byte block size). If\nlst is given, an individual database file is opened for each item.\nIf sym2 is non-NIL, it is opened in append-mode as an\nasynchronous replication journal. If sym3 is non-NIL,\nit is opened for reading and appending, to be used as a synchronous transaction\nlog during commits. Calling\n(pool) without arguments just closes the current database. See also\ndbs, *Dbs and journal.\n\n
\n: *Dbs\n-> (1 2 2 4)\n: (pool \"dbFile\" *Dbs)\n-> T\n\n$ ls -l dbFile*\n-rw-r--r-- 1 abu abu  256 Jul  3 08:30 dbFile@\n-rw-r--r-- 1 abu abu  256 Jul  3 08:30 dbFileA\n-rw-r--r-- 1 abu abu  256 Jul  3 08:30 dbFileB\n-rw-r--r-- 1 abu abu 1024 Jul  3 08:30 dbFileC\n\n# DB directly on a device\n: (pool \"/dev/hda2\")\n-> T\n
\n\n
(pool2 'sym . prg) -> any
\n
Temporary switches to another database specified by sym. This\ndatabase must be a multi-file DB with exactly the same *Dbs structure as the currently open one. The\ncurrent database is not closed - I/O is just redirected to the new one. All\nfiles are opened before prg runs, and are closed thereafter. The\nresult of prg is returned. No replication journal or transaction\nlog is written. Also, possibly cached objects of the current DB remain in the\nheap, so an explicit call to rollback may be necessary. See also\nblk.\n\n
\n(pool2 \"db2/\"  # Update a read-only DB\n   (journal \"file.jnl\") )\n\n(rollback)\n(pool2 \"db2/\"  # Access object(s)\n   (show *DB) )\n(rollback)\n
\n\n
(pop 'var) -> any
\n
Pops the first element (CAR) from the stack in var. See also\npush, ++, shift, queue, cut, del and fifo.\n\n
\n: (setq S '((a b c) (1 2 3)))\n-> ((a b c) (1 2 3))\n: (pop S)\n-> a\n: (pop (cdr S))\n-> 1\n: (pop 'S)\n-> (b c)\n: S\n-> ((2 3))\n
\n\n
(port ['T] 'cnt|(cnt . cnt) ['var]) -> cnt
\n
Opens a TCP-Port cnt (or a UDP-Port if the first argument is\nT), and returns a socket descriptor suitable as an argument for\nlisten or accept (or udp, respectively). If cnt is zero,\nsome free port number is allocated. If a pair of cnts is given\ninstead, it should be a range of numbers which are tried in turn. When\nvar is given, it is bound to the port number.\n\n
\n: (port 0 'A)                       # Allocate free port\n-> 4\n: A\n-> 1034                             # Got 1034\n: (port (4000 . 4008) 'A)           # Try one of these ports\n-> 5\n: A\n-> 4002\n
\n\n
(pp 'sym) -> sym
\n
(pp 'sym 'cls) -> sym
\n
(pp '(sym . cls)) -> sym
\n
Pretty-prints the function or method definition of sym. The\noutput format would regenerate that same definition when read and executed. See\nalso pretty, debug and vi.\n\n
\n: (pp 'tab)\n(de tab (Lst . @)\n   (for N Lst\n      (let V (next)\n         (and (gt0 N) (space (- N (length V))))\n         (prin V)\n         (and\n            (lt0 N)\n            (space (- 0 N (length V))) ) ) )\n   (prinl) )\n-> tab\n\n: (pp 'has> '+Entity)\n(dm has> (Var Val)\n   (or\n      (nor Val (get This Var))\n      (has> (meta This Var) Val (get This Var)) ) )\n-> has>\n\n: (more (can 'has>) pp)\n(dm (has> . +relation) (Val X)\n   (and (= Val X) X) )\n\n(dm (has> . +Fold) (Val X)\n   (extra\n      Val\n      (if (= Val (fold Val)) (fold X) X) ) )\n\n(dm (has> . +Entity) (Var Val)\n   (or\n      (nor Val (get This Var))\n      (has> (meta This Var) Val (get This Var)) ) )\n\n(dm (has> . +List) (Val X)\n   (and\n      Val\n      (or\n         (extra Val X)\n         (find '((X) (extra Val X)) X) ) ) )\n\n(dm (has> . +Bag) (Val X)\n   (and\n      Val\n      (or (super Val X) (car (member Val X))) ) )\n
\n\n
(pr 'any ..) -> any
\n
Binary print: Prints all any arguments to the current output\nchannel in encoded binary format. See also rd, bytes, tell, hear and wr.\n\n
\n: (out \"x\" (pr 7 \"abc\" (1 2 3) 'a))  # Print to \"x\"\n-> a\n: (hd \"x\")\n00000000  04 0E 0E 61 62 63 01 04 02 04 04 04 06 03 05 61  ...abc.........a\n-> NIL\n
\n\n
(prBase64 'cnt ['str]) -> NIL
\n
Multiline base64 printing. Echoes bytes from the current input channel to\nthe current output channel in Base64 format. A newline is inserted after every\ncnt byte-triples (character-quadruples). If str is\ngiven (typically a carriage return), it is output before the newline. See also\necho mail.\n\n
\n: (in \"image.png\" (prBase64 18))  # Print 72 columns\n
\n\n
(prEval 'prg ['cnt]) -> any
\n
Executes prg, similar to run, by evaluating all expressions in\nprg (within the binding environment given by cnt-1).\nAs a side effect, all atomic expressions will be printed with prinl. See also eval.\n\n
\n: (let Prg 567\n   (prEval\n      '(\"abc\" (prinl (+ 1 2 3)) Prg 987) ) )\nabc\n6\n567\n987\n-> 987\n
\n\n
(pre? 'any1 'any2) -> any2 | NIL
\n
Returns any2 when the string representation of\nany1 is a prefix of the string representation of any2.\nSee also sub? and head.\n\n
\n: (pre? \"abc\" \"abcdefg\")\n-> \"abcdef\"\n: (pre? \"def\" \"abcdefg\")\n-> NIL\n: (pre? (+ 3 4) \"7fach\")\n-> \"7fach\"\n: (pre? NIL \"abcdefg\")\n-> \"abcdefg\"\n\n: (pre? \"abc\" '(a b c d e f g))\n-> \"abcdefg\"\n: (pre? '(a b c) \"abcdefg\")\n-> \"abcdefg\"\n
\n\n
(pretty 'any 'cnt)
\n
Pretty-prints any. If any is an atom, or a list\nwith a size not greater than 12, it is\nprinted as is. Otherwise, only the\nopening parenthesis and the CAR of the list is printed, all other elements are\npretty-printed recursively indented by three spaces, followed by a space and the\ncorresponding closing parenthesis. The initial indentation level\ncnt defaults to zero. See also pp.\n\n
\n: (pretty '(a (b c d) (e (f (g) (h) (i)) (j (k) (l) (m))) (n o p) q))\n(a\n   (b c d)\n   (e\n      (f (g) (h) (i))\n      (j (k) (l) (m)) )\n   (n o p)\n   q )-> \")\"\n
\n\n
(prin 'any ..) -> any
\n
Prints the string representation of all any arguments to the\ncurrent output channel. No space or newline is printed between individual items,\nor after the last item. For lists, all elements are prin'ted\nrecursively. See also prinl.\n\n
\n: (prin 'abc 123 '(a 1 b 2))\nabc123a1b2-> (a 1 b 2)\n
\n\n
(prinl 'any ..) -> any
\n
Prints the string representation of all any arguments to the\ncurrent output channel, followed by a newline. No space or newline is printed\nbetween individual items. For lists, all elements are prin'ted\nrecursively. See also prin.\n\n
\n: (prinl 'abc 123 '(a 1 b 2))\nabc123a1b2\n-> (a 1 b 2)\n
\n\n
(print 'any ..) -> any
\n
Prints all any arguments to the current output channel. If\nthere is more than one argument, a space is printed between successive\narguments. No space or newline is printed after the last item. See also println, printsp, sym and str\n\n
\n: (print 123)\n123-> 123\n: (print 1 2 3)\n1 2 3-> 3\n: (print '(a b c) 'def)\n(a b c) def-> def\n
\n\n
(println 'any ..) -> any
\n
Prints all any arguments to the current output channel,\nfollowed by a newline. If there is more than one argument, a space is printed\nbetween successive arguments. See also print, printsp.\n\n
\n: (println '(a b c) 'def)\n(a b c) def\n-> def\n
\n\n
(printsp 'any ..) -> any
\n
Prints all any arguments to the current output channel,\nfollowed by a space. If there is more than one argument, a space is printed\nbetween successive arguments. See also print, println.\n\n
\n: (printsp '(a b c) 'def)\n(a b c) def -> def\n
\n\n
(prior 'lst1 'lst2) -> lst | NIL
\n
Returns the cell in lst2 which immediately precedes the cell\nlst1, or NIL if lst1 is not found in\nlst2 or is the very first cell. == is used for comparison (pointer equality). See\nalso offset and memq.\n\n
\n: (setq L (1 2 3 4 5 6))\n-> (1 2 3 4 5 6)\n: (setq X (cdddr L))\n-> (4 5 6)\n: (prior X L)\n-> (3 4 5 6)\n
\n\n
(private) sym|lst
\n
Intern symbols locally into an internal special namespace named 'priv'. This\nnamespace is always searched first, but never gets new symbols\nautomatically interned. (private) expects a single symbol\nor a list of symbols immediately following in the current input stream.\nSee also pico, symbols, local, export, import and intern.\n\n
\n: (symbols 'myLib 'pico)\n-> (pico)\nmyLib: (symbols)\n-> (myLib pico)\nmyLib: (private) (foo bar)  # Intern 'foo' and 'bar' in 'priv'\nmyLib: (symbols)\n-> (myLib pico)\nmyLib: (all 'priv)\n-> (priv~foo priv~bar)\n
\n\n
(proc 'sym ..) -> T
\n
(Debug mode on Linux only) Shows a list of processes with command names\ngiven by the sym arguments, using the system ps\nutility. See also kids, kill and hd.\n\n
\n: (proc 'pil)\n  PID  PPID  STARTED  SIZE %CPU WCHAN  CMD\n16993  3267 12:38:21  1516  0.5 -      /usr/bin/picolisp /usr/lib/picolisp/lib.l /usr/bin/pil +\n15731  1834 12:36:35  2544  0.1 -      /usr/bin/picolisp /usr/lib/picolisp/lib.l /usr/bin/pil app/main.l -main -go +\n15823 15731 12:36:44  2548  0.0 -        /usr/bin/picolisp /usr/lib/picolisp/lib.l /usr/bin/pil app/main.l -main -go +\n-> T\n
\n\n
(prog . prg) -> any
\n
Executes prg, and returns the result of the last expression.\nSee also nil, t, prog1 and prog2.\n\n
\n: (prog (print 1) (print 2) (print 3))\n123-> 3\n
\n\n
(prog1 'any1 . prg) -> any1
\n
Executes all arguments, and returns the result of the first expression\nany1. See also nil,\nt, prog and prog2.\n\n
\n: (prog1 (print 1) (print 2) (print 3))\n123-> 1\n
\n\n
(prog2 'any1 'any2 . prg) -> any2
\n
Executes all arguments, and returns the result of the second expression\nany2. See also nil,\nt, prog and prog1.\n\n
\n: (prog2 (print 1) (print 2) (print 3))\n123-> 2\n
\n\n
(prompt 'any . prg) -> any
\n
Sets the prompt for non-REPL readline(3) calls to\nany during the execution of prg. See also tty.\n\n
\n: (prompt \"== \" (line))\n== abc\n-> (\"a\" \"b\" \"c\")\n
\n\n
(prop 'sym1|lst ['sym2|cnt ..] 'sym) -> var
\n
Fetches a property for a property key sym from a symbol. That\nsymbol is sym1 (if no other arguments are given), or a symbol found\nby applying the get algorithm to\nsym1|lst and the following arguments. The property (the cons pair,\nnot just its value) is returned, suitable for direct (destructive) manipulations\nwith functions expecting a var argument. See also ::.\n\n
\n: (put 'X 'cnt 0)\n-> 0\n: (prop 'X 'cnt)\n-> (0 . cnt)\n: (inc (prop 'X 'cnt))        # Directly manipulate the property value\n-> 1\n: (get 'X 'cnt)\n-> 1\n
\n\n
(protect . prg) -> any
\n
Executes prg, and returns the result of the last expression. If\na signal is received during that time, its handling will be delayed until the\nexecution of prg is completed. See also alarm, *Hup, *Sig[12] and kill.\n\n
\n: (protect (journal \"db1.log\" \"db2.log\"))\n-> T\n
\n\n
(prove 'lst ['lst]) -> lst
\n
The Pilog interpreter. Tries to prove the query\nlist in the first argument, and returns an association list of symbol-value\npairs, or NIL if not successful. The query list is modified as a\nside effect, allowing subsequent calls to prove for further\nresults. The optional second argument may contain a list of symbols; in that\ncase the successful matches of rules defined for these symbols will be traced.\nSee also goal, -> and unify.\n\n
\n: (prove (goal '((equal 3 3))))\n-> T\n: (prove (goal '((equal 3 @X))))\n-> ((@X . 3))\n: (prove (goal '((equal 3 4))))\n-> NIL\n
\n\n
(prune ['cnt])
\n
Optimizes memory usage by pruning in-memory nodes of database trees.\nTypically called repeatedly during bulk data imports. If cnt is\n0, the pruning process is initialized, and if it is\nNIL, further pruning will be disabled. Otherwise, all nodes which\nhave not been accessed (with fetch,\nstore, scan or iter) for cnt calls to\nprune will be wiped. See\nalso lieu.\n\n
\n(in File1\n   (prune 0)\n   (while (someData)\n      (new T '(+Cls1) ..)\n      (at (0 . 10000) (commit) (prune 100)) ) )\n(in File2\n   (prune 0)\n   (while (moreData)\n      (new T '(+Cls2) ..)\n      (at (0 . 10000) (commit) (prune 100)) ) )\n(commit)\n(prune)\n
\n\n
(push 'var 'any ..) -> any
\n
Implements a stack using a list in var. The any\narguments are cons'ed in front of the value list. See also push1, push1q, pop, shift, queue and fifo.\n\n
\n: (push 'S 3)              # Use the VAL of 'S' as a stack\n-> 3\n: S\n-> (3)\n: (push 'S 2)\n-> 2\n: (push 'S 1)\n-> 1\n: S\n-> (1 2 3)\n: (push S 999)             # Now use the CAR of the list in 'S'\n-> 999\n: (push S 888 777)\n-> 777\n: S\n-> ((777 888 999 . 1) 2 3)\n
\n\n
(push1 'var 'any ..) -> any
\n
Maintains a unique list in var. Each any argument\nis cons'ed in front of the value list only if it is not already a member of that list. See also push, push1q, pop and queue.\n\n
\n: (push1 'S 1 2 3)\n-> 3\n: S\n-> (3 2 1)\n: (push1 'S 2 4)\n-> 4\n: S\n-> (4 3 2 1)\n
\n\n
(push1q 'var 'any ..) -> any
\n
Maintains a unique list in var. Each any argument\nis cons'ed in front of the value list only if it is not already memq of that list (pointer equality). See also\npush, push1, pop and queue.\n\n
\n: (push1q 'S 'a (1) 'b (2) 'c)\n-> c\n: S\n-> (c (2) b (1) a)\n: (push1q 'S 'b (1) 'd)       # (1) is not pointer equal to the previous one\n-> d\n: S\n->  (d (1) c (2) b (1) a)     # (1) is twice in the list\n
\n\n
(put 'sym1|lst ['sym2|cnt ..] 'any) -> any
\n
Stores a new value any for a property key (or in the symbol\nvalue for zero) in a symbol, or in a list. That symbol is sym1 (if\nno other arguments are given), or a symbol found by applying the get algorithm to sym1|lst and the\nfollowing arguments. If the final destination is a list, the value is stored in\nthe CDR of an asoqed element (if the\nkey argument is a symbol), or the n'th element (if the key is a number). See\nalso =:.\n\n
\n: (put 'X 'a 1)\n-> 1\n: (get 'X 'a)\n-> 1\n: (prop 'X 'a)\n-> (1 . a)\n\n: (setq L '(A B C))\n-> (A B C)\n: (setq B 'D)\n-> D\n: (put L 2 0 'p 5)  # Store '5' under the 'p' property of the value of 'B'\n-> 5\n: (getl 'D)\n-> ((5 . p))\n
\n\n
(put! 'obj 'sym 'any) -> any
\n
Transaction wrapper function for put. Note that for setting property values of\nentities typically the put!> message is used. See also\nnew!, request!, set! and inc!.\n\n
\n(put! Obj 'cnt 0)  # Setting a property of a non-entity object\n
\n\n
(putl 'sym1|lst1 ['sym2|cnt ..] 'lst) -> lst
\n
Stores a complete new property list lst in a symbol. That\nsymbol is sym1 (if no other arguments are given), or a symbol found\nby applying the get algorithm to\nsym1|lst1 and the following arguments. All previously defined\nproperties for that symbol are lost. See also getl and maps.\n\n
\n: (putl 'X '((123 . a) flg (\"Hello\" . b)))\n-> ((123 . a) flg (\"Hello\" . b))\n: (get 'X 'a)\n-> 123\n: (get 'X 'b)\n-> \"Hello\"\n: (get 'X 'flg)\n-> T\n
\n\n
(pwd) -> sym
\n
Returns the path to the current working directory. See also dir and cd.\n\n
\n: (pwd)\n-> \"/home/app\"\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refQ.html",
    "content": "\n\n\n\n\n\nQ\n\n\n\n\n
Q
\n\n
\n\n
(qsym . sym) -> lst
\n
Returns a cons pair of the value and property list of sym. See\nalso quote, val and getl.\n\n
\n: (setq A 1234)\n-> 1234\n: (put 'A 'a 1)\n-> 1\n: (put 'A 'b 2)\n-> 2\n: (put 'A 'f T)\n-> T\n: (qsym . A)\n-> (1234 f (2 . b) (1 . a))\n
\n\n
(quote . any) -> any
\n
Returns any unevaluated. The reader recognizes the single quote\nchar ' as a macro for this function. See also lit.\n\n
\n: 'a\n-> a\n: '(foo a b c)\n-> (foo a b c)\n: (quote (quote (quote a)))\n-> ('('(a)))\n
\n\n
(query 'lst ['lst]) -> flg
\n
Handles an interactive Pilog query. The two\nlst arguments are passed to prove. query displays each\nresult, waits for a key, and terminates when ESC is pressed. See also ?, pilog and solve.\n\n
\n: (query (goal '((append @X @Y (a b c)))))\n @X=NIL @Y=(a b c)\n @X=(a) @Y=(b c)\n @X=(a b) @Y=(c)\n @X=(a b c) @Y=NIL\n-> NIL\n
\n\n
(queue 'var 'any) -> any
\n
Implements a queue using a list in var. The any\nargument is (destructively) concatenated to the end of the value list. See also\npush, pop, rid and fifo.\n\n
\n: (queue 'A 1)\n-> 1\n: (queue 'A 2)\n-> 2\n: (queue 'A 3)\n-> 3\n: A\n-> (1 2 3)\n: (pop 'A)\n-> 1\n: A\n-> (2 3)\n
\n\n
(quit ['any ['any]])
\n
Stops current execution. If no arguments are given, all pending finally expressions are executed and control\nis returned to the top level read-eval-print loop. Otherwise, an error handler\nis entered. The first argument can be some error message, and the second might\nbe the reason for the error. See also Error\nHandling.\n\n
\n: (de foo (X) (quit \"Sorry, my error\" X))\n-> foo\n: (foo 123)                                  # 'X' is bound to '123'\n123 -- Sorry, my error                       # Error entered\n? X                                          # Inspect 'X'\n-> 123\n?                                            # Empty line: Exit\n:\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refR.html",
    "content": "\n\n\n\n\n\nR\n\n\n\n\n
R
\n\n
\n\n
*Rule
\n
A global variable holding the current Pilog\nrule symbol. It is cleared at the beginning of a new REPL. See also be and clause.\n\n
\n: (be likes (John Mary))\n-> likes\n: *Rule\n-> likes\n
\n\n
*Run
\n
This global variable can hold a list of prg expressions which\nare used during key, sync, wait and listen. The first element of each expression\nmust either be a positive number (thus denoting a file descriptor to wait for)\nor a negative number (denoting a timeout value in milliseconds (in that case\nanother number must follow to hold the remaining time)). A poll(2)\nsystem call is performed with these values, and the corresponding\nprg body is executed when input data are available or when a\ntimeout occurred (with @ set to the file\ndescriptor or timeout value). See also task.\n\n
\n: (de *Run (-2000 0 (println '2sec)))     # Install 2-sec-timer\n-> *Run\n: 2sec                                    # Prints \"2sec\" every 2 seconds\n2sec\n2sec\n                                          # (Ctrl-D) Exit\n$\n
\n\n
+Ref
\n
Prefix class for maintaining non-unique indexes to +relations, a subclass of +index. Accepts an optional argument for a\n+Hook attribute. See also Database.\n\n
\n(rel tel (+Fold +Ref +String))  # Phone number with folded, non-unique index\n
\n\n
+Ref2
\n
Prefix class for maintaining a secondary (\"backing\") index to +relations. Can only be used as a prefix\nclass to +Key or +Ref. It maintains an index in the current\n(sub)class, in addition to that in one of the superclasses (must be a\n+Ref), to allow (sub)class-specific queries. See also Database.\n\n
\n(class +Ord +Entity)             # Order class\n(rel nr (+Need +Ref +Number))    # Order number\n...\n(class +EuOrd +Ord)              # EU-specific order subclass\n(rel nr (+Ref2 +Key +Number))    # Order number with backing index\n
\n\n
+relation
\n
Abstract base class of all database relations. Relation objects are usually\ndefined with rel. The class hierarchy\nincludes the classes +Any, +Bag, +Bool, +Number, +Date, +Time, +Symbol, +String, +Link, +Joint and +Blob, and the prefix classes +Hook, +Hook2, +index, +Key, +Ref, +Ref2, +Idx, +IdxFold, +Sn, +Fold, +Aux, +UB, +Dep, +List, +Need, +Mis, +Alt and +Swap. See also Database and +Entity.\n\n
Messages to relation objects include\n\n
\nmis> (Val Obj)       # Return error if mismatching type or value\nhas> (Val X)         # Check if the value is present\nput> (Obj Old New)   # Put new value\nrel> (Obj Old New)   # Maintain relational structures\nlose> (Obj Val)      # Delete relational structures\nkeep> (Obj Val)      # Restore deleted relational structures\nzap> (Obj Val)       # Clean up relational structures\n
\n\n
(rand ['cnt1 'cnt2] | ['T]) -> cnt | flg
\n
Returns a pseudo random number in the range of the positive short numbers\ncnt1 and cnt2 (or -2147483648 .. +2147483647 if no\narguments are given). If the argument is T, a boolean value\nflg is returned. Note that if a range is given, the results are\n\"more random\" because the higher bits of the internal generator are used. See\nalso seed.\n\n
\n: (rand 3 9)\n-> 3\n: (rand 3 9)\n-> 7\n
\n\n
(range 'num1 'num2 ['num3]) -> lst
\n
Produces a list of numbers in the range num1 through\nnum2. When num3 is non-NIL, it is used\nto increment num1 (if it is smaller than num2) or to\ndecrement num1 (if it is greater than num2). See also\nneed.\n\n
\n: (range 1 6)\n-> (1 2 3 4 5 6)\n: (range 6 1)\n-> (6 5 4 3 2 1)\n: (range -3 3)\n-> (-3 -2 -1 0 1 2 3)\n: (range 3 -3 2)\n-> (3 1 -1 -3)\n
\n\n
range/3
\n
(Deprecated since version 25.5.30) Pilog predicate that succeeds if the first\nargument is in the range of the result of applying the get algorithm to the following\narguments. Typically used as filter predicate in select/3 database queries. See also\nComparing, isa/2, same/3, bool/3, head/3, fold/3, part/3 and tolr/3.\n\n
\n: (?\n   @Nr (1 . 5)  # Numbers between 1 and 5\n   @Nm \"part\"\n   (select (@Item)\n      ((nr +Item @Nr) (nm +Item @Nm))\n      (range @Nr @Item nr)\n      (part @Nm @Item nm) ) )\n @Nr=(1 . 5) @Nm=\"part\" @Item={B1}\n @Nr=(1 . 5) @Nm=\"part\" @Item={B2}\n-> NIL\n
\n\n
(rank 'any 'lst ['flg]) -> lst
\n
Searches a ranking list. lst should be sorted. Returns the\nelement from lst with a maximal CAR less or equal to\nany (if flg is NIL), or with a minimal\nCAR greater or equal to any (if flg is\nnon-NIL), or NIL if no match is found. See also\nassoc and Comparing.\n\n
\n: (rank 0 '((1 . a) (100 . b) (1000 . c)))\n-> NIL\n: (rank 50 '((1 . a) (100 . b) (1000 . c)))\n-> (1 . a)\n: (rank 100 '((1 . a) (100 . b) (1000 . c)))\n-> (100 . b)\n: (rank 300 '((1 . a) (100 . b) (1000 . c)))\n-> (100 . b)\n: (rank 9999 '((1 . a) (100 . b) (1000 . c)))\n-> (1000 . c)\n: (rank 50 '((1000 . a) (100 . b) (1 . c)) T)\n-> (100 . b)\n
\n\n
(rassoc 'any 'lst) -> lst
\n
Reverse assoc. Returns the first\nelement from lst with its CDR equal to any, or\nNIL if no match is found. See also rasoq and asoq.\n\n
\n: (rassoc 7 '((999 1 2 3) (\"b\" . 7) (\"ok\" \"Hello\")))\n-> (\"b\" . 7)\n: (rassoc (1 2 3) '((999 1 2 3) (\"b\" . 7) (\"ok\" \"Hello\")))\n-> (999 1 2 3)\n: (rassoc 'u '((999 1 2 3) (\"b\" . 7) (\"ok\" \"Hello\")))\n-> NIL\n
\n\n
(rasoq 'any 'lst) -> lst
\n
Reverse asoq. Returns the first\nelement from lst with any as its CDR, or\nNIL if no match is found. == is used for comparison (pointer equality). See\nalso assoc and rassoc.\n\n
\n: (rasoq 'b '((1 . a) (2 . b) (3 . c))) )\n-> (2 . b)\n: (rasoq \"b\" '((1 . a) (2 . b) (3 . c))) )\n-> NIL\n
\n\n
(raw ['flg]) -> flg
\n
Console mode control function. When called without arguments, it returns the\ncurrent console mode (NIL for \"cooked mode\"). Otherwise, the\nconsole is set to the new state. See also key.\n\n
\n$ pil +\n: (raw)\n-> NIL\n: (raw T)\n-> T\n...  # Raw mode, no echo!\n
\n\n
(rc 'sym 'any1 ['any2 ['any3 'any4..]]) -> any
\n
Fetches a value from a resource file sym, or stores one or more\nkey-value pairs (any1 . any2) in that file, using the key\nany1 (and optionally any3 etc. for multiple stores).\nAll values are stored in a list in the file, using assoc. During the whole operation, the file is\nexclusively locked with ctl.\n\n
\n: (info \"a.rc\")               # File exists?\n-> NIL                        # No\n: (rc \"a.rc\" 'a 1)            # Store 1 for 'a'\n-> 1\n: (rc \"a.rc\" 'b (2 3 4))      # Store (2 3 4) for 'b'\n-> (2 3 4)\n: (rc \"a.rc\" 'c 'b)           # Store 'b' for 'c'\n-> b\n: (info \"a.rc\")               # Check file\n-> (28 733124 . 61673)\n: (in \"a.rc\" (echo))          # Display it\n((c . b) (b 2 3 4) (a . 1))\n-> T\n: (rc \"a.rc\" 'c)              # Fetch value for 'c'\n-> b\n: (rc \"a.rc\" @)               # Fetch value for 'b'\n-> (2 3 4)\n
\n\n
(rd ['sym]) -> any
\n
(rd 'cnt) -> num | NIL
\n
Binary read: Reads one item from the current input channel in encoded binary\nformat. When called with a cnt argument (second form), that number\nof raw bytes (in big endian format if cnt is positive, otherwise\nlittle endian) is read as a single number. Upon end of file, if the\nsym argument is given, it is returned, otherwise NIL.\nSee also pr, tell, hear and wr.\n\n
\n: (out \"x\" (pr 'abc \"EOF\" 123 \"def\"))\n-> \"def\"\n: (in \"x\" (rd))\n-> abc\n: (in \"x\"\n   (make\n      (use X\n         (until (== \"EOF\" (setq X (rd \"EOF\")))  # '==' detects end of file\n            (link X) ) ) ) )\n-> (abc \"EOF\" 123 \"def\")  # as opposed to reading a symbol \"EOF\"\n\n: (in \"/dev/urandom\" (rd 20))\n-> 396737673456823753584720194864200246115286686486\n
\n\n
(read ['sym1 ['sym2]]) -> any
\n
Reads one item from the current input channel. NIL is returned\nupon end of file. When called without arguments, an arbitrary Lisp expression is\nread. Otherwise, a token (a number, an internal symbol, a transient symbol (for\npunctuation), or a list of symbols (for a string)) is read. In that case,\nsym1 specifies which set of characters to accept for continuous\nsymbol names (in addition to the standard alphanumerical characters), and\nsym2 an optional comment character. See also any, str, line, skip and eof.\n\n
\n: (list (read) (read) (read))    # Read three things from console\n123                              # a number\nabcd                             # a symbol\n(def                             # and a list\nghi\njkl\n)\n-> (123 abcd (def ghi jkl))\n: (make (while (read \"_\" \"#\") (link @)))\nabc = def_ghi(\"xyz\"+-123) # Comment\nNIL\n-> (abc \"=\" def_ghi \"(\" (\"x\" \"y\" \"z\") \"+\" \"-\" 123 \")\")\n
\n\n
(recur lst . prg) -> any
\n
(recurse ['any ..]) -> any
\n
Implements anonymous recursion, by defining the function\nrecurse on the fly. During the execution of prg, the\nsymbol recurse is bound to the function definition (lst .\nprg). See also let, lambda and tco.\n\n
\n: (de fibonacci (N)\n   (when (lt0 N)\n      (quit \"Bad fibonacci\" N) )\n   (recur (N)\n      (if (>= 2 N)\n         1\n         (+\n            (recurse (dec N))\n            (recurse (- N 2)) ) ) ) )\n-> fibonacci\n: (fibonacci 22)\n-> 17711\n: (fibonacci -7)\n-7 -- Bad fibonacci\n
\n\n
(redef sym . fun) -> sym
\n
Redefines sym in terms of itself. The current definition is\nsaved in a new symbol, which is substituted for each occurrence of\nsym in fun, and which is also returned. See also\nde, undef, daemon and patch.\n\n
\n: (de hello () (prinl \"Hello world!\"))\n-> hello\n: (pp 'hello)\n(de hello NIL\n   (prinl \"Hello world!\") )\n-> hello\n\n: (redef hello (A B)\n   (println 'Before A)\n   (prog1 (hello) (println 'After B)) )\n-> \"hello\"\n: (pp 'hello)\n(de hello (A B)\n   (println 'Before A)\n   (prog1 (\"hello\") (println 'After B)) )\n-> hello\n: (hello 1 2)\nBefore 1\nHello world!\nAfter 2\n-> \"Hello world!\"\n\n: (redef * @\n   (msg (rest))\n   (pass *) )\n-> \"*\"\n: (* 1 2 3)\n(1 2 3)\n-> 6\n\n: (redef + @\n   (pass (ifn (num? (next)) pack +) (arg)) )\n-> \"+\"\n: (+ 1 2 3)\n-> 6\n: (+ \"a\" 'b '(c d e))\n-> \"abcde\"\n
\n\n
(reflect 'cnt 'sym)
\n
Global variable holding a (possibly empty) function, which can be called\nfrom native code to supply information of native data structures to Lisp. See\nalso native.\n\n
\n
\n\n
(rel sym lst [any ..]) -> any
\n
Defines a relation for sym in the current class *Class, using lst as the list of\nclasses for that relation, and possibly additional arguments any\nfor its initialization. See also Database, class, extend, dm and var.\n\n
\n(class +Person +Entity)\n(rel nm  (+List +Ref +String))            # Names\n(rel tel (+Ref +String))                  # Telephone\n(rel adr (+Joint) prs (+Address))         # Address\n\n(class +Address +Entity)\n(rel cit (+Need +Hook +Link) (+City))     # City\n(rel str (+List +Ref +String) cit)        # Street\n(rel prs (+List +Joint) adr (+Person))    # Inhabitants\n\n(class +City +Entity)\n(rel nm  (+List +Ref +String))            # Zip / Names\n
\n\n
(release 'sym) -> NIL
\n
Releases the mutex represented by the file 'sym'. This is the reverse\noperation of acquire.\n\n
\n: (release \"sema1\")\n-> NIL\n
\n\n
(remark 'any)
\n
Global variable holding a (possibly empty) function, which will be called\nwhen a value is printed in the REPL. It can be used to provide further\ninformation about that value.\n\n
\n: (date)\n-> 739542  # 2024-12-16\n: (scl 3)\n-> 3  # 0.003\n: 12.3\n-> 12300  # 12.300\n: (date)\n-> 739542  # 2024-12-16 739.542
\n\n
remote/2
\n
(Deprecated since version 25.5.30) Pilog predicate for remote database queries.\nIt takes a list and an arbitrary number of clauses. The list should\ncontain a Pilog variable for the result in the CAR, and a list of\nresources in the CDR. The clauses will be evaluated on remote machines\naccording to these resources. Each resource must be a cons pair of two\nfunctions, an \"out\" function in the CAR, and an \"in\" function in the\nCDR. See also *Ext, revolve/2, select/3 and db/3.\n\n
\n(setq *Ext           # Set up external offsets\n   (mapcar\n      '((@Host @Ext)\n         (cons @Ext\n            (curry (@Host @Ext (Sock)) (Obj)\n               (when (or Sock (setq Sock (connect @Host 4040)))\n                  (ext @Ext\n                     (out Sock (pr (cons 'qsym Obj)))\n                     (prog1\n                        (in Sock (rd))\n                        (unless @\n                           (close Sock)\n                           (off Sock) ) ) ) ) ) ) )\n      '(\"localhost\")\n      '(20) ) )\n\n(de rsrc ()  # Simple resource handler, ignoring errors or EOFs\n   (extract\n      '((@Ext Host)\n         (let? @Sock (connect Host 4040)\n            (cons\n               (curry (@Ext @Sock) (X)  # out\n                  (ext @Ext (out @Sock (pr X))) )\n               (curry (@Ext @Sock) ()  # in\n                  (ext @Ext (in @Sock (rd))) ) ) ) )\n      '(20)\n      '(\"localhost\") ) )\n\n: (?\n   @Nr (1 . 3)\n   @Sup 2\n   @Rsrc (rsrc)\n   (remote (@Item . @Rsrc)\n      (db nr +Item @Nr @Item)\n      (val @Sup @Item sup nr) )\n   (show @Item) )\n{AF2} (+Item)\n   pr 1250\n   inv 100\n   sup {AG2}\n   nm \"Spare Part\"\n   nr 2\n @Nr=(1 . 3) @Sup=2 @Rsrc=((((X) (ext 20 (out 3 (pr X)))) NIL (ext 20 (in 3 (rd))))) @Item={AF2}\n-> NIL\n
\n\n
(remove 'cnt 'lst) -> lst
\n
Removes the element at position cnt from lst. This\nis a non-destructive operation. See also insert, place, append, delete and replace.\n\n
\n: (remove 3 '(a b c d e))\n-> (a b d e)\n: (remove 1 '(a b c d e))\n-> (b c d e)\n: (remove 9 '(a b c d e))\n-> (a b c d e)\n
\n\n
(repeat) -> lst
\n
Makes the current Pilog definition \"tail\nrecursive\", by closing the previously defined rules in the definition's T\nproperty to a circular list. See also repeat/0 and be.\n\n
\n(be a (1))     # Define three facts\n(be a (2))\n(be a (3))\n(repeat)       # Unlimited supply\n\n: (? (a @N))\n @N=1\n @N=2\n @N=3\n @N=1\n @N=2\n @N=3.         # Stop\n-> NIL\n
\n\n
repeat/0
\n
Pilog predicate that always succeeds, also on\nbacktracking. See also repeat and\ntrue/0.\n\n
\n: (be integer (@I)   # Generate unlimited supply of integers\n   (^ @C (box 0))    # Init to zero\n   (repeat)          # Repeat from here\n   (^ @I (inc @C)) )\n-> integer\n\n: (? (integer @X))\n @X=1\n @X=2\n @X=3\n @X=4.               # Stop\n-> NIL\n
\n\n
(replace 'lst 'any1 'any2 ..) -> lst
\n
Replaces in lst all occurrences of any1 with\nany2. For optional additional argument pairs, this process is\nrepeated. This is a non-destructive operation. See also append, delete, insert, remove and place.\n\n
\n: (replace '(a b b a) 'a 'A)\n-> (A b b A)\n: (replace '(a b b a) 'b 'B)\n-> (a B B a)\n: (replace '(a b b a) 'a 'B 'b 'A)\n-> (B A A B)\n
\n\n
(request 'typ 'sym ['hook] 'val ..) -> obj
\n
Returns a database object. If a matching object cannot be found (using\ndb), a new object of the given type is\ncreated (using new). See also obj.\n\n
\n: (request '(+Item) 'nr 2)\n-> {B2}\n
\n\n
(request! 'typ 'sym ['hook] 'val ..) -> obj
\n
Transaction wrapper function for request.\nSee also new!, set!, put! and inc!.\n\n
\n
\n\n
(rest) -> lst
\n
Can only be used inside functions with a variable number of arguments (with\n@). Returns the list of all remaining arguments from the internal\nlist. See also args, next, arg and pass.\n\n
\n: (de foo @ (println (rest)))\n-> foo\n: (foo 1 2 3)\n(1 2 3)\n-> (1 2 3)\n
\n\n
(retract) -> lst
\n
Removes a Pilog fact or rule. See also be, clause, asserta and assertz.\n\n
\n: (be a (1))\n-> a\n: (be a (2))\n-> a\n: (be a (3))\n-> a\n\n: (retract '(a (2)))\n-> (((1)) ((3)))\n\n:  (? (a @N))\n @N=1\n @N=3\n-> NIL\n
\n\n
retract/1
\n
Pilog predicate that removes a fact or rule.\nSee also retract, asserta/1 and assertz/1.\n\n
\n: (be a (1))\n-> a\n: (be a (2))\n-> a\n: (be a (3))\n-> a\n\n: (? (retract (a 2)))\n-> T\n: (rules 'a)\n1 (be a (1))\n2 (be a (3))\n-> a\n
\n\n
(rev 'cnt1 'cnt2) -> cnt
\n
Reverses the lowest cnt1 bits of cnt2. See also\n>> and hash.\n\n
\n: (bin (rev 4 (bin \"0101\")))\n-> \"1010\"\n: (rev 32 1)\n-> 2147483648\n: (hex @)\n-> \"80000000\"\n: (rev 32 (hex \"E0000000\"))\n-> 7\n
\n\n
(reverse 'lst) -> lst
\n
Returns a reversed copy of lst. See also flip.\n\n
\n: (reverse (1 2 3 4))\n-> (4 3 2 1)\n
\n\n
(rewind) -> flg
\n
Sets the file position indicator for the current output stream to the\nbeginning of the file, and truncates the file length to zero. Returns\nT when successful. See also flush.\n\n
\n: (out \"a\" (prinl \"Hello world\"))\n-> \"Hello world\"\n: (in \"a\" (echo))\nHello world\n-> T\n: (info \"a\")\n-> (12 733216 . 53888)\n: (out \"a\" (rewind))\n-> T\n: (info \"a\")\n-> (0 733216 . 53922)\n
\n\n
revolve/2
\n
(Deprecated since version 25.5.30) Pilog predicate for quasi-parallel evaluation\nof clauses. It takes a list and an arbitrary number of clauses. The list\nshould contain a Pilog variable for the result in the CAR, another Pilog\nvariable for passing the values in the CADR, and a list of values in the\nCDDR. The clauses will be evaluated in a round-robin fashion. See also\nremote/2.\n\n
\n: (solve\n   (quote\n      @Rsrc '((1 2 3 4) (5 6 7 8) (a b c))\n      (revolve (@Res @Lst . @Rsrc)\n         (lst @Res @Lst) ) )\n   @Res )\n-> (1 5 a 2 6 b 3 7 c 4 8)\n
\n\n
(rid 'var 'any) -> any
\n
Destructively removes all occurrences of any from the (possibly\ncircular) value of var, and returns the new value. See also\nfifo, queue, cut and del.\n\n
\n$: (off E)\n-> NIL\n: (fifo 'E 1 2 3 2 4 2)\n-> 2\n: E\n-> (2 1 2 3 2 4 .)\n$: (rid 'E 2)\n-> (4 1 3 .)\n$: (rid 'E 4)\n-> (3 1 .)\n
\n\n
(rollback) -> flg
\n
Cancels a transaction, by discarding all modifications of external symbols.\nSee also commit.\n\n
\n: (pool \"db\")\n-> T\n# .. Modify external objects ..\n: (rollback)            # Rollback\n-> T\n
\n\n
(root 'tree) -> (num . sym)
\n
Returns the root of a database index tree, with the number of entries in\nnum, and the base node in sym. See also tree.\n\n
\n: (root (tree 'nr '+Item))\n-> (6 . {H1})\n
\n\n
(rot 'lst ['cnt]) -> lst
\n
Rotate: The contents of the cells of lst are (destructively)\nshifted right, and the value from the last cell is stored in the first cell.\nWithout the optional cnt argument, the whole list is rotated,\notherwise only the first cnt elements. See also flip .\n\n
\n: (rot (1 2 3 4))             # Rotate all four elements\n-> (4 1 2 3)\n: (rot (1 2 3 4 5 6) 3)       # Rotate only the first three elements\n-> (3 1 2 4 5 6)\n
\n\n
(round 'num1 ['num2]) -> sym
\n
Formats a number num1 with num2 decimal places,\naccording to the current scale *Scl.\nnum2 defaults to 3. See also Numbers\nand format.\n\n
\n: (scl 4)               # Set scale to 4\n-> 4  # 0.0004\n: (round 123456)        # Format with three decimal places\n-> \"12.346\"\n: (round 123456 2)      # Format with two decimal places\n-> \"12.35\"\n: (format 123456 *Scl)  # Format with full precision\n-> \"12.3456\"\n
\n\n
(rt cnt . prg) -> any
\n
Real/Runtime measurement: Executes prg, then (destructively)\nadds the number of elapsed microseconds to the cnt parameter. Thus,\ncnt will finally contain the total number of microseconds spent in\nprg. See also usec.\n\n
\n: (de foo ()                        # Define function with empty loop\n   (rt 0 (do 999999999)) )\n-> foo\n: (foo)                             # Execute it\n-> NIL\n: (pp 'foo)\n(de foo NIL\n   (rt 2022324 (do 999999999)) )    # 'rt' incremented 'cnt' by 2022324\n-> foo\n
\n\n
(rules 'sym ..) -> sym
\n
Prints all rules defined for the sym arguments. See also Pilog and be.\n\n
\n: (rules 'member 'append)\n1 (be member (@X (@X . @)))\n2 (be member (@X (@ . @Y)) (member @X @Y))\n1 (be append (NIL @X @X))\n2 (be append ((@A . @X) @Y (@A . @Z)) (append @X @Y @Z))\n-> append\n
\n\n
(run 'any ['cnt]) -> any
\n
If any is an atom, run behaves like eval. Otherwise any is a list,\nwhich is evaluated in sequence. The last result is returned. If an offset\ncnt is given, the value of @ in the cnt'th call environment\nis used during that evaluation. cnt should be greater than zero.\nSee also up.\n\n
\n: (run '((println (+ 1 2 3)) (println 'OK)))\n6\nOK\n-> OK\n\n: (de f (N . Prg)\n   (when (gt0 N)\n      (prinl \"1: @ = \" @)  # '@' is 4, as 'N' is 4 from the call below\n      (run Prg 1) ) )  # but printed is 3, as it was set by 'and'\n-> f\n\n: (and 3 (f 4 (prinl \"2: @ = \" @)))  # '@' was 3 when 'f' was called\n1: @ = 4\n2: @ = 3\n-> 3\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refS.html",
    "content": "\n\n\n\n\n\nS\n\n\n\n\n
S
\n\n
\n\n
*Scl
\n
A global variable holding the current fixpoint input scale. See also Numbers and scl.\n\n
\n: (str \"123.45\")  # Default value of '*Scl' is 0\n-> (123)\n: (setq *Scl 3)\n-> 3\n: (str \"123.45\")\n-> (123450)\n\n: 123.4567\n-> 123457\n: 12.3456\n-> 12346\n
\n\n
*Sig1
\n
*Sig2
\n
Global variables holding (possibly empty) prg bodies, which\nwill be executed when a SIGUSR1 signal (or a SIGUSR2 signal, respectively) is\nsent to the current process. See also alarm, *Hup, sigio, *TStp[12], *Winch and *Term.\n\n
\n: (de *Sig1 (msg 'SIGUSR1))\n-> *Sig1\n
\n\n
*Solo
\n
A global variable indicating exclusive database access. Its value is\n0 initially, set to T (or NIL) during\ncooperative database locks when lock\nis successfully called with a NIL (or non-NIL)\nargument. See also *Zap.\n\n
\n: *Solo\n-> 0\n: (lock *DB)\n-> NIL\n: *Solo\n-> NIL\n: (rollback)\n-> T\n: *Solo\n-> 0\n: (lock)\n-> NIL\n: *Solo\n-> T\n: (rollback)\n-> T\n: *Solo\n-> T\n
\n\n
+Sn
\n
Prefix class for maintaining indexes according to a modified soundex\nalgorithm, for tolerant name searches, to +String relations. Typically used in\ncombination with the +Idx prefix\nclass. See also Database.\n\n
\n(rel nm (+Sn +Idx +String))  # Name\n
\n\n
+String
\n
Class for string (transient symbol) relations, a subclass of +Symbol. Accepts an optional argument for\nthe string length (currently not used). See also Database.\n\n
\n(rel nm (+Sn +Idx +String))  # Name, indexed by soundex and substrings\n
\n\n
+Swap
\n
Prefix class for +relations\nwhere the data are to be stored in the value of a separate external symbol\ninstead of the relation's object. Typically used for data which are relatively\nlarge and/or rarely accessed. Doesn't work with bidirectional relations\n(+Joint or +index). See also Database.\n\n
\n(rel pw (+Swap +String))               # Password\n(rel nr (+Swap +List +Number))         # List of bignums\n
\n\n
+Symbol
\n
Class for symbolic relations, a subclass of +relation. Objects of that class typically\nmaintain internal symbols, as opposed to the more often-used +String for transient symbols. See also Database.\n\n
\n(rel perm (+List +Symbol))  # Permission list\n
\n\n
same/3
\n
(Deprecated since version 25.5.30) Pilog predicate that succeeds if the first\nargument matches the result of applying the get algorithm to the following\narguments. Typically used as filter predicate in select/3 database queries. See also\nisa/2, bool/3, range/3, head/3, fold/3, part/3 and tolr/3.\n\n
\n: (?\n   @Nr 2\n   @Nm \"Spare\"\n   (select (@Item)\n      ((nr +Item @Nr) (nm +Item @Nm))\n      (same @Nr @Item nr)\n      (head @Nm @Item nm) ) )\n @Nr=2 @Nm=\"Spare\" @Item={B2}\n
\n\n
(scan 'tree ['fun] ['any1] ['any2] ['flg])
\n
Scans through a database tree by applying fun to all key-value\npairs. fun should be a function accepting two arguments for key and\nvalue. It defaults to println.\nany1 and any2 may specify a range of keys. If\nany1 is greater than any2, the traversal will be in\nopposite direction. Note that the keys need not to be atomic, depending on the\napplication's index structure. If flg is non-NIL,\npartial keys are skipped. See also tree, iter, init and step.\n\n
\n: (scan (tree 'nm '+Item))\n(\"ASLRSNSTRSTN\" {B3} . T) {B3}\n(\"Additive\" {B4}) {B4}\n(\"Appliance\" {B6}) {B6}\n(\"Auxiliary Construction\" . {B3}) {B3}\n(\"Construction\" {B3}) {B3}\n(\"ENNSNNTTTF\" {B4} . T) {B4}\n(\"Enhancement Additive\" . {B4}) {B4}\n(\"Fittings\" {B5}) {B5}\n(\"GTSTFLNS\" {B6} . T) {B6}\n(\"Gadget Appliance\" . {B6}) {B6}\n...\n\n: (scan (tree 'nm '+Item) println NIL T T)  # 'flg' is non-NIL\n(\"Auxiliary Construction\" . {B3}) {B3}\n(\"Enhancement Additive\" . {B4}) {B4}\n(\"Gadget Appliance\" . {B6}) {B6}\n(\"Main Part\" . {B1}) {B1}\n(\"Metal Fittings\" . {B5}) {B5}\n(\"Spare Part\" . {B2}) {B2}\n-> NIL\n
\n\n
(scl 'num [. prg]) -> num
\n
If prg is given, it binds *Scl dynamically to num during the\nexecution of prg. Otherwise, it sets *Scl globally to num. See also Numbers.\n\n
\n: (scl 0)\n-> 0\n: (str \"123.45\")\n-> (123)\n: (scl 1)\n-> 1  # 0.1\n: (read)\n123.45\n-> 1235  # 123.5\n: (scl 3)\n-> 3  # 0.003\n: (str \"123.45\")\n-> (123450)\n: (scl 1 (str \"123.45\"))\n-> (1235)\n: *Scl\n-> 3  # 0.003\n
\n\n
(script 'any ..) -> any
\n
The first any argument is loaded, with the remaining arguments passed as variable arguments. They can be\naccessed with next, arg, args and rest. With that, the syntax in the script is\nthe same as that in the body of a function with variable arguments (see lambda expressions, \"when the CAR is the symbol @\").\n\n
\n$ cat x\n(* (next) (next))\n\n$ pil +\n: (script \"x\" 3 4)\n-> 12\n
\n\n
(search 'any 'lst ['any 'lst ..] ['fun]) -> lst
\n
(search 'lst) -> obj | NIL
\n
Searches the database for an arbitrary number\nof any criteria. The first form returns a list holding a query\nstructure according to the corresponding lst lists of relation\nspecifications. A search criterion can be an atom for an exact search, or a cons\npair for a range search. A relation specification can be a list (var cls\n[hook]) for an index search, a cons pair (sym . sym) for the\ntwo endpoints of a +Joint, or - only\ninstead of the first specification in lst - two functions: A\ngenerator function and a filter function. The final fun argument\nmay optionally filter and possibly modify each result. The second form takes a\nquery structure as returned from the first form, and returns the next result (an\nobject) or NIL (if there are no more matching results).\nsearch is described in detail in The 'search'\nFunction. See also init, step and collect.\n\n
\n: (for\n   (Q\n      (search\n         (2 . 5) '((nr +Item))  # Select all items with numbers between 2 and 5\n         \"Active\" '((nm +CuSu) (sup +Item)) )  # and suppliers matching \"Active\"\n      (search Q) )\n   (show @) )\n{B3} (+Item)\n   sup {C1}\n   nr 3\n   pr 15700\n   inv 100\n   nm \"Auxiliary Construction\"\n{B5} (+Item)\n   sup {C1}\n   nr 5\n   pr 7980\n   inv 100\n   nm \"Metal Fittings\"\n-> {B5}\n
\n\n
(sect 'lst1 'lst2) -> lst
\n
Returns the intersection of list arguments, all elements which are both in\nlst1 and in lst2. See also diff.\n\n
\n: (sect (1 2 3 4) (3 4 5 6))\n-> (3 4)\n: (sect (1 2 3) (4 5 6))\n-> NIL\n
\n\n
(seed 'any) -> cnt
\n
Initializes the random generator's seed, and returns a pseudo random number\nin the range -2147483648 .. +2147483647. See also rand and hash.\n\n
\n: (seed \"init string\")\n-> -417605464\n: (rand)\n-> -1061886707\n: (rand)\n-> 822065436\n\n: (seed (time))\n-> 128285383\n
\n\n
(seek 'fun 'lst ..) -> lst
\n
Applies fun to lst and all successive CDRs, until\nnon-NIL is returned. Returns the tail of lst starting\nwith that element (and stores the non-NIL value in the global\nvariable @@), or NIL if\nfun did not return non-NIL for any element of\nlst. When additional lst arguments are given, they are\npassed to fun in the same way. See also find, pick.\n\n
\n: (seek '((X) (> (car X) 9)) (1 5 8 12 19 22))\n-> (12 19 22)\n
\n\n
(select [var ..] cls [hook] [var val ..]) -> obj | NIL
\n
(Debug mode only) Interactive database function, loosely modelled after the\nSQL 'SELECT' command. A front-end to search. When called with only a\ncls argument, select steps through all objects of that\nclass, and shows their complete\ncontents (this is analog to 'SELECT * from CLS'). If cls is\nfollowed by attribute/value specifications, the search is limited to these\nvalues (this is analog to 'SELECT * from CLS where VAR = VAL'). If before\ncls one or several attribute names are supplied, only these\nattribute (instead of the full show) are printed. These attribute\nspecifications may also be lists, then those will be evaluated to retrieve\nrelated data. After each step, select waits for a key, and\nterminates when ESC is pressed. The global variable This is set to the last result. See also Database and Pilog.\n\n
\n: (select +Item)                       # Show all items\n{B1} (+Item)\n   nr 1\n   nm \"Main Part\"\n   pr 29900\n   inv 100\n   sup {C1}\n{B2} (+Item)\n   nr 2\n   nm \"Spare Part\"\n   pr 1250\n   inv 100\n   sup {C2}\n-> {B2}                                # ESC was pressed\n\n: (select +Item nr 3)                  # Show only item 3\n{B3} (+Item)\n   nr 3\n   sup {C1}\n   pr 15700\n   nm \"Auxiliary Construction\"\n   inv 100\n-> NIL\n\n# Show selected attributes for items 3 through 3\n: (select nr nm pr (: sup nm) +Item nr (3 . 5))\n3 \"Auxiliary Construction\" 157.00 \"Active Parts Inc.\" {B3}\n4 \"Enhancement Additive\" 9.99 \"Seven Oaks Ltd.\" {B4}\n5 \"Metal Fittings\" 79.80 \"Active Parts Inc.\" {B5}\n-> NIL\n
\n\n
select/3
\n
(Deprecated since version 25.5.30) Pilog database predicate that allows combined\nsearches over +index and\nother relations. It takes a list of Pilog variables, a list of generator\nclauses, and an arbitrary number of filter clauses. The functionality is\ndescribed in detail in The 'select' Predicate.\nSee also db/3, isa/2, same/3, bool/3, range/3, head/3, fold/3, part/3, tolr/3 and remote/2.\n\n
\n: (?\n   @Nr (2 . 5)          # Select all items with numbers between 2 and 5\n   @Sup \"Active\"        # and suppliers matching \"Active\"\n   (select (@Item)                                  # Bind results to '@Item'\n      ((nr +Item @Nr) (nm +CuSu @Sup (sup +Item)))  # Generator clauses\n      (range @Nr @Item nr)                          # Filter clauses\n      (part @Sup @Item sup nm) ) )\n @Nr=(2 . 5) @Sup=\"Active\" @Item={B3}\n @Nr=(2 . 5) @Sup=\"Active\" @Item={B5}\n-> NIL\n
\n\n
(send 'msg 'obj ['any ..]) -> any
\n
Sends the message msg to the object obj,\noptionally with arguments any. If the message cannot be located in\nobj, its classes and superclasses, an error \"Bad\nmessage\" is issued. See also OO Concepts,\ntry, method, meth, super and extra.\n\n
\n: (send 'stop> Dlg)  # Equivalent to (stop> Dlg)\n-> NIL\n
\n\n
(seq 'cnt|sym1) -> sym | NIL
\n
Sequential single step: Returns the first external symbol in the\ncnt'th database file, or the next external symbol following\nsym1 in the database, or NIL when the end of the\ndatabase is reached. See also free.\n\n
\n: (pool \"db\")\n-> T\n: (seq *DB)\n-> {2}\n: (seq @)\n-> {3}\n
\n\n
(set 'var 'any ..) -> any
\n
Stores new values any in the var arguments. See\nalso setq, val, swap, con and def.\n\n
\n: (set 'L '(a b c)  (cdr L) 999)\n-> 999\n: L\n-> (a 999 c)\n
\n\n
(set! 'obj 'any) -> any
\n
Transaction wrapper function for set. Note that for setting the value of entities\ntypically the set!> message\nis used. See also new!, request!, put! and inc!.\n\n
\n(set! Obj (* Count Size))  # Setting a non-entity object to a numeric value\n
\n\n
(setq var 'any ..) -> any
\n
Stores new values any in the var arguments. See\nalso set, val and def.\n\n
\n: (setq  A 123  B (list A A))  # Set 'A' to 123, then 'B' to (123 123)\n-> (123 123)\n
\n\n
(shadows ['flg]) -> lst
\n
(Debug mode only) Returns a list of all symbols shadowing other symbols in\nthe current namespace search order.\nWhen flg non-NIL, these and the overshadowed\nsymbols are printed as a side effect. See also symbols and namespaces.\n\n
\n: (symbols '(vip pico))\n-> (pico)\nvip: (shadows T)\n   vi pico~vi\n   cmd pico~cmd\n   shift pico~shift\n-> (vi cmd shift)\nvip: (symbols '(pico))\n-> (vip pico)\n\n$ pty  # After starting \"chess\" in PilBox\nchess: (shadows T)\n   field pico~field\n   wake android~wake\n   queue pico~queue\n   alarm pico~alarm\n-> (field wake queue alarm)\nchess: (nsp 'field)\n-> chess\nchess: (nsp 'wake)\n-> simul\nchess: (nsp 'alarm)\n-> android\n
\n\n
(shift 'var) -> any
\n
Sets the list in var to its CDR. (shift 'var) is\nequivalent to (set 'var (cdr (val 'var))). See also push and pop.\n\n
\n: (setq A (1 2 3))\n-> (1 2 3)\n: (shift 'A)\n-> (2 3)\n: A\n-> (2 3)\n
\n\n
(show 'any ['sym|cnt ..]) -> any
\n
Shows the name, value and property list of a symbol found by applying the\nget algorithm to any and\nthe following arguments. See also view.\n\n
\n: (setq A 123456)\n-> 123456\n: (put 'A 'x 1)\n-> 1\n: (put 'A 'lst (9 8 7))\n-> (9 8 7)\n: (put 'A 'flg T)\n-> T\n\n: (show 'A)\nA 123456\n   flg\n   lst (9 8 7)\n   x 1\n-> A\n\n: (show 'A 'lst 2)\n-> 8\n
\n\n
show/1
\n
Pilog predicate that always succeeds, and shows\nthe name, value and property list of the argument symbol. See also show.\n\n
\n: (? (db nr +Item 2 @Item) (show @Item))\n{B2} (+Item)\n   nm \"Spare Part\"\n   nr 2\n   pr 1250\n   inv 100\n   sup {C2}\n @Item={B2}\n-> NIL\n
\n\n
(sigio 'cnt . prg) -> cnt
\n
Sets a signal handler prg for SIGIO on the file descriptor\ncnt. Returns the file descriptor. See also alarm, *Hup, *Winch, *Sig[12], *TStp[12] and *Term.\n\n
\n# First session\n: (sigio (setq *SigSock (port T 4444))  # Register signal handler at UDP port\n   (while (udp *SigSock)                # Queue all received data\n      (fifo '*SigQueue @) ) )\n-> 3\n\n# Second session\n: (for I 7 (udp \"localhost\" 4444 I))  # Send numbers to first session\n\n# First session\n: (fifo '*SigQueue)\n-> 1\n: (fifo '*SigQueue)\n-> 2\n
\n\n
(size 'any) -> cnt
\n
Returns the \"size\" of any. For numbers this is the number of\nbytes needed for the value, for external symbols it is the number of bytes it\nwould occupy in the database, for other symbols it is the number of bytes\noccupied by the UTF-8 representation of the name, and for lists it is the total\nnumber of cells in this list and all its sublists. See also length and bytes.\n\n
\n: (size \"abc\")\n-> 3\n: (size \"äbc\")\n-> 4\n: (size 127)  # One byte\n-> 1\n: (size 128)  # Two bytes (eight bits plus sign bit!)\n-> 2\n: (size (1 (2) 3))\n-> 4\n: (size (1 2 3 .))\n-> 3\n
\n\n
(skip ['any]) -> sym
\n
Skips all whitespace (and comments if any is given) in the\ninput stream. Returns the next available character, or NIL upon end\nof file. See also peek and eof.\n\n
\n$ cat a\n# Comment\nabcd\n$ pil +\n: (in \"a\" (skip \"#\"))\n-> \"a\"\n
\n\n
(solve 'lst [. prg]) -> lst
\n
Evaluates a Pilog query and, returns the list\nof result sets. If prg is given, it is executed for each result\nset, with all Pilog variables bound to their matching values, and returns a list\nof the results. See also pilog,\n?, goal and prove.\n\n
\n: (solve '((append @X @Y (a b c))))\n-> (((@X) (@Y a b c)) ((@X a) (@Y b c)) ((@X a b) (@Y c)) ((@X a b c) (@Y)))\n\n: (solve '((append @X @Y (a b c))) @X)\n-> (NIL (a) (a b) (a b c))\n
\n\n
(sort 'lst ['fun]) -> lst
\n
Returns a sorted list by destructively exchanging the elements of\nlst. If fun is given, it is used as a \"less than\"\npredicate for comparisons. Typically, sort is used in combination\nwith by, giving shorter and often more efficient\nsolutions than with the predicate function. See also Comparing, group, maxi, mini and uniq.\n\n
\n: (sort '(a 3 1 (1 2 3) d b 4 T NIL (a b c) (x y z) c 2))\n-> (NIL 1 2 3 4 a b c d (1 2 3) (a b c) (x y z) T)\n: (sort '(a 3 1 (1 2 3) d b 4 T NIL (a b c) (x y z) c 2) >)\n-> (T (x y z) (a b c) (1 2 3) d c b a 4 3 2 1 NIL)\n: (by cadr sort '((1 4 3) (5 1 3) (1 2 4) (3 8 5) (6 4 5)))\n-> ((5 1 3) (1 2 4) (1 4 3) (6 4 5) (3 8 5))\n
\n\n
(space ['cnt]) -> cnt
\n
Prints cnt spaces, or a single space when cnt is\nnot given. See also beep, prin and char.\n\n
\n: (space)\n -> 1\n: (space 1)\n -> 1\n: (space 2)\n  -> 2\n
\n\n
(sp? 'any) -> flg
\n
Returns T when the argument any is\nNIL, or if it is a string (symbol) that consists only of whitespace\ncharacters.\n\n
\n: (sp? \"  \")\n-> T\n: (sp? \"ABC\")\n-> NIL\n: (sp? 123)\n-> NIL\n
\n\n
(split 'lst 'any ..) -> lst
\n
Splits lst at all places containing an element any\nand returns the resulting list of sublists. See also stem.\n\n
\n: (split (1 a 2 b 3 c 4 d 5 e 6) 'e 3 'a)\n-> ((1) (2 b) (c 4 d 5) (6))\n: (mapcar pack (split (chop \"The quick brown fox\") \" \"))\n-> (\"The\" \"quick\" \"brown\" \"fox\")\n
\n\n
(sq 'num1 ['num2]) -> num
\n
Returns the square of num1. If num2 is given, the\nresult will be divided by it and rounded. (sq 'num1 'num2) is\nequivalent to (*/ 'num1 'num1 'num2). See also */.\n\n
\n: (sq 6)\n-> 36\n: (sq -6 10)\n-> 4\n\n: (scl 6)\n-> 6  # 0.000006\n: (sqrt 2.0 1.0)\n-> 1414214  # 1.414214\n: (sq @ 1.0)\n-> 2000001  # 2.000001\n
\n\n\n
(sqrt 'num ['flg|num]) -> num
\n
Returns the square root of the num argument. If\nflg is given and non-NIL, the result will be rounded.\nIf in addition to that flg is a number, the first argument will be\nmultiplied with it before doing the square root calculation. See also */.\n\n
\n: (sqrt 64)\n-> 8\n: (sqrt 1000)\n-> 31\n: (sqrt 1000 T)\n-> 32\n: (sqrt 10000000000000000000000000000000000000000)\n-> 100000000000000000000\n\n: (scl 6)\n-> 6  # 0.000006\n: (sqrt 2.0 1.0)\n-> 1414214  # 1.414214\n
\n\n
(ssl 'host 'path . prg) -> any
\n
Executes prg in an input stream (using in) from \"@bin/ssl\" requesting path\nfrom host.\n\n
\n: (ssl \"picolisp.com\" \"wiki/?home\" (line T))\n-> \"<!DOCTYPE html>\"\n
\n\n
(stack ['cnt ['cnt]]) -> cnt | (.. (any . cnt) . cnt)
\n
Maintains the stack segment sizes for coroutines. By default, coroutine sizes are 64 kB\neach, and the main stack segment size is 256 kB. If called with at least one\nargument and no coroutine running, the stack segment size is set to the first\ncnt argument, and optionally the main segment size is set to the\nsecond cnt argument. Otherwise, the current size in kilobytes is\nreturned and - if there are running coroutines - pairs of their tags and unused\nstack spaces are consed in front of\nthe size. See also heap.\n\n
\n$ ulimit -s unlimited  &&  pil +  # Guarantee stack space\n: (stack)        # Current size\n-> 64            # 64 kB\n: (stack 20 80)  # Reduce to 20 kB\n-> 20\n: (co 'inc (let N 0 (loop (yield (inc 'N)))))  # Create two coroutines\n-> 1\n: (co 'dec (let N 0 (loop (yield (dec 'N)))))\n-> -1\n: (stack)\n-> ((dec . 19) (inc . 19) (T . 75) . 20)\n
\n\n
(stamp ['dat 'tim] | ['T]) -> sym
\n
Returns a date-time string in the form \"YYYY-MM-DD HH:MM:SS\". If\ndat and tim is missing, the current date and time is\nused. If T is passed, the current Coordinated Universal Time (UTC)\nis used instead. See also date and\ntime.\n\n
\n: (stamp)\n-> \"2000-09-12 07:48:04\"\n: (stamp (date) 0)\n-> \"2000-09-12 00:00:00\"\n: (stamp (date 2000 1 1) (time 12 0 0))\n-> \"2000-01-01 12:00:00\"\n
\n\n
(state 'var (sym|lst exe [. prg]) ..) -> any
\n
Implements a finite state machine. The variable var holds the\ncurrent state as a symbolic value. When a clause is found that contains the\ncurrent state in its CAR sym|lst value, and where the\nexe in its CADR evaluates to non-NIL, the current\nstate will be set to that value, the body prg in the CDDR will be\nexecuted, and the result returned. T is a catch-all for any state.\nIf no state-condition matches, NIL is returned. See also case, cond and job.\n\n
\n: (de tst ()\n   (job '((Cnt . 4))\n      (state '(start)\n         (start 'run\n            (printsp 'start) )\n         (run (and (gt0 (dec 'Cnt)) 'run)\n            (printsp 'run) )\n         (run 'stop\n            (printsp 'run) )\n         (stop 'start\n            (setq Cnt 4)\n            (println 'stop) ) ) ) )\n-> tst\n: (do 12 (tst))\nstart run run run run stop\nstart run run run run stop\n-> stop\n: (pp 'tst)\n(de tst NIL\n   (job '((Cnt . 4))\n      (state '(start)\n      ...\n-> tst\n: (do 3 (tst))\nstart run run -> run\n: (pp 'tst)\n(de tst NIL\n   (job '((Cnt . 2))\n      (state '(run)\n      ...\n-> tst\n
\n\n
(stem 'lst 'any ..) -> lst
\n
Returns the tail of lst that does not contain any of the\nany arguments. (stem 'lst 'any ..) is equivalent to\n(last (split 'lst 'any ..)). See also tail and split.\n\n
\n: (stem (chop \"abc/def\\\\ghi\") \"/\" \"\\\\\")\n-> (\"g\" \"h\" \"i\")\n
\n\n
(step 'lst ['flg]) -> any
\n
Single-steps iteratively through a database tree. lst is a\nstructure as received from init. If\nflg is non-NIL, partial keys are skipped. The key for\neach returned value is stored in the global variable @@. See also tree, scan, iter, leaf and fetch.\n\n
\n: (setq Q (init (tree 'nr '+Item) 3 5))\n-> (((3 . 5) ((3 NIL . {B3}) (4 NIL . {B4}) (5 NIL . {B5}) (6 NIL . {B6}))))\n: (get (step Q) 'nr)\n-> 3\n: (get (step Q) 'nr)\n-> 4\n: (get (step Q) 'nr)\n-> 5\n: (get (step Q) 'nr)\n-> NIL\n
\n\n
(store 'tree 'any1 'any2 ['(num1 . num2)])
\n
Stores a value any2 for the key any1 in a database\ntree. num1 is a database file number, as used in new (defaulting to 1), and num2 a\ndatabase block size (defaulting to 256). When any2 is\nNIL, the corresponding entry is deleted from the tree. See also\ntree and fetch.\n\n
\n: (store (tree 'nr '+Item) 2 '{B2})\n
\n\n
(str 'sym ['sym1]) -> lst
\n
(str 'lst) -> sym
\n
In the first form, the string sym is parsed into a list. This\nmechanism is also used by load. If\nsym1 is given, it should specify a set of characters, and\nstr will then return a list of tokens analog to read. The second form does the reverse\noperation by building a string from a list. See also any, name and sym.\n\n
\n: (str \"a (1 2) b\")\n-> (a (1 2) b)\n: (str '(a \"Hello\" DEF))\n-> \"a \\\"Hello\\\" DEF\"\n: (str \"a*3+b*4\" \"_\")\n-> (a \"*\" 3 \"+\" b \"*\" 4)\n
\n\n
(str? 'any) -> sym | NIL
\n
Returns the argument any when it is a transient symbol\n(string), otherwise NIL. See also sym?, box? and ext?.\n\n
\n: (str? 123)\n-> NIL\n: (str? '{ABC})\n-> NIL\n: (str? 'abc)\n-> NIL\n: (str? \"abc\")\n-> \"abc\"\n
\n\n
(strDat 'sym) -> dat
\n
Converts a string sym in the date format of the current\nlocale to a date. See also expDat, $dat and datStr.\n\n
\n: (strDat \"2007-06-01\")\n-> 733134\n: (strDat \"01.06.2007\")\n-> NIL\n: (locale \"DE\" \"de\")\n-> NIL\n: (strDat \"01.06.2007\")\n-> 733134\n: (strDat \"1.6.2007\")\n-> 733134\n
\n\n
(strip 'any) -> any
\n
Strips all leading quote calls from any. See also\nlit.\n\n
\n: (strip 123)\n-> 123\n: (strip '''(a))\n-> (a)\n: (strip (quote quote a b c))\n-> (a b c)\n
\n\n
(struct 'num 'any 'any ..) -> any
\n
Creates or extracts data structures, suitable to be passed to or returned\nfrom native functions. The first\nnum argument should be a native value, either a scalar, or a\npointer obtained by calling functions like malloc(). The second\nargument any is a result\nspecification, while all following initialization items are stored in the structure\npointed to by the first argument. See also Native C\nCalls.\n\n
\n: (scl 2)\n-> 2  # 0.02\n\n## /* We assume the following C structure */\n## typedef struct value {\n##    int x, y;\n##    double a, b, c;\n##    long z;\n##    char nm[4];\n## } value;\n\n# Allocate structure\n: (setq P (%@ \"malloc\" 'N 56))\n-> 498324676928\n\n# Store two integers, three doubles, one long, and four characters\n: (struct P NIL -7 -4 (1.0 0.11 0.22 0.33) (7 . 8) 65 66 67 0)\n-> NIL\n\n# Extract the structure\n: (struct P '((I . 2) (1.0 . 3) N (C . 4)))\n-> ((7 4) (11 22 33) 7 (\"A\" \"B\" \"C\"))\n\n# Do both in a single call (allowing conversions of data types)\n: (struct P\n   '((I . 2) (1.0 . 3) N (C . 4))\n   -7 -4 (1.0 0.11 0.22 0.33) (7 . 8) 65 66 67 0 )\n-> ((7 4) (11 22 33) 7 (\"A\" \"B\" \"C\"))\n\n# De-allocate structure\n: (%@ \"free\" NIL P)\n-> NIL\n
\n\n
(sub? 'any1 'any2 ['cnt]) -> any2 | NIL
\n
Returns any2 when the string representation of\nany1 is a substring of the string representation of\nany2, and stores the substring's byte position in the\nglobal variable @@. When\ncnt is given, the search starts at that byte position\n(default is 1). See also pre?,\noffset and index.\n\n
\n: (sub? \"def\" \"abcdefg\")\n-> \"abcdefg\"\n: (sub? \"abb\" \"abcdefg\")\n-> NIL\n: (sub? NIL \"abcdefg\")\n-> \"abcdefg\"\n\n: (sub? \"def\" '(a b c d e f g))\n-> \"abcdefg\"\n: (sub? '(d e f) \"abcdefg\")\n-> \"abcdefg\"\n\n: (sub? \"\" \"abc\") @@\n-> 0\n: (sub? \"a\" \"abc\") @@\n-> 1\n: (sub? \"b\" \"abc\") @@\n-> 2\n\n: (sub? \"bc\" \"abcXabc\") @@\n-> 2\n: (sub? \"bc\" \"abcXabc\" 2) @@\n-> 2\n: (sub? \"bc\" \"abcXabc\" 3) @@\n-> 6\n
\n\n
(subr 'sym) -> num
\n
Converts a Lisp-function that was previously converted with expr back to a SUBR function.\n\n
\n: car\n-> 67313448\n: (expr 'car)\n-> (@ (pass $385260187))\n: (subr 'car)\n-> 67313448\n: car\n-> 67313448\n
\n\n
(sum 'fun 'lst ..) -> num
\n
Applies fun to each element of lst. When\nadditional lst arguments are given, their elements are also passed\nto fun. Returns the sum of all numeric values returned from\nfun.\n\n
\n: (setq A 1  B 2  C 3)\n-> 3\n: (sum val '(A B C))\n-> 6\n: (sum * (3 4 5) (5 6 7))        # Vector dot product\n-> 74\n: (sum                           # Total size of symbol list values\n   '((X)\n      (and (pair (val X)) (size @)) )\n   (what) )\n-> 32021\n
\n\n
(super ['any ..]) -> any
\n
Can only be used inside methods. Sends the current message to the current\nobject This, this time starting the search for a method at the\nsuperclass(es) of the class where the current method was found. See also OO Concepts, extra, method, meth, send and try.\n\n
\n(dm stop> ()         # 'stop>' method of current class\n   (super)           # Call the 'stop>' method of the superclass\n   ... )             # other things\n
\n\n
(swap 'var 'any) -> any
\n
Set the value of var to any, and return the\nprevious value. See also xchg and\nset.\n\n
\n: (setq A 7  L (1 2 3))\n-> (1 2 3)\n: (swap (cdr L) (swap 'A 'xyz))\n-> 2\n: A\n-> xyz\n: L\n-> (1 7 3)\n
\n\n
(sym 'any) -> sym
\n
Generate the printed representation of any into the name of a\nnew symbol sym. This is the reverse operation of any. See also name and str.\n\n
\n: (sym '(abc \"Hello\" 123))\n-> \"(abc \\\"Hello\\\" 123)\"\n
\n\n
(sym? 'any) -> flg
\n
Returns T when the argument any is a symbol. See\nalso num?, atom, pair, str?, box? and ext?.\n\n
\n: (sym? 'a)\n-> T\n: (sym? NIL)\n-> T\n: (sym? 123)\n-> NIL\n: (sym? '(a b))\n-> NIL\n
\n\n
(symbols) -> lst
\n
(symbols 'lst) -> lst
\n
(symbols 'lst . prg) -> any
\n
(symbols ['T] 'sym1 'sym2 ..) -> lst
\n
Creates and manages namespaces of\ninternal symbols: In the first form, the current list of namespaces is\nreturned. In the second form, the current namespace list is set to\nlst, and the previous namespace list is returned. In the\nthird form, the current namespace list is set to lst during\nthe execution of prg, and the result is returned. In the\nfourth form, sym1 is initialized to a new namespace if its\nvalue is NIL and not modified otherwise, sym1,\nsym2 and all following arguments are set as the current\nnamespace list, and if the value of the global variable *Dbg is non-NIL, the current line\nnumber and file name (if any) are stored in the *Dbg\nproperty of sym1. If the first argument is T,\nthe resulting namespace list is also exported from the current REPL. See\nalso pico, nsp, -symbols, private, local, namespaces, shadows, export, import, intern and load.\n\n
\n: (symbols 'myLib 'pico)\n-> (pico)\nmyLib: (de foo (X)\n   (bar (inc X)) )\n-> foo\nmyLib: (symbols 'pico)\n-> (myLib pico)\n: (pp 'foo)\n(de foo . NIL)\n-> foo\n: (pp 'myLib~foo)\n(de \"foo\" (X)\n   (\"bar\" (inc X)) )\n-> \"foo\"\n: (symbols '(myLib pico))\n-> (pico)\nmyLib: (pp 'foo)\n(de foo (X)\n   (bar (inc X)) )\n-> foo\nmyLib:\n
\n\n
(-symbols) -> lst
\n
Command line frontend to symbols. Inserts the next command line\nargument as the first namespace into the current search order. --symbols\nmyLib on the command line (see Invocation)\nis equivalent to -\"symbols '(myLib ...)\". See also opt.\n\n
\n$ ./pil lib/gis.l lib/simul.l  --symbols gis  --symbols simul  +\nsimul: (symbols)\n-> (simul gis pico)\nsimul:\n
\n\n
(sync) -> flg
\n
Waits for pending data from all family processes. While other processes are\nstill sending data (via the tell\nmechanism), a poll(2) system call is executed for all file\ndescriptors and timers in the VAL of the global variable *Run. When used in a non-database context,\n(tell) should be called in the end to inform the parent process\nthat it may grant synchronization to other processes waiting for\nsync. In a database context, where sync is usually\ncalled by dbSync, this is not\nnecessary because it is done internally by commit or rollback.\n\nSee also key and wait.\n\n
\n: (or (lock) (sync))       # Ensure database consistency\n-> T                       # (numeric process-id if lock failed)\n
\n\n
(sys 'any ['any]) -> sym
\n
Returns or sets a system environment variable.\n\n
\n: (sys \"TERM\")  # Get current value\n-> \"xterm\"\n: (sys \"TERM\" \"vt100\")  # Set new value\n-> \"vt100\"\n: (sys \"TERM\")\n-> \"vt100\"\n
\n\n
(sysdefs 'sym1 '[sym2])
\n
Loads system-dependent definitions for all symbols in the section named\nsym1 from the file \"@lib/sysdefs\" (or an alternative file given by\nsym2). All symbols in that section are defined to their given values. See also native.\n\n
\n: (sysdefs \"networking\")  # Load networking system definitions\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refT.html",
    "content": "\n\n\n\n\n\nT\n\n\n\n\n
T
\n\n
\n\n
*Term
\n
Global variable holding a (possibly empty) prg body, which will\nbe executed when a SIGTERM signal is sent to the current process. If it returns\nnon-NIL, the signal is ignored.\nSee also\nalarm, sigio, *Hup, *Winch, *Sig[12] and *TStp[12].\n\n
\n: (de *Term (msg 'SIGTERM) T)\n-> *Term\n
\n\n
*TStp1
\n
*TStp2
\n
Global variables holding (possibly empty) prg bodies, which\nwill be executed when a SIGTSTP signal (*TStp1) or a SIGCONT signal\n(*TStp2) is sent to the current process. See also alarm, sigio, *Hup, *Winch, *Sig[12] and *Term.\n\n
\n: (de *TStp1 (msg 'SIGTSTP))\n-> *TStp1\n
\n\n
*Tmp
\n
A global variable holding the temporary directory name created with tmp. See also *Bye.\n\n
\n: *Bye\n-> ((saveHistory) (and *Tmp (call 'rm \"-r\" *Tmp)))\n: (tmp \"foo\" 123)\n-> \"/home/app/.pil/tmp/27140/foo123\"\n: *Tmp\n-> \"/home/app/.pil/tmp/27140/\"\n
\n\n
+Time
\n
Class for clock time values (as calculated by time), a subclass of +Number. See also Database.\n\n
\n(rel tim (+Time))  # Time of the day\n
\n\n
T
\n
A global constant, evaluating to itself. T is commonly returned\nas the boolean value \"true\" (though any non-NIL values could be\nused). It represents the absolute maximum, as it is larger than any other\nobject. As a property key, it is used to store Pilog clauses, and inside Pilog clauses it is the\ncut operator. See also NIL and\nand Comparing.\n\n
\n: T\n-> T\n: (= 123 123)\n-> T\n: (get 'not T)\n-> ((@P (1 @P) T (fail)) (@P))\n
\n\n
This
\n
Holds the current object during method execution (see OO Concepts), or inside the body of a with statement. As it is a normal symbol,\nhowever, it can be used in normal bindings anywhere. See also isa, :,\n=:, :: and var:. See also\nwith and\nthis.\n\n
\n: (with 'X (println 'This 'is This))\nThis is X\n-> X\n: (put 'X 'a 1)\n-> 1\n: (put 'X 'b 2)\n-> 2\n: (put 'Y 'a 111)\n-> 111\n: (put 'Y 'b 222)\n-> 222\n: (mapcar '((This) (cons (: a) (: b))) '(X Y))\n-> ((1 . 2) (111 . 222))\n
\n\n
(t . prg) -> T
\n
Executes prg, and returns T. See also nil, prog, prog1 and prog2.\n\n
\n: (t (println 'OK))\nOK\n-> T\n
\n\n
(tab 'lst 'any ..) -> NIL
\n
Print all any arguments in a tabular format. lst\nshould be a list of numbers, specifying the field width for each argument. All\nitems in a column will be left-aligned for negative numbers, otherwise\nright-aligned. See also align,\ncenter and wrap.\n\n
\n: (let Fmt (-3 14 14)\n   (tab Fmt \"Key\" \"Rand 1\" \"Rand 2\")\n   (tab Fmt \"---\" \"------\" \"------\")\n   (for C '(A B C D E F)\n      (tab Fmt C (rand) (rand)) ) )\nKey        Rand 1        Rand 2\n---        ------        ------\nA               0    1481765933\nB     -1062105905    -877267386\nC      -956092119     812669700\nD       553475508   -1702133896\nE      1344887256   -1417066392\nF      1812158119   -1999783937\n-> NIL\n
\n\n
(tail 'cnt|lst 'lst) -> lst
\n
Returns the last cnt elements of lst. If\ncnt is negative, it is added to the length of lst. If\nthe first argument is a lst, tail is a predicate\nfunction returning that argument list if it is equal to the tail of\nthe second argument, and NIL otherwise. (tail -2 Lst)\nis equivalent to (nth Lst 3). See also offset, head, last and stem.\n\n
\n: (tail 3 '(a b c d e f))\n-> (d e f)\n: (tail -2 '(a b c d e f))\n-> (c d e f)\n: (tail 0 '(a b c d e f))\n-> NIL\n: (tail 10 '(a b c d e f))\n-> (a b c d e f)\n: (tail '(d e f) '(a b c d e f))\n-> (d e f)\n
\n\n
(task 'num ['num] [sym 'any ..] [. prg]) -> lst
\n
A front-end to the *Run global. If\ncalled with only a single num argument, the corresponding entry is\nremoved from the value of *Run. Otherwise, a new entry is created.\nIf an entry with that key already exists, an error is issued. For negative\nnumbers, a second number must be supplied. If sym/any\narguments are given, a job environment\nis built for the *Run entry. See also tasks and timeout.\n\n
\n: (task -10000 5000 N 0 (tty (println (inc 'N))))  # Install task for every 10 seconds\n-> (-10000 5000 (job '((N . 0)) (tty (println (inc 'N)))))\n: 1                                                # ... after 5 seconds\n2                                                  # ... after 10 seconds\n3                                                  # ... after 10 seconds\n(task -10000)                                      # remove again\n-> NIL\n\n: (task (port T 4444) (eval (udp @)))              # Receive RPC via UDP\n-> (3 (eval (udp @)))\n\n# Another session (on the same machine)\n: (udp \"localhost\" 4444 '(println *Pid))  # Send RPC message\n-> (println *Pid)\n
\n\n
(tasks . prg)
\n
Runs a task with variable event\nspecification in a single *Run entry.\nThe task body prg should return either a positive number (a file\ndescriptor) or a negative number (a timeout value) to be used in the next\niteration. The first value must be a timeout. A value of NIL\nremoves the task. Uses -2 as implicit key. See also timeout.\n\n
\n(tasks  # Three iterations with varying timeout\n   (let X (pop '(((-1000 . a) (-4000 . b) (-1000 . c))))\n      (tty (println (cdr X)))\n      (car X) ) )\n\n(tasks\n   (co 'echoes  # Coroutine\n      (use S\n         (loop  # Loop infinitely\n            (yield -4000)  # First wait 4 seconds\n            (tty (println 'OK))\n            (yield  # Then wait for remote data\n               (setq S\n                  (pipe (exec \"sh\" \"-c\" \"sleep 2; echo 7\")) ) )\n            (tty (println (in S (read))))\n            (close S) ) ) ) )\n
\n\n
(tco lst . prg) -> any
\n
(tc ['any ..])
\n
Tail call optimization. tco implements a loop which is\nrestarted whenever tc is called during the execution of\nprg. This is faster and uses much less stack space than a recursive\nfunction call. lst is a list of parameter symbols. tc\nmust be the very last function called in a function body. See also recur and catch.\n\n
\n: (de f (N)\n   (if (=0 N)\n      'OK\n      (printsp N)\n      (f (dec N)) ) )  # Recursive call\n-> f\n: (f 8)\n8 7 6 5 4 3 2 1 -> OK\n\n# Equivalent to\n: (de f (N)\n   (tco (N)\n      (if (=0 N)\n         'OK\n         (printsp N)\n         (tc (dec N)) ) ) )  # Tail call\n-> f\n: (f 8)\n8 7 6 5 4 3 2 1 -> OK\n\n# Mutually recursive functions\n: (de f (N)\n   (tco (N)\n      (if (le0 N)\n         'OK\n         (printsp N)\n         (g (dec N)) ) ) )\n-> f\n: (de g (N)\n   (if (le0 N)\n      'OK\n      (tc (dec N)) ) )  # Tail call\n-> g\n: (f 8)\n8 6 4 2 -> OK\n
\n\n
(telStr 'sym) -> sym
\n
Formats a telephone number according to the current locale. If the string head matches the local\ncountry code, it is replaced with the national trunk prefix, otherwise\n+ is prepended. See also expTel, datStr, money and format.\n\n
\n: (telStr \"49 1234 5678-0\")\n-> \"+49 1234 5678-0\"\n: (locale \"DE\" \"de\")\n-> NIL\n: (telStr \"49 1234 5678-0\")\n-> \"01234 5678-0\"\n
\n\n
(tell ['cnt] 'sym ['any ..]) -> any
\n
Family IPC: Send an executable list (sym any ..) to all family\nmembers (i.e. all children of the current process, and all other children of the\nparent process, see fork) for\nautomatic execution. When the cnt argument is given and non-zero,\nit should be the PID of such a process, and the list will be sent only to that\nprocess. If cnt is zero, the list will be sent to the parent\nprocess instead. When called without arguments, no message is actually sent, and\nthe parent process may grant sync to\nthe next waiting process. tell is also used internally by commit to notify about database changes. When\ncalled explicitly, the size of the message is limited to the POSIX constant\nPIPE_BUF. See also kids, detach and hear.\n\n
\n: (call 'ps \"x\")                          # Show processes\n  PID TTY      STAT   TIME COMMAND\n  ..\n 1321 pts/0    S      0:00 /usr/bin/picolisp ..  # Parent process\n 1324 pts/0    S      0:01 /usr/bin/picolisp ..  # First child\n 1325 pts/0    S      0:01 /usr/bin/picolisp ..  # Second child\n 1326 pts/0    R      0:00 ps x\n-> T\n: *Pid                                    # We are the second child\n-> 1325\n: (tell 'println '*Pid)                   # Ask all others to print their Pid's\n1324\n-> *Pid\n
\n\n
(test 'any . prg)
\n
Executes prg, and issues an error if the result does not match the any argument. See also\nassert.\n\n
\n: (test 12 (* 3 4))\n-> NIL\n: (test 12 (+ 3 4))\n((+ 3 4))\n12 -- 'test' failed\n?\n
\n\n
(text 'any1 'any ..) -> sym
\n
Builds a new transient symbol (string) from the string representation of\nany1, by replacing all occurrences of an at-mark \"@\",\nfollowed by one of the letters \"1\" through \"9\", and\n\"A\" through \"Z\", with the corresponding\nany argument. In this context \"@A\" refers to the 10th\nargument. A literal at-mark in the text can be represented by two successive\nat-marks. See also pack and glue.\n\n
\n: (text \"abc @1 def @2\" 'XYZ 123)\n-> \"abc XYZ def 123\"\n: (text \"a@@bc.@1\" \"de\")\n-> \"a@bc.de\"\n
\n\n
(this 'any) -> any
\n
Sets the current object This to the new value any.\n(this 'any) is equivalent to (setq This 'any).\nSee also with.\n\n
\n: (this 'X)\n-> X\n: This\n-> X\n
\n\n
(throw 'sym 'any)
\n
Non-local jump into a previous catch environment with the jump label\nsym (or T as a catch-all). Any pending finally expressions are executed, local\nsymbol bindings are restored, open files are closed and internal data structures\nare reset appropriately, as the environment was at the time when the\ncorresponding catch was called. Then any is returned\nfrom that catch. See also quit.\n\n
\n: (de foo (N)\n   (println N)\n   (throw 'OK) )\n-> foo\n: (let N 1  (catch 'OK (foo 7))  (println N))\n7\n1\n-> 1\n
\n\n
(till 'any ['flg]) -> lst|sym
\n
Reads from the current input channel till a character contained in\nany is found (or until end of file if any is\nNIL). If flg is NIL, a list of\nsingle-character transient symbols is returned. Otherwise, a single string is\nreturned. See also from and line.\n\n
\n: (till \":\")\nabc:def\n-> (\"a\" \"b\" \"c\")\n: (till \":\" T)\nabc:def\n-> \"abc\"\n
\n\n
(tim$ 'tim ['flg]) -> sym
\n
Formats a time tim.\nIf flg is NIL, the format is HH:MM, otherwise it is\nHH:MM:SS. See also $tim and dat$.\n\n
\n: (tim$ (time))\n-> \"10:57\"\n: (tim$ (time) T)\n-> \"10:57:56\"\n
\n\n
(time ['T]) -> tim
\n
(time 'tim) -> (h m s)
\n
(time 'h 'm ['s]) -> tim | NIL
\n
(time '(h m [s])) -> tim | NIL
\n
Calculates the time of day, represented as the number of seconds since\nmidnight. When called without arguments, the current local time is returned.\nWhen called with a T argument, the time of the last call to\ndate is returned. When called with a\nsingle number tim, it is taken as a time value and a list with the\ncorresponding hour, minute and second is returned. When called with two or three\nnumbers (or a list of two or three numbers) for the hour, minute (and optionally\nthe second), the corresponding time value is returned (or NIL if\nthey do not represent a legal time). See also date, stamp, usec, tim$ and $tim.\n\n
\n: (time)                         # Now\n-> 32334\n: (time 32334)                   # Now\n-> (8 58 54)\n: (time 12 70)                   # Illegal time\n-> NIL\n
\n\n
(timeout ['num])
\n
Sets or refreshes a timeout value in the *Run global, so that the current process\nexecutes bye after the given period. If\ncalled without arguments, the timeout is removed. Uses -1 as\nimplicit key. See also task.\n\n
\n: (timeout 3600000)           # Timeout after one hour\n-> (-1 3600000 (bye))\n: *Run                        # Look after a few seconds\n-> ((-1 3574516 (bye)))\n
\n\n
(tmp ['any ..]) -> sym
\n
Returns the path name to the packed any arguments in a\nprocess-local temporary directory. The directory name consists of the path to\n\".pil/tmp/\" in the user's home directory, followed by the current process ID\n*Pid. This directory is automatically\ncreated if necessary, and removed upon termination of the process (bye). See also *Tmp and *Bye .\n\n
\n: *Pid\n-> 27140\n: (tmp \"foo\" 123)\n-> \"/home/app/.pil/tmp/27140/foo123\"\n: (out (tmp \"foo\" 123) (println 'OK))\n-> OK\n: (dir (tmp))\n-> (\"foo123\")\n: (in (tmp \"foo\" 123) (read))\n-> OK\n
\n\n
tolr/3
\n
(Deprecated since version 25.5.30) Pilog predicate that succeeds if the first\nargument, after folding it to\na canonical form, is either a substring or a +Sn soundex match of the result\nof applying the get algorithm\nto the following arguments. Typically used as filter predicate in\nselect/3 database queries.\nSee also isa/2, same/3, bool/3, range/3, head/3, fold/3 and part/3.\n\n
\n: (?\n   @Nr (1 . 5)\n   @Nm \"Sven\"\n   (select (@CuSu)\n      ((nr +CuSu @Nr) (nm +CuSu @Nm))\n      (range @Nr @CuSu nr)\n      (tolr @Nm @CuSu nm) )\n   (val @Name @CuSu nm) )\n @Nr=(1 . 5) @Nm=\"Sven\" @CuSu={C2} @Name=\"Seven Oaks Ltd.\"\n
\n\n
(touch 'sym) -> sym
\n
When sym is an external symbol, it is marked as \"modified\" so\nthat upon a later commit it will be\nwritten to the database file. An explicit call of touch is only\nnecessary when the value or properties of sym are indirectly\nmodified.\n\n
\n: (get '{2} 'lst)\n-> (1 2 3 4 5)\n: (set (cdr (get (touch '{2}) 'lst)) 999)    # Only read-access, need 'touch'\n-> 999\n: (get '{2} 'lst)                            # Modified second list element\n-> (1 999 3 4 5)\n
\n\n
(trace 'sym)
\n
(trace 'sym 'cls)
\n
(trace '(sym . cls))
\n
(Debug mode only) Inserts a $ trace\nfunction call at the beginning of the function or method body of\nsym, so that trace information will be printed before and after\nexecution. Can only be used with EXPRs and SUBRs. Built-in functions (SUBRs) are\nautomatically converted to Lisp expressions (see expr). See also *Dbg, traceAll and untrace, debug and lint.\n\n
\n: (trace '+)\n-> +\n: (+ 3 4)\n + : 3 4\n + = 7\n-> 7\n
\n\n
(-trace)
\n
(Debug mode only) Command line frontend to trace. See also -debug.\n\n
\n$ ./pil --trace append +\n: (append (1 2 3) (4 5 6))\n append : (1 2 3) (4 5 6)\n append = (1 2 3 4 5 6)\n-> (1 2 3 4 5 6)\n
\n\n
(traceAll ['lst]) -> sym
\n
(Debug mode only) Traces all Lisp level functions by inserting a $ function call at the beginning. lst\nmay contain symbols which are to be excluded from that process. In addition, all\nsymbols in the global variable *NoTrace are excluded. See also\ntrace, untrace and *Dbg.\n\n
\n: (traceAll)      # Trace all Lisp level functions\n-> balance\n
\n\n
(trail ['flg]) -> lst
\n
Returns a stack backtrace for the current point of program execution. The\nlist elements are either list expressions (denoting function or method calls),\nor symbols followed by their corresponding values. If flg is\nNIL, the symbols and their values are omitted, and only the\nexpressions are returned. See also bt,\nup and env.\n\n
\n: (de f (A B)\n   (g (inc A) (dec B)) )\n-> f\n: (de g (X Y)\n   (trail T) )\n-> g\n: (f 3 4)\n-> ((f 3 4) A 3 B 4 (g (inc A) (dec B)) X 4 Y 3)\n
\n\n
(tree 'sym 'cls ['hook]) -> tree
\n
Returns a data structure specifying a database index tree. sym\nand cls determine the relation, with an optional hook\nobject. See also root, fetch, store, count, leaf, minKey, maxKey, init, step, scan, iter, prune, zapTree and chkTree.\n\n
\n: (tree 'nm '+Item)\n-> (nm . +Item)\n
\n\n
(trim 'lst) -> lst
\n
Returns a copy of lst with all trailing whitespace characters\nor NIL elements removed. See also clip.\n\n
\n: (trim (1 NIL 2 NIL NIL))\n-> (1 NIL 2)\n: (trim '(a b \" \" \" \"))\n-> (a b)\n
\n\n
true/0
\n
Pilog predicate that always succeeds. See also\nfail/0 and repeat/0.\n\n
\n:  (? (true))\n-> T\n
\n\n
(try 'msg 'obj ['any ..]) -> any
\n
Tries to send the message msg to the object obj,\noptionally with arguments any. If obj is not an\nobject, or if the message cannot be located in obj, in its classes\nor superclasses, NIL is returned. See also OO Concepts, send, method, meth, super and extra.\n\n
\n: (try 'msg> 123)\n-> NIL\n: (try 'html> 'a)\n-> NIL\n
\n\n
(tty . prg) -> any
\n
Redirects the current output channel to the terminal (stderr) during the\nexecution of prg. The current output channel and the state of\nreadline(3) will be saved and restored appropriately. See also\nout.\n\n
\n: (task -2000 0 (tty (println (inc (0)))))\n-> (-2000 0 (tty (println (inc (0)))))\n1\n2\n3\n: (* 3 4)  # Typed while numbers are printed\n
\n\n
(type 'any) -> lst
\n
Return the type (list of classes) of the object any. See also\nOO Concepts, isa, class, new and object.\n\n
\n: (type '{1A;3})\n(+Address)\n: (type '+DnButton)\n-> (+Tiny +Rid +JS +Able +Button)\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refU.html",
    "content": "\n\n\n\n\n\nU\n\n\n\n\n
U
\n\n
\n\n
*Uni
\n
A global variable holding an idx\ntree, with all unique data that were collected with the comma (,)\nread-macro. Typically used for localization. Setting *Uni to\nT disables this mechanism. See also Read-Macros and locale.\n\n
\n: (off *Uni)            # Clear\n-> NIL\n: ,\"abc\"                # Collect a transient symbol\n-> \"abc\"\n: ,(1 2 3)              # Collect a list\n-> (1 2 3)\n: *Uni\n-> (\"abc\" NIL (1 2 3))\n
\n\n
+UB
\n
Prefix class for +Aux to maintain\nan UB-Tree index instead of the direct values. This allows efficient range\naccess to multi-dimensional data. Only positive numeric keys are supported. See\nalso ubIter and Database.\n\n
\n(class +Pos +Entity)\n(rel x (+UB +Aux +Ref +Number) (y z))\n(rel y (+Number))\n(rel z (+Number))\n\n: (scan (tree 'x '+Pos))\n(288362200753438306 . {13}) {13}\n(348187139486943716 . {16}) {16}\n(605261596962573238 . {11}) {11}\n(638523558602802506 . {7}) {7}   # UBKEY of (453062 450921 613956)\n(654697989157410399 . {12}) {12}\n...\n\n: (show '{7})\n{7} (+Pos)\n   x 453062\n   y 450921\n   z 613956\n-> {7}\n\n# Discrete queries work the same way as without the +UB prefix\n: (db 'x '+Pos 453062 'y 450921 'z 613956)\n-> {7}\n: (aux 'x '+Pos 453062 450921 613956)\n-> {7}\n: (? (db x +Pos (453062 450921 613956) @Pos))\n @Pos={7}\n-> NIL\n\n# Range queries work efficiently with 'collect'. Note that though also Pilog\nqueries can handle UB-trees, they may do so sub-optimally for certain ranges.\n: (collect 'x '+Pos (200000 200000 200000) (899999 899999 899999))\n-> ({7} {14} {17} {15})\n
\n\n
(u) -> T
\n
(Debug mode only) Removes ! all\nbreakpoints in all subexpressions of the current breakpoint. Typically used when\nsingle-stepping a function or method with debug. See also d and unbug.\n\n
\n! (u)                         # Unbug subexpression(s) at breakpoint\n-> T\n
\n\n
(ubIter 'tree 'dim 'fun 'lst1 'lst2)
\n
Efficiently iterates through a database +UB tree, by applying fun to all\nvalues. dim is the number of the key dimensions, lst1\nand lst2 specify a range of keys. collect uses ubIter internally\nfor UB-tree queries. See also iter.\n\n
\n: (ubIter (tree 'x '+Pos) 3 show (200000 200000 200000) (899999 899999 899999))\n{7} (+Pos)\n   z 613956\n   y 450921\n   x 453062\n{14} (+Pos)\n   z 771372\n   y 262217\n   x 862358\n{17} (+Pos)\n   z 676836\n   y 529576\n   x 398229\n{15} (+Pos)\n   z 889332\n   y 691799\n   x 265381\n-> NIL\n
\n\n
(udp 'any1 'any2 'any3) -> any
\n
(udp 'cnt) -> any
\n
Simple unidirectional sending/receiving of UDP packets. In the first form,\nany3 is sent to a UDP server listening at host any1,\nport any2. In the second form, one item is received from a UDP\nsocket cnt, established with port. See also listen and connect.\n\n
\n# First session\n: (port T 6666)\n-> 3\n: (udp 3)  # Receive a datagram\n\n# Second session (on the same machine)\n: (udp \"localhost\" 6666 '(a b c))\n-> (a b c)\n\n# First session\n-> (a b c)\n
\n\n
(ultimo 'y 'm) -> cnt
\n
Returns the date of the last day\nof the month m in the year y. See also day and week.\n\n
\n: (date (ultimo 2007 1))\n-> (2007 1 31)\n: (date (ultimo 2007 2))\n-> (2007 2 28)\n: (date (ultimo 2004 2))\n-> (2004 2 29)\n: (date (ultimo 2000 2))\n-> (2000 2 29)\n: (date (ultimo 1900 2))\n-> (1900 2 28)\n
\n\n
(unbug 'sym) -> T
\n
(unbug 'sym 'cls) -> T
\n
(unbug '(sym . cls)) -> T
\n
(Debug mode only) Removes all !\nbreakpoints in the function or method body of sym, as inserted with debug or d, or directly with vi. See also u.\n\n
\n: (pp 'tst)\n(de tst (N)\n   (! println (+ 3 N)) )         # 'tst' has a breakpoint '!'\n-> tst\n: (unbug 'tst)                   # Unbug it\n-> T\n: (pp 'tst)                      # Restore\n(de tst (N)\n   (println (+ 3 N)) )\n
\n\n
(undef 'sym) -> fun
\n
(undef 'sym 'cls) -> fun
\n
(undef '(sym . cls)) -> fun
\n
Undefines the function or method sym. Returns the previous\ndefinition. See also de, dm, def\nand redef.\n\n
\n: (de hello () \"Hello world!\")\n-> hello\n: hello\n-> (NIL \"Hello world!\")\n: (undef 'hello)\n-> (NIL \"Hello world!\")\n: hello\n-> NIL\n
\n\n
(unify 'any) -> lst
\n
(unify 'cnt) -> cnt
\n
The first form unifies any with the current Pilog environment at the current level and with a\nvalue of NIL, and returns the new environment or NIL\nif not successful. The second form unifies all variables at the given level with\nthe current one. See also prove and\n->.\n\n
\n: (? (^ @A (unify '(@B @C))))\n @A=(((NIL . @C) 0 . @C) ((NIL . @B) 0 . @B) T)\n
\n\n
(uniq 'lst) -> lst
\n
Returns a unique list, by eliminating all duplicate elements from\nlst. See also Comparing, sort and group.\n\n
\n: (uniq (2 4 6 1 2 3 4 5 6 1 3 5))\n-> (2 4 6 1 3 5)\n
\n\n
uniq/2
\n
Pilog predicate that succeeds if the second\nargument is not yet stored in the first argument's index structure. idx is used internally storing for the values\nand checking for uniqueness. See also member/2.\n\n
\n: (let U NIL\n   (? (lst @X (a b c b c d)) (uniq U @X)) )\n @X=a\n @X=b\n @X=c\n @X=d\n-> NIL\n: (solve '((^ @B (box)) (lst @X (a b c b c d)) (uniq @B @X)) @X)\n-> (a b c d)\n
\n\n
(unless 'any . prg) -> any
\n
Conditional execution: When the condition any evaluates to\nnon-NIL, NIL is returned. Otherwise prg\nis executed and the result returned. See also when, ifn, nor, nand and nond.\n\n
\n: (unless (= 3 3) (println 'Strange 'result))\n-> NIL\n: (unless (= 3 4) (println 'Strange 'result))\nStrange result\n-> result\n
\n\n
(until 'any . prg) -> any
\n
Conditional loop: While the condition any evaluates to\nNIL, prg is repeatedly executed. If prg\nis never executed, NIL is returned. Otherwise the result of\nprg is returned. See also while, for, loop and do.\n\n
\n: (until (=T (setq N (read)))\n   (println 'square (* N N)) )\n4\nsquare 16\n9\nsquare 81\nT\n-> 81\n
\n\n
(untrace 'sym) -> sym
\n
(untrace 'sym 'cls) -> sym
\n
(untrace '(sym . cls)) -> sym
\n
(Debug mode only) Removes the $ trace\nfunction call at the beginning of the function or method body of\nsym, so that no more trace information will be printed before and\nafter execution. Built-in functions (SUBRs) are automatically converted to their\noriginal form (see subr). See also\ntrace and traceAll.\n\n
\n: (trace '+)                           # Trace the '+' function\n-> +\n: +\n-> (@ ($ + @ (pass $385455126)))       # Modified for tracing\n: (untrace '+)                         # Untrace '+'\n-> +\n: +\n-> 67319120                            # Back to original form\n
\n\n
(up [cnt] sym ['val]) -> any
\n
Looks up (or modifies) the cnt'th previously saved value of\nsym in the corresponding enclosing environment. If cnt\nis not given, 1 is used. It is allowed to omit the sym argument,\nthen the corresponding expression (function or method call) is returned. See\nalso eval, run, trail and env.\n\n
\n: (let N 1 ((quote (N) (println N (up N))) 2))\n2 1\n-> 1\n: (let N 1 ((quote (N) (println N (up N) (up N 7))) 2) N)\n2 1 7\n-> 7\n\n: (de foo (N)\n   (println (up))\n   (inc N) )\n-> foo\n: (foo 7)\n(foo 7)\n-> 8\n
\n\n
(upd sym ..) -> lst
\n
Synchronizes the internal state of all passed (external) symbols by passing\nthem to wipe. upd is the\nstandard function passed to commit\nduring database transactions.\n\n
\n(commit 'upd)  # Commit changes, informing all sister processes\n
\n\n
(upp? 'any) -> sym | NIL
\n
Returns any when the argument is a string (symbol) that starts\nwith an uppercase character. See also uppc and low?\n\n
\n: (upp? \"A\")\n-> \"A\"\n: (upp? \"a\")\n-> NIL\n: (upp? 123)\n-> NIL\n: (upp? \".\")\n-> NIL\n
\n\n
(uppc 'any) -> any
\n
Upper case conversion: If any is not a symbol, it is returned\nas it is. Otherwise, a new transient symbol with all characters of\nany, converted to upper case, is returned. See also lowc, fold and upp?.\n\n
\n: (uppc 123)\n-> 123\n: (uppc \"abc\")\n-> \"ABC\"\n: (uppc 'car)\n-> \"CAR\"\n
\n\n
(use sym . prg) -> any
\n
(use (sym ..) . prg) -> any
\n
Defines local variables. The value of the symbol sym - or the\nvalues of the symbols sym in the list of the second form - are\nsaved, prg is executed, then the symbols are restored to their\noriginal values. During execution of prg, the values of the symbols\ncan be temporarily modified. The return value is the result of prg.\nSee also bind, job and let.\n\n
\n: (setq  X 123  Y 456)\n-> 456\n: (use (X Y) (setq  X 3  Y 4) (* X Y))\n-> 12\n: X\n-> 123\n: Y\n-> 456\n
\n\n
(useKey 'sym 'cls ['hook]) -> num
\n
Generates or reuses a key for a database tree, by randomly trying to locate\na free number. See also genKey.\n\n
\n: (maxKey (tree 'nr '+Item))\n-> 8\n: (useKey 'nr '+Item)\n-> 12\n
\n\n
(usec ['flg]) -> num
\n
Returns a number of microseconds. If flg is\nnon-NIL, the microsecond fraction of the last call to time is returned, otherwise the number of\nmicroseconds since interpreter startup. See also date.\n\n
\n: (usec)\n-> 1154702479219050\n: (list (date (date)) (time (time T)) (usec T))\n-> ((2013 1 4) (10 12 39) 483321)\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refV.html",
    "content": "\n\n\n\n\n\nV\n\n\n\n\n
V
\n\n
\n\n
(val 'var) -> any
\n
Returns the current value of var. See also setq, set and def.\n\n
\n: (setq L '(a b c))\n-> (a b c)\n: (val 'L)\n-> (a b c)\n: (val (cdr L))\n-> b\n
\n\n
val/3
\n
(Deprecated since version 25.5.30) Pilog predicate that returns the value of an\nobject's attribute. Typically used in database queries. The first\nargument is a Pilog variable to bind the value, the second is the\nobject, and the third and following arguments are used to apply the\nget algorithm to that object.\nSee also db/3 and select/3.\n\n
\n: (?\n   (db nr +Item (2 . 5) @Item)   # Fetch articles 2 through 5\n   (val @Nm @Item nm)            # Get item description\n   (val @Sup @Item sup nm) )     # and supplier's name\n @Item={B2} @Nm=\"Spare Part\" @Sup=\"Seven Oaks Ltd.\"\n @Item={B3} @Nm=\"Auxiliary Construction\" @Sup=\"Active Parts Inc.\"\n @Item={B4} @Nm=\"Enhancement Additive\" @Sup=\"Seven Oaks Ltd.\"\n @Item={B5} @Nm=\"Metal Fittings\" @Sup=\"Active Parts Inc.\"\n-> NIL\n
\n\n
(var sym . any) -> any
\n
(var (sym . cls) . any) -> any
\n
Defines a class variable sym with the initial value\nany for the current class, implicitly given by the value of the\nglobal variable *Class, or - in the\nsecond form - for the explicitly given class cls. See also OO Concepts, rel and var:.\n\n
\n: (class +A)\n-> +A\n: (var a . 1)\n-> 1\n: (var b . 2)\n-> 2\n: (show '+A)\n+A NIL\n   b 2\n   a 1\n-> +A\n
\n\n
(var: sym) -> any
\n
Fetches the value of a class variable sym for the current\nobject This, by searching the property\nlists of its class(es) and superclasses. See also OO\nConcepts, var, with, meta, :,\n=: and ::.\n\n
\n: (class +A)\n-> +A\n: (var a . 1)\n-> 1\n: (var b . 2)\n-> 2\n: (object 'O '(+A) 'a 9 'b 8)\n-> O\n: (with 'O (list (: a) (: b) (var: a) (var: b)))\n-> (9 8 1 2)\n
\n\n
(version ['flg]) -> lst
\n
(version 'lst) -> lst
\n
Prints the current version as a string of dot-separated numbers, and returns\nthe current version as a list of numbers. When flg is non-NIL,\nprinting is suppressed. The second form checks for the required version in\nlst and throws an error if the current version is too old. See also\n*CPU and *OS.\n\n
\n$ pil -version\n25.5.8\n\n: (version T)\n-> (25 5 8)\n: (version)\n25.5.8\n-> (25 5 8)\n\n: (version (25 5 9))\n!? (version (25 5 9))\n(25 5 8) -- Inadequate PicoLisp version\n?\n
\n\n
(vi 'sym) -> sym | NIL
\n
(vi 'sym 'cls) -> sym | NIL
\n
(vi 'lst) -> lst | NIL
\n
(v . lst) -> lst | NIL
\n
(v) -> NIL
\n
(Debug mode only) Opens the Vip editor on the function or method definition\nof sym (source file or direct path name), or on a list of symbols\nlst (in-memory). (v) resumes a Vip session suspended\nwith \"qz\". See also doc, *Dbg, debug and pp.\n\n
\n: (vi 'put> '+Entity)  # Edit the method's source code\n: (v {1})  # In-memory-edit the database root object\n-> put>\n
\n\n
(view 'lst ['T]) -> any
\n
Views lst as tree-structured ASCII graphics. When the\nT argument is given, lst should be a binary tree\nstructure (as generated by idx), which\nis then shown as a left-rotated tree. See also pretty and show.\n\n
\n: (balance 'I '(a b c d e f g h i j k l m n o))\n-> NIL\n: I\n-> (h (d (b (a) c) f (e) g) l (j (i) k) n (m) o)\n\n: (view I)\n+-- h\n|\n+---+-- d\n|   |\n|   +---+-- b\n|   |   |\n|   |   +---+-- a\n|   |   |\n|   |   +-- c\n|   |\n|   +-- f\n|   |\n|   +---+-- e\n|   |\n|   +-- g\n|\n+-- l\n|\n+---+-- j\n|   |\n|   +---+-- i\n|   |\n|   +-- k\n|\n+-- n\n|\n+---+-- m\n|\n+-- o\n-> NIL\n\n: (view I T)\n         o\n      n\n         m\n   l\n         k\n      j\n         i\nh\n         g\n      f\n         e\n   d\n         c\n      b\n         a\n-> NIL\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refW.html",
    "content": "\n\n\n\n\n\nW\n\n\n\n\n
W
\n\n
\n\n
*Winch
\n
Global variable holding a (possibly empty) prg body, which will\nbe executed when a SIGWINCH signal is sent to the current process. See also\nalarm, sigio, *Hup, *Sig[12], *TStp[12] and *Term.\n\n
\n: (de *Winch (msg 'SIGWINCH))\n-> *Winch\n
\n\n
(wait 'cnt|NIL . prg) -> any
\n
(wait 'cnt|NIL T 'fd) -> fd|NIL
\n
Waits for a condition. While the result of the execution of prg\nis NIL (first form), or no input is available for the file\ndescriptor in fd (second form), a poll(2) system call\nis executed for all file descriptors and timers in the VAL of the\nglobal variable *Run. When\ncnt is non-NIL, the waiting time is limited to\ncnt milliseconds. Returns the result of prg. See also\nkey and sync.\n\n
\n: (wait 2000)                                # Wait 2 seconds\n-> NIL\n: (prog\n   (zero *Cnt)\n   (setq *Run                                # Install background loop\n      '((-2000 0 (println (inc '*Cnt)))) )   # Increment '*Cnt' every 2 sec\n   (wait NIL (> *Cnt 6))                     # Wait until > 6\n   (off *Run) )\n1                                            # Waiting ..\n2\n3\n4\n5\n6\n7\n-> NIL\n
\n\n
(week 'dat) -> num
\n
Returns the number of the week for a given date dat. See also day, ultimo, datStr and strDat.\n\n
\n: (datStr (date))\n-> \"2007-06-01\"\n: (week (date))\n-> 22\n
\n\n
(when 'any . prg) -> any
\n
Conditional execution: When the condition any evaluates to\nnon-NIL, prg is executed and the result is returned.\nOtherwise NIL is returned. See also unless, if, and\nand cond.\n\n
\n: (when (> 4 3) (println 'OK) (println 'Good))\nOK\nGood\n-> Good\n
\n\n
(while 'any . prg) -> any
\n
Conditional loop: While the condition any evaluates to\nnon-NIL, prg is repeatedly executed. If\nprg is never executed, NIL is returned. Otherwise the\nresult of prg is returned. See also until, for, loop and do.\n\n
\n: (while (read)\n   (println 'got: @) )\nabc\ngot: abc\n1234\ngot: 1234\nNIL\n-> 1234\n
\n\n
(what 'sym) -> lst
\n
(Debug mode only) Returns a list of all internal symbols that match the\npattern string sym. See also match, who, has and can.\n\n
\n: (what \"cd@dr\")\n-> (cdaddr cdaadr cddr cddddr cdddr cddadr cdadr)\n
\n\n
(who 'any) -> lst
\n
(Debug mode only) Returns a list of all functions or method definitions that\ncontain the atom or pattern any. See also match, what, has and can.\n\n
\n: (who 'caddr)                         # Who is using 'caddr'?\n-> ($dat lint1 expDat datStr $tim tim$ mail _gen dat$ datSym)\n\n: (who \"Type error\")\n-> ((mis> . +Link) *Uni (mis> . +Joint))\n\n: (more (who \"Type error\") pp)         # Pretty print all results\n(dm (mis> . +Link) (Val Obj)\n   (and\n      Val\n      (nor (isa (: type) Val) (canQuery Val))\n      \"Type error\" ) )\n.                                      # Stop\n-> T\n
\n\n
(wipe 'sym|lst) -> sym|lst
\n
Clears the VAL and the property list of sym, or of\nall symbols in the list lst. When a symbol is an external symbol,\nits state is also set to \"not loaded\". Does nothing when sym is an\nexternal symbol that has been modified or deleted (\"dirty\").\n\n
\n: (setq A (1 2 3 4))\n-> (1 2 3 4)\n: (put 'A 'a 1)\n-> 1\n: (put 'A 'b 2)\n-> 2\n: (show 'A)\nA (1 2 3 4)\n   b 2\n   a 1\n-> A\n: (wipe 'A)\n-> A\n: (show 'A)\nA NIL\n-> A\n
\n\n
(with 'any . prg) -> any
\n
Saves the current object This and sets it to the new value\nany. Then prg is executed, and\nThis is restored to its previous value. The return value is\nthe result of prg. Used typically to access the local data\nof var in the same manner as inside a method body.\nprg is not executed (and NIL is returned) when\nvar is NIL. (with 'X . prg) is\nequivalent to (let? This 'X . prg). See also this.\n\n
\n: (put 'X 'a 1)\n-> 1\n: (put 'X 'b 2)\n-> 2\n: (with 'X (list (: a) (: b)))\n-> (1 2)\n
\n\n
(wr 'cnt ..) -> cnt
\n
Writes all cnt arguments as raw bytes to the current output\nchannel. See also rd and pr.\n\n
\n: (out \"x\" (wr 1 255 257))  # Write to \"x\"\n-> 257\n: (hd \"x\")\n00000000  01 FF 01                                         ...\n-> NIL\n
\n\n
(wrap 'cnt 'lst) -> sym
\n
(wrap 'cnt 'sym) -> lst
\n
The first form returns a transient symbol with all characters in\nlst packed in lines with\na maximal length of cnt. The second form converts a symbol to a\nlist of transient symbols each with a maximal length of cnt. See\nalso tab, align and center.\n\n
\n: (wrap 20 (chop \"The quick brown fox jumps over the lazy dog\"))\n-> \"The quick brown fox^Jjumps over the lazy^Jdog\"\n: (wrap 8 (chop \"The quick brown fox jumps over the lazy dog\"))\n-> \"The^Jquick^Jbrown^Jfox^Jjumps^Jover the^Jlazy dog\"\n: (wrap 8 \"The quick brown fox jumps over the lazy dog\")\n-> (\"The\" \"quick\" \"brown\" \"fox\" \"jumps\" \"over the\" \"lazy dog\")\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refX.html",
    "content": "\n\n\n\n\n\nX\n\n\n\n\n
X
\n\n
\n\n
(xchg 'var 'var ..) -> any
\n
Exchange the values of successive var argument pairs. See also\nswap and set.\n\n
\n: (setq  A 1  B 2  C '(a b c))\n-> (a b c)\n: (xchg  'A C  'B (cdr C))\n-> 2\n: A\n-> a\n: B\n-> b\n: C\n-> (1 2 c)\n
\n\n
(xor 'any 'any) -> flg
\n
Returns T if exactly one of the arguments evaluates to non-NIL.\n\n
\n: (xor T NIL)\n-> T\n: (xor T T)\n-> NIL\n
\n\n
(x| 'num ..) -> num
\n
Returns the bitwise XOR of all num arguments. When\none of the arguments evaluates to NIL, it is returned immediately.\nSee also &, | and bit?.\n\n
\n: (x| 2 7)\n-> 5\n: (x| 2 7 1)\n-> 4\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refY.html",
    "content": "\n\n\n\n\n\nY\n\n\n\n\n
Y
\n\n
\n\n
(yield 'any ['any2] [. prg]) -> any
\n
Transfers control from the current coroutine back to the caller (when the\nany2 tag is not given), or to some other coroutine\n(specified by any2) to continue execution at the point\nwhere that coroutine had called yield before. In the first\ncase, the value any will be returned from the corresponding\nco call, in the second case it\nwill be the return value of that yield call. If\nprg is given, it is executed in the destination environment\nbefore the coroutine resumes execution. See also stack, catch and throw.\n\n
\n: (co \"rt1\"                            # Start first routine\n   (msg (yield 1) \" in rt1 from rt2\")  # Return '1', wait for value from \"rt2\"\n   7 )                                 # Then return '7'\n-> 1\n\n: (co \"rt2\"                            # Start second routine\n   (yield 2 \"rt1\") )                   # Send '2' to \"rt1\"\n2 in rt1 from rt2\n-> 7\n\n: (co 'a (let N 0 (loop (yield (inc 'N)))))  # Incrementing coroutine\n-> 1\n: (co 'a T)                            # Next value\n-> 2\n: (yield NIL 'a (println N))           # Print value, then increment\n2\n-> 3\n: (yield NIL 'a (println N))\n3\n-> 4\n: (yield NIL 'a (yield N))             # Immediately yield back\n-> 4                                   # Can be used to inspect a value\n: (yield NIL 'a (yield N))             # in another coroutine\n-> 4\n: (co 'a T)                            # Next value\n-> 5\n: (yield NIL 'a (yield (env)))         # Return the whole environment\n
\n\n
(yoke 'any ..) -> any
\n
Inserts one or several new elements any in front of the list in\nthe current make environment.\nyoke returns the last inserted argument. See also link, chain and made.\n\n
\n: (make (link 2 3) (yoke 1) (link 4))\n-> (1 2 3 4)\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/refZ.html",
    "content": "\n\n\n\n\n\nZ\n\n\n\n\n
Z
\n\n
\n\n
*Zap
\n
A global variable holding a list and a pathname. If given, and the value of\n*Solo is NIL, external\nsymbols which are no longer accessible can be collected in the CAR, e.g. during\nDB tree processing, and written to the file in the CDR at the next commit. A (typically periodic) call to\nzap_ will clean them up later.\n\n
\n: (setq *Zap '(NIL . \"db/app/_zap\"))\n-> (NIL . \"db/app/_zap\")\n
\n\n
(zap 'sym) -> sym
\n
\"Delete\" the symbol sym. For internal symbols, that means to\nremove it from the current namespace, effectively transforming it to a transient\nsymbol. For external symbols, it means to mark it as \"deleted\", so that upon a\nlater commit it will be removed from\nthe database file. See also intern.\n\n
\n: (de foo (Lst) (car Lst))          # 'foo' calls 'car'\n-> foo\n: (zap 'car)                        # Delete the symbol 'car'\n-> \"car\"\n: (pp 'foo)\n(de foo (Lst)\n   (\"car\" Lst) )                    # 'car' is now a transient symbol\n-> foo\n: (foo (1 2 3))                     # 'foo' still works\n-> 1\n: (car (1 2 3))                     # Reader returns a new 'car' symbol\n!? (car (1 2 3))\ncar -- Undefined\n?\n
\n\n
(zapTree 'sym)
\n
Recursively deletes a tree structure from the database. See also tree, chkTree and prune.\n\n
\n: (zapTree (cdr (root (tree 'nm '+Item))))\n
\n\n
(zap_)
\n
Delayed deletion (with zap) of\nexternal symbols which were collected e.g. during DB tree processing. An\nauxiliary file (with the name taken from the CDR of the value of *Zap, concatenated with a \"_\"\ncharacter) is used as an intermediary file.\n\n
\n: *Zap\n-> (NIL . \"db/app/Z\")\n: (call 'ls \"-l\" \"db/app\")\n...\n-rw-r--r-- 1 abu abu     1536 2007-06-23 12:34 Z\n-rw-r--r-- 1 abu abu     1280 2007-05-23 12:15 Z_\n...\n: (zap_)\n...\n: (call 'ls \"-l\" \"db/app\")\n...\n-rw-r--r-- 1 abu abu     1536 2007-06-23 12:34 Z_\n...\n
\n\n
(zero var ..) -> 0
\n
Stores 0 in all var arguments. See also one, on,\noff and onOff.\n\n
\n: (zero A B)\n-> 0\n: A\n-> 0\n: B\n-> 0\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/ref_.html",
    "content": "\n\n\n\n\n\nOther\n\n\n\n\n
Other
\n\n
\n\n
(! . exe) -> any
\n
Low level breakpoint function: The current execution environment is saved\nand the I/O channels are redirected to the console. Then exe is\ndisplayed, and a read-eval-print-loop is entered (with ! as its\nprompt character), to evaluate expressions and examine the current program\nenvironment. An empty input line terminates the read-eval-print-loop, the\nenvironment and I/O channels are restored, and the result of exe is\nreturned. ! is normally inserted into existing programs with the\ndebug function. See also !!, e,\n^ and *Dbg.\n\n
\n: (de foo (N) (and (println 1) (! println N) (println 2)))\n-> foo\n: (foo 7)\n1                 # Executed '(println 1)'\n(println N)       # Entered breakpoint\n! N               # Examine the value of 'N'\n-> 7\n! (e)             # Evaluate '^', i.e. (println N)\n7\n-> 7\n! (e @)           # Evaluate '@' -> the result of '(println 1)'\n-> 1\n!                 # Empty line: continue\n7                 # Executed '(println N)'\n2                 # Executed '(println 2)'\n-> 2\n
\n\n
(!! 'any . exe) -> any
\n
Conditional low level breakpoint function. Behaves as !, but stops only if any evaluates to\nnon-NIL.\n\n
\n: (for N 7 (!! (= 4 N) println N))\n1\n2\n3\n(println N)\n! N\n-> 4\n!\n4\n5\n6\n7\n-> 7\n
\n\n
($ sym|lst lst . prg) -> any
\n
Low level trace function: The first argument sym|lst is printed\nto the console with a proper indentation, followed by a colon :. If\na function is traced, the first argument is the function symbol, else if a\nmethod is traced, it is a cons pair of message and class. The second argument\nlst should be a list of symbols, identical to the function's\nargument list. The current values of these symbols are printed, followed by a\nnewline. Then prg is executed, and its return value printed in a\nsimilar way (this time with an equals sign = instead of a colon)\nand returned. $ is normally inserted into existing programs with\nthe trace function.\n\n
\n: (de foo (A B) ($ foo (A B) (* A B)))\n-> foo\n: (foo 3 4)\n foo : 3 4        # Function entry, arguments 3 and 4\n foo = 12         # Function exit, return value 12\n-> 12\n
\n\n
($dat 'sym1 ['sym2]) -> dat
\n
Converts a string sym1 in ISO format to a date, optionally using a delimiter character\nsym2. See also dat$,\n$tim, strDat and expDat.\n\n
\n: ($dat \"20070601\")\n-> 733134\n: ($dat \"2007-06-01\" \"-\")\n-> 733134\n
\n\n
($tim 'sym) -> tim
\n
Converts a string to a time. The\nminutes and seconds are optional and default to zero. See also tim$ and $dat.\n\n
\n: (time ($tim \"10:57:56\"))\n-> (10 57 56)\n: (time ($tim \"10:57\"))\n-> (10 57 0)\n: (time ($tim \"10\"))\n-> (10 0 0)\n
\n\n
(% 'num ..) -> num
\n
Returns the remainder from the divisions of successive num\narguments. The sign of the result is that of the first argument. When one of the\narguments evaluates to NIL, it is returned immediately. See also\n/ and */ .\n\n
\n: (% 17 5)\n-> 2\n: (% -17 5)  # Sign is that of the first argument\n-> -2\n: (% 5 2)\n-> 1\n: (% 15 10)\n-> 5\n: (% 15 10 2)  # (% 15 10) -> 5, then (% 5 2) -> 1\n-> 1\n
\n\n
(%@ 'cnt|sym 'any 'any ..) -> any
\n
Convenience function for a common use case of native. (%@ \"fun\" ...) is\nequivalent to (native \"@\" \"fun\" ...).\n\n
\n: (%@ \"getenv\" 'S \"TERM\")  # Same as (sys \"TERM\")\n-> \"xterm\"\n: (%@ \"symlink\" 'I \"file\" \"link\")\n-> 0\n: (%@ \"isatty\" 'I 0)\n-> 1\n: (round (%@ \"cos\" 1.0  3.1415926535897932))\n-> \"1.000\"\n: (use Tim\n   (%@ \"time\" NIL '(Tim (8 B . 8)))  # time_t 8   # Get time_t structure\n   (%@ \"localtime\" '(I . 9) (cons NIL (8) Tim)) ) # Read local time\n-> (43 19 14 6 10 120 5 310 0)  # 14:19:43, Nov 6th, 2020\n
\n\n
(& 'num ..) -> num
\n
Returns the bitwise AND of all num arguments. When\none of the arguments evaluates to NIL, it is returned immediately.\nSee also |, x| and bit?.\n\n
\n: (& 6 3)\n-> 2\n: (& 7 3 1)\n-> 1\n
\n\n
(* 'num ..) -> num
\n
Returns the product of all num arguments. When one of the\narguments evaluates to NIL, it is returned immediately. See also\n/, */, + and\n-.\n\n
\n: (* 1 2 3)\n-> 6\n: (* 5 3 2 2)\n-> 60\n
\n\n
(** 'num1 'num2) -> num
\n
Integer exponentiation: Returns num1 to the power of\nnum2.\n\n
\n: (** 2 3)\n-> 8\n: (** 100 100)\n-> 10000000000000000000000000000000000000000000000000000000000000000000000000000\n00000000000000000000000000000000000000000000000000000000000000000000000000000000\n00000000000000000000000000000000000000000000\n
\n\n
(*/ 'num1 ['num2 ..] 'num3) -> num
\n
Returns the product of num1 and all following num2\narguments, divided by the num3 argument. The result is rounded to\nthe nearest integer value. When one of the arguments evaluates to\nNIL, it is returned immediately. Note that */ is\nespecially useful for fixed point arithmetic, by multiplying with (or dividing\nby) the scale factor. See also *,\n/, +, - and\nsqrt.\n\n
\n: (*/ 3 4 2)\n-> 6\n: (*/ 1234 2 10)\n-> 247\n: (*/ 100 6)\n-> 17\n\n: (scl 2)\n-> 2  # 0.02\n: (format (*/ 3.0 1.5 1.0) *Scl)\n-> \"4.50\"\n\n: (scl 20)\n-> 20  # 0.00000000000000000020\n: (format (*/ 9.9 9.789 9.56789 `(sq 1.0)) *Scl)\n-> \"927.23474457900000000000\"\n\n
\n\n
(+ 'num ..) -> num
\n
Returns the sum of all num arguments. When one of the arguments\nevaluates to NIL, it is returned immediately. See also inc, -,\n*, / and */.\n\n
\n: (+ 1 2 3)\n-> 6\n
\n\n
(++ var) -> any
\n
Pops the first element (CAR) from the stack in var. (++\nLst) is equivalent to (pop 'Lst). See also pop.\n\n
\n
\n\n
(- 'num ..) -> num
\n
Returns the difference of the first num argument and all\nfollowing arguments. If only a single argument is given, it is negated. When one\nof the arguments evaluates to NIL, it is returned immediately. See\nalso dec, +, *,\n/ and */.\n\n
\n: (- 7)\n-> -7\n: (- 7 2 1)\n-> 4\n
\n\n
(-> any [cnt]) -> any
\n
Searches for the value of any (typically a Pilog variable, or an expression of variables) at top\nlevel (or level cnt) in the current environment. See also prove and unify.\n\n
\n: (? (append (1 2 3) (4 5 6) @X) (^ @ (println 'X '= (-> @X))))\nX = (1 2 3 4 5 6)\n @X=(1 2 3 4 5 6)\n-> NIL\n
\n\n
(/ 'num ..) -> num
\n
Returns the first num argument successively divided by all\nfollowing arguments. When one of the arguments evaluates to NIL, it\nis returned immediately. See also *,\n*/, %, + and\n-.\n\n
\n: (/ 12 3)\n-> 4\n: (/ 60 -3 2 2)\n-> -5\n
\n\n
(: sym|0 [sym1|cnt ..]) -> any
\n
Fetches a value any from the properties (or value) of a symbol,\nor from a list, by applying the get\nalgorithm to This and the following arguments. Used typically in\nmethods or with bodies. (:\n..) is equivalent to (; This ..). See also ;, =: and\n::.\n\n
\n: (put 'X 'a 1)\n-> 1\n: (with 'X (: a))\n-> 1\n
\n\n
(:: sym [sym1|cnt .. sym2]) -> var
\n
Fetches a property for a property key sym or sym2\nfrom a symbol. That symbol is This (if no other arguments are\ngiven), or a symbol found by applying the get algorithm to This and the\nfollowing arguments. The property (the cons pair, not just its value) is\nreturned, suitable for direct (destructive) manipulations with functions\nexpecting a var argument. Used typically in methods or with bodies. See also =:, prop and :.\n\n
\n: (with 'X (=: cnt 0) (inc (:: cnt)) (: cnt))\n-> 1\n
\n\n
(; 'sym1|lst [sym2|cnt ..]) -> any
\n
Fetches a value any from the properties of a symbol, or from a\nlist, by applying the get algorithm to\nsym1|lst and the following arguments. See also :, =: and\n::.\n\n
\n: (put 'A 'a 1)\n-> 1\n: (put 'A 'b 'B)\n-> B\n: (put 'B 'c 7)\n-> 7\n: (; 'A a)\n-> 1\n: (; 'A b c)\n-> 7\n
\n\n
(< 'any ..) -> flg
\n
Returns T when all arguments any are in strictly\nincreasing order. See also Comparing.\n\n
\n: (< 3 4)\n-> T\n: (< 'a 'b 'c)\n-> T\n: (< 999 'a)\n-> T\n
\n\n
(<= 'any ..) -> flg
\n
Returns T when all arguments any are in strictly\nnon-decreasing order. See also Comparing.\n\n
\n: (<= 3 3)\n-> T\n: (<= 1 2 3)\n-> T\n: (<= \"abc\" \"abc\" \"def\")\n-> T\n
\n\n
(<> 'any ..) -> flg
\n
Returns T when not all any arguments are equal\n(structure equality). (<> 'any ..) is equivalent to\n(not (= 'any ..)). See also Comparing.\n\n
\n: (<> 'a 'b)\n-> T\n: (<> 'a 'b 'b)\n-> T\n: (<> 'a 'a 'a)\n-> NIL\n
\n\n
(= 'any ..) -> flg
\n
Returns T when all any arguments are equal\n(structure equality). See also Comparing.\n\n
\n: (= 6 (* 1 2 3))\n-> T\n: (= \"a\" \"a\")\n-> T\n: (== \"a\" \"a\")\n-> T\n: (= (1 (2) 3) (1 (2) 3))\n-> T\n
\n\n
(=0 'any) -> 0 | NIL
\n
Returns 0 when any is a number with value zero.\nSee also n0, lt0, le0, ge0, gt0 and =1.\n\n
\n: (=0 (- 6 3 2 1))\n-> 0\n: (=0 'a)\n-> NIL\n
\n\n
(=1 'any) -> 1 | NIL
\n
Returns 1 when any is a number with value one.\nSee also =0.\n\n
\n: (=1 (- 6 3 2))\n-> 1\n: (=1 'a)\n-> NIL\n
\n\n
(=: sym|0 [sym1|cnt ..] 'any) -> any
\n
Stores a new value any for a property key (or in the symbol\nvalue for zero) in a symbol, or in a list. That symbol is This (if\nno other arguments are given), or a symbol found by applying the get algorithm to This and the\nfollowing arguments. If the final destination is a list, the value is stored in\nthe CDR of an asoqed element (if the\nkey argument is a symbol), or the n'th element (if the key is a number). Used\ntypically in methods or with bodies.\nSee also put, : and ::.\n\n
\n: (with 'X (=: a 1) (=: b 2))\n-> 2\n: (get 'X 'a)\n-> 1\n: (get 'X 'b)\n-> 2\n
\n\n
(== 'any ..) -> flg
\n
Returns T when all any arguments are the same\n(pointer equality). See also n== and Comparing.\n\n
\n: (== 'a 'a)\n-> T\n: (== 'NIL NIL (val NIL) (car NIL) (cdr NIL))\n-> T\n: (== (1 2 3) (1 2 3))\n-> NIL\n
\n\n
(====) -> NIL
\n
Close the current transient scope by clearing the transient index. All\ntransient symbols become hidden and inaccessible by the reader.\nSee also extern and intern.\n\n
\n: (setq S \"abc\")           # Read \"abc\"\n-> \"abc\"\n: (== S \"abc\")             # Read again, get the same symbol\n-> T\n: (====)                   # Close scope\n-> NIL\n: (== S \"abc\")             # Read again, get another symbol\n-> NIL\n
\n\n
(=T 'any) -> flg
\n
Returns T when any is the symbol T.\n(=T X) is equivalent to (== T X). See also nT.\n\n
\n: (=T 0)\n-> NIL\n: (=T \"T\")\n-> NIL\n: (=T T)\n-> T\n
\n\n
(> 'any ..) -> flg
\n
Returns T when all arguments any are in strictly\ndecreasing order. See also Comparing.\n\n
\n: (> 4 3)\n-> T\n: (> 'A 999)\n-> T\n
\n\n
(>= 'any ..) -> flg
\n
Returns T when all arguments any are in strictly\nnon-increasing order. See also Comparing.\n\n
\n: (>= 'A 999)\n-> T\n: (>= 3 2 2 1)\n-> T\n
\n\n
(>> 'cnt 'num) -> num
\n
Shifts right the num argument by cnt\nbit-positions. If cnt is negative, a corresponding left shift is\nperformed. See also rev.\n\n
\n: (>> 1 8)\n-> 4\n: (>> 3 16)\n-> 2\n: (>> -3 16)\n-> 128\n: (>> -1 -16)\n-> -32\n
\n\n
(? [sym ..] [pat 'any ..] . lst) -> flg
\n
Top-level function for interactive Pilog\nqueries. ? is a non-evaluating front-end to the query function. It displays each result, waits\nfor console input, and terminates when ESC is pressed. If a preceding list of\n(non-pattern-) symbols is given, they will be taken as rules to be traced by\nprove. The list of variable/value\npairs is passed to goal for an initial\nPilog environment. See also pilog and\nsolve.\n\n
\n: (? (append (a b c) (d e f) @X))\n @X=(a b c d e f)\n-> NIL\n\n: (? (append @X @Y (a b c)))\n @X=NIL @Y=(a b c)\n @X=(a) @Y=(b c)\n @X=(a b) @Y=(c)\n @X=(a b c) @Y=NIL\n-> NIL\n\n: (? (append @X @Y (a b c)))\n @X=NIL @Y=(a b c)                     # ESC was pressed\n-> NIL\n\n: (? append (append @X @Y (a b c)))    # Trace 'append'\n1 (append NIL (a b c) (a b c))\n @X=NIL @Y=(a b c)\n2 (append (a . @X) @Y (a b c))\n1 (append NIL (b c) (b c))\n @X=(a) @Y=(b c).                      # Stopped\n-> NIL\n
\n\n
@
\n
Holds the result of the last top level expression in the current\nread-eval-print loop, or the result of the conditional expression during the\nevaluation of flow functions (see @\nResult). When @ is used as a formal parameter in lambda expressions, it denotes a variable number of\nevaluated arguments.\n
\n\n
@@
\n
Holds the result of the second last top level expression in the current\nread-eval-print loop (see @ Result).\nSome functions store a secondary return value in @@.\n
\n\n
@@@
\n
Holds the result of the third last top level expression in the current\nread-eval-print loop (see @ Result).\n
\n\n
^
\n
Holds the currently executed expression during a breakpoint or an error. See\nalso debug, !, e and\n*Dbg.\n\n
\n: (* (+ 3 4) (/ 7 0))\n!? (/ 7 0)\nDiv/0\n? ^\n-> (/ 7 0)\n
\n\n
(| 'num ..) -> num
\n
Returns the bitwise OR of all num arguments. When\none of the arguments evaluates to NIL, it is returned immediately.\nSee also x|, & and bit?.\n\n
\n: (| 1 2)\n-> 3\n: (| 1 2 4 8)\n-> 15\n
\n\n
\n\n\n\n"
  },
  {
    "path": "doc/search",
    "content": "Search criteria\n   Numbers\n      3\n      (3 . 4)\n   Strings\n      \"abc\"\n      (\"a\" . \"z\")\n   Objects\n      {2}\n   Symbols\n      abc\n      (a . z)\n\nRelation types\n   Number, Date, Time\n      (+Key +Number)\n         7 {2}\n\n      (+Ref +Number)\n         (7 . {2}) {2}\n\n   Keywords\n      (+Key +String)\n         \"Regen Axer\" {2}\n\n      (+Ref +String)\n         (\"Regen Axer\" . {2}) {2}\n\n   Phone numbers\n      (+Fold +Ref +String)\n         (\"regenaxer\" . {2}) {2}\n\n   E-Mail addresses\n      (+Fold +Idx +String)\n         (\"axer\" {2}) {2}\n         (\"egenaxer\" {2}) {2}\n         (\"enaxer\" {2}) {2}\n         (\"genaxer\" {2}) {2}\n         (\"naxer\" {2}) {2}\n         (\"regenaxer\" . {2}) {2}\n         (\"xer\" {2}) {2}\n\n   Personal names\n      (+Sn +IdxFold +String)\n         (\"RSNSR\" {2} . T) {2}\n         (\"Regen Axer\" . {2}) {2}\n         (\"axer\" {2}) {2}\n         (\"egen\" {2}) {2}\n         (\"gen\" {2}) {2}\n         (\"regenaxer\" {2}) {2}\n         (\"xer\" {2}) {2}\n\n   Item names\n      (+IdxFold +String)\n         (\"Regen Axer\" . {2}) {2}\n         (\"axer\" {2}) {2}\n         (\"egen\" {2}) {2}\n         (\"gen\" {2}) {2}\n         (\"regenaxer\" {2}) {2}\n         (\"xer\" {2}) {2}\n\n      (+List +Fold +Ref +String)\n         (\"axer\" . {2}) {2}\n         (\"regen\" . {2}) {2}\n\n   Identifiers\n      (+Idx +String)\n         (\"Axer\" {2}) {2}\n         (\"Regen Axer\" . {2}) {2}\n         (\"egen\" {2}) {2}\n         (\"gen\" {2}) {2}\n         (\"xer\" {2}) {2}\n\n   GIS coordinates\n      (+UB +Aux +Ref +Number)\n         (56919522950766600 . {2}) {2}\n\n   Objects\n      (+Ref +Link)\n         ({7} . {2}) {2}\n"
  },
  {
    "path": "doc/search.html",
    "content": "\n\n\n\n\n\nThe 'search' Function\n\n\n\nabu@software-lab.de\n\n
The 'search' Function
\n\n
(c) Software Lab. Alexander Burger\n\n
The search function allows to search the database for a combination of search criteria.\n\n
It finds all objects - directly from the criteria or after traversing all\nassociations - which fulfill all given search criteria, and returns them\none at a time.\n\n
\n\n\n
\n
Examples
\n\n
The examples in this document will use the demo application in \"app/*.l\" (in\ndemoApp.tgz).\n\n
To get an interactive prompt, start it as:\n\n
\n$ pil app/main.l -main +\n:\n
\n\n
As ever, you can terminate the interpreter by hitting Ctrl-D.\n\n\n
\n
Syntax
\n\n
search is called in two different forms.\n\n
The first form initializes a query. It takes two or more arguments, and\nreturns a query structure (a list).\n\n
The second form can then be called repeatedly with that structure, and will\nsubsequently return the next resulting object, or NIL if no more\nresults can be found.\n\n
To start a new query, search is called with an arbitrary number\nof argument pairs, each consisting of a search criterion and a list of relation\nspecifications, and an optional extraction function which filters and possibly\nmodifies the results.\n\n
For example, to find the item with the number 2:\n\n
\nap: (search 2 '((nr +Item)))\n-> (NIL ...\n
\n\n
The first argument 2 is a search criterion (the key to\nlook for), and ((nr +Item)) is a list with a single relation\nspecification (the nr index of the +Item class).\n\n
The returned query structure is abbreviated here, because it is big and not\nrelevant. It can now be used to fetch the result:\n\n
\nap: (search @)\n-> {B2}\nap: (show @)\n{B2} (+Item)\n   nr 2\n   pr 1250\n   inv 100\n   sup {C2}\n   nm \"Spare Part\"\n-> {B2}\n
\n\n
There are no further results, because nr is a unique key:\n\n
\nap: (search @@@)  # '@@@' refers to the third-last REPL result, the query\n-> NIL\n
\n\n\n
Search Criteria
\n\n
Each criterion is an attribute of a database object (like name, e-mail,\naddress etc.), or some given database object. It may be used to find objects\ndirectly, or as a starting point for a recursive search for other objects\nreachable by this object.\n\n
For every search criterion which is NIL, no search is performed,\nand the following relation specification is ignored. If, however, all\nsearch criteria are NIL, a full search over the last relation\nspecification is forced.\n\n\n
Numbers
\n\n
If the search criterion is numeric (including derived types like date or\ntime), it can be atomic for an exact search, or a cons pair for searching a\nrange of numbers.\n\n
Extending the above example, we may search for all items with a number\nbetween 2 and (including) 6:\n\n
\nap: (search (2 . 6) '((nr +Item)))\n-> (NIL ...\n
\n\n
We may use a for loop to retrieve all results:\n\n
\nap: (for\n   (Q\n      (search (2 . 6) '((nr +Item)))\n      (search Q) )\n   (printsp @) )\n{B2} {B3} {B4} {B5} {B6}\n
\n\n\n
Strings
\n\n
If the search criterion is a string (transient symbol) or an internal symbol,\nor a cons pair of those, the exact behavior depends on the relation type. It\nincludes all cases where it matches the heads of the result attributes (string\nprefixes), but may also match substrings and/or tolerant (folded or soundex-encoded) searches.\n\n
\nap: (for\n   (Q\n      (search \"Api\" '((em +CuSu)))\n      (search Q) )\n   (println (; @ em)) )\n\"info@api.tld\"\n
\n\n
\nap: (for\n   (Q\n      (search \"part\" '((nm +Item)))\n      (search Q) )\n   (with @\n      (println (: nr) (: nm)) ) )\n1 \"Main Part\"\n2 \"Spare Part\"\n
\n\n
Or, combined with a number range search:\n\n
\nap: (for\n   (Q\n      (search\n         (2 . 6) '((nr +Item))\n         \"part\" '((nm +Item)) )\n      (search Q) )\n   (with @\n      (println (: nr) (: nm)) ) )\n2 \"Spare Part\"\n
\n\n\n
Objects
\n\n
A database object can also be used as a search criterion. A cons pair (i.e. a\nrange) of objects makes no sense, because objects by themselves are not ordered.\n\n
Searching for all items from a given supplier:\n\n
\nap: (for\n   (Q\n      (search '{C1} '((sup +Item)))\n      (search Q) )\n   (printsp @) )\n{B1} {B3} {B5}\n
\n\n
or for all positions in a given order:\n\n
\nap: (for\n   (Q\n      (search '{B7} '((ord . pos)))\n      (search Q) )\n   (printsp @) )\n{A1} {A2} {A4} {A3} ...\n
\n\n\n
Relation Specifications
\n\n
Every second argument to search is a list of relation\nspecifications. In typical use cases, a relation specification is either\n\n
    \n
  • a list (var cls [hook]) for an index relation, or\n
  •  a cons pair (sym . sym) for a +Joint relation\n
\n\n
For general cases, the first specification in the list may be replaced\nby two custom functions: A generator function and a filter function. This allows\nto start the search from arbitrary resources like remote databases or\ncoroutines.\n\n
If a specification is (var cls) but var is not an\nindex of cls, a brute force search through the objects in the\ndatabase file of cls will be performed. This should only be done\nfor small files with ideally all objects of type cls.\n\n
The rest of the list contains associations (which are also relation\nspecifications) to recursively search through associated objects. They are\ntypically (+Joint), (+List +Joint),\nor (+Ref +Link) relations.\n\n
Look for example at the choOrd (\"choose Order\") function in the\ndemo application. You can access it directly in the REPL with (vi\n'choOrd). The search call is\n\n
\n(search\n   *OrdCus '((nm +CuSu) (cus +Ord))\n   *OrdOrt '((ort +CuSu) (cus +Ord))\n   *OrdItem '((nm +Item) (itm +Pos) (pos . ord))\n   *OrdSup '((nm +CuSu) (sup +Item) (itm +Pos) (pos . ord))\n   (and *OrdNr (cons @)) '((nr +Ord))\n   (and *OrdDat (cons @)) '((dat +Ord)) )\n
\n\n
The global variables *OrdCus through *OrdDat hold\nthe search criteria from the search fields in the dialog GUI.\n\n
The line with the longest chain of associations is:\n\n
\n   *OrdSup '((nm +CuSu) (sup +Item) (itm +Pos) (pos . ord))\n
\n\n
This means:\n\n
    \n
  1. Search suppliers by name\n
  2. For each matching supplier, go through his items\n
  3. For each item, find order positions where it is referred\n
  4. For each position, return the order where it is in\n
\n\n
Testing this line stand-alone, searching orders only by supplier name:\n\n
\nap: (for\n   (Q\n      (search\n         \"Seven Oaks\"\n         (quote\n            (nm +CuSu)\n            (sup +Item)\n            (itm +Pos)\n            (pos . ord) ) )\n      (search Q) )\n   (printsp @) )\n{B7}\n
\n\n
Custom Generators and Filters
\n\n
If the list of relation specifications does not start with an index relation\n(var cls) or a joint relation (sym . sym), but instead\nwith a function like ((X) (foo)), the first two elements of\nthe list are taken as generator and filter functions, respectively.\n\n
We could rewrite the last example in a slightly simplified form, but with\ncustom functions:\n\n
\nap: (for\n   (Q\n      (search\n         \"Seven Oaks\"\n         (quote\n            ((X)  # Generator function\n               (iter> (meta '(+CuSu) 'nm)\n                  \"Seven Oaks\"\n                  '(nm +CuSu) ) )\n            ((This X)  # Filter function\n               (pre? \"Seven Oaks\" (: nm)) )\n            (sup +Item)\n            (itm +Pos)\n            (pos . ord) ) )\n      (search Q) )\n   (printsp @) )\n{B7}\n
\n\n
The iter> method implements the mechanisms to produce the\ninternal query structures for individual relations. There is a convenience\nfunction relQ for this. It can be used to simplify such standard\ngenerators. Instead of:\n\n
\n   ((X)  # Generator function\n      (iter> (meta '(+CuSu) 'nm)\n         \"Seven Oaks\"\n         '(nm +CuSu) ) )\n
\n\n
we can write:\n\n
\n   ((X)  # Generator function\n      (relQ \"Seven Oaks\" '(nm +CuSu)) )\n
\n\n\n
Multiple Indexes
\n\n
While relQ is normally not used directly by application\nprograms, because its functionality is provided by the standard relation\nspecification syntax, there is a function relQs which is indeed\nuseful.\n\n
relQs produces proper generator and filter functions which can\nsearch multiple indexes for a singe search criterion.\n\n
The general syntax is:\n\n
\n   (relQs '((var1 +Cls1) (var2 +Cls2) ..) (sym1 ..) (sym2 ..)..)\n
\n\n
to search first the index (var1 +Cls1), then (var2\n+Cls2) etc., and then follow the optional associations (sym1\n..), (sym2 ..) etc.\n\n
A typical use case is searching for a telephone number in both the landline\nand mobile attributes. You find an example in the choCuSu (\"choose\nCustomer/Supplier\") function in the demo application, in the line:\n\n
\n   *CuSuTel (relQs '((tel +CuSu) (mob +CuSu)))\n
\n\n
Note that (relQs ..) must not be quoted, because it needs\nto be evaluate to produce the right functions and query structure.\n\n\n
Extraction Function
\n\n
Sometimes it is necessary to to do further checks on a search result, which\nmay not be covered by the standard matching of combined search criteria.\n\n
An example can be found in the tut.tgz tutorial in the file\n\"db/family.l\", in the contemporaries report. It searches for people\nliving roughly at the same time as the given person:\n\n
\n   '(let @Fin\n      (or\n         (: home obj fin)\n         (+ (: home obj dat) 36525) )\n      (search\n         (cons (- (: home obj dat) 36525) @Fin) '((dat +Person))\n         (curry (@Fin) (Obj)\n            (and\n               (n== Obj (: home obj))\n               (>= (; Obj fin) (: home obj dat))\n               (>= @Fin (; Obj dat))\n               Obj ) ) ) )\n
\n\n
@Fin is set to either the date when the given person died, or to\nthe birth date plus ten years if not known. Then all persons born in the range\nof ten years before the given person and @Fin are searched.\n\n
curry builds the filter function, taking an\nobject and doing range checks to see if that person died after the given person\nwas born, and that he or she was born before @Fin.\n\n
If those conditions are not met, the function returns NIL, and\nsearch continues to search for the next result.\n\n
The extraction function may also - instead of returning the object or\nNIL, return some other value as appropriate for the application.\n\n\n
Sorting
\n\n
In general, the values returned by search are not sorted when\nmultiple search criteria are given. This is because the indexes are iterated\nover in an unpredictable order.\n\n
If, however, only a single search criterion is given, or only one of the\nsearch criteria is non-NIL, then the results will be returned in\nsorted order according to the given index.\n\n
If all search criteria are NIL, and thus the last\nrelation specification is used (see above under Search\nCriteria), then the results will turn up in increasing order.\n\n\n\n"
  },
  {
    "path": "doc/select.html",
    "content": "\n\n\n\n\n\nThe 'select' Predicate\n\n\n\nabu@software-lab.de\n\n
The 'select' Predicate
\n\n
(c) Software Lab. Alexander Burger\n\n
Note: 'select' and related database Pilog predicates are deprecated since\nversion 25.5.30, and moved to a separate \"@lib/select.l\" file! New applications\nshould use search instead (see search.html).\n\n
The Pilog select/3 predicate is rather complex, and quite\ndifferent from other predicates. This document tries to explain it in detail,\nand shows some typical use cases.\n\n
\n\n\n
\n
Syntax
\n\n
select takes at least three arguments:\n\n
    \n
  • A list of unification variables,\n
  • a list of generator clauses\n
  • and an arbitrary number of filter clauses\n
\n\n
We will describe these arguments in the following, but demonstrate them first\non a concrete example.\n\n\n
\n
First Example
\n\n
The examples in this document will use the demo application in \"app/*.l\" (in\ndemoApp.tgz). To get an\ninteractive prompt, start it as\n\n
\n$ pil app/main.l -ap~main +\n:\n
\n\n
As ever, you can terminate the interpreter by hitting Ctrl-D.\n\n
For a first, typical example, let's write a complete call to solve that returns a list of articles with numbers\nbetween 1 and 4, which contain \"Part\" in their description, and have a price\nless than 100:\n\n
\n(let (Nr (1 . 4)  Nm \"Part\"  Pr '(NIL . 100.00))\n   (solve\n      (quote\n         @Nr Nr\n         @Nm Nm\n         @Pr Pr\n         (select (@Item)\n            ((nr +Item @Nr) (nm +Item @Nm) (pr +Item @Pr))\n               (range @Nr @Item nr)\n               (part @Nm @Item nm)\n               (range @Pr @Item pr) ) )\n      @Item ) )\n
\n\n
This expression will return, with the default database setup of \"app/init.l\",\na list of exactly one item ({B2}), the item with the number 2.\n\n
The let statement assigns values to\nthe search parameters for number Nr, description Nm\nand price Pr. The Pilog query (the first argument to\nsolve) passes these values to the Pilog variables @Nr,\n@Nm and @Pr. Ranges of values are always specified by\ncons pairs, so (1 . 4) includes the numbers 1 through 4, while\n(NIL . 100.00) includes prices from minus infinite up to one\nhundred.\n\n
The list of unification variables is\n\n
\n   (@Item)\n
\n\n
The list of generator clauses is\n\n
\n      ((nr +Item @Nr) (nm +Item @Nm) (pr +Item @Pr))\n
\n\n
The filter clauses are\n\n
\n         (range @Nr @Item nr)\n         (part @Nm @Item nm)\n         (range @Pr @Item pr)\n
\n\n\n
\n
Unification Variables
\n\n
As stated above, the first argument to select should be a list\nof variables. These variables communicate values (via unify) from the select\nenvironment to the enclosing Pilog environment.\n\n
The first variable in this list (@Item in the above example) is\nmandatory, it takes the direct return value of select. Additional\noptional variables may be unified by clauses in the body of select,\nand return further values.\n\n\n
\n
Generator Clauses
\n\n
The second argument to select is a list of \"generator clauses\".\nEach of these clauses specifies some kind of database B-Tree +index, to be traversed by\nselect, step by step, where each step returns a suitable single\ndatabase object. In the simplest case, they consist like here just of a relation\nname (e.g. nr), a class (e.g. +Item), an optional hook\nspecifier (not in this example), and a pattern (values or ranges, e.g. (1 . 4)\nor \"Part\").\n\n
The generator clauses are the core of 'select'. In some way, they behave\nanalog to or/2, as each of them\ngenerates a sequence of values. However, the generator clauses behave different,\nas they will not generate an exhaustive set of values upon backtracking, one\nafter the other, where the next gets its turn when the previous one is\nexhausted. Instead, all clauses will generate their values quasi-parallel, with\na built-in optimization so that successful clauses will be called with a higher\nprobability. \"Successful\" means that the returned values successfully pass\nselect's filter clauses.\n\n\n
\n
B-Tree Stepping
\n\n
In its basic form, a generator clause is equivalent to the db/3 predicate, stepping through a single\nB-Tree. The clause\n\n
\n(nr +Item @Nr)\n
\n\n
generates the same values as would be produced by a stand-alone Pilog clause\n\n
\n(db nr +Item @Nr @Item)\n
\n\n
as can be seen in the following two calls:\n\n
\n: (? (db nr +Item (1 . 4) @Item))\n @Item={B1}\n @Item={B2}\n @Item={B3}\n @Item={B4}\n-> NIL\n: (? (select (@Item) ((nr +Item (1 . 4)))))\n @Item={B1}\n @Item={B2}\n @Item={B3}\n @Item={B4}\n-> NIL\n
\n\n\n
\n
Interaction of Generator Clauses
\n\n
select is mostly useful if more than one generator clause is\ninvolved. The tree search parameters of all clauses are meant to form a logical\nAND. Only those objects should be returned, for which all search\nparameters (and the associated filter clauses) are valid. As soon as one of the\nclauses finishes stepping through its database (sub)tree, the whole call to\nselect will terminate, because further values returned from other\ngenerator clauses cannot be part of the result set.\n\n
Therefore, select would find all results most quickly if it\ncould simply call only the generator clause with the smallest (sub)tree.\nUnfortunately, this is usually not known in advance. It depends on the\ndistribution of the data in the database, and on the search parameters to each\ngenerator clause.\n\n
Instead, select single-steps each generator clause in turn, in a\nround-robin scheme, applies the filter clauses to each generated object, and\nre-arranges the order of generator clauses so that the more successful clauses\nwill be preferred. This process usually converges quickly and efficiently.\n\n\n
\n
Combined Indexes
\n\n
A generator clause can also combine several (similar) indexes into a single\none. Then the clause is written actually as a list of clauses.\n\n
For example, a generator clause to search for a customer by phone number is\n\n
\n(tel +CuSu @Tel)\n
\n\nIf we want to search for a customer without knowing whether a given number is a\nnormal or a mobile phone number, then a combined generator clause searching both\nindex trees could look like\n\n
\n((tel +CuSu @Tel  mob +CuSu @Tel))\n
\n\n
The generator will first traverse all matching entries in the +Ref tree of the tel relation, and\nthen, when these are exhausted, all matching entries in the mob\nindex tree.\n\n\n
\n
Indirect Object Associations
\n\n
But generator clauses are not limited to the direct B-Tree interaction of\ndb/3. They can also traverse trees of\nassociated objects, and then follow +Link / +Joint relations, or tree relations like\n+Ref to arrive at database objects\nwith a type suitable for return values from select.\n\n
To locate appropriate objects from associated objects, the generator clause\ncan contain - in addition to the standard relation/class/pattern specification\n(see Generator Clauses above) - an arbitrary number of\nassociation specifiers. Each association specifier can be\n\n
    \n
  1. A symbol. Then a +Link or\n+Joint will be followed, or a\n+List of those will be traversed to\nlocate appropriate objects.\n\n
  2. A list. Then this list should hold a relation and a class (and an optional\nhook) which specify some B-Tree +index to be traversed to locate appropriate\nobjects.\n\n
\n\nIn this way, a single generator clause can cause the traversal of a tree of\nobject relations to generate the desired sequence of objects.\n\nAn example can be found in \"app/gui.l\", in the 'choOrd' function which\nimplements the search dialog for +Ord (order) objects. Orders can\nbe searched for order number and date, customer name and city, item description\nand supplier name:\n\n
\n(select (@@)\n   ((nr +Ord @Nr) (dat +Ord @Dat)\n      (nm +CuSu @Cus (cus +Ord))\n      (ort +CuSu @Ort (cus +Ord))\n      (nm +Item @Item (itm +Pos) ord)\n      (nm +CuSu @Sup (sup +Item) (itm +Pos) ord) )\n
\n\n
While (nr +Ord @Nr) and (dat +Ord @Dat) are direct\nindex traversals, (nm +CuSu @Cus (cus +Ord)) iterates the\nnm (name) index of customers/suppliers +CuSu, and then\nfollows the +Ref +Link of the cus relation to the\norders. The same applies to the search for city names via ort.\n\n
The most complex example is (nm +CuSu @Sup (sup +Item) (itm +Pos)\nord), where the supplier name is searched in the nm tree of\n+CuSu, then the +Ref tree\n(sup +Item) tree is followed to locate items of that supplier, then\nall positions for those items are found using (itm +Pos), and\nfinally the ord +Joint\nis followed to arrive at the order object(s).\n\n\n
\n
Nested Pilog Queries
\n\n
In the most general case, a generator clause can be an arbitrary Pilog query.\nOften this is a query to a database on a remote machine, using the remote/2 predicate, or some other resource\nnot accessible via database indexes, like iterating a +List of +Links or +Joints.\n\n
Syntactically, such a generator clause is recognized by the fact that its CAR\nis a Pilog variable to denote the return value.\n\n
The second argument is a list of Pilog variables to communicate values (via\nunify) from the surrounding\nselect environment.\n\n
The third argument is the actual list of clauses for the nested query.\n\n
Finally, an arbitrary number of association specifiers may follow, as\ndescribed in the Indirect Object Associations\nsection.\n\n
We can illustrate this with a somewhat useless (but simple) example, which\nreplaces the standard generators for item number and supplier name\n\n
\n(select (@Item)\n   ((nr +Item @Nr) (nm +CuSu @Sup (sup +Item)))\n   ...\n
\n\n
with the equivalent form\n\n
\n(select (@Item)\n   ((@A (@Nr) ((db nr +Item @Nr @A)))\n      (@B (@Sup) ((db nm +CuSu @Sup @B)) (sup +Item)) )\n
\n\n
That is, a query with the db/3 tree\niteration predicate is used to generate appropriate values.\n\n\n
\n
Filter Clauses
\n\n
The generator clauses produce - independent from each other - lots of\nobjects, which match the patterns of individual generator clauses, but not\nnecessarily the desired result set of the total select call.\nTherefore, the filter clauses are needed to retain the good, and throw away the\nbad objects. In addition, they give feedback to the generator for optimizing its\ntraversal priorities (as described in Generator Clauses).\n\n
select then collects all objects which passed through the\nfilters into a unique list, to avoid duplicates which would otherwise appear,\nbecause most objects can be found by more than one generator clause.\n\n
Technically, the filters are normal Pilog clauses, which just happen to be\nevaluated in the context of select. Arbitrary Pilog predicates can\nbe used, though there exist some predicates (e.g. isa/2, same/3, bool/3, range/3, head/3, fold/3, part/3 or tolr/3) especially suited for that task.\n\n\n
\n
A Little Report
\n\n
Assume we want to know how many pieces of item #2 were sold in the year 2007.\nThen we must find all +Pos (position) objects referring to that\nitem and at the same time belonging to orders of the year 2007 (see the class\ndefinition for +Pos in \"app/er.l\"). The number of sold pieces is\nthen in the cnt property of the +Pos objects.\n\n
As shown in the complete select below, we will hold the item\nnumber in the variable @Nr and the date range for the year in\n@Year.\n\n
Now, all positions referred by item #2 can be found by the generator clause\n\n
\n(nr +Item @Nr (itm +Pos))\n
\n\n
and all positions sold in 2007 can be found by\n\n
\n(dat +Ord @Year pos)\n
\n\n
However, the combination of both generator clauses\n\n
\n(select (@Pos)\n   ((nr +Item @Nr (itm +Pos)) (dat +Ord @Year pos)) )\n
\n\n
will probably generate too many results, namely all positions with item #2\nOR from the year 2007. Thus, we need two filter clauses. With them, the\nfull search expression will be:\n\n
\n(?\n   @Nr 2                                                 # Item number\n   @Year (cons (date 2007 1 1) (date 2007 12 31))        # Date range 2007\n   (select (@Pos)\n      ((nr +Item @Nr (itm +Pos)) (dat +Ord @Year pos))   # Generator clauses\n      (same @Nr @Pos itm nr)                             # Filter item number\n      (range @Year @Pos ord dat) ) )                     # Filter order date\n
\n\n
For completeness, let's calculate the total count of sold items:\n\n
\n(let Cnt 0     # Counter variable\n   (pilog\n      (quote\n         @Nr 2\n         @Year (cons (date 2007 1 1) (date 2007 12 31))\n         (select (@Pos)\n            ((nr +Item @Nr (itm +Pos)) (dat +Ord @Year pos))\n            (same @Nr @Pos itm nr)\n            (range @Year @Pos ord dat) ) )\n      (inc 'Cnt (get @Pos 'cnt)) )  # Increment total count\n   Cnt )  # Return count\n
\n\n\n
\n
Filter Predicates
\n\n
As mentioned under Filter Clauses, some predicates\nexists mainly for select filtering.\n\n
Some of these predicates are of general use: isa/2 can be used to check for a type,\nsame/3 checks for a definite value,\nbool/3 looks if the value is\nnon-NIL. These predicates are rather independent of the +relation type.\n\n
range/3 checks whether a value\nis within a given range. This could be used with any +relation type, but typically it will be\nused for numeric (+Number) or time\n( +Date and +Time) relations.\n\n
Other predicates make only sense in the context of a certain +relation type:\n\n
\n\n\n\n"
  },
  {
    "path": "doc/structures",
    "content": "# 09jul24 Software Lab. Alexander Burger\n\n   ### Primary data types ###\n\n   cnt   xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxS010\n   big   xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxS100\n   sym   xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx1000\n   pair  xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx0000\n\n\n         Bignum\n         |\n         V\n      +-----+-----+\n      | DIG |  |  |\n      +-----+--+--+\n               |\n               V\n            +-----+-----+\n            | DIG |  |  |\n            +-----+--+--+\n                     |\n                     V\n                  +-----+-----+\n                  | DIG | CNT |\n                  +-----+-----+\n\n\n      Pair\n      |\n      V\n      +-----+-----+\n      | CAR | CDR |\n      +-----+-----+\n\n\n            Symbol\n            |\n            V\n      +-----+-----+                                +-----+-----+\n      |  |  | VAL |                                |'cba'|'fed'|\n      +--+--+-----+                                +-----+-----+\n         | tail                                       ^\n         |                                            |\n         V                                            | name\n         +-----+-----+     +-----+-----+     +-----+--+--+\n         |  |  |  ---+---> | KEY |  ---+---> |  |  |  |  |\n         +--+--+-----+     +-----+-----+     +--+--+-----+\n            |                                   |\n            V                                   V\n            +-----+-----+                       +-----+-----+\n            | VAL | KEY |                       | VAL | KEY |\n            +-----+-----+                       +-----+-----+\n\n\n      NIL:  /\n            |\n            V\n      +-----+-----+-----+-----+\n      |'LIN'|  /  |  /  |  /  |\n      +-----+-----+-----+-----+\n\n\n   Symbol tail\n      Internal/Transient\n         0010 Short name\n         0100 Long name\n         0000 Properties\n\n      External\n         1010 Short name\n         1000 Properties\n\n   Name final short\n      Internals, Transients\n         0000.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx0010\n           60      52      44      36      28      20      12       4\n\n      Externals\n         42 bit Object (4 Tera objects)\n         16 bit File (64 K files)\n          2 bit Status\n            Loaded    01........\n            Dirty     10........\n            Deleted   11........\n\n         1+2 Bytes: 1 file, 64K objects                  {177777}\n         1+3 Bytes: 16 files, 1M objects               {O3777777}\n         1+4 Bytes: 256 files, 16M objects           {OO77777777}\n         1+5 Bytes: 256 files, 4G objects         {OO37777777777}\n         1+6 Bytes: 65536 files, 4G objects     {OOOO37777777777}\n         1+8 Bytes: 65536 files, 4T objects  {OOOO77777777777777}\n         (2 + 10 + 8 + 12 + 8 + 20)\n         xx.xxxxxxxxx.xxxxxxx.xxxxxxxxxxx.xxxxxxx.xxxxxxxxxxxxxxxxxxxE010\n           obj       file    obj         file    obj\n                     ^6      ^5      ^4      ^3      ^2\n\n\n   ### Heap ###\n\n      Heaps, Avail\n      |\n      |  +-----------------------+\n      |  |                       |\n      V  |                       V\n      +--+--+-----+-----+-----+-----+-----+---     ---+-----+-----+-----+\n      |  |  |     |           |  /  |     |    ...    |  |  |     |  |  |\n      +-----+-----+-----+-----+-----+-----+---     ---+--+--+-----+--+--+\n                                                         |           |\n                                                         |           +-----> Heaps\n                                                         |\n                                                         +-----> Avail\n\n\n   ### Stack ###\n\n      Saved values:\n\n         ^\n         |\n         +---- LINK\n               val  <-- Link\n\n\n      Bind frame:\n\n                        ^\n               Expr     |\n               LINK ----+\n                @\n         +---> [@]\n         |\n         +---- LINK\n               sym1\n         +---> val1\n         .\n         .\n         +---- LINK\n               symN\n               valN  <-- Bind\n\n\n      VarArgs frame:\n\n            [Bind frame]\n         ^\n         |\n         +---- LINK\n               arg1 <------------+\n         +-------   <-- Next     |\n         |                       |\n         |     LINK -------------+\n         | +-> arg2\n         +-|->   ----------------+\n           |                     |\n           +-- LINK              |\n               arg3 <-- Link     |\n                /   <------------+\n\n\n      Apply args:\n\n         ^\n         |\n         +---- LINK\n               fun  <---+  <-----+\n               zero     |        |\n         +---- cdr      |        |\n         |     car  ----+  <-- E |\n         |                       |\n         |     LINK -------------+\n         | +-> val1 <---+\n         | |   zero     |\n         | |   cdr1 ----|-----+\n         +---> car1 ----+     |\n           |                  |\n           +-- LINK           |\n         +---> valN  <-- Link |\n         |     zero           |\n         |      /             |\n         +---- carN <---------+\n\n\n      I/O frame:\n                        ^\n               put/get  |\n               pid      |\n               fd       |\n               LINK ----+  <-- InFrames, OutFrames, ErrFrames, CtlFrames\n\n\n      Catch frame:\n                        ^\n               [rst]    |\n               [env]    |\n               ...      |\n               co       |\n               fin      |\n               tag      |\n               LINK ----+  <-- Catch\n\n\n      Coroutine:\n\n               [rst]\n               [env]\n               ...\n               [@]\n               lim\n               prg\n               otg\n               org\n         +---- nxt\n         |     tag   <----- Coroutines\n         |\n         |\n         |     [rst]\n         |     [env]\n         |     ...\n         |     [@]\n         |     lim\n         |     prg\n         |     otg\n         |     org\n         |     nxt\n         +---> tag\n\n\n      IPC pipes:\n\n                  +--------------------------+ Mic\n                  |\n                  |  +-----------------+ Tell         \n                  |  |\n                  |  +-----------------> Hear\n          |  |\n                  |  |\n         Spkr <---+  |\n                  |  |\n                  |  |\n                  |  +-----------------+ Tell\n                  |  |\n                  |  +-----------------> Hear         \n                  |\n                  +--------------------------+ Mic\n\n\n   ### Database file ###\n\n                  +-------------+-+-------------+-+----+\n      Block 0:    |   Free       0|   Next       0| << |\n                  +-------------+-+-------------+-+----+\n                  0               BLK                  2*Blk+1\n\n\n                  +-------------+-+\n      Free:       |   Link       0|\n                  +-------------+-+\n                  0\n\n\n                  +-------------+-+----\n      ID-Block:   |   Link       1| Data\n                  +-------------+-+----\n                  0              BLK\n\n\n                  +-------------+-+----\n      EXT-Block:  |   Link       n| Data\n                  +-------------+-+----\n                  0              BLK\n\n\n   ### Assumptions ###\n\n   - 8 bit per byte\n   - 64 bit per word\n   - Pointer size is 64 bit\n   - Stack grows downwards\n   - sizeof(float) = 4 bytes\n   - sizeof(double) = 8 bytes\n"
  },
  {
    "path": "doc/tut.html",
    "content": "\n\n\n\n\n\nPicoLisp Tutorial\n\n\n\nabu@software-lab.de\n\n
A PicoLisp Tutorial
\n\n
(c) Software Lab. Alexander Burger\n\n
This document demonstrates some aspects of the PicoLisp system in detail and\nexample. For a general description of the PicoLisp kernel please look at the PicoLisp Reference.\n\n
This is not a Lisp tutorial, as it assumes some basic knowledge of\nprogramming, Lisp, and even PicoLisp. Please read these sections before coming\nback here: Introduction and The PicoLisp Machine. This tutorial concentrates on the\nspecificities of PicoLisp, and its differences with other Lisp dialects.\n\n
Now let's start
\n\n
If not stated otherwise, all examples assume that PicoLisp was started from a\nglobal installation (see Installation) from the\nshell prompt as\n\n
\n$ pil +\n:\n
\n\n
It loads the PicoLisp base system and the debugging environment, and waits\nfor you to enter input lines at the interpreter prompt (:). You can\nterminate the interpreter and return to the shell at any time, by either hitting\nthe Ctrl-D key, or by executing the function (bye).\n\n
Input editing is done via the readline(3) library. You will want\nto configure it according to your taste via your \"~/.inputrc\" file. Useful value\nfor PicoLisp are\n\n
\nset keyseq-timeout 40\nset blink-matching-paren on\nTAB: menu-complete\nC-y: menu-complete-backward\n
\n\nIn addition to the above, I (preferring vi-style) do also have\n\n
\nset editing-mode vi\nset keymap vi-command\nv: \"\"\n
\n\n
Table of content
\n\n
If you are new to PicoLisp, you might want to read the following sections in\nthe given order, as some of them assume knowledge about previous ones. Otherwise\njust jump anywhere you are interested in.\n\n
\n\n
\n
Browsing
\n\n
PicoLisp provides some functionality for inspecting pieces of data and code\nwithin the running system.\n\n
Basic tools
\n\nThe really basic tools are of course available and their name alone is enough\nto know:\nprint,\nsize\n...\n\n
But you will appreciate some more powerful tools like:\n
  • match, a predicate which\n    compares S-expressions with bindable wildcards when matching,
    • \n
\n\n
Inspect a symbol with show
\n\n
The most commonly used tool is probably the show function. It takes a symbolic argument,\nand shows the symbol's name (if any), followed by its value, and then the\ncontents of the property list on the following lines (assignment of such things\nto a symbol can be done with set,\nsetq, and put).\n\n
\n: (setq A '(This is the value))  # Set the value of 'A'\n-> (This is the value)\n: (put 'A 'key1 'val1)           # Store property 'key1'\n-> val1\n: (put 'A 'key2 'val2)           # and 'key2'\n-> val2\n: (show 'A)                      # Now 'show' the symbol 'A'\nA (This is the value)\n   key2 val2\n   key1 val1\n-> A\n
\n\n
show accepts an arbitrary number of arguments which are\nprocessed according to the rules of get, resulting in a symbol which is showed then.\n\n
\n: (put 'B 'a 'A)        # Put 'A' under the 'a'-property of 'B'\n-> A\n: (setq Lst '(A B C))   # Create a list with 'B' as second argument\n-> (A B C)\n: (show Lst 2 'a)       # Show the property 'a of the 2nd element of 'Lst'\nA (This is the value)   # (which is 'A' again)\n   key2 val2\n   key1 val1\n-> A\n
\n\n
Inspect and edit symbols in-memory
\n\n
If you pass one or more symbols as a list to vi, they are written to a temporary file in a\nformat similar to show, and Vip is started with that\nfile.\n\n
\n: (vi '(A B))\n
\n\n
The Vip window will look like\n\n
\nA (This is the value)\nkey1 val1\nkey2 val2\n\n(=======)\n\nB NIL\na A  # (This is the value)\n\n(=======)\n
\n\n
A convenient shortcut is the non-evaluating version v of\nvi. An equivalent call to the above is:\n\n
\n(v A B)\n
\n\n
Now you can modify values or properties. You should not touch the\nparenthesized hyphens, as they serve as delimiters. If you position the cursor\non the first character of a symbol name and type 'K' (\"Keyword\nlookup\"), the editor will be restarted with that symbol added to the editor\nwindow. 'Q' (for \"Quit\") will bring you back to the previous view.\n\n
If you exit Vip with e.g. \":x\", any changes you made in your editing session\nwill be communicated back to the REPL.\n\n
In-memory editing is also very useful to browse in a database. You can follow\nthe links between objects with 'K', and even - e.g. for low-level\nrepairs - modify the data (but only if you are really sure about what you are\ndoing, and don't forget to commit\nwhen you are done).\n\n
Built-in pretty print with pp
\n\n
The pretty-print function pp\ntakes a symbol that has a function defined (or two symbols that specify message\nand class for a method definition), and displays that definition in a formatted\nand indented way.\n\n
\n: (pp 'pretty)\n(de pretty (X N)\n   (setq N (abs (space (or N 0))))\n   (while (and (pair X) (== 'quote (car X)))\n      (prin \"'\")\n      (pop 'X) )\n   (cond\n      ...\n      (T (prtty0 X N)) ) )\n-> pretty\n
\n\n
The style is the same as we use in source files:\n\n
    \n\n
  • The indentation level is three spaces\n\n
  • If a list is too long (to be precise: if its size is greater than 12), pretty-print the CAR\non the current line, and each element of the CDR recursively on its own line.\n\n
  • A closing parenthesis a preceded by a space if the corresponding open\nparenthesis is not on the same line\n\n
\n\n
Inspect elements one by one with more
\n\n
more is a simple tool that displays\nthe elements of a list one by one. It stops after each element and waits for\ninput. If you just hit ENTER, more continues with the next element,\notherwise (usually I type a dot (.) followed by ENTER) it\nterminates.\n\n
\n: (more (1 2 3 4 5 6))\n1                          # Hit ENTER\n2   .                      # Hit '.' and ENTER\n-> T                       # stopped\n
\n\n
Optionally more takes a function as a second argument and\napplies that function to each element (instead of the default print). Here, often show or\npp (see below) is used.\n\n
\n: (more '(A B))            # Step through 'A' and 'B'\nA\nB\n-> NIL\n: (more '(A B) show)       # Step through 'A' and 'B' with 'show'\nA (This is the value)      # showing 'A'\n   key2 val2\n   key1 val1\n                           # Hit ENTER\nB NIL                      # showing 'B'\n   a A\n-> NIL\n
\n\n
Search through available symbols with what
\n\n
The what function returns a list of\nall internal symbols in the system which match a given pattern (with\n'@' wildcard characters).\n\n
\n: (what \"prin@\")\n-> (prin print prinl print> printsp println)\n
\n\n
Search through values or properties of symbols with who
\n\n
The function who returns \"who\ncontains that\", i.e. a list of symbols that contain a given argument\nsomewhere in their value or property list.\n\n
\n: (who 'print)\n-> (query _pretty spPrt prtty1 prtty2 prtty3 pretty (\"syms>\" . \"+Buffer\")\nmsg more show view (print> . +Date) rules select (print> . +relation) pico)\n
\n\n
A dotted pair indicates either a method definition or a property entry. So\n(print> . +relation) denotes the print> method of\nthe +relation class.\n\n
who can be conveniently combined with more and\npp:\n\n
\n: (more (who 'print) pp)\n(de query (\"Q\" \"Dbg\")  # Pretty-print these functions one by one\n   (use \"R\"\n      (loop\n         (NIL (prove \"Q\" \"Dbg\"))\n         (T (=T (setq \"R\" @)) T)\n         (for X \"R\"\n            (space)\n            (print (car X))\n            (print '=)\n            (print (cdr X))\n            (flush) )\n         (T (line)) ) ) )\n\n(de pretty (X N)\n   ...\n
\n\n
The argument to who may also be a pattern list (see match):\n\n
\n: (who '(print @ (less (val @))))\n-> (show)\n\n: (more (who '(% @ 7)) pp)\n(de day (Dat Lst)\n   (when Dat\n      (get\n         (or Lst *DayFmt)\n         (inc (% (inc Dat) 7)) ) ) )\n\n(de _week (Dat)\n   (/ (- Dat (% (inc Dat) 7)) 7) )\n
\n\n
Find what classes can accept a given message with can
\n\n
The function can returns a list\nwhich indicates which classes can accept a given message. Again, this\nlist is suitable for iteration with pp:\n\n
\n: (can 'del>)                                   # Which classes accept 'del>' ?\n-> ((del> . +List) (del> . +Entity) (del> . +relation))\n\n: (more (can 'del>) pp)                         # Inspect the methods with 'pp'\n(dm (del> . +List) (Obj Old Val)\n   (and ((<> Old Val) (delete Val Old)) )\n\n(dm (del> . +Entity) (Var Val)\n   (when\n      (and\n         Val\n         (has> (meta This Var) Val (get This Var)) )\n      (let Old (get This Var)\n         (rel>\n            (meta This Var)\n            This\n            Old\n            (put This Var (del> (meta This Var) This Old @)) )\n         (when (asoq Var (meta This 'Aux))\n            (relAux This Var Old (cdr @)) )\n         (upd> This Var Old) ) ) )\n\n(dm (del> . +relation) (Obj Old Val)\n   (and ((<> Old Val) Val) )\n
\n\n
Inspect dependencies with dep
\n\n
dep shows the dependencies in a\nclass hierarchy. That is, for a given class it displays the tree of its\n(super)class(es) above it, and the tree of its subclasses below it.\n\n
To view the complete hierarchy of input fields, we start with the root class\n+relation:\n\n
\n: (dep '+relation)\n+relation\n   +Bag\n   +Any\n   +Blob\n   +Link\n      +Joint\n   +Bool\n   +Symbol\n      +String\n   +Number\n      +Time\n      +Date\n-> +relation\n
\n\n
If we are interested in +Link:\n\n
\n: (dep '+Link)\n   +relation\n+Link\n   +Joint\n-> +Link\n
\n\n
This says that +Link is a subclass of +relation, and has a single subclass\n(+Joint).\n\n\n
\n
Defining Functions
\n\n
Most of the time during programming is spent defining functions (or methods).\nIn the following we will concentrate on functions, but most will be true for\nmethods as well except for using dm\ninstead of de.\n\n
Functions with no argument
\n\n
The notorious \"Hello world\" function must be defined:\n\n
\n: (de hello ()\n   (prinl \"Hello world\") )\n-> hello\n
\n\n
The () in the first line indicates a function without arguments.\nThe body of the function is in the second line, consisting of a single\nstatement. The last line is the return value of de, which here is\nthe defined symbol. From now on we will omit the return values of examples when\nthey are unimportant.\n\n
Now you can call this function this way:\n\n
\n: (hello)\nHello world\n
\n\n
Functions with one argument
\n\n
A function with an argument might be defined this way:\n\n
\n: (de hello (X)\n   (prinl \"Hello \" X) )\n# hello redefined\n-> hello\n
\n\n
PicoLisp informs you that you have just redefined the function. This might be\na useful warning in case you forgot that a bound symbol with that name already\nexisted.\n\n
\n: (hello \"world\")\nHello world\n
\n\n
\n: (hello \"Alex\")\nHello Alex\n
\n\n
Preventing arguments evaluation and variable number of arguments
\n\n
Normally, PicoLisp evaluates the arguments before it passes them to a\nfunction:\n\n
\n: (hello (+ 1 2 3))\nHello 6\n
\n\n
\n: (setq A 1  B 2)       # Set 'A' to 1 and 'B' to 2\n-> 2\n: (de foo (X Y)         # 'foo' returns the list of its arguments\n   (list X Y) )\n-> foo\n: (foo A B)             # Now call 'foo' with 'A' and 'B'\n-> (1 2)                # -> We get a list of 1 and 2, the values of 'A' and 'B'\n
\n\n
In some cases you don't want that. For some functions (setq for example) it is better if the function\ngets all arguments unevaluated, and can decide for itself what to do with them.\n\n
For such cases you do not define the function with a list of\nparameters, but give it a single atomic parameter instead. PicoLisp will\nthen bind all (unevaluated) arguments as a list to that parameter.\n\n
\n: (de foo X\n   (list (car X) (cadr X)) )        # 'foo' lists the first two arguments\n\n: (foo A B)                         # Now call it again\n-> (A B)                            # -> We don't get '(1 2)', but '(A B)'\n\n: (de foo X\n   (list (car X) (eval (cadr X))) ) # Now evaluate only the second argument\n\n: (foo A B)\n-> (A 2)                            # -> We get '(A 2)'\n
\n\n
Mixing evaluated arguments and variable number of unevaluated arguments
\n\n
As a logical consequence, you can combine these principles. To define a\nfunction with 2 evaluated and an arbitrary number of unevaluated arguments:\n\n
\n: (de foo (X Y . Z)     # Evaluate only the first two args\n   (list X Y Z) )\n\n: (foo A B C D E)\n-> (1 2 (C D E))        # -> Get the value of 'A' and 'B' and the remaining list\n
\n\n
Variable number of evaluated arguments
\n\n
More common, in fact, is the case where you want to pass an arbitrary number\nof evaluated arguments to a function. For that, PicoLisp recognizes the\nsymbol @ as a single atomic parameter and remembers all evaluated\narguments in an internal frame. This frame can then be accessed sequentially\nwith the args, next, arg and rest functions.\n\n
\n: (de foo @\n   (list (next) (next)) )     # Get the first two arguments\n\n: (foo A B)\n-> (1 2)\n
\n\n
Again, this can be combined:\n\n
\n: (de foo (X Y . @)\n   (list X Y (next) (next)) ) # 'X' and 'Y' are fixed arguments\n\n: (foo A B (+ 3 4) (* 3 4))\n-> (1 2 7 12)                 # All arguments are evaluated\n
\n\n
These examples are not very useful, because the advantage of a variable\nnumber of arguments is not used. A function that prints all its evaluated\nnumeric arguments, each on a line followed by its squared value:\n\n
\n: (de foo @\n   (while (args)                    # Check if there are some args left\n      (let N (next)\n         (println N (* N N)) ) ) )\n\n: (foo (+ 2 3) (- 7 1) 1234 (* 9 9))\n5 25\n6 36\n1234 1522756\n81 6561\n-> 6561\n
\n\n
This next example shows the behaviour of args and\nrest:\n\n
\n: (de foo @\n   (while (args)\n      (println (next) (args) (rest)) ) )\n: (foo 1 2 3)\n1 T (2 3)\n2 T (3)\n3 NIL NIL\n
\n\n
Finally, it is possible to pass all these evaluated arguments to another\nfunction, using pass:\n\n
\n: (de foo @\n   (pass println 9 8 7)       # First print all arguments preceded by 9, 8, 7\n   (pass + 9 8 7) )           # Then add all these values\n\n: (foo (+ 2 3) (- 7 1) 1234 (* 9 9))\n9 8 7 5 6 1234 81             # Printing ...\n-> 1350                       # Return the result\n
\n\n
Anonymous functions without the lambda keyword
\n\nThere's no distinction between code and data in PicoLisp,\nquote will do what you want (see\nalso this FAQ entry).\n\n
\n: ((quote (X) (* X X)) 9)\n-> 81\n
\n\n
\n: (setq f '((X) (* X X)))  # This is equivalent to (de f (X) (* X X))\n-> ((X) (* X X))\n: f\n-> ((X) (* X X))\n: (f 3)\n-> 9\n
\n\n\n
\n
Debugging
\n\n
There are two major ways to debug functions (and methods) at runtime:\nTracing and single-stepping.\n\n
In this section we will use the REPL to explore the debugging facilities, but\nin the Scripting section, you will learn how to launch\nPicoLisp scripts with some selected functions debugged:\n\n
\n$ pil app/file1.l -\"trace 'foo\" -main -\"debug 'bar\" app/file2.l +\n
\n\n
Tracing
\n\n
Tracing means letting functions of interest print their name and arguments\nwhen they are entered, and their name again and the return value when they are\nexited.\n\n
For demonstration, let's define the unavoidable factorial function:\n\n
\n(de fact (N)\n   (if (=0 N)\n      1\n      (* N (fact (dec N))) ) )\n
\n\n
With trace we can put it in trace\nmode:\n\n
\n: (trace 'fact)\n-> fact\n
\n\n
Calling fact now will display its execution trace.\n\n
\n: (fact 3)\n fact : 3\n  fact : 2\n   fact : 1\n    fact : 0\n    fact = 1\n   fact = 1\n  fact = 2\n fact = 6\n-> 6\n
\n\n
As can be seen here, each level of function call will indent by an additional\nspace. Upon function entry, the name is separated from the arguments with a\ncolon (:), and upon function exit with an equals sign\n(=) from the return value.\n\n
trace works by modifying the function body, so generally it\nworks only for functions defined as lists (lambda expressions, see Evaluation). Tracing a built-in function (SUBR) is\npossible, however, when it is a function that evaluates all its arguments.\n\n
So let's trace the functions =0 and\n*:\n\n
\n: (trace '=0)\n-> =0\n: (trace '*)\n-> *\n
\n\n
If we call fact again, we see the additional output:\n\n
\n: (fact 3)\n fact : 3\n  =0 : 3\n  =0 = NIL\n  fact : 2\n   =0 : 2\n   =0 = NIL\n   fact : 1\n    =0 : 1\n    =0 = NIL\n    fact : 0\n     =0 : 0\n     =0 = 0\n    fact = 1\n    * : 1 1\n    * = 1\n   fact = 1\n   * : 2 1\n   * = 2\n  fact = 2\n  * : 3 2\n  * = 6\n fact = 6\n-> 6\n
\n\n
To reset a function to its untraced state, call untrace:\n\n
\n: (untrace 'fact)\n-> fact\n: (untrace '=0)\n-> =0\n: (untrace '*)\n-> *\n
\n\n
or simply use mapc:\n\n
\n: (mapc untrace '(fact =0 *))\n-> *\n
\n\n
Single-stepping
\n\n
Single-stepping means to execute a function step by step, giving the\nprogrammer an opportunity to look more closely at what is happening. The\nfunction debug inserts a breakpoint\ninto each top-level expression of a function. When the function is called, it\nstops at each breakpoint, displays the expression it is about to execute next\n(this expression is also stored into the global variable ^) and enters a read-eval-loop. The programmer\ncan then\n\n
    \n\n
  • inspect the current environment by typing variable names or calling\nfunctions\n\n
  • execute (d) to recursively debug the\nnext expression (looping through subexpressions of this expression)\n\n
  • execute (e) to evaluate the next\nexpression, to see what will happen without actually advancing on\n\n
  • type ENTER (that is, enter an empty line) to leave the read-eval loop and\ncontinue with the next expression\n\n
\n\n
Thus, in the simplest case, single-stepping consists of just hitting ENTER\nrepeatedly to step through the function.\n\n
To try it out, let's look at the stamp system function. You may need to have a\nlook at\n\n
    \n
  • =T (T test),
    • \n\n
  • date and time (grab system date and time)\n\n
  • default (conditional\nassignments)\n\n
  • pack (kind of concatenation), and\n\n
  • dat$ and tim$ (date and time formats)
    • \n\n
\n\nto understand this definition.\n\n
\n: (pp 'stamp)\n(de stamp (Dat Tim)\n   (and (=T Dat) (setq Dat (date T)))\n   (default Dat (date) Tim (time T))\n   (pack (dat$ Dat \"-\") \" \" (tim$ Tim T)) )\n-> stamp\n
\n\n
\n: (debug 'stamp)                       # Debug it\n-> T\n: (stamp)                              # Call it again\n(and (=T Dat) (setq Dat (date T)))     # stopped at first expression\n!                                      # ENTER\n(default Dat (date) Tim (time T))      # second expression\n!                                      # ENTER\n(pack (dat$ Dat \"-\") \" \" (tim$ ...     # third expression\n! Tim                                  # inspect 'Tim' variable\n-> 41908\n! (time Tim)                           # convert it\n-> (11 38 28)\n!                                      # ENTER\n-> \"2004-10-29 11:38:28\"               # done, as there are only 3 expressions\n
\n\n
Now we execute it again, but this time we want to look at what's happening\ninside the second expression.\n\n
\n: (stamp)                              # Call it again\n(and (=T Dat) (setq Dat (date T)))\n!                                      # ENTER\n(default Dat (date) Tim (time T))\n!                                      # ENTER\n(pack (dat$ Dat \"-\") \" \" (tim$ ...     # here we want to look closer\n! (d)                                  # debug this expression\n-> T\n!                                      # ENTER\n(dat$ Dat \"-\")                         # stopped at first subexpression\n! (e)                                  # evaluate it\n-> \"2004-10-29\"\n!                                      # ENTER\n(tim$ Tim T)                           # stopped at second subexpression\n! (e)                                  # evaluate it\n-> \"11:40:44\"\n!                                      # ENTER\n-> \"2004-10-29 11:40:44\"               # done\n
\n\n
The breakpoints still remain in the function body. We can see them when we\npretty-print it:\n\n
\n: (pp 'stamp)\n(de stamp (Dat Tim)\n   (! and (=T Dat) (setq Dat (date T)))\n   (! default Dat (date) Tim (time T))\n   (! pack\n      (! dat$ Dat \"-\")\n      \" \"\n      (! tim$ Tim T) ) )\n-> stamp\n
\n\n
To reset the function to its normal state, call unbug:\n\n
\n: (unbug 'stamp)\n
\n\n
Often, you will not want to single-step a whole function. Just use\nv (see above) to insert a single breakpoint (the exclamation mark\nfollowed by a space) as CAR of an expression, and run your program. Execution\nwill then stop there as described above; you can inspect the environment and\ncontinue execution with ENTER when you are done.\n\n\n
\n
Functional I/O
\n\n
Input and output in PicoLisp is functional, in the sense that there are not\nvariables assigned to file descriptors, which need then to be passed to I/O\nfunctions for reading, writing and closing. Instead, these functions operate on\nimplicit input and output channels, which are created and maintained as dynamic\nenvironments.\n\n
Standard input and standard output are the default channels. Try reading a\nsingle expression:\n\n
\n: (read)\n(a b c)        # Console input\n-> (a b c)\n
\n\n
To read from a file, we redirect the input with in. Note that comments and whitespace are\nautomatically skipped by read:\n\n
\n: (in \"@lib.l\" (read))\n-> (de task (Key . Prg) (nond (...\n
\n\n
The skip function can also be used\ndirectly. To get the first non-white character in the file with char:\n\n
\n: (in \"@lib.l\" (skip \"#\") (char))\n-> \"(\"\n
\n\n
from searches through the input\nstream for given patterns. Typically, this is not done with Lisp source files\n(there are better ways), but for a simple example let's extract all items\nimmediately following fact in the file,\n\n
\n: (in \"@lib.l\" (while (from \"nond\") (println (read))))\n(Prg (del (assoc Key *Run) '*Run))\n((pair \"X\") (or (pair (getd \"X\")) (expr \"X\")))\n(\"Prg\" (caar (idx \"Var\" \"K\")))\n
\n\n
or the word following \"(de \" with till:\n\n
\n: (in \"@lib.l\" (from \"(de \") (till \" \" T))\n-> \"task\"\n
\n\n
 To read the contents of a whole file (or the rest of it starting from the\ncurrent position):\n\n
\n: (in \"f.l\" (till NIL T))\n-> \"... file contents ...\"\n
\n\n\n
With line, a line of characters is\nread, either into a single transient symbol\n(the type used by PicoLisp for strings),\n\n
\n: (in \"@doc/tut.html\" (line T))\n-> \"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" \"http://...\"\n
\n\n
or into a list of symbols (characters):\n\n
\n: (in \"@doc/tut.html\" (line))\n-> (\"<\" \"!\" \"D\" \"O\" \"C\" \"T\" \"Y\" \"P\" \"E\" \" \" \"H\" \"T\" \"M\" \"L\" ...\n
\n\n
line is typically used to read tabular data from a file.\nAdditional arguments can split the line into fixed-width fields, as described in\nthe reference manual. If, however, the\ndata are of variable width, delimited by some special character, the split function can be used to extract the\nfields. A typical way to import the contents of such a file is:\n\n
\n(in '(\"bin/utf2\" \"importFile.txt\")              # Pipe: Convert to UTF-8\n   (until (eof)                                 # Process whole file\n      (let L (split (line) \"\\t\")                # TAB-delimited data\n         ...                                    # process them\n
\n\n
Some more examples with echo:\n\n
\n(in \"a\"                                         # Copy the first 40 Bytes\n   (out \"b\"                                     # from file \"a\" to file \"b\"\n      (echo 40) ) )\n\n(in \"@doc/tut.html\"                             # Show the HTTP-header\n   (line)\n   (echo \"<body>\") )\n\n(out \"file.mac\"                                 # Convert to Macintosh\n   (in \"file.txt\"                               # from Unix or DOS format:\n      (while (char)\n         (prin\n            (case @\n               (\"\\r\" NIL)                       # ignore CR\n               (\"\\n\" \"\\r\")                      # convert LF to CR\n               (T @) ) ) ) ) )                  # otherwise no change\n\n(out \"c\"                                        # Merge the contents of \"a\"\n   (in \"b\"                                      # and \"b\" into \"c\"\n      (in \"a\"\n         (while (read)                          # Read an item from \"a\",\n            (println @ (in -1 (read))) ) ) ) )  # print it with an item from \"b\"\n
\n\n\n
\n
Scripting
\n\n
There are two possibilities to get the PicoLisp interpreter into doing useful\nwork: via command line arguments, or as a stand-alone script.\n\n
Command line arguments for the PicoLisp interpreter
\n\n
The command line can specify either files for execution, or arbitrary Lisp\nexpressions for direct evaluation (see Invocation):\nif an argument starts with a hyphen, it is evaluated, otherwise it is loaded as a file. A typical invocation might\nlook like:\n\n
\n$ pil app/file1.l -main app/file2.l +\n
\n\n
It loads the debugging environment, an application source file, calls the\nmain function, and then loads another application source. In a typical\ndevelopment and debugging session, this line is often modified using the shell's\nhistory mechanisms, e.g. by inserting debugging statements:\n\n
\n$ pil app/file1.l -\"trace 'foo\" -main -\"debug 'bar\" app/file2.l +\n
\n\n
Another convenience during debugging and testing is to put things into the\ncommand line (shell history) which would otherwise have to be done each time in\nthe application's user interface:\n\n
\n$ pil app/file1.l -main app/file2.l -go -'login \"name\" \"password\"' +\n
\n\n
The final production release of an application usually includes a shell\nscript, which initializes the environment, does some bookkeeping and cleanup,\nand calls the application with a proper command line. It is no problem if the\ncommand line is long and complicated.\n\n
For small utility programs, however, this is overkill. Enter full PicoLisp\nscripts.\n\n
PicoLisp scripts
\n\nIt is better to write\na single executable file using the mechanisms of \"interpreter files\". If the\nfirst two characters in an executable file are \"#!\", the operating\nsystem kernel will pass this file to an interpreter program whose pathname is\ngiven in the first line (optionally followed by a single argument). This is fast\nand efficient, because the overhead of a subshell is avoided.\n\n
Let's assume you installed PicoLisp in the directory \"/home/foo/pil21/\",\nand put links to the executable and the installation directory as:\n\n
\n$ ln -s /home/foo/pil21 /usr/lib/picolisp\n$ ln -s /usr/lib/picolisp/bin/picolisp /usr/bin\n
\n\nThen a simple hello-world script might look like:\n\n
\n#!/usr/bin/picolisp /usr/lib/picolisp/lib.l\n(prinl \"Hello world!\")\n(bye)\n
\n\n
If you write this into a text file, and use chmod to set it to\n\"executable\", it can be executed like any other command. Note that (because\n# is the comment character in PicoLisp) the first line will not be\ninterpreted, and you can still use that file as a normal command line argument\nto PicoLisp (useful during debugging).\n\n
Grab command line arguments from PicoLisp scripts
\n\n
The fact that a hyphen causes evaluation of command line arguments can be\nused to implement command line options. The following script defines two\nfunctions a and f, and then calls (load T) to process the rest of the command line\n(which otherwise would be ignored because of the (bye) statement):\n\n
\n#!/usr/bin/picolisp /usr/lib/picolisp/lib.l\n\n(de a ()\n   (println '-a '-> (opt)) )\n\n(de f ()\n   (println '-f '-> (opt)) )\n\n(load T)\n(bye)\n
\n\n(opt retrieves the next command line\noption)\n\n
Calling this script (let's say we named it \"testOpts\") gives:\n\n
\n$ ./testOpts -f abc\n-f -> \"abc\"\n$ ./testOpts -a xxx  -f yyy\n-a -> \"xxx\"\n-f -> \"yyy\"\n
\n\n
We have to be aware of the fact, however, that the aggregation of arguments\nlike\n\n
\n$ ./testOpts -axxx  -fyyy\n
\n\n
or\n\n
\n$ ./testOpts -af yyy\n
\n\n
cannot be achieved with this simple and general mechanism of command line\nprocessing.\n\n
Run scripts from arbitrary places on the host file system
\n\n
Utilities are typically used outside the context of the PicoLisp environment.\nAll examples above assumed that the current working directory is the PicoLisp\ninstallation directory, which is usually all right for applications developed in\nthat environment. Command line file arguments like \"app/file1.l\" will be\nproperly found.\n\n
To allow utilities to run in arbitrary places on the host file system, the\nconcept of home directory substitution was introduced. The interpreter\nremembers internally at start-up the pathname of its first argument (usually\n\"lib.l\"), and substitutes any leading \"@\" character in subsequent\nfile names with that pathname. Thus, to run the above example in some other\nplace, simply write:\n\n
\n$ /home/foo/pil21/pil @app/file1.l -main @app/file2.l +\n
\n\n
that is, supply a full path name to the initial command (here 'pil'), or put\nit into your PATH variable, and prefix each file which has to be\nloaded from the PicoLisp home directory with a @ character.\n\"Normal\" files (not prefixed by @) will be opened or created\nrelative to the current working directory as usual.\n\n
Stand-alone scripts will often want to load additional modules from the\nPicoLisp environment, beyond the \"lib.l\" we provided in the first line of the\nhello-world script. Typically, at least a call to\n\n
\n(load \"@lib/misc.l\")\n
\n\n
(note the home directory substitution) will be included near the beginning of\nthe script.\n\n
As a more complete example, here is a script which extracts the date, name\nand size of the latest official PicoLisp release version from the download web\nsite, and prints it to standard output:\n\n
\n#!/usr/bin/picolisp /usr/lib/picolisp/lib.l\n\n(load \"@lib/misc.l\" \"@lib/http.l\")\n\n(use (@Date @Name @Size)\n   (when\n      (match\n         '(@Date ~(chop \" - <a href=\\\"\") @Name \"\\\"\" \">\"\n             @Name ~(chop \"</a> (\") @Size )\n         (client \"software-lab.de\" 80 \"down.html\"\n            (from \"Release Archive\")\n            (from \"<li>\")\n            (till \",\") ) )\n      (prinl @Name)\n      (prinl @Date \" -- \" @Size) ) )\n\n(bye)\n
\n\n\n\n"
  },
  {
    "path": "doc/viprc.sample",
    "content": "# 21dec25 Software Lab. Alexander Burger\n# Copy to ~/.pil/viprc\n\n## Uncomment to enable the \":cal\" (calendar) command\n## (load \"@lib/vip/cal.rc.l\")\n\n(map+q \"d\" \":bd\\r\")\n\n## If you prefer LEFT and RIGHT to move the cursor:\n## (map+ \"\\e[D\" \"h\")\n## (map+ \"\\e[C\" \"l\")\n\n(cmd \"pb1n\" (L Lst Cnt)  # Pastebin\n   (pipe\n      (out '(\"curl\" \"-F\" \"f=@-;\" \"pb1n.de\")\n         (mapc prinl (: buffer text)) )\n      (prCmd (rdLines)) ) )\n\n(cmd \"ix.io\" (L Lst Cnt)\n   (pipe\n      (out '(\"curl\" \"-sF\" \"f:1=<-\" \"ix.io\")\n         (mapc prinl (: buffer text)) )\n      (prCmd (rdLines)) ) )\n\n(cmd \"tabs\" (L Lst Cnt)\n   (let N (or (format L) 3)\n      (=: buffer text\n         (mapcar\n            '((L)\n               (make\n                  (for (I . C) L\n                     (if (= \"\\t\" C)\n                        (loop\n                           (link (name \" \"))\n                           (T (=0 (% I N)))\n                           (inc 'I) )\n                        (link C) ) ) ) )\n            (: buffer text) ) ) ) )\n\n(cmd \"words\" (L Lst Cnt)\n   (xchg 'delimNs\n      (quote\n         ((C)\n            (nand C\n               (sub? C\n                  \"0123456789\\\n                  ABCDEFGHIJKLMNOPQRSTUVWXYZ\\\n                  _\\\n                  abcdefghijklmnopqrstuvwxyz\" ) ) ) ) )\n   (prCmd\n      (list (chop (xchg '(\" C\") '(\" Lisp\")))) ) )\n\n(de *F7  # Find current definition\n   (let L (nth (: buffer text) (: posY))\n      (prCmd\n         (list\n            (loop\n               (NIL (setq L (prior L (: buffer text))))\n               (T (head '`(chop \"(class \") (car L))\n                  (car L) )\n               (T (head '`(chop \"(extend \") (car L))\n                  (car L) ) ) ) ) ) )\n\n(de *F8  # Expression size\n   (evCmd (size (s-expr))) )\n\n# Timestamp\n(local) vipDat\n\n(de vipDat (N)\n   (when (<> N (: posY))\n      (let (@L (get (: text) N)  @A)\n         (and\n            (match '(@A \" \" @L) @L)\n            (member @A '((\"#\") (\"/\" \"/\") (\"/\" \"*\")))\n            (>= 31 (format (cut 2 '@L)) 1)\n            (member (pack (cut 3 '@L)) *mon)\n            (format (cut 2 '@L))\n            (mapc set\n               (set (nth (: text) N)\n                  (conc\n                     @A\n                     (list (char 32))\n                     (chop (datSym (date)))\n                     @L ) )\n               1 ) ) ) ) )\n\n(daemon '(save> . +Buffer)\n   (or (vipDat 1) (vipDat 2) (vipDat 3)) )\n\n# Local\n(and (info \".viprc\") (load \".viprc\"))\n"
  },
  {
    "path": "ext.l",
    "content": "# 27oct20 Software Lab. Alexander Burger\n\n(load \"@lib/net.l\" \"@lib/misc.l\" \"@lib/btree.l\" \"@lib/db.l\" \"@lib/pilog.l\")\n\n`*Dbg\n(docs \"@doc/\")\n"
  },
  {
    "path": "lib/adm.l",
    "content": "# 30dec24 Software Lab. Alexander Burger\n\n# *Salt *Login *Users *Perms\n\n# crypt(3) algorithm, e.g. (setq *Salt (16 . \"$6$@1$\"))\n(de passwd (Str Salt)\n   (if *Salt\n      (native \"libcrypt.so\" \"crypt\" 'S Str (or Salt (salt)))\n      Str ) )\n\n(de salt ()\n   (text (cdr *Salt) (randpw (car *Salt))) )\n\n(de randpw (Len)\n   (make\n      (in \"/dev/urandom\"\n         (do Len\n            (link\n               (get\n                  '`(mapcar char\n                     (conc\n                        (range (char \".\") (char \"9\"))\n                        (range (char \"A\") (char \"Z\"))\n                        (range (char \"a\") (char \"z\")) ) )\n                  (inc (& 63 (rd 1))) ) ) ) ) ) )\n\n(de auth (Nm Pw Cls)\n   (with (db 'nm (or Cls '+User) Nm)\n      (and\n         (: pw 0)\n         (= @ (passwd Pw @))\n         This ) ) )\n\n### Login ###\n(de login (Nm Pw Cls)\n   (ifn (setq *Login (auth Nm Pw Cls))\n      (msg *Pid \" ? \" Nm)\n      (msg *Pid \" * \" (stamp) \" \" Nm)\n      (tell 'hi *Pid Nm *Adr)\n      (push1 '*Bye '(logout))\n      (when *Timeout\n         (timeout (setq *Timeout `(* 3600 1000))) ) )\n   *Login )\n\n(de logout ()\n   (when *Login\n      (rollback)\n      (off *Login)\n      (tell 'hi *Pid)\n      (msg *Pid \" / \" (stamp))\n      (when *Timeout\n         (timeout (setq *Timeout `(* 300 1000))) ) ) )\n\n(de hi (Pid Nm Adr)\n   (if (and Nm (= Nm (; *Login nm)) (= Adr *Adr))\n      (bye)\n      (hi2 Pid Nm)\n      (tell 'hi2 *Pid (; *Login nm)) ) )\n\n(de hi2 (Pid Nm)\n   (if2 Nm (lup *Users Pid)\n      (con @ Nm)\n      (idx '*Users (cons Pid Nm) T)\n      (idx '*Users @ NIL) ) )\n\n\n### Role ###\n(class +Role +Entity)\n\n(rel nm (+Need +Key +String))          # Role name\n(rel perm (+List +Symbol))             # Permission list\n(rel usr (+List +Joint) role (+User))  # Associated users\n\n(allow \"@lib/role.l\")\n\n(dm url> (Tab)\n   (and (may RoleAdmin) (list \"@lib/role.l\" '*ID This)) )\n\n\n### User ###\n(class +User +Entity)\n\n(rel nm (+Need +Key +String))          # User name\n(rel pw (+Swap +String))               # Password\n(rel role (+Joint) usr (+Role))        # User role\n(rel nam (+String))                    # Full Name\n(rel tel (+String))                    # Phone\n(rel em (+String))                     # E-Mail\n\n(allow \"@lib/user.l\")\n\n(dm url> (Tab)\n   (and\n      (or (may UserAdmin) (== *Login This))\n      (list \"@lib/user.l\" '*ID This) ) )\n\n(dm gui> (This)\n   ( 2\n      ,\"Full Name\" (gui '(+E/R +TextField) '(nam : home obj) 40)\n      ,\"Phone\" (gui '(+E/R +TelField) '(tel : home obj) 40)\n      ,\"E-Mail\" (gui '(+E/R +MailField) '(em : home obj) 40) ) )\n\n(dm login> ())\n\n\n### Permission management ###\n(de permission Lst\n   (while Lst\n      (queue '*Perms (car Lst))\n      (def (++ Lst) (++ Lst)) ) )\n\n(de may Args\n   (mmeq Args (; *Login role perm)) )\n\n(de must Args\n   (unless\n      (if (cdr Args)\n         (find\n            '((X)\n               (if (atom X)\n                  (memq X (; *Login role perm))\n                  (eval X) ) )\n            @ )\n         *Login )\n      (forbidden (car Args)) ) )\n\n### GUI ###\n(de choUser (Dst)\n   (choDlg Dst ,\"Users\" '(nm +User)) )\n\n(de loginForm \"Opt\"\n   (form NIL\n      (when \"Opt\"\n         (eval (car \"Opt\"))\n         (----) )\n      ( 2\n         ,\"Name\" (gui 'nm '(+Focus +Able +TextField) '(not *Login) 20)\n         ,\"Password\" (gui 'pw '(+Able +PwField) '(not *Login) 20) )\n      (--)\n      (gui '(+Button) '(if *Login ,\"logout\" ,\"login\")\n         '(cond\n            (*Login (post (logout)))\n            ((login (val> (: home nm)) (val> (: home pw)))\n               (post\n                  (clr> (: home pw))\n                  (login> *Login) ) )\n            (T (error ,\"Permission denied\")) ) )\n      (when *Login\n         ( 4)\n         ( \"bold green\"\n            (ht:Prin \"'\" (; *Login nm) ,\"' logged in\") ) )\n      (when \"Opt\"\n         (----)\n         (htPrin (cdr \"Opt\")) ) ) )\n\n(class +PasswdField +E/R +Fmt +TextField)\n\n(dm T @\n   (pass super\n      '(pw : home obj)\n      '((V) (and V \"****\"))\n      '((V)\n         (if (= V \"****\")\n            (: home obj pw 0)\n            (passwd V (: home obj pw 0)) ) ) ) )\n"
  },
  {
    "path": "lib/app.l",
    "content": "# 13apr23 Software Lab. Alexander Burger\n\n# Exit on error\n(de *Err\n   (prinl *Pid \" ! \" (stamp) \" [\" *Adr \" \" (host *Adr) \"] \" *Agent)\n   (for (\"L\" (trail T)  \"L\")\n      (cond\n         ((pair (car \"L\"))\n            (let \"E\" (++ \"L\")\n               (println\n                  (if (getd (box? (car \"E\")))\n                     (cons @ (cdr \"E\"))\n                     \"E\" ) ) ) )\n         ((== '\"L\" (car \"L\"))\n            (setq \"L\" (cddr \"L\")) )\n         (T\n            (space 3)\n            (println (++ \"L\") (++ \"L\")) ) ) )\n   (println '====)\n   (show This)\n   (println '*Uri (pack *Uri))\n   (println '*Host (pack *Host))\n   (for \"X\" '(*Port *SesId *ConId *Tab *Gui *Btn *Get *ID)\n      (println \"X\" (val \"X\")) )\n   (println '*PRG *PRG (val *PRG))\n   (rollback) )\n\n# User identification\n(de user (Pid1 Pid2 Nm To)\n   (nond\n      (Pid1 (tell 'user *Pid))\n      (Pid2\n         (tell 'user Pid1 *Pid (get *Login 'nm)\n            (/ (- *Timeout (cadr (assoc -1 *Run))) 60000) ) )\n      ((<> *Pid Pid1) (println Pid2 Nm To)) ) )\n\n# Timestamp\n(msg *Pid \" + \" (stamp))\n(flush)\n\n# Extend 'app' function\n(conc (last app)\n   '((msg *Pid \" + \" (stamp) \" [\" *Adr \" \" (host *Adr) (and *Cipher (pack \" / \" @)) \"] \" *Agent)) )\n\n# Bye message\n(push '*Fork\n   '(finish (and *SesId (msg *Pid \" - \" (stamp)))) )\n"
  },
  {
    "path": "lib/bash_completion",
    "content": "# Bash completion for picolisp + pil\n# Alexander Burger \n\n_pil()\n{\n    local -a ARGS\n    local IFS=$'\\n'\n\n    for A in \"${COMP_WORDS[@]:1:$((COMP_CWORD-1))}\"\n    do\n        test \"${A:0:1}\" = \"-\" || ARGS[${#ARGS[@]}]=\"${A//\\\\ / }\"\n    done\n    COMPREPLY=($(${COMP_WORDS[0]} ${ARGS[@]} /usr/lib/picolisp/lib/complete.l \"${COMP_WORDS[$COMP_CWORD]}\" -bye + 2>&1))\n    return 0\n} &&\ncomplete -o nospace  -F _pil  picolisp  &&\ncomplete -o nospace  -F _pil  pil\n"
  },
  {
    "path": "lib/btree.l",
    "content": "# 13apr25 Software Lab. Alexander Burger\n\n# *Prune\n\n(private) (_store _put _splitBt _del)\n\n(de root (Tree)\n   (cond\n      ((not Tree) (val *DB))\n      ((atom Tree) (val Tree))\n      ((ext? (cdr Tree)) (get @ (car Tree)))\n      ((atom (cdr Tree))\n         (get *DB (cdr Tree) (car Tree)) )\n      (T (get (cddr Tree) (cadr Tree) (car Tree))) ) )\n\n# Fetch\n(de fetch (Tree Key)\n   (let? Node (cdr (root Tree))\n      (and *Prune (idx '*Prune Node T))\n      (use R\n         (loop\n            (and *Prune (set (prop Node NIL) 0))\n            (T\n               (and\n                  (setq R (rank Key (cdr (val Node))))\n                  (= Key (car R)) )\n               (or (cddr R) (fin (car R))) )\n            (NIL\n               (setq Node (if R (cadr R) (car (val Node)))) ) ) ) ) )\n\n# Store\n(de store (Tree Key Val Dbf)\n   (default Dbf (1 . 256))\n   (if (atom Tree)\n      (let Base (or Tree *DB)\n         (_store (or (val Base) (set Base (cons 0)))) )\n      (let Base\n         (if (atom (cdr Tree))\n            (or\n               (ext? (cdr Tree))\n               (get *DB (cdr Tree))\n               (put *DB (cdr Tree) (new T 0)) )\n            (or\n               (get (cddr Tree) (cadr Tree))\n               (put (cddr Tree) (cadr Tree) (new T)) ) )\n         (_store\n            (or\n               (get Base (car Tree))\n               (put Base (car Tree) (cons 0)) ) ) ) ) )\n\n(de _store (Root)\n   (and *Prune (cdr Root) (idx '*Prune @ T))\n   (ifn Val\n      (when (and (cdr Root) (_del @))\n         (touch Base)\n         (cond\n            (*Solo (zap (cdr Root)))\n            (*Zap (push @ (cdr Root))) )\n         (con Root) )\n      (and (= Val (fin Key)) (off Val))\n      (if (cdr Root)\n         (when (_put @)\n            (touch Base)\n            (con Root (def (new (car Dbf)) (list (car @) (cdr @)))) )\n         (touch Base)\n         (con Root\n            (def (new (car Dbf))\n               (list NIL (cons Key NIL Val)) ) )\n         (and *Prune (set (prop (cdr Root) NIL) 0))\n         (inc Root) ) ) )\n\n(de _put (Top)\n   (and *Prune (set (prop Top NIL) 0))\n   (let (V (val Top)  R (rank Key (cdr V)))\n      (cond\n         (R\n            (if (= Key (car R))\n               (nil (touch Top) (con (cdr R) Val))\n               (let X (memq R V)\n                  (if (cadr R)\n                     (when (_put @)\n                        (touch Top)\n                        (set (cdr R) (car @))\n                        (con X (cons (cdr @) (cdr X)))\n                        (_splitBt) )\n                     (touch Top)\n                     (con X\n                        (cons (cons Key (cons NIL Val)) (cdr X)) )\n                     (touch Base)\n                     (inc Root)\n                     (_splitBt) ) ) ) )\n         ((car V)\n            (when (_put @)\n               (touch Top)\n               (set V (car @))\n               (con V (cons (cdr @) (cdr V)))\n               (_splitBt) ) )\n         (T\n            (touch Top)\n            (con V\n               (cons (cons Key (cons NIL Val)) (cdr V)) )\n            (touch Base)\n            (inc Root)\n            (_splitBt) ) ) ) )\n\n(de _splitBt ()\n   (when (and (cddddr V) (> (size Top) (cdr Dbf)))\n      (let (N (>> 1 (length V))  X (get V (inc N)))\n         (set (cdr X)\n            (def (new (car Dbf))\n               (cons (cadr X) (nth V (+ 2 N))) ) )\n         (cons\n            (if *Solo\n               (prog (set Top (head N V)) Top)\n               (and *Zap (push @ Top))\n               (def (new (car Dbf)) (head N V)) )\n            X ) ) ) )\n\n# Del\n(de _del (Top)\n   (and *Prune (set (prop Top NIL) 0))\n   (let (V (val Top)  R (rank Key (cdr V)))\n      (cond\n         ((not R)\n            (when (and (car V) (_del @))\n               (touch Top)\n               (cond\n                  (*Solo (zap (car V)))\n                  (*Zap (push @ (car V))) )\n               (set V)\n               (not (cdr V)) ) )\n         ((= Key (car R))\n            (if (cadr R)\n               (let X (val @)\n                  (while (car X) (setq X (val @)))\n                  (touch Top)\n                  (xchg R (cadr X))\n                  (con (cdr R) (cddr (cadr X)))\n                  (when (_del (cadr R))\n                     (cond\n                        (*Solo (zap (cadr R)))\n                        (*Zap (push @ (cadr R))) )\n                     (set (cdr R)) ) )\n               (touch Base)\n               (dec Root)\n               (nand\n                  (or\n                     (con V (delq R (cdr V)))\n                     (car V) )\n                  (touch Top) ) ) )\n         ((cadr R)\n            (when (_del @)\n               (touch Top)\n               (cond\n                  (*Solo (zap (cadr R)))\n                  (*Zap (push @ (cadr R))) )\n               (set (cdr R)) ) ) ) ) )\n\n\n# Delayed deletion\n(de zap_ ()\n   (let (F (cdr *Zap)  Z (pack F \"_\"))\n      (cond\n         ((info Z)\n            (in Z (while (rd) (zap @)))\n            (if (info F)\n               (call \"mv\" F Z)\n               (%@ \"unlink\" NIL Z) ) )\n         ((info F) (call \"mv\" F Z)) ) ) )\n\n# Tree node count\n(de count (Tree)\n   (or (car (root Tree)) 0) )\n\n# Return first leaf\n(de leaf (Tree)\n   (let (Node (cdr (root Tree))  X)\n      (while (val Node)\n         (setq X (cadr @)  Node (car @)) )\n      (cddr X) ) )\n\n(private) revNode\n\n# Reverse node\n(de revNode (Node)\n   (let? Lst (val Node)\n      (let (L (car Lst)  R)\n         (for X (cdr Lst)\n            (push 'R (cons (car X) L (cddr X)))\n            (setq L (cadr X)) )\n         (cons L R) ) ) )\n\n# Key management\n(de minKey (Tree Min Max)\n   (default Max T)\n   (let (Node (cdr (root Tree))  K)\n      (use (V R X)\n         (loop\n            (NIL (setq V (val Node)) K)\n            (T\n               (and\n                  (setq R (rank Min (cdr V)))\n                  (= Min (car R)) )\n               Min )\n            (if R\n               (prog\n                  (and\n                     (setq X (cdr (memq R V)))\n                     (>= Max (caar X))\n                     (setq K (caar X)) )\n                  (setq Node (cadr R)) )\n               (when (>= Max (caadr V))\n                  (setq K (caadr V)) )\n               (setq Node (car V)) ) ) ) ) )\n\n(de maxKey (Tree Min Max)\n   (default Max T)\n   (let (Node (cdr (root Tree))  K)\n      (use (V R X)\n         (loop\n            (NIL (setq V (revNode Node)) K)\n            (T\n               (and\n                  (setq R (rank Max (cdr V) T))\n                  (= Max (car R)) )\n               Max )\n            (if R\n               (prog\n                  (and\n                     (setq X (cdr (memq R V)))\n                     (>= (caar X) Min)\n                     (setq K (caar X)) )\n                  (setq Node (cadr R)) )\n               (when (>= (caadr V) Min)\n                  (setq K (caadr V)) )\n               (setq Node (car V)) ) ) ) ) )\n\n# Step\n(de init (Tree Beg End)\n   (or Beg End (on End))\n   (let (Node (cdr (root Tree))  Q)\n      (use (V R X)\n         (if (>= End Beg)\n            (loop\n               (NIL (setq V (val Node)))\n               (T\n                  (and\n                     (setq R (rank Beg (cdr V)))\n                     (= Beg (car R)) )\n                  (push 'Q (memq R V)) )\n               (if R\n                  (prog\n                     (and\n                        (setq X (cdr (memq R V)))\n                        (>= End (caar X))\n                        (push 'Q X) )\n                     (setq Node (cadr R)) )\n                  (and\n                     (cdr V)\n                     (>= End (caadr V))\n                     (push 'Q (cdr V)) )\n                  (setq Node (car V)) ) )\n            (loop\n               (NIL (setq V (revNode Node)))\n               (T\n                  (and\n                     (setq R (rank Beg (cdr V) T))\n                     (= Beg (car R)) )\n                  (push 'Q (memq R V)) )\n               (if R\n                  (prog\n                     (and\n                        (setq X (cdr (memq R V)))\n                        (>= (caar X) End)\n                        (push 'Q X) )\n                     (setq Node (cadr R)) )\n                  (and\n                     (cdr V)\n                     (>= (caadr V) End)\n                     (push 'Q (cdr V)) )\n                  (setq Node (car V)) ) ) ) )\n      (cons (cons (cons Beg End) Q)) ) )\n\n(de step (Q Flg)\n   (use (L F X)\n      (loop\n         (T\n            (loop\n               (T (cdar Q))\n               (NIL (cdr Q) T)\n               (set Q (cadr Q))\n               (con Q (cddr Q)) ) )\n         (setq\n            L (car Q)\n            F (>= (cdar L) (caar L))\n            X (pop (cdr L)) )\n         (or (cadr L) (con L (cddr L)))\n         (T\n            (if ((if F > <) (car X) (cdar L))\n               (con (car Q))\n               (for\n                  (V (cadr X)\n                     ((if F val revNode) V)\n                     (car @) )\n                  (con L (cons (cdr @) (cdr L))) )\n               (unless (and Flg (flg? (fin (car X))))\n                  (if (cddr X)\n                     (prog (setq @@ (car X)) @)\n                     (setq @@ (caar X))\n                     (fin (car X)) ) ) )\n            @ ) ) ) )\n\n(private) (_scan _nacs _iter _reti)\n(private) (Tree Fun Beg End Flg Node R X V)\n\n# Scan tree nodes\n(de scan (Tree Fun Beg End Flg)\n   (default Fun println)\n   (or Beg End (on End))\n   (let Node (cdr (root Tree))\n      (and *Prune (idx '*Prune Node T))\n      ((if (>= End Beg) _scan _nacs) Node) ) )\n\n(de _scan (Node)\n   (let? V (val Node)\n      (for X\n         (if (rank Beg (cdr V))\n            (let R @\n               (if (= Beg (car R))\n                  (memq R (cdr V))\n                  (_scan (cadr R))\n                  (cdr (memq R (cdr V))) ) )\n            (_scan (car V))\n            (cdr V) )\n         (T (> (car X) End))\n         (unless (and Flg (flg? (fin (car X))))\n            (Fun\n               (car X)\n               (or (cddr X) (fin (car X))) ) )\n         (_scan (cadr X)) )\n      (and *Prune (set (prop Node NIL) 0)) ) )\n\n(de _nacs (Node)\n   (let? V (revNode Node)\n      (for X\n         (if (rank Beg (cdr V) T)\n            (let R @\n               (if (= Beg (car R))\n                  (memq R (cdr V))\n                  (_nacs (cadr R))\n                  (cdr (memq R (cdr V))) ) )\n            (_nacs (car V))\n            (cdr V) )\n         (T (> End (car X)))\n         (unless (and Flg (flg? (fin (car X))))\n            (Fun\n               (car X)\n               (or (cddr X) (fin (car X))) ) )\n         (_nacs (cadr X)) )\n      (and *Prune (set (prop Node NIL) 0)) ) )\n\n# Iterate tree values\n(de iter (Tree Fun Beg End Flg)\n   (default Fun println)\n   (or Beg End (on End))\n   (let Node (cdr (root Tree))\n      (and *Prune (idx '*Prune Node T))\n      ((if (>= End Beg) _iter _reti) Node) ) )\n\n(de _iter (Node)\n   (let? V (val Node)\n      (for X\n         (if (rank Beg (cdr V))\n            (let R @\n               (if (= Beg (car R))\n                  (memq R (cdr V))\n                  (_iter (cadr R))\n                  (cdr (memq R (cdr V))) ) )\n            (_iter (car V))\n            (cdr V) )\n         (T (> (car X) End))\n         (unless (and Flg (flg? (fin (car X))))\n            (Fun (or (cddr X) (fin (car X)))) )\n         (_iter (cadr X)) )\n      (and *Prune (set (prop Node NIL) 0)) ) )\n\n(de _reti (Node)\n   (let? V (revNode Node)\n      (for X\n         (if (rank Beg (cdr V) T)\n            (let R @\n               (if (= Beg (car R))\n                  (memq R (cdr V))\n                  (_reti (cadr R))\n                  (cdr (memq R (cdr V))) ) )\n            (_reti (car V))\n            (cdr V) )\n         (T (> End (car X)))\n         (unless (and Flg (flg? (fin (car X))))\n            (Fun (or (cddr X) (fin (car X)))) )\n         (_reti (cadr X)) )\n      (and *Prune (set (prop Node NIL) 0)) ) )\n\n# UB-Trees\n(de ub>= (Dim End Val Beg)\n   (let (D (>> (- 1 Dim) 1)  Pat D)\n      (while (> End Pat)\n         (setq Pat (| D (>> (- Dim) Pat))) )\n      (do Dim\n         (NIL\n            (>=\n               (& Pat End)\n               (& Pat Val)\n               (& Pat Beg) ) )\n         (setq Pat (>> 1 Pat)) ) ) )\n\n(private) (Tree Dim Fun X1 X2 Node Lst Left Beg End B E X Msb Pat N Min Max Lo Hi)\n\n(de ubIter (Tree Dim Fun X1 X2)\n   (let\n      (Node (cdr (root Tree))\n         Lst (val Node)\n         Left (++ Lst)\n         Beg (ubZval (copy X1))\n         End (ubZval (copy X2) T)\n         B (car Beg)\n         E (car End) )\n      (recur (Left Lst Beg End  X)\n         (while (setq X (++ Lst))\n            (cond\n               ((> (car X) End)\n                  (setq Lst (; Left 0 -1)  Left (; Left 0 1)) )\n               ((> Beg (car X))\n                  (if Lst\n                     (setq Left (cadr X))\n                     (setq Left (; X 2 0 1)  Lst (; X 2 0 -1)) ) )\n               ((ub>= Dim E (caar X) B)\n                  (Fun (cdar X))\n                  (recurse (; Left 0 1) (; Left 0 -1) Beg (car X))\n                  (setq Beg (car X))\n                  (if Lst\n                     (setq Left (cadr X))\n                     (setq Left (; X 2 0 1)  Lst (; X 2 0 -1)) ) )\n               (T\n                  (let (Msb 1  Pat 0  N 0  Min B  Max E  Lo (caar X)  Hi Lo)\n                     (while (>= Max Msb)\n                        (setq Msb (>> -1 Msb)  Pat (>> -1 Pat))  # Msb 100000000\n                        (when (= Dim (inc 'N))                           # Pat 000100100\n                           (inc 'Pat)\n                           (zero N) ) )\n                     (catch \"ub\"                                    # Clr 111..111011011\n                        (let (Top Msb   Clr (| Top (x| Pat (dec Msb))))\n                           (loop\n                              (T (=0 (setq Msb (>> 1 Msb))))\n                              (setq\n                                 Pat (>> 1 Pat)\n                                 Clr (| Top (>> 1 Clr)) )\n                              (ifn (bit? Msb (caar X))\n                                 (when (bit? Msb Max)\n                                    (ifn (bit? Msb Min)  # 001\n                                       (setq\n                                          Max (- (| Pat Max) Msb)  # 0111(Max)\n                                          Lo (| Msb (& Min Clr)) )   # 1000(Min)\n                                       (setq Lo Min)     # 011\n                                       (throw \"ub\") ) )\n                                 (unless (bit? Msb Min)\n                                    (if (bit? Msb Max)   # 101\n                                       (setq\n                                          Hi (- (| Pat Max) Msb)   # 0111(Max)\n                                          Min (| Msb (& Min Clr)) )  # 1000(Min)\n                                       (setq Hi Max)     # 100\n                                       (throw \"ub\") ) ) ) ) ) )\n                     (recurse (; Left 0 1) (; Left 0 -1) Beg (cons Hi T))\n                     (setq Beg (cons Lo))\n                     (if Lst\n                        (setq Left (cadr X))\n                        (setq Left (; X 2 0 1)  Lst (; X 2 0 -1)) ) ) ) ) ) ) ) )\n\n(de prune (N)\n   (for Node (idx '*Prune)\n      (recur (Node)\n         (let? V (val (lieu Node))\n            (if (>= (inc (prop Node NIL)) N)\n               (wipe Node)\n               (recurse (car V))\n               (for X (cdr V)\n                  (recurse (cadr X)) ) ) ) ) )\n   (or (gt0 N) (setq *Prune N)) )\n\n# Delete Tree\n(de zapTree (Node)\n   (let? V (val Node)\n      (zapTree (car V))\n      (for L (cdr V)\n         (zapTree (cadr L)) )\n      (zap Node) ) )\n\n(private) (Node Fun N L V X Y)\n\n# Check tree structure\n(de chkTree (Node Fun)\n   (let (N 0  X)\n      (when Node\n         (recur (Node)\n            (let V (val Node)\n               (let L (car V)\n                  (for Y (cdr V)\n                     (when L\n                        (unless (ext? L)\n                           (quit \"Bad node link\" Node) )\n                        (recurse L) )\n                     (when (>= X (car Y))\n                        (quit \"Bad sequence\" Node) )\n                     (setq X (car Y))\n                     (inc 'N)\n                     (and\n                        Fun\n                        (not (Fun (car Y) (cddr Y)))\n                        (quit \"Check fail\" Node) )\n                     (setq L (cadr Y)) )\n                  (and L (recurse L)) ) )\n            (wipe Node) ) )\n      N ) )\n"
  },
  {
    "path": "lib/canvas.js",
    "content": "/* 21jan25 Software Lab. Alexander Burger */\n\nfunction renderCanvas(cvs, lst) {\n   var ctx = cvs.getContext(\"2d\");\n   var cmd, i, j;\n\n   if (lst) {\n      for (i = 0; i < lst.length; ++i) {\n         switch ((cmd = lst[i])[0]) {  // Sync with \"@lib/canvas.l\"\n         /*** Functions ***/\n         case 1:  // (csFont Str)\n            ctx.font = cmd[1];\n         case 2:  // (csFillText Str X Y)\n            ctx.fillText(cmd[1], cmd[2], cmd[3]);\n            break;\n         case 3:  // (csStrokeLine X1 Y1 X2 Y2)\n            ctx.beginPath();\n            ctx.moveTo(cmd[1], cmd[2]);\n            ctx.lineTo(cmd[3], cmd[4]);\n            ctx.closePath();\n            ctx.stroke();\n            break;\n         case 4:  // (csClearRect X Y DX DY)\n            ctx.clearRect(cmd[1], cmd[2], cmd[3], cmd[4]);\n            break;\n         case 5:  // (csStrokeRect X Y DX DY)\n            ctx.strokeRect(cmd[1], cmd[2], cmd[3], cmd[4]);\n            break;\n         case 6:  // (csFillRect X Y DX DY)\n            ctx.fillRect(cmd[1], cmd[2], cmd[3], cmd[4]);\n            break;\n         case 7:  // (csBeginPath)\n            ctx.beginPath();\n            break;\n         case 8:  // (csClosePath)\n            ctx.closePath();\n            break;\n         case 9:  // (csMoveTo X Y)\n            ctx.moveTo(cmd[1], cmd[2]);\n            break;\n         case 10:  // (csLineTo X Y)\n            ctx.lineTo(cmd[1], cmd[2]);\n            break;\n         case 11:  // (csBezierCurveTo X1 Y1 X2 Y2 X Y)\n            ctx.bezierCurveTo(cmd[1], cmd[2], cmd[3], cmd[4], cmd[5], cmd[6]);\n            break;\n         case 12:  // (csQuadraticCurveTo X1 Y1 X2 Y2)\n            ctx.quadraticCurveTo(cmd[1], cmd[2], cmd[3], cmd[4]);\n            break;\n         case 13:  // (csLine X1 Y1 X2 Y2)\n            ctx.moveTo(cmd[1], cmd[2]);\n            ctx.lineTo(cmd[3], cmd[4]);\n            break;\n         case 14:  // (csRect X Y DX DY)\n            ctx.rect(cmd[1], cmd[2], cmd[3], cmd[4]);\n            break;\n         case 15:  // (csArc X Y R A B F)\n            ctx.arc(cmd[1], cmd[2], cmd[3], cmd[4], cmd[5], cmd[6]);\n            break;\n         case 16:  // (csStroke)\n            ctx.stroke();\n            break;\n         case 17:  // (csFill)\n            ctx.fill();\n            break;\n         case 18:  // (csClip)\n            ctx.clip();\n            break;\n         case 19:  // (csDef Key [DX DY Lst])\n            if (!cvs.pre)\n               cvs.pre = new Array();\n            var buf = cvs.pre[cmd[1]] = document.createElement('canvas');\n            if (cmd[2]) {\n               buf.width = cmd[2];\n               buf.height = cmd[3];\n               renderCanvas(buf, cmd[4]);\n            }\n            else {\n               buf.width = cvs.width;\n               buf.height = cvs.height;\n               buf.getContext(\"2d\").drawImage(cvs, 0, 0);\n            }\n            break;\n         case 20:  // (csDraw Key X Y)\n            var buf = cvs.pre[cmd[1]];\n            ctx.clearRect(cmd[2], cmd[3], buf.width, buf.height);\n            ctx.drawImage(buf, cmd[2], cmd[3]);\n            break;\n         case 21:  // (csDrawDots DX DY Lst)\n            if (cmd[3])\n               for (j = 0; j < cmd[3].length; j += 2)\n                  ctx.fillRect(cmd[3][j], cmd[3][j+1], cmd[1], cmd[2]);\n            break;\n         case 22:  // (csDrawImage Img X Y Lst DX DY [Key])\n            var img;\n\n            if (cmd[7]  &&  (img = (cvs.img || (cvs.img = new Array()))[cmd[7]])) {\n               if (img.lst.length > 0)\n                  img.lst.push([cmd[2], cmd[3], cmd[4], cmd[5], cmd[6]]);\n               else {\n                  if (cmd[5])\n                     ctx.drawImage(img, cmd[2], cmd[3], cmd[5], cmd[6]);\n                  else\n                     ctx.drawImage(img, cmd[2], cmd[3]);\n                  if (cmd[4])\n                     renderCanvas(cvs, cmd[4]);\n               }\n            }\n            else {\n               (img = new Image()).src = cmd[1];\n               img.lst = [[cmd[2], cmd[3], cmd[4], cmd[5], cmd[6]]];\n               (function (img) {\n                  img.onload = function() {\n                     do {\n                        var a = img.lst.shift();\n                        if (a[3])\n                           ctx.drawImage(img, a[0], a[1], a[3], a[4]);\n                        else\n                           ctx.drawImage(img, a[0], a[1]);\n                        if (a[2])\n                           renderCanvas(cvs, a[2]);\n                     } while (img.lst.length > 0);\n                  } } )(img);\n               if (cmd[7])\n                  cvs.img[cmd[7]] = img;\n            }\n            break;\n         case 23:  // (csTranslate X Y)\n            ctx.translate(cmd[1], cmd[2]);\n            break;\n         case 24:  // (csRotate A)\n            ctx.rotate(cmd[1]);\n            break;\n         case 25:  // (csScale X Y)\n            ctx.scale(cmd[1], cmd[2]);\n            break;\n         case 26:  // (csSave)\n            ctx.save();\n            break;\n         case 27:  // (csRestore)\n            ctx.restore();\n            break;\n         /*** Variables ***/\n         case 28:  // (csCursor Lst)\n            cvs.curs = cmd[1];\n            break;\n         case 29:  // (csFillStyle V)\n            ctx.fillStyle = cmd[1];\n            break;\n         case 30:  // (csStrokeStyle V)\n            ctx.strokeStyle = cmd[1];\n            break;\n         case 31:  // (csGlobalAlpha V)\n            ctx.globalAlpha = cmd[1];\n            break;\n         case 32:  // (csLineWidth V)\n            ctx.lineWidth = cmd[1];\n            break;\n         case 33:  // (csLineCap V)\n            ctx.lineCap = cmd[1];\n            break;\n         case 34:  // (csLineJoin V)\n            ctx.lineJoin = cmd[1];\n            break;\n         case 35:  // (csMiterLimit V)\n            ctx.miterLimit = cmd[1];\n            break;\n         case 36:  // (csGlobalCompositeOperation V)\n            ctx.globalCompositeOperation = cmd[1];\n            break;\n         case 37:  // (csDelay N)\n            cvs.dly = cmd[1];\n            break;\n         case 38:  // (csPost)\n            cvs.post = true;\n            break;\n         }\n      }\n   }\n}\n\nfunction drawCanvas(id, dly) {\n   var req = new XMLHttpRequest();\n   var url = document.getElementsByTagName(\"BASE\")[0].href + SesId + \"!jsDraw?\" + id + \"&+\" + dly;\n   var flg = arguments[2];\n\n   for (var i = 2; i < arguments.length; ++i)\n      if (typeof arguments[i] === \"number\")\n         url += \"&+\" + arguments[i];\n      else\n         url += \"&\" + arguments[i];\n   try {req.open(\"POST\", url);}\n   catch (e) {return true;}\n   req.responseType = \"arraybuffer\";\n   req.onload = function() {\n      var ele = document.getElementById(id);\n\n      ele.dly = dly;\n      renderCanvas(ele, plio(new Uint8Array(req.response)));\n      if (ele.post) {\n         ele.post = false;\n         while (ele = ele.parentNode) {\n            if (ele.tagName == \"FORM\") {\n               post(ele, false, null, null);\n               break;\n            }\n         }\n      }\n      if (!flg) {\n         if (ele.auto)\n            clearTimeout(ele.auto);\n         if (ele.dly == 0)\n            drawCanvas(id, 0);\n         else if (ele.dly > 0)\n            ele.auto = setTimeout(function() {drawCanvas(id, dly)}, ele.dly);\n      }\n      ele.dly = dly;\n   };\n   try {req.send(null);}\n   catch (e) {\n      req.abort();\n      return true;\n   }\n   return false;\n}\n\nfunction doCsDn(cvs, x, y) {\n   var r = cvs.getBoundingClientRect();\n\n   cvs.csDn = true;\n   cvs.csDnX = x - r.left;\n   cvs.csDnY = y - r.top;\n   cvs.csMv = false;\n   return false;\n}\n\nfunction csMouseDn(cvs, event) {\n   return doCsDn(cvs, event.clientX, event.clientY);\n}\n\nfunction csTouchDn(cvs, event) {\n   return doCsDn(cvs, event.touches[0].clientX, event.touches[0].clientY);\n}\n\nfunction doCsMv(cvs, x, y) {\n   var r = cvs.getBoundingClientRect();\n\n   if (cvs.curs)\n      csCursor(cvs, x - r.left, y - r.top);\n   if (!cvs.csDn)\n      return true;\n   if (!cvs.csMv)\n      cvs.csMv = [x, y];\n   else {\n      if (Array.isArray(cvs.csMv)) {\n         if (drawCanvas(cvs.id, cvs.dly, 0, cvs.csDnX, cvs.csDnY, cvs.csMv[0] - r.left, cvs.csMv[1] - r.top))\n            return true;\n         cvs.csMv = true;\n      }\n      if (drawCanvas(cvs.id, cvs.dly, -1, cvs.csDnX, cvs.csDnY, x - r.left, y - r.top))\n         return true;\n   }\n   return false;\n}\n\nfunction csMouseMv(cvs, event) {\n   return doCsMv(cvs, event.clientX, event.clientY);\n}\n\nfunction csTouchMv(cvs, event) {\n   if (event.targetTouches.length == 1) {\n      event.preventDefault();\n      return doCsMv(cvs, event.touches[0].clientX, event.touches[0].clientY);\n   }\n   return false;\n}\n\nfunction csMouseUp(cvs) {\n   cvs.csDn = false;\n   if (cvs.clicked) {\n      clearTimeout(cvs.clicked);\n      cvs.clicked = null;\n      return drawCanvas(cvs.id, cvs.dly, 2, cvs.csDnX, cvs.csDnY);\n   }\n   if (cvs.csMv)\n      return drawCanvas(cvs.id, cvs.dly, \"$T\");\n   cvs.clicked = setTimeout(\n      function() {\n         cvs.clicked = null;\n         drawCanvas(cvs.id, cvs.dly, 1, cvs.csDnX, cvs.csDnY);\n      },\n      200 );\n   return false;\n}\n\nfunction csTouchEnd(cvs) {\n   cvs.csDn = false;\n   if (cvs.csMv)\n      return drawCanvas(cvs.id, cvs.dly, \"$T\");\n   return false;\n}\n\nfunction csLeave(cvs) {\n   cvs.style.cursor = \"\";\n   cvs.csDn = cvs.csMv = false;\n   if (cvs.clicked) {\n      clearTimeout(cvs.clicked);\n      cvs.clicked = null;\n   }\n   return drawCanvas(cvs.id, cvs.dly, \"$T\");\n}\n\nfunction csCursor(cvs, x, y) {\n   var a;\n\n   for (var i = 0; i < cvs.curs.length; ++i) {\n      if (typeof (a = cvs.curs[i]) === \"string\") {\n         cvs.style.cursor = a;\n         return;\n      }\n      for (var j = 1; j < a.length; j += 4) {\n         if (a[j] <= x && x <= a[j+2] && a[j+1] <= y && y <= a[j+3]) {\n            cvs.style.cursor = a[0];\n            return;\n         }\n      }\n   }\n   cvs.style.cursor = \"\";\n}\n"
  },
  {
    "path": "lib/canvas.l",
    "content": "# 19sep23 Software Lab. Alexander Burger\n\n(allow \"!jsDraw\" )\n(push1 '*JS (allow \"@lib/plio.js\") (allow \"@lib/canvas.js\"))\n\n# Draw   (drawCanvas Id Dly [T])\n# Click  (drawCanvas Id Dly 1 X Y)\n# Double (drawCanvas Id Dly 2 X Y)\n# Start  (drawCanvas Id Dly 0 X Y X2 Y2)\n# Move   (drawCanvas Id Dly -1 X Y X2 Y2)\n(de jsDraw (Id Dly F X Y X2 Y2)\n   (http1 \"application/octet-stream\" 0)\n   (let Lst (drawCanvas Id Dly F X Y X2 Y2)\n      (prinl \"Content-Length: \" (bytes Lst) \"\\r\\n\\r\")\n      (pr Lst) ) )\n\n# Canvas Commands\n(for (Opc . L)\n   (quote  # In sync with \"@lib/canvas.js\"\n      ### Functions ###\n      (csFont Str)\n      (csFillText Str X Y)\n      (csStrokeLine X1 Y1 X2 Y2)\n      (csClearRect X Y DX DY)\n      (csStrokeRect X Y DX DY)\n      (csFillRect X Y DX DY)\n      (csBeginPath)\n      (csClosePath)\n      (csMoveTo X Y)\n      (csLineTo X Y)\n      (csBezierCurveTo X1 Y1 X2 Y2 X Y)\n      (csQuadraticCurveTo X1 Y1 X2 Y2)\n      (csLine X1 Y1 X2 Y2)\n      (csRect X Y DX DY)\n      (csArc X Y R A B F)\n      (csStroke)\n      (csFill)\n      (csClip)\n      (csDef Key DX DY Lst)\n      (csDraw Key X Y)\n      (csDrawDots DX DY Lst)\n      (csDrawImage Img X Y Lst DX DY Key)\n      (csTranslate X Y)\n      (csRotate A)\n      (csScale X Y)\n      (csSave)\n      (csRestore)\n      ### Variables ###\n      (csCursor Lst)\n      (csFillStyle V)\n      (csStrokeStyle V)\n      (csGlobalAlpha V)\n      (csLineWidth V)\n      (csLineCap V)\n      (csLineJoin V)\n      (csMiterLimit V)\n      (csGlobalCompositeOperation V)\n      (csDelay N)\n      (csPost) )\n   (def (car L)\n      (list\n         (cdr L)\n         (list 'link\n            (if (cdr L)\n               (cons 'list Opc @)\n               (list Opc) ) ) ) ) )\n\n(de  (Id DX DY Alt)\n   (prin\n      \"\" Alt \"\" ) )\n\n(de  (Id DX DY Dly Post)\n   (unless (str? Id)\n      (put Id 'home *Top)\n      (setq Id (pack \"$\" Id)) )\n   ( Id DX DY)\n   (if Post\n      ( \"Post = function() {drawCanvas('\" Id \"', \" Dly \")}; Post()\")\n      ( \"drawCanvas('\" Id \"', \" Dly \")\") ) )\n\n### Debug ###\n`*Dbg\n\n(noLint 'drawCanvas)\n"
  },
  {
    "path": "lib/clang.l",
    "content": "# 19may21 Software Lab. Alexander Burger\n\n(de clang (Nm L . Lst)\n   (out (tmp Nm \".c\") (here \"/**/\"))\n   (apply call L \"clang\" \"-o\" (tmp Nm)\n      \"-fPIC\" \"-O\" \"-w\" \"-shared\" (tmp Nm \".c\"))\n   (for L Lst\n      (def (car L)\n         (list\n            (cadr L)\n            (cons 'native (tmp Nm) (name (caddr L)) (cdddr L)) ) )\n      (when (== '@ (fin (cadr L)))\n         (push (cdaar L) 'pass) ) ) )\n"
  },
  {
    "path": "lib/complete.l",
    "content": "# 29dec20 Software Lab. Alexander Burger\n\n(if (opt)\n   (let \"Lst\" (chop @)\n      (if (= \"-\" (car \"Lst\"))\n         (let \"Pre\" (++ \"Lst\")\n            (when (member (car \"Lst\") '(\"\\\"\" \"'\"))\n               (setq \"Pre\" (++ \"Lst\")) )\n            (let \"Str\" (pack \"Lst\")\n               (for \"Sym\" (all)\n                  (and\n                     (pre? \"Str\" \"Sym\")\n                     (getd \"Sym\")\n                     (prinl \"Pre\" \"Sym\" (and (= \"-\" \"Pre\") \" \")) ) ) ) )\n         (let (\"Path\" (rot (split \"Lst\" \"/\"))  \"Str\" (pack (car \"Path\")))\n            (setq \"Path\" (and (cdr \"Path\") (pack (glue \"/\" @) \"/\")))\n            (for \"Sym\" (dir \"Path\" T)\n               (when (pre? \"Str\" \"Sym\")\n                  (prinl \"Path\"\n                     (replace (chop \"Sym\") \" \" \"\\\\ \")\n                     (if (=T (car (info (pack \"Path\" \"Sym\"))))\n                        \"/\"\n                        \" \" ) ) ) ) ) ) )\n   (prinl '+) )\n"
  },
  {
    "path": "lib/db.l",
    "content": "# 12apr26 Software Lab. Alexander Burger\n\n# *Jnl *Blob\n\n### Tree Access ###\n(de tree (Var Cls Hook)\n   (cons Var\n      (if Hook\n         (cons Cls Hook)\n         Cls ) ) )\n\n(de genKey (Var Cls Hook Min Max)\n   (if (lt0 Max)\n      (let K (minKey (tree Var Cls Hook) Min Max)\n         (if (lt0 K) (dec K) (or Max -1)) )\n      (let K (maxKey (tree Var Cls Hook) Min Max)\n         (if (gt0 K) (inc K) (or Min 1)) ) ) )\n\n(de useKey (Var Cls Hook)\n   (let (Tree (tree Var Cls Hook)  Max (* 2 (inc (count Tree)))  N)\n      (while (fetch Tree (setq N (rand 1 Max))))\n      N ) )\n\n(de genStrKey (Str Var Cls Hook)\n   (while (fetch (tree Var Cls Hook) Str)\n      (setq Str (pack \"# \" Str)) )\n   Str )\n\n(de ubZval (Lst X)\n   (let (Res 0  P 1  Q 1)\n      (while (find '((N) (>= N Q)) Lst)\n         (for N Lst\n            (and\n               N\n               (bit? Q N)\n               (setq Res (| Res P)) )\n            (setq P (>> -1 P)) )\n         (setq Q (>> -1 Q)) )\n      (cons Res X) ) )\n\n\n### Relations ###\n(class +relation)\n\n(dm T (Var)\n   (=: cls *Class)\n   (=: var Var) )\n\n# Type check\n(dm mis> (Val Obj))  #> lst\n(dm ele> (Val))\n\n# Value present?\n(dm has> (Val X)  #> flg\n   (= Val X) )\n\n# Set value\n(dm put> (Obj Old New)\n   New )\n\n# Delete value\n(dm del> (Obj Old Val)\n   (and (<> Old Val) Val) )\n\n# Maintain relations\n(dm rel> (Obj Old New))\n\n(dm rel?> (Obj Val)\n   T )\n\n(dm lose> (Obj Val))\n\n(dm keep> (Obj Val))\n\n# Search\n(dm iter> (X Lst)\n   (cons\n      (list (: cls Dbf 1))\n      (let @Cls (: cls)\n         (curry (@Cls) (P)\n            (loop\n               (NIL (and (car P) (set P (seq (car P)))))\n               (T (and (isa '@Cls @) (not (; @ T)))\n                  (car P) ) ) ) ) ) )\n\n(dm match> (X Val Obj)\n   (cond\n      ((not X) Val)\n      ((str? X) (pre? X Val))\n      ((atom X) (and (= X Val) Val))\n      ((>= (cdr X) (car X))\n         (and (>= (cdr X) Val (car X)) Val) )\n      ((>= (car X) Val (cdr X)) Val) ) )\n\n# Finalizer\n(dm zap> (Obj Val))\n\n\n(class +Any +relation)\n\n# (+Bag) (cls ..) (..) (..)\n(class +Bag +relation)\n\n(dm T (Var Lst)\n   (=: bag\n      (mapcar\n         '((L)\n            (prog1\n               (new (car L) Var (cdr L))\n               (and (get @ 'hook) (=: hook T)) ) )\n         Lst ) )\n   (super Var) )\n\n(dm mis> (Val Obj)\n   (ifn (lst? Val)\n      \"Not a Bag\"\n      (pick\n         '((This V)\n            (mis> This V Obj\n               (when (: hook)\n                  (get (if (sym? @) Obj Val) (: hook)) ) ) )\n         (: bag)\n         Val ) ) )\n\n(dm ele> (Val)\n   (and Val\n      (or\n         (atom Val)\n         (find 'ele> (: bag) Val) ) ) )\n\n(dm has> (Val X)\n   (when Val\n      (if (atom Val)\n         (find 'has> (: bag) Val X)\n         (fully 'has> (: bag) Val X) ) ) )\n\n(dm put> (Obj Old New)\n   (trim\n      (mapcar\n         '((X O N) (put> X Obj O N))\n         (: bag)\n         Old\n         New ) ) )\n\n(dm rel> (Obj Old New)\n   (when Old\n      (mapc\n         '((This O)\n            (rel> This Obj O NIL\n               (when (: hook)\n                  (get (if (sym? @) Obj Old) (: hook)) ) ) )\n         (: bag)\n         Old ) )\n   (when New\n      (mapc\n         '((This N)\n            (rel> This Obj NIL N\n               (when (: hook)\n                  (get (if (sym? @) Obj New) (: hook)) ) ) )\n         (: bag)\n         New ) ) )\n\n(dm rel?> (Obj Val)\n   (fully\n      '((This V)\n         (or\n            (not V)\n            (rel?> This Obj V\n               (when (: hook)\n                  (get (if (sym? @) Obj Val) (: hook)) ) ) ) )\n      (: bag)\n      Val ) )\n\n(dm lose> (Obj Val)\n   (mapc\n      '((This V)\n         (lose> This Obj V\n            (when (: hook)\n               (get (if (sym? @) Obj Val) (: hook)) ) ) )\n      (: bag)\n      Val ) )\n\n(dm keep> (Obj Val)\n   (mapc\n      '((This V)\n         (keep> This Obj V\n            (when (: hook)\n               (get (if (sym? @) Obj Val) (: hook)) ) ) )\n      (: bag)\n      Val ) )\n\n(dm iter> (X Lst)\n   (if\n      (find\n         '((B) (isa '+index B))\n         (: bag) )\n      (iter> @ X Lst)\n      (super X Lst) ) )\n\n(dm match> (X Val Obj)\n   (pick 'match> (: bag)\n      (circ X)\n      Val\n      (circ Obj) ) )\n\n\n(class +Bool +relation)\n\n(dm mis> (Val Obj)\n   (and Val (nT Val) ,\"Boolean input expected\") )\n\n\n# (+Number) [num]\n(class +Number +relation)\n\n(dm T (Var Lst)\n   (=: scl (car Lst))\n   (super Var) )\n\n(dm mis> (Val Obj)\n   (and Val (not (num? Val)) ,\"Numeric input expected\") )\n\n\n# (+Date)\n(class +Date +Number)\n\n(dm T (Var Lst)\n   (super Var (cons NIL Lst)) )\n\n\n# (+Time)\n(class +Time +Number)\n\n(dm T (Var Lst)\n   (super Var (cons NIL Lst)) )\n\n\n# (+Symbol)\n(class +Symbol +relation)\n\n(dm mis> (Val Obj)\n   (unless (sym? Val)\n      ,\"Symbolic type expected\" ) )\n\n\n# (+String)\n(class +String +Symbol)\n\n(dm mis> (Val Obj)\n   (and Val (not (str? Val)) ,\"String type expected\") )\n\n\n(private) canQuery\n\n# (+Link) typ\n(class +Link +relation)\n\n(dm T (Var Lst)\n   (unless (=: type (car Lst))\n      (quit \"No Link\" Var) )\n   (super Var) )\n\n(de canQuery (Val)\n   (and\n      (pair Val)\n      (pair (car Val))\n      (fully\n         '((L)\n            (find\n               '((Cls)\n                  (get Cls\n                     ((if (lst? (car L)) cadr car) L) ) )\n               (: type) ) )\n         Val ) ) )\n\n(dm mis> (Val Obj)\n   (and\n      Val\n      (nor\n         (isa (: type) Val)\n         (canQuery Val) )\n      ,\"Type error\" ) )\n\n\n# (+Joint) var typ [put get]\n(class +Joint +Link)\n\n(dm T (Var Lst)\n   (=: slot (car Lst))\n   (=: put (caddr Lst))\n   (=: get (cadddr Lst))\n   (super Var (cdr Lst)) )\n\n(dm mis> (Val Obj)\n   (and\n      Val\n      (nor\n         (canQuery Val)\n         (and\n            (isa (: type) Val)\n            (with (meta Val (: slot))\n               (or\n                  (isa '+Link This)\n                  (find\n                     '((B) (isa '+Link B))\n                     (: bag) ) ) ) ) )\n      ,\"Type error\" ) )\n\n(dm rel> (Obj Old New)\n   (and Old\n      (del> Old (: slot)\n         (if (: get)\n            (@ Obj (get Old (: slot)))\n            Obj ) ) )\n   (and New\n      (not (get Obj T))\n      (not (has> New (: slot) Obj))\n      (put> New (: slot)\n         (if (: put) (@ Obj) Obj) ) ) )\n\n(dm rel?> (Obj Val)\n   (let X (get Val (: slot))\n      (cond\n         ((atom X) (== Obj X))\n         ((: get) (@ Obj X))\n         (T (memq Obj X)) ) ) )\n\n(dm lose> (Obj Val)\n   (when Val\n      (put Val (: slot)\n         (del> (meta Val (: slot))\n            Obj\n            (get Val (: slot))\n            (if (: put) (@ Obj) Obj) ) ) ) )\n\n(dm keep> (Obj Val)\n   (when Val\n      (put Val (: slot)\n         (put> (meta Val (: slot))\n            Obj\n            (get Val (: slot))\n            (if (: put) (@ Obj) Obj) ) ) ) )\n\n\n# +Link or +Joint prefix\n(class +Hook)\n\n(dm rel> (Obj Old New Hook)\n   (let L\n      (extract\n         '((X)\n            (and (atom X) (setq X (cons T X)))\n            (and\n               (or\n                  (== (: var) (meta Obj (cdr X) 'hook))\n                  (find\n                     '((B) (== (: var) (get B 'hook)))\n                     (meta Obj (cdr X) 'bag) ) )\n               X ) )\n         (getl Obj) )\n      (for X L\n         (rel> (meta Obj (cdr X)) Obj (car X) NIL (or Old *DB))\n         (rel> (meta Obj (cdr X)) Obj NIL (car X) (or New *DB)) ) )\n   (extra Obj Old New Hook) )\n\n\n# +Index prefix\n(class +Hook2)\n\n(dm rel> (Obj Old New Hook)\n   (extra Obj Old New *DB)\n   (when (or (and Hook (n== Hook *DB)) (and (: hook) (get Obj @)))\n      (extra Obj Old New Hook) ) )\n\n(dm lose> (Obj Val Hook)\n   (extra Obj Val *DB)\n   (when (or (and Hook (n== Hook *DB)) (and (: hook) (get Obj @)))\n      (extra Obj Val Hook) ) )\n\n(dm keep> (Obj Val Hook)\n   (extra Obj Val *DB)\n   (when (or (and Hook (n== Hook *DB)) (and (: hook) (get Obj @)))\n      (extra Obj Val Hook) ) )\n\n\n# (+Blob)\n(class +Blob +relation)\n\n(de blob (Obj Var)\n   (pack *Blob (glue \"/\" (chop Obj)) \".\" Var) )\n\n(dm put> (Obj Old New)\n   (and\n      New\n      (dirname (blob Obj))\n      (call \"mkdir\" \"-p\" @) )\n   (if (flg? New)\n      New\n      (in New (out (blob Obj (: var)) (echo)))\n      T ) )\n\n(dm zap> (Obj Val)\n   (and Val (%@ \"unlink\" NIL (blob Obj (: var)))) )\n\n\n### Index classes ###\n(private) (idxRel? relAux)\n\n(class +index)\n\n(dm T (Var Lst)\n   (=: hook (car Lst))\n   (extra Var (cdr Lst)) )\n\n(dm rel?> (Obj Val Hook))\n\n\n# (+Key +relation) [hook]\n(class +Key +index)\n\n(dm mis> (Val Obj Hook)\n   (or\n      (extra Val Obj Hook)\n      (and\n         Val\n         (not (has> Obj (: var) Val))\n         (fetch\n            (tree (: var) (: cls) (or Hook (and (: hook) (get Obj @))))\n            Val )\n         ,\"Not unique\" ) ) )\n\n(dm rel> (Obj Old New Hook)\n   (let Tree (tree (: var) (: cls) (or Hook (and (: hook) (get Obj @))))\n      (and Old\n         (= Obj (fetch Tree Old))\n         (store Tree Old NIL (: dbf)) )\n      (and New\n         (not (get Obj T))\n         (not (fetch Tree New))\n         (store Tree New Obj (: dbf)) ) )\n   (extra Obj Old New Hook) )\n\n(dm rel?> (Obj Val Hook)\n   (== Obj\n      (fetch\n         (tree (: var) (: cls) (or Hook (and (: hook) (get Obj @))))\n         Val ) ) )\n\n(dm lose> (Obj Val Hook)\n   (store\n      (tree (: var) (: cls) (or Hook (and (: hook) (get Obj @))))\n      Val NIL (: dbf) )\n   (extra Obj Val Hook) )\n\n(dm keep> (Obj Val Hook)\n   (store\n      (tree (: var) (: cls) (or Hook (and (: hook) (get Obj @))))\n      Val Obj (: dbf) )\n   (extra Obj Val Hook) )\n\n(dm iter> (X Lst)\n   (let Tree (tree (: var) (: cls) (caddr Lst))\n      (cons\n         (nond\n            ((atom X)\n               (nond\n                  ((str? (car X))\n                     (init Tree (car X) (cdr X)) )\n                  ((>= (cdr X) (car X))\n                     (init Tree (pack (car X) `(char T)) (cdr X)) )\n                  (NIL\n                     (init Tree (car X) (pack (cdr X) `(char T))) ) ) )\n            ((str? X) (init Tree X X))\n            (NIL (init Tree X (pack X `(char T)))) )\n         (let @Cls (cadr Lst)\n            (curry (@Cls) (Q)\n               (loop\n                  (NIL (step Q))\n                  (T (isa '@Cls @) @) ) ) ) ) ) )\n\n\n# (+Ref +relation) [hook]\n(class +Ref +index)\n\n(dm rel> (Obj Old New Hook)\n   (let\n      (Tree (tree (: var) (: cls) (or Hook (and (: hook) (get Obj @))))\n         Aux (mapcar '((S) (get Obj S)) (: aux)) )\n      (when Old\n         (let Key (cons Old Aux)\n            (store Tree\n               (if (: ub)\n                  (ubZval Key Obj)\n                  (append Key Obj) )\n               NIL\n               (: dbf) ) ) )\n      (and New\n         (not (get Obj T))\n         (let Key (cons New Aux)\n            (store Tree\n               (if (: ub)\n                  (ubZval Key Obj)\n                  (conc Key Obj) )\n               Obj\n               (: dbf) ) ) ) )\n   (extra Obj Old New Hook) )\n\n(dm rel?> (Obj Val Hook)\n   (let Key (cons Val (mapcar '((S) (get Obj S)) (: aux)))\n      (== Obj\n         (fetch\n            (tree (: var) (: cls) (or Hook (and (: hook) (get Obj @))))\n            (if (: ub)\n               (ubZval Key Obj)\n               (append Key Obj) ) ) ) ) )\n\n(dm lose> (Obj Val Hook)\n   (let Key (cons Val (mapcar '((S) (get Obj S)) (: aux)))\n      (store\n         (tree (: var) (: cls) (or Hook (and (: hook) (get Obj @))))\n         (if (: ub)\n            (ubZval Key Obj)\n            (conc Key Obj) )\n         NIL\n         (: dbf) ) )\n   (extra Obj Val Hook) )\n\n(dm keep> (Obj Val Hook)\n   (let Key (cons Val (mapcar '((S) (get Obj S)) (: aux)))\n      (store\n         (tree (: var) (: cls) (or Hook (and (: hook) (get Obj @))))\n         (if (: ub)\n            (ubZval Key Obj)\n            (conc Key Obj) )\n         Obj\n         (: dbf) ) )\n   (extra Obj Val Hook) )\n\n(dm iter> (X Lst @Flg)\n   (let Tree (tree (: var) (: cls) (caddr Lst))\n      (cons\n         (nond\n            (X (init Tree NIL T))\n            ((atom X)\n               (nond\n                  ((str? (car X))\n                     (if (>= (cdr X) (car X))\n                        (init Tree\n                           (cons (car X))\n                           (cons (cdr X) T) )\n                        (init Tree\n                           (cons (car X) T)\n                           (cons (cdr X)) ) ) )\n                  ((>= (cdr X) (car X))\n                     (init Tree\n                        (cons (pack (car X) `(char T)) T)\n                        (cons (cdr X)) ) )\n                  (NIL\n                     (init Tree\n                        (cons (car X))\n                        (cons (pack (cdr X) `(char T)) T) ) ) ) )\n            ((str? X)\n               (init Tree (cons X) (cons X T)) )\n            (NIL\n               (init Tree (cons X) (cons (pack X `(char T)) T)) ) )\n         (let @Cls (cadr Lst)\n            (curry (@Flg @Cls) (Q)\n               (loop\n                  (NIL (step Q @Flg))\n                  (T (isa '@Cls @) @) ) ) ) ) ) )\n\n\n# Backing index prefix\n(class +Ref2)\n\n(dm T (Var Lst)\n   (unless (meta *Class Var)\n      (quit \"No Ref2\" Var) )\n   (extra Var Lst) )\n\n(dm rel> (Obj Old New Hook)\n   (with (meta (: cls) (: var))\n      (let Tree (tree (: var) (: cls))\n         (when Old\n            (store Tree (cons Old Obj) NIL (: dbf)) )\n         (and New\n            (not (get Obj T))\n            (store Tree (cons New Obj) Obj (: dbf)) ) ) )\n   (extra Obj Old New Hook) )\n\n(dm rel?> (Obj Val Hook)\n   (and\n      (with (meta (: cls) (: var))\n         (== Obj\n            (fetch\n               (tree (: var) (: cls))\n               (cons Val Obj) ) ) )\n      (extra Obj Val Hook) ) )\n\n(dm lose> (Obj Val Hook)\n   (with (meta (: cls) (: var))\n      (store (tree (: var) (: cls)) (cons Val Obj) NIL (: dbf)) )\n   (extra Obj Val Hook) )\n\n(dm keep> (Obj Val Hook)\n   (with (meta (: cls) (: var))\n      (store (tree (: var) (: cls)) (cons Val Obj) Obj (: dbf)) )\n   (extra Obj Val Hook) )\n\n\n# (+Idx +relation) [cnt [hook]]\n(class +Idx +Ref)\n\n(dm T (Var Lst)\n   (=: min (or (car Lst) 3))\n   (super Var (cdr Lst)) )\n\n(de idxRel (Obj Old Old2 Olds New New2 News Hook)\n   (let\n      (Tree (tree (: var) (: cls) (or Hook (and (: hook) (get Obj @))))\n         Aux (mapcar '((S) (get Obj S)) (: aux))\n         Aux2 (append Aux (cons Obj)) )\n      (setq Aux (conc Aux Obj))\n      (and Old (store Tree (cons @ Aux) NIL (: dbf)))\n      (and Old2 (store Tree (cons @ Aux2) NIL (: dbf)))\n      (for S Olds\n         (while (nth S (: min))\n            (store Tree (cons (pack S) Aux2) NIL (: dbf))\n            (++ S) ) )\n      (unless (get Obj T)\n         (and New (store Tree (cons @ Aux) Obj (: dbf)))\n         (and New2 (store Tree (cons @ Aux2) Obj (: dbf)))\n         (for S News\n            (while (nth S (: min))\n               (store Tree (cons (pack S) Aux2) Obj (: dbf))\n               (++ S) ) ) ) ) )\n\n(de idxRel? (Obj Val Val2 Vals Hook)\n   (let\n      (Tree (tree (: var) (: cls) (or Hook (and (: hook) (get Obj @))))\n         Aux (mapcar '((S) (get Obj S)) (: aux))\n         Aux2 (append Aux (cons Obj)) )\n      (setq Aux (conc Aux Obj))\n      (and\n         (== Obj (fetch Tree (cons Val Aux)))\n         (or (not Val2) (== Obj (fetch Tree (cons Val2 Aux2))))\n         (fully\n            '((S)\n               (loop\n                  (NIL (nth S (: min)) T)\n                  (NIL (== Obj (fetch Tree (cons (pack S) Aux2))))\n                  (++ S) ) )\n            Vals ) ) ) )\n\n(dm rel> (Obj Old New Hook)\n   (idxRel Obj\n      Old NIL (split (cdr (chop Old)) \" \" \"\\n\")\n      New NIL (split (cdr (chop New)) \" \" \"\\n\")\n      Hook )\n   (extra Obj Old New Hook) )\n\n(dm rel?> (Obj Val Hook)\n   (and\n      (idxRel? Obj\n         Val NIL (split (cdr (chop Val)) \" \" \"\\n\")\n         Hook )\n      (extra Obj Val Hook) ) )\n\n(dm lose> (Obj Val Hook)\n   (idxRel Obj\n      Val NIL (split (cdr (chop Val)) \" \" \"\\n\")\n      NIL NIL NIL\n      Hook )\n   (extra Obj Val Hook) )\n\n(dm keep> (Obj Val Hook)\n   (idxRel Obj\n      NIL NIL NIL\n      Val NIL (split (cdr (chop Val)) \" \" \"\\n\")\n      Hook )\n   (extra Obj Val Hook) )\n\n(dm iter> (X Lst)\n   (on *Iter+)\n   (super X Lst (not X)) )\n\n(dm match> (X Val Obj)\n   (sub? X Val) )\n\n\n# (+Sn +index) [hook]\n(class +Sn)\n\n(dm rel> (Obj Old New Hook)\n   (let Tree (tree (: var) (: cls) (or Hook (and (: hook) (get Obj @))))\n      (and Old\n         (ext:Snx Old)\n         (store Tree (cons @ Obj T) NIL (: dbf)) )\n      (and New\n         (not (get Obj T))\n         (ext:Snx New)\n         (store Tree (cons @ Obj T) Obj (: dbf)) ) )\n   (extra Obj Old New Hook) )\n\n(dm rel?> (Obj Val Hook)\n   (and\n      (let S (ext:Snx Val)\n         (or\n            (not S)\n            (== Obj\n               (fetch\n                  (tree (: var) (: cls) (or Hook (and (: hook) (get Obj @))))\n                  (cons S Obj T) ) ) ) )\n      (extra Obj Val Hook) ) )\n\n(dm lose> (Obj Val Hook)\n   (let? S (ext:Snx Val)\n      (store\n         (tree (: var) (: cls) (or Hook (and (: hook) (get Obj @))))\n         (cons S Obj T)\n         NIL (: dbf) ) )\n   (extra Obj Val Hook) )\n\n(dm keep> (Obj Val Hook)\n   (let? S (ext:Snx Val)\n      (store\n         (tree (: var) (: cls) (or Hook (and (: hook) (get Obj @))))\n         (cons S Obj T)\n         Obj (: dbf) ) )\n   (extra Obj Val Hook) )\n\n(dm iter> (X Lst)\n   (on *Iter+)\n   (cons\n      (list\n         (list\n            (car (extra X Lst))\n            (init (tree (: var) (: cls) (caddr Lst))\n               (cons (setq X (ext:Snx X)))\n               (cons (pack X `(char T)) T) ) ) )\n      (let @Cls (cadr Lst)\n         (curry (@Cls) (Q)\n            (loop\n               (NIL\n                  (or\n                     (step (caar Q))\n                     (and (cdar Q) (shift Q) (step (caar Q))) ) )\n               (T (isa '@Cls @) @) ) ) ) ) )\n\n(dm match> (X Val Obj)\n   (or\n      (extra X Val Obj)\n      (and (pre? (ext:Snx X) (ext:Snx Val)) Val) ) )\n\n\n# (+Fold +index) [hook]\n(class +Fold)\n\n(dm has> (Val X)\n   (extra Val\n      (if (= Val (fold Val)) (fold X) X) ) )\n\n(dm rel> (Obj Old New Hook)\n   (extra Obj (fold Old) (fold New) Hook) )\n\n(dm rel?> (Obj Val Hook)\n   (let V (fold Val)\n      (or (not V) (extra Obj V Hook)) ) )\n\n(dm lose> (Obj Val Hook)\n   (extra Obj (fold Val) Hook) )\n\n(dm keep> (Obj Val Hook)\n   (extra Obj (fold Val) Hook) )\n\n(dm iter> (X Lst)\n   (extra\n      (if (pair X)\n         (cons (fold (car X)) (fold (cdr X)))\n         (fold X) )\n      Lst ) )\n\n(dm match> (X Val Obj)\n   (when\n      (extra\n         (if (pair X)\n            (cons (fold (car X)) (fold (cdr X)))\n            (fold X) )\n         (fold Val)\n         Obj )\n      Val ) )\n\n\n# (+IdxFold +relation) [cnt [hook]]\n(class +IdxFold +Ref)\n\n(dm T (Var Lst)\n   (=: min (or (car Lst) 3))\n   (super Var (cdr Lst)) )\n\n(dm rel> (Obj Old New Hook)\n   (idxRel Obj\n      Old (fold Old)\n      (extract '((L) (extract fold L))\n         (split (cdr (chop Old)) \" \" \"\\n\") )\n      New (fold New)\n      (extract '((L) (extract fold L))\n         (split (cdr (chop New)) \" \" \"\\n\") )\n      Hook )\n   (extra Obj Old New Hook) )\n\n(dm rel?> (Obj Val Hook)\n   (and\n      (let V (fold Val)\n         (or (not V)\n            (idxRel? Obj\n               Val V\n               (extract '((L) (extract fold L))\n                  (split (cdr (chop Val)) \" \" \"\\n\") )\n               Hook ) ) )\n      (extra Obj Val Hook) ) )\n\n(dm lose> (Obj Val Hook)\n   (idxRel Obj\n      Val (fold Val)\n      (extract '((L) (extract fold L))\n         (split (cdr (chop Val)) \" \" \"\\n\") )\n      NIL NIL NIL\n      Hook )\n   (extra Obj Val Hook) )\n\n(dm keep> (Obj Val Hook)\n   (idxRel Obj\n      NIL NIL NIL\n      Val (fold Val)\n      (extract '((L) (extract fold L))\n         (split (cdr (chop Val)) \" \" \"\\n\") )\n      Hook )\n   (extra Obj Val Hook) )\n\n(dm iter> (X Lst)\n   (on *Iter+)\n   (super (fold X) Lst (not X)) )\n\n(dm match> (X Val Obj)\n   (and (sub? (fold X) (fold Val)) Val) )\n\n\n# (+Aux) lst\n(class +Aux)\n\n(dm T (Var Lst)\n   (=: aux (car Lst))\n   (with *Class\n      (for A (car Lst)\n         (if (asoq A (: Aux))\n            (queue '@ Var)\n            (queue (:: Aux) (list A Var)) ) ) )\n   (extra Var (cdr Lst)) )\n\n(de relAux (Obj Var Old Lst)\n   (let New (get Obj Var)\n      (put Obj Var Old)\n      (for A Lst\n         (rel> (meta Obj A) Obj (get Obj A) NIL) )\n      (put Obj Var New)\n      (for A Lst\n         (rel> (meta Obj A) Obj NIL (get Obj A)) ) ) )\n\n(dm iter> (X Lst)\n   (if (or (atom X) (atom (car X)))\n      (extra X Lst)\n      (let Tree (tree (: var) (: cls) (caddr Lst))\n         (cons\n            (if (>= (cdr X) (car X))\n               (init Tree\n                  (car X)\n                  (append (cdr X) T) )\n               (init Tree\n                  (append (car X) T)\n                  (cdr X) ) )\n            (let @Cls (cadr Lst)\n               (curry (@Cls) (Q)\n                  (loop\n                     (NIL (step Q))\n                     (T (isa '@Cls @) @) ) ) ) ) ) ) )\n\n(dm match> (X Val Obj)\n   (if (or (atom X) (atom (car X)))\n      (extra X Val Obj)\n      (setq Val\n         (cons Val\n            (mapcar '((S) (get Obj S)) (: aux)) ) )\n      (when\n         (if (>= (cdr X) (car X))\n            (>= (append (cdr X) T) Val (car X))\n            (>= (append (car X) T) Val (cdr X)) )\n         Val ) ) )\n\n\n# UB-Tree (+Aux prefix)\n(class +UB)\n\n(dm T (Var Lst)\n   (=: ub T)\n   (extra Var Lst) )\n\n(dm has> (Val X)\n   (and Val\n      (or\n         (extra Val X)\n         (extra\n            (let (N (inc (length (: aux)))  M 1  V 0)\n               (while (gt0 Val)\n                  (and (bit? 1 Val) (inc 'V M))\n                  (setq M (>> -1 M)  Val (>> N Val)) )\n               V )\n            X ) ) ) )\n\n(dm iter> (X Lst)\n   (cons\n      (init (tree (: var) (: cls) (caddr Lst))\n         (ubZval (car X))\n         (ubZval (cdr X) T) )\n      (let @Cls (cadr Lst)\n         (curry (@Cls) (Q)\n            (loop\n               (NIL (step Q))\n               (T (isa '@Cls @) @) ) ) ) ) )\n\n\n### Relation prefix classes ###\n(class +Dep)\n\n(dm T (Var Lst)\n   (=: dep (car Lst))\n   (extra Var (cdr Lst)) )\n\n(dm rel> (Obj Old New Hook)\n   (unless New\n      (for Var (: dep)\n         (let? V (get Obj Var)\n            (rel> (meta Obj Var) Obj V\n               (put Obj Var (put> (meta Obj Var) Obj V NIL)) )\n            (when (asoq Var (meta Obj 'Aux))\n               (relAux Obj Var V (cdr @)) )\n            (upd> Obj Var V) ) ) )\n   (extra Obj Old New Hook) )\n\n\n(class +List)\n\n(dm mis> (Val Obj)\n   (ifn (lst? Val)\n      \"Not a List\"\n      (pick '((V) (extra V Obj)) Val) ) )\n\n(dm ele> (Val)\n   (and Val (or (atom Val) (find extra Val))) )\n\n(dm has> (Val X)\n   (when Val\n      (or\n         (= Val X)\n         (find '((X) (extra Val X)) X)\n         (loop\n            (NIL\n               (let (V (++ Val)  Y (++ X))\n                  (or (= V Y) (extra V Y)) ) )\n            (NIL (or Val X) T)\n            (T (xor Val X)) ) ) ) )\n\n(dm put> (Obj Old New)\n   (if (ele> This New)\n      (cons (extra Obj Old New) Old)\n      (mapcar\n         '((N O) (extra Obj O N))\n         New\n         Old ) ) )\n\n(dm del> (Obj Old Val)\n   (and\n      (<> Old Val)\n      (delete Val Old T) ) )\n\n(dm rel> (Obj Old New Hook)\n   (if (or (ele> This Old) (ele> This New))\n      (extra Obj Old New Hook)\n      (for O Old\n         (if (: bag)\n            (for (I . This) @\n               (let V (get O I)\n                  (unless (find '((L) (= V (get L I))) New)\n                     (rel> This Obj V NIL\n                        (when (: hook)\n                           (get (if (sym? @) Obj O) (: hook)) ) ) ) ) )\n            (unless (member O New)\n               (extra Obj O NIL Hook) ) ) )\n      (for N New\n         (if (: bag)\n            (for (I . This) @\n               (let V (get N I)\n                  (unless (find '((L) (= V (get L I))) Old)\n                     (rel> This Obj NIL V\n                        (when (: hook)\n                           (get (if (sym? @) Obj N) (: hook)) ) ) ) ) )\n            (unless (member N Old)\n               (extra Obj NIL N Hook) ) ) ) ) )\n\n(dm rel?> (Obj Val Hook)\n   (for V Val\n      (NIL (or (not V) (extra Obj V Hook)))\n      T ) )\n\n(dm lose> (Obj Val Hook)\n   (if (ele> This Val)\n      (extra Obj Val Hook)\n      (for V Val\n         (extra Obj V Hook) ) ) )\n\n(dm keep> (Obj Val Hook)\n   (if (ele> This Val)\n      (extra Obj Val Hook)\n      (for V Val\n         (extra Obj V Hook) ) ) )\n\n(dm iter> (X Lst)\n   (on *Iter+)\n   (extra X Lst (not X)) )\n\n(dm match> (X Val Obj)\n   (pick '((Y) (extra X Y Obj)) Val) )\n\n\n(class +Need)\n\n(dm mis> (Val Obj)\n   (ifn Val\n      ,\"Input required\"\n      (extra Val Obj) ) )\n\n\n(class +Mis)\n\n(dm T (Var Lst)\n   (=: mis (car Lst))\n   (extra Var (cdr Lst)) )\n\n(dm mis> (Val Obj)\n   (or ((: mis) Val Obj) (extra Val Obj)) )\n\n\n(class +Alt)\n\n(dm T (Var Lst)\n   (extra Var (cdr Lst))\n   (=: cls (car Lst)) )\n\n\n(class +Swap)\n\n(dm mis> (Val Obj)\n   (extra (if (ext? Val) (val Val) Val) Obj) )\n\n(dm has> (Val X)\n   (if (ext? Val)\n      (== Val X)\n      (extra Val (val X)) ) )\n\n(dm put> (Obj Old New)\n   (let N\n      (extra\n         Obj\n         (val Old)\n         (if (ext? New) (val @) New) )\n      (cond\n         ((ext? Old)\n            (if (ext? New)\n               New\n               (set Old N)\n               Old ) )\n         (N\n            (prog1\n               (new (or (: dbf 1) 1))\n               (set @ N) ) ) ) ) )\n\n(dm del> (Obj Old Val)\n   (ifn (ext? Old)\n      (extra Obj Old Val)\n      (set @ (extra Obj (val Old) Val))\n      @ ) )\n\n(dm rel> (Obj Old New Hook)\n   (extra\n      Obj\n      (if (ext? Old) (val @) Old)\n      (if (ext? New) (val @) New)\n      Hook ) )\n\n(dm rel?> (Obj Val Hook)\n   (if (ext? Val)\n      (if (val @)\n         (extra Obj @ Hook)\n         T )\n      (extra Obj Val Hook) ) )\n\n(dm lose> (Obj Val Hook)\n   (extra Obj (if (ext? Val) (val @) Val) Hook) )\n\n(dm keep> (Obj Val Hook)\n   (extra Obj (if (ext? Val) (val @) Val) Hook) )\n\n\n### Entities ###\n(de dbSync (Obj)\n   (let *Run NIL\n      (while (lock (or Obj *DB))\n         (wait 40) )\n      (sync) ) )\n\n(class +Entity)\n\n(var Dbf)\n(var Aux)\n\n(de incECnt (Obj)\n   (let M NIL\n      (for Cls (type Obj)\n         (recur (Cls)\n            (or\n               (== '+Entity Cls)\n               (memq Cls M)\n               (when (isa '+Entity (push 'M Cls))\n                  (for C (type @)\n                     (recurse C) )\n                  (if (get *DB Cls)\n                     (inc @)\n                     (put *DB Cls (new T 1)) ) ) ) ) ) ) )\n\n(de decECnt (Obj)\n  (let M NIL\n     (for Cls (type Obj)\n        (recur (Cls)\n           (or\n              (== '+Entity Cls)\n              (memq Cls M)\n              (when (isa '+Entity (push 'M Cls))\n                 (for C (type @)\n                    (recurse C) )\n                 (and (get *DB Cls) (dec @)) ) ) ) ) ) )\n\n(private) (cloneKey cloneAny)\n\n(dm T @\n   (incECnt This)\n   (while (args)\n      (let A (next)\n         (cond\n            ((=T A) (put This T T))\n            ((atom A) (put> This A (next)))\n            (T (put> This (car A) (eval (cdr A)))) ) ) )\n   (upd> This (val This)) )\n\n(dm zap> ()\n   (for X (getl This)\n      (let V (or (atom X) (++ X))\n         (and (meta This X) (zap> @ This V)) ) )\n   (unless (: T) (decECnt This)) )\n\n(dm url> (Tab Fld))\n\n(dm url1> (Tab Fld) (url> This 1 Fld))\n(dm url2> (Tab Fld) (url> This 2 Fld))\n(dm url3> (Tab Fld) (url> This 3 Fld))\n(dm url4> (Tab Fld) (url> This 4 Fld))\n(dm url5> (Tab Fld) (url> This 5 Fld))\n(dm url6> (Tab Fld) (url> This 6 Fld))\n(dm url7> (Tab Fld) (url> This 7 Fld))\n(dm url8> (Tab Fld) (url> This 8 Fld))\n(dm url9> (Tab Fld) (url> This 9 Fld))\n\n(dm gui> ())\n\n(dm upd> (X Old))\n\n(dm has> (Var Val)\n   (or\n      (nor\n         Val\n         (if2 (get This Var) (ext? @) (val @) @) )\n      (has> (meta This Var) Val (get This Var)) ) )\n\n(dm rel?> (Var Val)\n   (nond\n      (Val T)\n      ((meta This Var) T)\n      (NIL (rel?> @ This Val)) ) )\n\n(dm put> (Var Val)\n   (unless (has> This Var Val)\n      (let Old (get This Var)\n         (rel> (meta This Var) This Old\n            (put This Var (put> (meta This Var) This Old Val)) )\n         (when (asoq Var (meta This 'Aux))\n            (relAux This Var Old (cdr @)) )\n         (upd> This Var Old) ) )\n   Val )\n\n(dm put!> (Var Val)\n   (unless (has> This Var Val)\n      (dbSync)\n      (let Old (get This Var)\n         (rel> (meta This Var) This Old\n            (put This Var (put> (meta This Var) This Old Val)) )\n         (when (asoq Var (meta This 'Aux))\n            (relAux This Var Old (cdr @)) )\n         (upd> This Var Old)\n         (commit 'upd) ) )\n   Val )\n\n(dm del> (Var Val)\n   (when (and Val (has> (meta This Var) Val (get This Var)))\n      (let Old (get This Var)\n         (rel> (meta This Var) This Old\n            (put This Var (del> (meta This Var) This Old Val)) )\n         (when (asoq Var (meta This 'Aux))\n            (relAux This Var Old (cdr @)) )\n         (upd> This Var Old) ) ) )\n\n(dm del!> (Var Val)\n   (when (and Val (has> (meta This Var) Val (get This Var)))\n      (dbSync)\n      (let Old (get This Var)\n         (rel> (meta This Var) This Old\n            (put This Var (del> (meta This Var) This Old Val)) )\n         (when (asoq Var (meta This 'Aux))\n            (relAux This Var Old (cdr @)) )\n         (upd> This Var Old)\n         (commit 'upd) ) ) )\n\n(dm inc> (Var Val)\n   (let P (prop This Var)\n      (when (num? (car P))\n         (let Old @\n            (rel> (meta This Var) This Old\n               (inc P (or Val 1)) )\n            (when (asoq Var (meta This 'Aux))\n               (relAux This Var Old (cdr @)) )\n            (upd> This Var Old) )\n         (car P) ) ) )\n\n(dm inc!> (Var Val)\n   (when (num? (get This Var))\n      (dbSync)\n      (let (P (prop This Var)  Old (car P))\n         (rel> (meta This Var) This Old\n            (inc P (or Val 1)) )\n         (when (asoq Var (meta This 'Aux))\n            (relAux This Var Old (cdr @)) )\n         (upd> This Var Old)\n         (commit 'upd)\n         (car P) ) ) )\n\n(dm dec> (Var Val)\n   (let P (prop This Var)\n      (when (num? (car P))\n         (let Old @\n            (rel> (meta This Var) This Old\n               (dec P (or Val 1)) )\n            (when (asoq Var (meta This 'Aux))\n               (relAux This Var Old (cdr @)) )\n            (upd> This Var Old) )\n         (car P) ) ) )\n\n(dm dec!> (Var Val)\n   (when (num? (get This Var))\n      (dbSync)\n      (let (P (prop This Var)  Old (car P))\n         (rel> (meta This Var) This Old\n            (dec P (or Val 1)) )\n         (when (asoq Var (meta This 'Aux))\n            (relAux This Var Old (cdr @)) )\n         (upd> This Var Old)\n         (commit 'upd)\n         (car P) ) ) )\n\n(dm mis> (Var Val)\n   (mis> (meta This Var) Val This) )\n\n(dm lose1> (Var)\n   (when (meta This Var)\n      (lose> @ This (get This Var)) ) )\n\n(dm lose> (Lst)\n   (unless (: T)\n      (for X (getl This)\n         (let V (or (atom X) (++ X))\n            (and\n               (not (memq X Lst))\n               (meta This X)\n               (lose> @ This V) ) ) )\n      (decECnt This)\n      (=: T T)\n      (upd> This) ) )\n\n(dm lose!> (Lst)\n   (dbSync)\n   (lose> This Lst)\n   (commit 'upd) )\n\n(de lose \"Prg\"\n   (let \"Flg\" (: T)\n      (=: T T)\n      (run \"Prg\")\n      (=: T \"Flg\") ) )\n\n(dm keep1> (Var)\n   (when (meta This Var)\n      (keep> @ This (get This Var)) ) )\n\n(dm keep> (Lst)\n   (when (: T)\n      (=: T)\n      (incECnt This)\n      (for X (getl This)\n         (let V (or (atom X) (++ X))\n            (and\n               (not (memq X Lst))\n               (meta This X)\n               (keep> @ This V) ) ) )\n      (upd> This T) ) )\n\n(dm keep?> (Lst)\n   (extract\n      '((X)\n         (with (and (pair X) (meta This (cdr X)))\n            (and\n               (isa '+Key This)\n               (fetch (tree (: var) (: cls) (and (: hook) (get (up This) @))) (car X))\n               (cons (car X) ,\"Not unique\") ) ) )\n      (getl This) ) )\n\n(dm keep!> (Lst)\n   (dbSync)\n   (keep> This Lst)\n   (commit 'upd) )\n\n(de keep \"Prg\"\n   (let \"Flg\" (: T)\n      (=: T)\n      (run \"Prg\")\n      (=: T \"Flg\") ) )\n\n(dm set> (Val)\n   (unless (= Val (val This))\n      (decECnt This)\n      (let Lst (make (maps '((X) (link (fin X))) This))\n         (for Var Lst\n            (let? Rel (meta This Var)\n               (unless (== Rel (meta Val Var))\n                  (let V (get This Var)\n                     (and (isa '+Swap Rel) (setq V (val V)))\n                     (rel> Rel This V (put> Rel This V NIL)) ) ) ) )\n         (xchg This 'Val)\n         (for Var Lst\n            (let? Rel (meta This Var)\n               (unless (== Rel (meta Val Var))\n                  (let V (get This Var)\n                     (rel> Rel This NIL\n                        (put> Rel This NIL\n                           (if (isa '+Swap Rel) (val V) V) ) ) ) ) ) ) )\n      (incECnt This)\n      (upd> This (val This) Val) )\n   (val This) )\n\n(dm set!> (Val)\n   (unless (= Val (val This))\n      (dbSync)\n      (decECnt This)\n      (let Lst (make (maps '((X) (link (fin X))) This))\n         (for Var Lst\n            (let? Rel (meta This Var)\n               (unless (== Rel (meta Val Var))\n                  (let V (get This Var)\n                     (and (isa '+Swap Rel) (setq V (val V)))\n                     (rel> Rel This V (put> Rel This V NIL)) ) ) ) )\n         (xchg This 'Val)\n         (for Var Lst\n            (let? Rel (meta This Var)\n               (unless (== Rel (meta Val Var))\n                  (let V (get This Var)\n                     (rel> Rel This NIL\n                        (put> Rel This NIL\n                           (if (isa '+Swap Rel) (val V) V) ) ) ) ) ) ) )\n      (incECnt This)\n      (upd> This (val This) Val)\n      (commit 'upd) )\n   (val This) )\n\n(dm clone> (Lst)\n   (let Obj (new (or (var: Dbf 1) 1) (val This))\n      (for X\n         (by\n            '((X)\n               (nand\n                  (pair X)\n                  (isa '+Hook (meta This (cdr X))) ) )\n            sort\n            (getl This) )\n         (unless (memq (fin X) Lst)\n            (if (atom X)\n               (ifn (meta This X)\n                  (put Obj X T)\n                  (let Rel @\n                     (put> Obj X T)\n                     (when (isa '+Blob Rel)\n                        (in (blob This X)\n                           (out (blob Obj X) (echo)) )\n                        (blob+ Obj X) ) ) )\n               (ifn (meta This (cdr X))\n                  (put Obj (cdr X) (car X))\n                  (let Rel @\n                     (cond\n                        ((find '((B) (isa '+Key B)) (get Rel 'bag))\n                           (let (K @  H (get K 'hook))\n                              (put> Obj (cdr X)\n                                 (mapcar\n                                    '((Lst)\n                                       (mapcar\n                                          '((B Val)\n                                             (if (== B K)\n                                                (cloneKey B (cdr X) Val\n                                                   (and H (get (if (sym? H) This Lst) H)) )\n                                                Val ) )\n                                          (get Rel 'bag)\n                                          Lst ) )\n                                    (car X) ) ) ) )\n                        ((isa '+Key Rel)\n                           (put> Obj (cdr X)\n                              (cloneKey Rel (cdr X) (car X)\n                                 (and (get Rel 'hook) (get This @)) ) ) )\n                        ((or (not (isa '+Joint Rel)) (isa '+List (meta Obj (cdr X))))\n                           (put> Obj (cdr X) (cloneAny (car X) Rel)) ) ) ) ) ) ) )\n      Obj ) )\n\n(de cloneKey (Rel Var Val Hook)\n   (cond\n      ((isa '+Number Rel)\n         (genKey Var (get Rel 'cls) Hook) )\n      ((isa '+String Rel)\n         (genStrKey (pack \"# \" Val) Var (get Rel 'cls) Hook) ) ) )\n\n(de cloneAny (Val Rel)\n   (cond\n      ((isa '+Swap Rel) (val Val))\n      ((isa '+Bag Rel)\n         (if (isa '+List Rel)\n            (mapcar\n               '((B) (mapcar cloneAny B (; Rel bag)))\n               Val )\n            (mapcar cloneAny Val (; Rel bag)) ) )\n      (T Val) ) )\n\n(dm clone!> ()\n   (prog2\n      (dbSync)\n      (clone> This)\n      (commit 'upd) ) )\n\n(de new! (\"Typ\" . @)\n   (prog2\n      (dbSync)\n      (pass new (or (meta \"Typ\" 'Dbf 1) 1) \"Typ\")\n      (commit 'upd) ) )\n\n(de set! (Obj Val)\n   (unless (= Val (val Obj))\n      (dbSync)\n      (set Obj Val)\n      (commit 'upd) )\n   Val )\n\n(de put! (Obj Var Val)\n   (unless (= Val (get Obj Var))\n      (dbSync)\n      (put Obj Var Val)\n      (commit 'upd) )\n   Val )\n\n(de inc! (Obj Var Val)\n   (when (num? (get Obj Var))\n      (prog2\n         (dbSync)\n         (inc (prop Obj Var) (or Val 1))\n         (commit 'upd) ) ) )\n\n(de blob! (Obj Var File)\n   (put!> Obj Var File)\n   (blob+ Obj Var)\n   File )\n\n(de blob+ (Obj Var)\n   (when *Jnl\n      (chdir *Blob\n         (%@ \"symlink\" 'I\n            (pack (glue \"/\" (chop Obj)) \".\" Var)\n            (pack \"=\" (name Obj) \".\" Var) ) ) ) )\n\n\n# Remote entities\n(class +Remote)\n\n(dm zap> ())\n(dm has> ~(method 'has> '+Entity))\n(dm url> (Tab Fld))\n(dm url1> ~(method 'url1> '+Entity))\n(dm url2> ~(method 'url2> '+Entity))\n(dm url3> ~(method 'url3> '+Entity))\n(dm url4> ~(method 'url4> '+Entity))\n(dm url5> ~(method 'url5> '+Entity))\n(dm url6> ~(method 'url6> '+Entity))\n(dm url7> ~(method 'url7> '+Entity))\n(dm url8> ~(method 'url8> '+Entity))\n(dm url9> ~(method 'url9> '+Entity))\n(dm put> (Var Val))\n(dm put!> (Var Val))\n(dm del> (Var Val))\n(dm del!> (Var Val))\n(dm inc> (Var Val))\n(dm inc!> (Var Val))\n(dm dec> (Var Val))\n(dm dec!> (Var Val))\n(dm mis> (Var Val))\n(dm lose1> (Var))\n(dm lose> (Lst))\n(dm lose!> (Lst))\n(dm keep1> (Var))\n(dm keep> (Lst))\n(dm keep?> (Lst))\n(dm keep!> (Lst))\n(dm set> (Val))\n(dm set!> (Val))\n\n\n# Default syncronization function\n(de upd Lst\n   (wipe Lst) )\n\n### DB Sizes ###\n(de dbs Lst\n   (setq *Dbs\n      (make\n         (for (N . L) Lst\n            (let Dbf (cons N (>> (- (link (car L))) 64))\n               (for Cls (cdr L)\n                  (if (atom Cls)\n                     (put Cls 'Dbf Dbf)\n                     (for Var (cdr Cls)\n                        (let Rel (get Cls 1 Var)\n                           (unless Rel\n                              (quit \"Bad relation\" (cons Var (car Cls))) )\n                           (when (or (isa '+index Rel) (isa '+Swap Rel))\n                              (put @ 'dbf Dbf) )\n                           (for B (; Rel bag)\n                              (when (or (isa '+index B) (isa '+Swap B))\n                                 (put @ 'dbf Dbf)) ) ) ) ) ) ) ) ) ) )\n\n(de db: Typ\n   (or (meta Typ 'Dbf 1) 1) )\n\n### Utilities ###\n(private) _db\n\n(de treeRel (Var Cls)\n   (with (or (get Cls Var) (meta Cls Var))\n      (or\n         (find '((B) (isa '+index B)) (: bag))\n         This ) ) )\n\n# (db 'var 'cls ['hook] 'any ['var 'any ..]) -> sym\n(de db (Var Cls . @)\n   (with (treeRel Var Cls)\n      (let (Tree (tree (: var) (: cls) (and (: hook) (next)))  Val (next))\n         (if (isa '+Key This)\n            (if (args)\n               (and (fetch Tree Val) (pass _db @))\n               (fetch Tree Val) )\n            (let Key (cons (if (isa '+Fold This) (fold Val) Val))\n               (let? A (: aux)\n                  (while (and (args) (== (++ A) (arg 1)))\n                     (next)\n                     (queue 'Key (next)) )\n                  (and (: ub) (setq Key (ubZval Key))) )\n               (let Q (init Tree Key (append Key T))\n                  (loop\n                     (NIL (step Q T))\n                     (T (pass _db @ Var Val) @) ) ) ) ) ) ) )\n\n(de _db (Obj . @)\n   (when (isa Cls Obj)\n      (loop\n         (NIL (next) Obj)\n         (NIL (has> Obj @ (next))) ) ) )\n\n# (aux 'var 'cls ['hook] 'any ..) -> sym\n(de aux (Var Cls . @)\n   (with (treeRel Var Cls)\n      (use Key\n         (step\n            (init (tree (: var) (: cls) (and (: hook) (next)))\n               (setq Key (if (: ub) (ubZval (rest)) (rest)))\n               (append Key T) ) ) ) ) )\n\n# (collect 'var 'cls ['hook] ['any|beg ['end [var ..]]]) -> lst\n(de collect (Var Cls . @)\n   (with (treeRel Var Cls)\n      (let\n         (Tree (tree (: var) (: cls) (and (: hook) (next)))\n            X1 (next)\n            X2 (if (args) (next) (or X1 T)) )\n         (make\n            (cond\n               ((isa '+Key This)\n                  (iter Tree\n                     '((X) (and (isa Cls X) (link (pass get X))))\n                     X1 X2 ) )\n               ((: ub)\n                  (if X1\n                     (ubIter Tree (inc (length (: aux)))\n                        '((X) (and (isa Cls X) (link (pass get X))))\n                        X1 X2 )\n                     (iter Tree\n                        '((X) (and (isa Cls X) (link (pass get X)))) ) ) )\n               (T\n                  (when (isa '+Fold This)\n                     (setq X1 (fold X1)  X2 (or (=T X2) (fold X2))) )\n                  (if (>= X2 X1)\n                     (if (pair X1)\n                        (setq X2 (append X2 T))\n                        (setq X1 (cons X1)  X2 (cons X2 T)) )\n                     (if (pair X1)\n                        (setq X1 (append X1 T))\n                        (setq X1 (cons X1 T)  X2 (cons X2)) ) )\n                  (iter Tree\n                     '((X)\n                        (and (isa Cls X) (link (pass get X))) )\n                     X1 X2\n                     (or (isa '+Idx This) (isa '+IdxFold This)) ) ) ) ) ) ) )\n\n# Combined 'search' function\n(private) (*SX *SY search1)\n\n(de relQ (X Lst)\n   (iter> (meta (cdr Lst) (car Lst)) X Lst) )\n\n(de search1 (Val Lst)  # ((Q . stepFun) . lst)\n   (let X (++ Lst)\n      (cons\n         (cond\n            ((pair (cdr X)) (relQ Val X))\n            ((pair (setq X (get Val (cdr X))))\n               (cons (list X) pop) )\n            (T (cons (list (list X)) pop)) )\n         Lst ) ) )\n\n(de search (*SX *SY . @)\n   (ifn *SY\n      (for (P (cddr *SX)  P  (or (cdr P) (cddr *SX)))  # Next search result\n         (NIL (setq *SY ((cadar P) (caaar P))))\n         (T\n            (and\n               (fully  # Filter\n                  '((L) ((cddr L) *SY (cdar L)))\n                  (cddr *SX) )\n               (nand  # Deduplicate\n                  (val *SX)\n                  (idx *SX (cons (hash *SY) *SY) T) )\n               ((cadr *SX) *SY) )  # Extract\n            (setq P\n               (rot (cddr *SX) (offset P (cddr *SX))) )\n            @ ) )\n      # Init search\n      (let\n         (*Iter+ NIL\n            Lst\n            (make\n               (link prog)  # idx and extract\n               (loop\n                  (when (or *SX (nor (args) (cdr (made))))\n                     (link  # ((Q . V) genFun . filterFun)\n                        (cons\n                           (cons\n                              (list\n                                 (if (pair (caar *SY))\n                                    (cons ((car *SY) *SX) (cddr *SY))  # (init . step)\n                                    (search1 *SX *SY) ) )\n                              *SX )\n                           '((Q)  # Generator\n                              (use Obj\n                                 (loop\n                                    (T\n                                       (nor  # Done\n                                          (setq Obj ((cdaar Q) (caaar Q)))\n                                          (cdr Q) ) )\n                                    (T (unless (cdar Q) Obj) Obj)  # Result\n                                    (if Obj\n                                       (let L (cdar Q)\n                                          (con Q (cons (car Q) (cdr Q)))\n                                          (or\n                                             (val *SX)  # 'idx'\n                                             (not\n                                                (isa '+List\n                                                   (if (pair (cdar L))\n                                                      (meta @ (caar L))  # (+Ref +Link)\n                                                      (with (meta Obj (cdar L))  # +Joint\n                                                         (meta (: type) (: slot)) ) ) ) )\n                                             (set *SX T) )\n                                          (set Q (search1 Obj L)) )\n                                       (set Q (cadr Q))\n                                       (con Q (cddr Q)) ) ) ) )\n                           (let  # Filter\n                              (@Exe\n                                 (if (pair (caar *SY))\n                                    (cons\n                                       (lit (car (shift '*SY)))\n                                       '(X V) )\n                                    (list 'match>\n                                       (lit\n                                          (if (atom (cdar *SY))\n                                             (with (meta *SX (cdar *SY))  # +Joint\n                                                (meta (: type) (: slot)) )\n                                             (meta (cdar *SY) (caar *SY)) ) )  # +index\n                                       'V\n                                       (list '; 'X (caar *SY))\n                                       'X ) )\n                                 @Lst (flip (mapcar car (cdr *SY))) )\n                              (curry (@Lst @Exe) (X V)\n                                 (let L '@Lst\n                                    (recur (X L)\n                                       (if L\n                                          (pick recurse\n                                             (fish ext? (get X (++ L)))\n                                             (circ L) )\n                                          @Exe ) ) ) ) ) ) ) )\n                  (setq *SX (next))\n                  (NIL (setq *SY (next))\n                     (and *SX (set (made) @)) ) ) ) )\n         (cons\n            (or *Iter+ (bool (cddr Lst)))  # 'idx'\n            Lst ) ) ) )\n\n# Multiple indexes\n(de relQs (@Lst . @)\n   (cons\n      (curry (@Lst) (X)\n         (on *Iter+)\n         (cons\n            (list\n               (mapcar '((Y) (relQ X Y)) '@Lst) )\n            '((Q)\n               (or\n                  ((cdaar Q) (caaar Q))\n                  (and\n                     (cdar Q)\n                     (shift Q)\n                     ((cdaar Q) (caaar Q)) ) ) ) ) )\n      (let\n         (@L\n            (mapcar\n               '((Y) (meta (cdr Y) (car Y)))\n               @Lst )\n            @V (mapcar car @Lst) )\n         (curry (@L @V) (X Val)\n            (find\n               '((R V) (match> R Val (get X V) X))\n               '@L\n               '@V ) ) )\n      (rest) ) )\n\n# Iterate all objects of given class or search query\n(private) (X Prg)\n\n(de forall (X . Prg)\n   (cond\n      ((or (atom X) (num? (car X)))  # 'seq'\n         (for\n            (This\n               (seq\n                  (or\n                     (and (pair X) (++ X))\n                     (; X Dbf 1)\n                     (meta X 'Dbf 1)\n                     1 ) )\n               This\n               (seq This) )\n            (and (isa X This) (run Prg 1)) ) )\n      ((flg? (car X))  # 'search'\n         (while (search X)\n            (with @ (run Prg 1)) ) )\n      (T  # 'init'\n         (while (step X)\n            (with @ (run Prg 1)) ) ) ) )\n\n# Define object variables as relations\n(de rel Lst\n   (def *Class\n      (car Lst)\n      (new (cadr Lst) (car Lst) (cddr Lst)) ) )\n\n# Find or create object\n(de request (Typ Var . @)\n   (let Dbf (or (meta Typ 'Dbf 1) 1)\n      (ifn Var\n         (new Dbf Typ)\n         (with (meta Typ Var)\n            (or\n               (pass db Var (: cls))\n               (if (: hook)\n                  (pass new Dbf Typ @ (next) Var)\n                  (pass new Dbf Typ Var) ) ) ) ) ) )\n\n(de request! (Typ Var . @)\n   (prog2\n      (dbSync)\n      (pass request Typ Var)\n      (commit 'upd) ) )\n\n# Create or update object\n(private) *ObjIdx\n\n(de obj Lst\n   (let Obj\n      (let L (++ Lst)\n         (if (pair (car L))\n            (apply request L)\n            (cache '*ObjIdx (++ Lst)\n               (new (or (meta L 'Dbf 1) 1) L) ) ) )\n      (while Lst\n         (let (K (++ Lst)  V (++ Lst))\n            (if (=T K)\n               (lose> Obj)\n               (put> Obj K V) ) ) )\n      Obj ) )\n\n# Create or update lots of objects\n(de create (Typ Key Vars . Prg)\n   (prune 0)\n   (setq Vars  # ((var fd lst cnt . cnt) ..)\n      (mapcar\n         '((Var)\n            (if (isa '+index (meta Typ Var))\n               (cons Var\n                  (open (tmp (pack \"create-\" Var)))\n                  NIL 0 1000000 )\n               Var ) )\n         Vars ) )\n   (while (run Prg)  # (val ..)\n      (let (Lst @  Obj (or (fin Lst) (new (meta Typ 'Dbf 1) Typ)))\n         (and Key (++ Lst) (put> Obj Key @))\n         (let store '((Tree Key Val Dbf) (link Key))\n            (mapc\n               '((V Val)\n                  (when (or Val (fin Lst))\n                     (if (atom V)\n                        (put> Obj V Val)\n                        (out (cadr V)\n                           (for Key (make (put> Obj (car V) Val))\n                              (at (cdddr V) (push (cddr V) Key))\n                              (pr Key Obj) ) ) ) ) )\n               Vars\n               Lst ) ) )\n      (at (0 . 1000000) (commit) (prune 2)) )\n   (commit)\n   (prune 0)\n   (let Lst\n      (extract\n         '((V)\n            (unless (atom V)\n               (close (cadr V))\n               (let\n                  (Var (car V)\n                     File (tmp (pack \"create-\" Var))\n                     N 0 )\n                  (setq V\n                     (mapcar\n                        '((Key)\n                           (let F (tmp (pack \"create-\" (inc 'N)))\n                              (cons Key F\n                                 (or (open F) (quit \"Too many files\")) ) ) )\n                        (cons NIL (sort (caddr V))) ) )\n                  (in File\n                     (while (setq Key (rd))\n                        (out (cddr (rank Key V))\n                           (pr Key (rd)) ) ) )\n                  (%@ \"unlink\" NIL File)\n                  (let (Dbf (meta Typ Var 'dbf)  Tree (cons Var (new T)))\n                     (for R V\n                        (close (cddr R))\n                        (for X\n                           (sort\n                              (make\n                                 (in (cadr R)\n                                    (while (rd)\n                                       (link (cons @ (rd))) ) ) ) )\n                           (store Tree (car X) (cdr X) Dbf)\n                           (at (0 . 1000) (prune 2)) )\n                        (commit)\n                        (prune 2)\n                        (%@ \"unlink\" NIL (cadr R)) )\n                     (commit)\n                     Tree ) ) ) )\n         Vars )\n      (prune)\n      (for Tree Lst\n         (let\n            (Base (get *DB (meta Typ (car Tree) 'cls))\n               Root (get (cdr Tree) (car Tree)) )\n            (ifn (get Base (car Tree))\n               (put Base (car Tree) Root)\n               (touch Base)\n               (inc @ (car Root)) ) )\n         (zap (cdr Tree)) )\n      (commit) ) )\n\n### Debug ###\n`*Dbg\n\n(noLint 'create 'store)\n\n(load \"@lib/sq.l\")\n"
  },
  {
    "path": "lib/dbgc.l",
    "content": "# 04jun23 Software Lab. Alexander Burger\n\n### DB Garbage Collection ###\n\n(private) (markData markExt)\n\n(de markExt (S)\n   (unless (mark S T)\n      (markData (val S))\n      (maps markData S)\n      (wipe S) ) )\n\n(de markData (X)\n   (while (pair X)\n      (markData (++ X)) )\n   (and (ext? X) (markExt X)) )\n\n(let Cnt 0\n   (dbSync)\n   (markExt *DB)\n   (for L *ExtDBs  # (\"path/\"  )\n      (let ((P N E) L  Lck)\n         (for I N\n            (let (Fd (open (pack P (hax (dec I))))  (Cnt . Siz) (blk Fd 0))\n               (and (=1 I) (setq Lck Fd))\n               (for Blk (dec Cnt)\n                  (mapc markExt\n                     (fish ext? (ext E (blk Fd Blk Siz Lck))) ) )\n               (close Fd) ) ) ) )\n   (finally (mark 0)\n      (for (F . @) (or *Dbs (2))\n         (for (S (seq F)  S  (seq S))\n            (unless (mark S)\n               (inc 'Cnt)\n               (and (isa '+Entity S) (zap> S))\n               (zap S) ) ) ) )\n   (when *Blob\n      (use (@S @R F S)\n         (let Pat (conc (chop *Blob) '(@S \".\" @R))\n            (in (list 'find *Blob \"-type\" \"f\")\n               (while (setq F (line))\n                  (when (match Pat F)\n                     (unless\n                        (and\n                           (setq S (extern (pack (delete \"/\" @S T))))\n                           (get S (intern @R)) )\n                        (inc 'Cnt)\n                        (%@ \"unlink\" NIL (pack F)) )\n                     (wipe S) ) ) ) ) ) )\n   (commit)\n   (gt0 Cnt) )\n"
  },
  {
    "path": "lib/debug.l",
    "content": "# 05nov25 Software Lab. Alexander Burger\n\n# Prompt\n(de *Prompt\n   (casq (car (symbols)) (pico) (T @)) )\n\n(private) (_who _match nest nst1 nst2 C D E M S X Y Z Fun Prg Who dep1 dep2)\n\n# Edit history\n(de h ()\n   (let F (tmp \"history\")\n      (out F\n         (mapc prinl (history)) )\n      (and\n         (vi (cons T F))\n         (history\n            (in F\n               (make (while (line T) (link @))) ) )\n         T ) ) )\n\n# Browsing\n(de help (Sym Ex)\n   (when (; Sym doc)\n      (prinl \"========================================\")\n      (in @\n         (from\n            (pack\n               \"
\" \"%3E\"\n                  \"\\^\" \"%5E\"\n                  \"|\" \"%7C\")\n               \"\\\">\" ) )\n         (out '(\"w3m\" \"-T\" \"text/html\" \"-dump\")\n            (prin \"
\")\n            (echo \"\")\n            (echo \"
\")\n            (prinl \"
\")\n            (echo \"\\n
\")\n            (ifn Ex\n               (prinl \"

\")\n               (prin \"
\")\n               (prinl (echo \"\\n
\")) ) ) ) )\n   Sym )\n\n(de docs (Dir)\n   (when (=T (car (info Dir)))\n      (let All (all)\n         (for F (dir Dir)\n            (when (match '(\"r\" \"e\" \"f\" @ \".\" \"h\" \"t\" \"m\" \"l\") (chop F))\n               (let P (pack Dir F)\n                  (in P\n                     (while (from \"
\" \"%3E\"\n                     \"\\^\" \"%5E\"\n                     \"|\" \"%7C\" ) )\n               \"@doc/ref.html\" ) ) ) ) )\n\n(de more (M Fun)\n   (let *Dbg NIL\n      (if (pair M)\n         ((default Fun println) (++ M))\n         (println (type M))\n         (setq\n            Fun (list '(X) (list 'pp 'X (lit M)))\n            M (mapcar car (filter pair (val M))) ) )\n      (loop\n         (T (atom M))\n         (T (= \"\\e\" (key)) T)\n         (Fun (++ M)) ) ) )\n\n(de what (S)\n   (let *Dbg NIL\n      (setq S (chop S))\n      (filter\n         '((\"X\") (match S (chop \"X\")))\n         (all) ) ) )\n\n(de who (X . Prg)\n   (let (*Dbg NIL  Who '(Who @ @@ @@@))\n      (make (mapc _who (all))) ) )\n\n(and noLint (@ 'who 'Prg))\n\n(de _who (Y)\n   (unless (or (ext? Y T) (memq Y Who))\n      (push 'Who Y)\n      (ifn (= `(char \"+\") (char Y))\n         (and (pair (val Y)) (nest @) (link Y))\n         (for Z (pair (val Y))\n            (if (atom Z)\n               (and (_match Z) (link Y))\n               (when (nest (cdr Z))\n                  (link (cons (car Z) Y)) ) ) )\n         (maps\n            '((Z)\n               (if (atom Z)\n                  (and (_match Z) (link Y))\n                  (when (nest (car Z))\n                     (link (cons (cdr Z) Y)) ) ) )\n            Y ) ) ) )\n\n(de nest (Y)\n   (nst1 Y)\n   (nst2 Y) )\n\n(de nst1 (Y)\n   (let Z (setq Y (strip Y))\n      (loop\n         (T (atom Y) (and (sym? Y) (_who Y)))\n         (and (sym? (car Y)) (_who (car Y)))\n         (and (pair (car Y)) (nst1 @))\n         (T (== Z (setq Y (cdr Y)))) ) ) )\n\n(de nst2 (Y)\n   (let Z (setq Y (strip Y))\n      (loop\n         (T (atom Y) (_match Y))\n         (T (or (_match (car Y)) (nst2 (car Y)))\n            T )\n         (T (== Z (setq Y (cdr Y)))) ) ) )\n\n(de _match (D)\n   (and\n      (cond\n         ((str? X) (and (str? D) (= X D)))\n         ((sym? X) (== X D))\n         (T (match X D)) )\n      (or\n         (not Prg)\n         (let *Dbg (up 2 *Dbg) (run Prg)) ) ) )\n\n(de has (X)\n   (let *Dbg NIL\n      (filter\n         '((S) (= X (val S)))\n         (all) ) ) )\n\n(de can (X)\n   (let *Dbg NIL\n      (extract\n         '((Y)\n            (and\n               (= `(char \"+\") (char Y))\n               (asoq X (val Y))\n               (cons X Y) ) )\n         (all) ) ) )\n\n(private) (Flg Nsp Lst Sym N L S)\n\n# Namespaces nested in current search order\n(de namespaces (Flg)\n   (let N 3\n      (make\n         (for Nsp (symbols)\n            (recur (Nsp N)\n               (link Nsp)\n               (when Flg\n                  (space N)\n                  (println Nsp) )\n               (for S (all Nsp)\n                  (and\n                     (pair (val S))\n                     (== '\\~ (car @))\n                     (not (memq S (made)))\n                     (recurse S (+ N 3)) ) ) ) ) ) ) )\n\n# Namespace shadowing\n(de shadows (Flg)\n   (let Lst (mapcan all (symbols))\n      (make\n         (while (cdr Lst)\n            (let Sym (++ Lst)\n               (unless (member Sym (made))\n                  (let? L\n                     (filter\n                        '((S)\n                           (and\n                              (= S Sym)\n                              (n== S Sym)\n                              (val S) ) )\n                        Lst )\n                     (when Flg\n                        (space 3)\n                        (apply println L Sym) )\n                     (link Sym) ) ) ) ) ) ) )\n\n# Class dependencies\n(de dep (C)\n   (let *Dbg NIL\n      (dep1 0 C)\n      (dep2 3 C)\n      C ) )\n\n(de dep1 (N C)\n   (for X (type C)\n      (dep1 (+ 3 N) X) )\n   (space N)\n   (println C) )\n\n(de dep2 (N C)\n   (for X (all)\n      (when\n         (and\n            (= `(char \"+\") (char X))\n            (memq C (type X)) )\n         (space N)\n         (println X)\n         (dep2 (+ 3 N) X) ) ) )\n\n# Inherited methods\n(de methods (Obj)\n   (make\n      (let Mark NIL\n         (recur (Obj)\n            (for X (val Obj)\n               (nond\n                  ((pair X) (recurse X))\n                  ((memq (car X) Mark)\n                     (link (cons (car X) Obj))\n                     (push 'Mark (car X)) ) ) ) ) ) ) )\n\n(private) (_dbg _dbg2 dbg ubg traced? U)\n\n# Single-Stepping\n(de _dbg (Lst)\n   (or\n      (atom (car Lst))\n      (num? (caar Lst))\n      (flg? (caar Lst))\n      (== '! (caar Lst))\n      (set Lst (cons '! (car Lst))) ) )\n\n(de _dbg2 (Lst)\n   (map\n      '((L)\n         (if (and (pair (car L)) (flg? (caar L)))\n            (map _dbg (cdar L))\n            (_dbg L) ) )\n      Lst ) )\n\n(de dbg (Lst)\n   (when (pair Lst)\n      (casq (++ Lst)\n         ((case casq state)\n            (_dbg Lst)\n            (for L (cdr Lst)\n               (map _dbg (cdr L)) ) )\n         ((cond nond)\n            (for L Lst\n               (map _dbg L) ) )\n         (quote\n            (when (fun? Lst)\n               (map _dbg (cdr Lst)) ) )\n         ((job use let let? recur)\n            (map _dbg (cdr Lst)) )\n         (loop\n            (_dbg2 Lst) )\n         ((bind do)\n            (_dbg Lst)\n            (_dbg2 (cdr Lst)) )\n         (for\n            (and (pair (car Lst)) (map _dbg (cdar Lst)))\n            (_dbg2 (cdr Lst)) )\n         (T (map _dbg Lst)) )\n      T ) )\n\n(de d ()\n   (let *Dbg NIL\n      (dbg ^) ) )\n\n(de -debug ()\n   (debug (intern (opt))) )\n\n(de debug (X C)\n   (ifn (traced? X C)\n      (let *Dbg NIL\n         (when (pair X)\n            (setq C (cdr X)  X (car X)) )\n         (or\n            (dbg (if C (method X C) (getd X)))\n            (quit \"Can't debug\" X) ) )\n      (untrace X C)\n      (debug X C)\n      (trace X C) ) )\n\n(de ubg (Lst)\n   (when (pair Lst)\n      (map\n         '((L)\n            (when (pair (car L))\n               (when (== '! (caar L))\n                  (set L (cdar L)) )\n               (ubg (car L)) ) )\n         Lst )\n      T ) )\n\n(de u ()\n   (let *Dbg NIL\n      (ubg ^) ) )\n\n(de unbug (X C)\n   (let *Dbg NIL\n      (when (pair X)\n         (setq C (cdr X)  X (car X)) )\n      (or\n         (ubg (if C (method X C) (getd X)))\n         (quit \"Can't unbug\" X) ) ) )\n\n# Tracing\n(de traced? (X C)\n   (setq X\n      (if C\n         (method X C)\n         (getd X) ) )\n   (and\n      (pair X)\n      (pair (cadr X))\n      (== '$ (caadr X)) ) )\n\n# Convert ((X Y) A B) --> ((X Y) ($ foo (X Y) A B))\n(de -trace ()\n   (trace (intern (opt))) )\n\n(de trace (X C)\n   (let *Dbg NIL\n      (when (pair X)\n         (setq C (cdr X)  X (car X)) )\n      (if C\n         (unless (traced? X C)\n            (or (method X C) (quit \"Can't trace\" X))\n            (con @\n               (cons\n                  (conc\n                     (list '$ (cons X C) (car @))\n                     (cdr @) ) ) ) )\n         (unless (traced? X)\n            (and (sym? (getd X)) (quit \"Can't trace\" X))\n            (and (num? (getd X)) (expr X))\n            (set X\n               (list\n                  (car (getd X))\n                  (conc (list '$ X) (getd X)) ) ) ) )\n      X ) )\n\n# Convert ((X Y) ($ foo (X Y) A B)) --> ((X Y) A B)\n(de untrace (X C)\n   (let *Dbg NIL\n      (when (pair X)\n         (setq C (cdr X)  X (car X)) )\n      (if C\n         (when (traced? X C)\n            (con\n               (method X C)\n               (cdddr (cadr (method X C))) ) )\n         (when (traced? X)\n            (let Y (set X (cddadr (getd X)))\n               (and\n                  (== '@ (++ Y))\n                  (=1 (length Y))\n                  (= 2 (length (car Y)))\n                  (== 'pass (caar Y))\n                  (sym? (cdadr Y))\n                  (subr X) ) ) ) )\n      X ) )\n\n(de *NoTrace\n   @ @@ @@@\n   pp show more led\n   what who can dep d e debug u unbug trace untrace )\n\n(de traceAll (Excl)\n   (let *Dbg NIL\n      (for X (all)\n         (or\n            (memq X Excl)\n            (memq X *NoTrace)\n            (= `(char \"*\") (char X))\n            (cond\n               ((= `(char \"+\") (char X))\n                  (mapc trace\n                     (extract\n                        '((Y)\n                           (and\n                              (pair Y)\n                              (fun? (cdr Y))\n                              (cons (car Y) X) ) )\n                        (val X) ) ) )\n               ((pair (getd X))\n                  (trace X) ) ) ) ) ) )\n\n# Process Listing\n(when (member *OS '(\"Android\" \"Linux\"))\n   (de proc @\n      (apply call\n         (make (while (args) (link \"-C\" (next))))\n         \"ps\" \"-H\" \"-o\" \"pid,ppid,start,size,pcpu,stat,cmd\" ) ) )\n\n# Benchmarking\n(de bench Prg\n   (let U (usec)\n      (prog1\n         (run Prg 1)\n         (out 2\n            (when (>= (setq U (- (usec) U)) 60000000)\n               (prin \"[\" (tim$ (/ U 1000000)) \"] \") )\n            (prinl (format (/ U 1000) 3) \" sec\") ) ) ) )\n\n# Backtrace\n(de bt (Flg)\n   (let (S NIL  *Dbg)\n      (for (L (trail T) L)\n         (if (pair (car L))\n            (let E (++ L)\n               (push 'S\n                  (list\n                     (if (getd (box? (car E)))\n                        (cons @ (cdr E))\n                        E ) ) ) )\n            (conc\n               (car (default S (cons (cons))))\n               (cons (cons (++ L) (++ L))) ) )\n         (T (== '^ (car L)))\n         (T\n            (and\n               (pair (car L))\n               (== 'bt (caar L)) ) ) )\n      (for L S\n         (let? X (++ L)\n            (pretty\n               (cons\n                  (or\n                     (and (sym? (car X)) (car X))\n                     (find\n                        '((S) (== (car X) (val S)))\n                        (all) )\n                     (car X) )\n                  (less (cdr X)) ) ) )\n         (prinl)\n         (while L\n            (space 3)\n            (println (caar L) (less (cdr (++ L)))) )\n         (NIL (or Flg (<> \"\\e\" (key))) T) ) ) )\n\n# Source code\n`(info \"@lib/map\")\n\n(symbols 'llvm 'pico)\n\n(in \"@lib/map\"\n   (while (read)\n      (let Sym @\n         (if (get Sym '*Dbg)\n            (set @ (read))\n            (put Sym '*Dbg (cons (read))) ) ) ) )\n"
  },
  {
    "path": "lib/form.js",
    "content": "/* 13mar25 Software Lab. Alexander Burger */\n\nvar Btn = [];\nvar SesId, Key, InBtn, Auto, Chg, Post, Drop, Hint, Hints, Item, Beg, End;\n\nfunction inBtn(btn,flg) {InBtn = flg;}\n\nfunction formKey(event) {\n   Key = event.key;\n   if (Hint  &&  Hint.style.visibility == \"visible\") {\n      if ((Item >= 0  &&  Key == \"Enter\")  ||  Key == \"ArrowUp\"  ||  Key == \"ArrowDown\")\n         return false;\n      if (Key == \"Enter\") {\n         Hint.style.visibility = \"hidden\";\n         return true;\n      }\n      if (Key == \"Escape\") {\n         Hint.style.visibility = \"hidden\";\n         return false;\n      }\n   }\n   if (Key == \"Backspace\")\n      Chg = true;\n   return true;\n}\n\nfunction fldChg(field) {\n   Chg = true;\n   if (!InBtn  &&  (Key != \"Enter\" || field.type == \"textarea\")) {\n      post(field.form, false, null, null);\n      Key = 0;\n   }\n   return true;\n}\n\nfunction doBtn(btn) {\n   Btn.push(btn);\n   return true;\n}\n\nfunction doDrag(event) {\n   event.stopPropagation();\n   event.preventDefault();\n}\n\nfunction doDrop(btn, event) {\n   doDrag(event);\n   if (event.dataTransfer.files.length != 0) {\n      Btn.push(Drop = btn);\n      btn.value = \"0 %\";\n      post(btn.form, false, null, event.dataTransfer.files[0]);\n   }\n}\n\nfunction dropProgress(event) {\n   if (Drop)\n      Drop.value = event.lengthComputable?\n         Math.round((event.loaded * 100) / event.total) + \" %\" : \"(?) %\";\n}\n\nfunction dropLoad(event) {\n   Drop = null;\n}\n\nfunction hasElement(form, name) {\n   for (var i = 0; i < form.elements.length; ++i)\n      if (form.elements[i].name == name)\n         return true;\n   return false;\n}\n\nfunction setHref(fld, url) {\n   var i = url.indexOf(\"~\");\n\n   if (url.charAt(i = i>=0? i+1 : 0) == \"+\")  {\n      url = url.substr(0,i) + url.substr(i+1);\n      fld.target = \"_blank\";\n   }\n   fld.href = decodeURIComponent(url);\n}\n\nfunction idFocus(fld) {\n   try {\n      document.createEvent(\"TouchEvent\");\n      return true;\n   } catch (e) {}\n   setTimeout(function() {document.getElementById(fld).focus()}, 420);\n}\n\nfunction setCheck(fld, val) {\n   var lst = document.getElementsByName(fld.name);\n\n   for (var i = 1;  i < lst.length; ++i)\n      if (lst[i] == fld)\n         return lst[i - 1] = val;\n}\n\n/*** Form submit ***/\nfunction doPost(form) {\n   for (var i = 0; ; ++i) {\n      if (i == Btn.length)\n         return true;\n      if (Btn[i].form == form)\n         return post(form, false, null, null);\n   }\n}\n\nfunction post(form, auto, exe, file) {\n   var i, data;\n   var req = new XMLHttpRequest();\n\n   if (!hasElement(form,\"*Form\") || (i = form.action.indexOf(\"~\")) <= 0)\n      return true;\n   form.style.cursor = \"wait\";\n   try {req.open(\"POST\", SesId + \"!jsForm?\" + form.action.substr(i+1));}\n   catch (e) {return true;}\n   req.onload = function() {\n      if (req.status != 200)\n         req.abort();\n      else if (req.responseText == \"T\")\n         form.submit();\n      else if (req.responseText) {\n         var txt = req.responseText.split(\"&\");\n\n         form.elements[\"*Evt\"].value = txt[0];\n         if (txt[1]) {\n            var r = txt[1].split(\":\");\n\n            if (Auto)\n               clearTimeout(Auto);\n            if (!r[1])\n               Auto = null;\n            else {\n               Auto = setTimeout(function() {\n                  if (Chg)\n                     Auto = setTimeout(arguments.callee, r[1]);\n                  else {\n                     Btn.push(document.getElementById(r[0]));\n                     post(form, true, null, null);\n                  }\n               }, r[1] );\n            }\n         }\n         if (!auto || !Chg) {\n            var i, j;\n\n            for (i = 2; i < txt.length;) {\n               var fld = txt[i++];\n               var val = decodeURIComponent(txt[i++]);\n\n               if (!fld) {\n                  window[txt[i++]](val);\n                  continue;\n               }\n               if (!(fld = document.getElementById(fld)))\n                  continue;\n               if (fld.tagName == \"SPAN\") {\n                  if (i != txt.length && txt[i].charAt(0) == \"=\")\n                     ++i;\n                  if (i == txt.length || txt[i].charAt(0) != \"+\") {\n                     if (fld.firstChild.tagName != \"A\")\n                        fld.firstChild.data = val? val : \"\\u00A0\";\n                     else\n                        fld.replaceChild(document.createTextNode(val? val : \"\\u00A0\"), fld.firstChild);\n                  }\n                  else {\n                     var a = document.createElement(\"A\");\n\n                     setHref(a, txt[i++].substr(1));\n                     a.appendChild(document.createTextNode(val));\n                     fld.replaceChild(a, fld.firstChild);\n                  }\n               }\n               else if (fld.tagName == \"A\") {\n                  if (i != txt.length && txt[i].charAt(0) == \"=\")\n                     ++i;\n                  if (i == txt.length || txt[i].charAt(0) != \"+\") {\n                     fld.replaceChild(document.createTextNode(val? val : \"\\u00A0\"), fld.firstChild);\n                     fld.removeAttribute(\"href\");\n                  }\n                  else {\n                     fld.firstChild.data = val;\n                     setHref(fld, txt[i++].substr(1));\n                  }\n               }\n               else if (fld.tagName == \"IMG\") {\n                  var parent = fld.parentNode;\n\n                  fld.src = val;\n                  fld.alt = txt[i++];\n                  if (parent.tagName == \"A\") {\n                     if (txt[i])\n                        setHref(parent, txt[i]);\n                     else {\n                        var grand = parent.parentNode;\n\n                        grand.removeChild(parent);\n                        grand.appendChild(fld);\n                     }\n                  }\n                  else if (txt[i]) {\n                     var a = document.createElement(\"A\");\n\n                     parent.removeChild(fld);\n                     parent.appendChild(a);\n                     a.appendChild(fld);\n                     setHref(a, txt[i]);\n                  }\n                  ++i;\n               }\n               else {\n                  if (fld.type == \"checkbox\") {\n                     fld.checked = val != \"\";\n                     setCheck(fld, \"\");\n                  }\n                  else if (fld.type == \"select-one\") {\n                     for (j = 0; j < fld.options.length; ++j) {\n                        if (fld.options[j].text == val)\n                           fld.selectedIndex = j;\n                        fld.options[j].disabled = false;\n                     }\n                  }\n                  else if (fld.type == \"radio\") {\n                     fld.value = val;\n                     fld.checked = txt[i++].charAt(0) != \"\";\n                  }\n                  else if (fld.type == \"image\")\n                     fld.src = val;\n                  else if (fld.value != val) {\n                     fld.value = val;\n                     if (fld.pilSetValue)\n                        fld.pilSetValue(val);\n                     fld.scrollTop = fld.scrollHeight;\n                  }\n                  fld.disabled = false;\n                  if (i < txt.length && txt[i].charAt(0) == \"=\") {\n                     if (fld.type == \"select-one\") {\n                        for (j = 0; j < fld.options.length; ++j)\n                           if (fld.options[j].text != val)\n                              fld.options[j].disabled = true;\n                     }\n                     fld.disabled = true;\n                     InBtn = 0;  // 'onblur' on won't come when disabled\n                     if (fld.type == \"checkbox\"  &&  fld.checked)\n                        setCheck(fld, \"T\");\n                     ++i;\n                  }\n                  if (fld.pilDisable)\n                     fld.pilDisable(fld.disabled);\n               }\n               while (i < txt.length && (j = \"#*?\".indexOf(txt[i].charAt(0))) >= 0) {\n                  switch (j) {\n\n                  case 0:  // '#'\n                     var cls;\n\n                     val = txt[i++].substr(1);\n                     if ((cls = fld.getAttribute(\"class\")) != null  &&  (j = cls.indexOf(\"  \")) >= 0)\n                        val += cls.substr(j);\n                     fld.setAttribute(\"class\", val);\n                     break;\n\n                  case 1:  // '*'\n                     var node = fld.parentNode.parentNode.lastChild;\n                     var img = document.createElement(\"IMG\");\n\n                     if (!node.firstChild)\n                        node = fld.parentNode.parentNode.parentNode.lastChild;\n                     node.removeChild(node.firstChild);\n                     img.src = txt[i++].substr(1);\n                     if (!txt[i])\n                        node.appendChild(img);\n                     else {\n                        var a = document.createElement(\"A\");\n\n                        setHref(a, txt[i]);\n                        a.appendChild(img);\n                        node.appendChild(a);\n                     }\n                     ++i;\n                     break;\n\n                  case 2:  // '?'\n                     fld.title = decodeURIComponent(txt[i++].substr(1));\n                     break;\n                  }\n               }\n            }\n            if (Post)\n               Post();\n            Chg = false;\n         }\n      }\n      form.style.cursor = \"\";\n   };\n   if (!exe)\n      data = \"\";\n   else {\n      data = \"*Gui:0=\" + exe[0];\n      for (var i = 1; i < exe.length; ++i)\n         data += \"&*JsArgs:\" + i + \"=\" + exe[i];\n   }\n   for (i = 0; i < Btn.length;)\n      if (Btn[i].form != form)\n         ++i;\n      else {\n         data += \"&\" + Btn[i].name + \"=\" + encodeURIComponent(Btn[i].type == \"submit\"? Btn[i].value : Btn[i].src);\n         Btn.splice(i,1);\n      }\n   for (i = 0; i < form.elements.length; ++i) {\n      var fld = form.elements[i];\n\n      if (fld.name  &&  fld.type != \"submit\") {   // \"image\" won't come :-(\n         var val;\n\n         if (fld.type == \"checkbox\")\n            val = fld.checked? \"T\" : \"\";\n         else if (fld.type == \"select-one\")\n            val = fld.options[fld.selectedIndex].text;\n         else if (fld.type == \"radio\" && !fld.checked)\n            continue;\n         else\n            val = fld.value;\n         data += \"&\" + fld.name + \"=\" + encodeURIComponent(val.replace(/ +$/,\"\"));\n      }\n   }\n   try {\n      if (!file)\n         req.send(data);\n      else {\n         var rd = new FileReader();\n\n         req.upload.addEventListener(\"progress\", dropProgress, false);\n         req.upload.addEventListener(\"load\", dropLoad, false);\n         rd.readAsBinaryString(file);\n         rd.onload = function() {\n            req.setRequestHeader(\"X-Pil\", \"*ContL=T\");\n            req.sendAsBinary(data + \"&*Drop=\" +\n               encodeURIComponent(file.name) + \"=\" +\n               file.size + \"\\n\" + rd.result );\n         }\n      }\n   }\n   catch (e) {\n      req.abort();\n      return true;\n   }\n   return false;\n}\n\n/*** Hints ***/\nfunction doHint(field) {\n   if (!Hint) {\n      Hint = document.createElement(\"div\");\n      Hint.setAttribute(\"class\", \"hint\");\n      Hint.style.visibility = \"hidden\";\n      Hint.style.position = \"absolute\";\n      Hint.style.zIndex = 9999;\n      Hint.style.textAlign = \"left\";\n      Hints = document.createElement(\"div\");\n      Hints.setAttribute(\"class\", \"hints\");\n      Hints.style.position = \"relative\";\n      Hints.style.top = \"-2px\";\n      Hints.style.left = \"-3px\";\n      Hint.appendChild(Hints);\n   }\n   field.parentNode.appendChild(Hint);\n   field.onblur = function() {\n      Hint.style.visibility = \"hidden\";\n   }\n   var top = field.offsetHeight;\n   var left = 0;\n   for (var obj = field;  obj && obj.style.position != \"absolute\";  obj = obj.offsetParent) {\n      top += obj.offsetTop;\n      left += obj.offsetLeft;\n   }\n   Hint.style.top = top + \"px\";\n   Hint.style.left = left + \"px\";\n}\n\nfunction hintKey(field, event, tok, coy) {\n   var i, data;\n\n   if (event.key == \"Tab\"  ||  event.key == \"Escape\")\n      return false;\n   if (Hint.style.visibility == \"visible\") {\n      if (Item >= 0  &&  event.key == \"Enter\") {\n         setHint(field, Hints.childNodes[Item]);\n         return false;\n      }\n      if (event.key == \"ArrowUp\") {\n         if (Item > 0) {\n            hintOff(Item);\n            hintOn(--Item);\n         }\n         return false;\n      }\n      if (event.key == \"ArrowDown\") {\n         if (Item < (lst = Hints.childNodes).length-1) {\n            if (Item >= 0)\n               hintOff(Item);\n            hintOn(++Item);\n         }\n         return false;\n      }\n   }\n   if (event.key == \"Enter\")\n      return true;\n   var req = new XMLHttpRequest();\n   if (tok) {\n      for (Beg = field.selectionStart;  Beg > 0 && !field.value.charAt(Beg-1).match(/\\s/);  --Beg);\n      End = field.selectionEnd;\n   }\n   else {\n      Beg = 0;\n      End = field.value.length;\n   }\n   if (event.key != \"Insert\") {\n      if (Beg == End) {\n         Hint.style.visibility = \"hidden\";\n         return false;\n      }\n      if (coy && Hint.style.visibility == \"hidden\")\n         return false;\n   }\n   try {\n      req.open(\"POST\", (SesId? SesId : \"\") +\n         ((i = field.id.lastIndexOf(\"-\")) < 0?\n            \"!jsHint?$\" + field.id : \"!jsHint?+\" + field.id.substr(i+1) ) );\n   }\n   catch (e) {return true;}\n   req.onload = function() {\n      var i, n, lst, str;\n\n      if ((str = req.responseText).length == 0)\n         Hint.style.visibility = \"hidden\";\n      else {\n         lst = str.split(\"&\");\n         while (Hints.hasChildNodes())\n            Hints.removeChild(Hints.firstChild);\n         for (i = 0, n = 7; i < lst.length; ++i) {\n            addHint(i, field, str = decodeURIComponent(lst[i]));\n            if (str.length > n)\n               n = str.length;\n         }\n         Hints.style.width = n + 3 + \"ex\";\n         Hint.style.width = n + 4 + \"ex\";\n         Hint.style.visibility = \"visible\";\n         Item = -1;\n      }\n   }\n   var data = \"*JsHint=\" + encodeURIComponent(field.value.substring(Beg,End));\n   for (i = 0; i < field.form.elements.length; ++i) {\n      var fld = field.form.elements[i];\n\n      if (fld.name == \"*Get\")\n         data += \"&*Get=\" + fld.value;\n      else if (fld.name == \"*Form\")\n         data += \"&*Form=\" + fld.value;\n   }\n   try {req.send(data);}\n   catch (e) {\n      req.abort();\n      return true;\n   }\n   return (event.key != \"Insert\");\n}\n\nfunction addHint(i, field, str) {\n   var item = document.createElement(\"div\");\n   item.appendChild(document.createTextNode(str));\n   item.onmouseover = function() {\n      if (Item >= 0)\n         hintOff(Item);\n      hintOn(i);\n      field.onblur = false;\n      field.onchange = false;\n      Item = i;\n   }\n   item.onmouseout = function() {\n      hintOff(Item);\n      field.onblur = function() {\n         Hint.style.visibility = \"hidden\";\n      }\n      field.onchange = function() {\n         return fldChg(field);\n      };\n      Item = -1;\n   }\n   item.onclick = function() {\n      setHint(field, item);\n   }\n   Hints.appendChild(item);\n}\n\nfunction setHint(field, item) {\n   Hint.style.visibility = \"hidden\";\n   field.value = field.value.substr(0,Beg) + item.firstChild.nodeValue + field.value.substr(End);\n   Chg = true;\n   post(field.form, false, null, null);\n   field.setSelectionRange(Beg + item.firstChild.nodeValue.length, field.value.length);\n   field.focus();\n   field.onchange = function() {\n      return fldChg(field)\n   };\n}\n\nfunction hintOn(i) {\n   var s = Hints.childNodes[i].style;\n   s.background = \"black\";\n   s.color= \"white\";\n}\n\nfunction hintOff(i) {\n   var s = Hints.childNodes[i].style;\n   s.background = \"white\";\n   s.color= \"black\";\n}\n\n/*** Scroll/touch ***/\nvar TblX, TblY;\n\nfunction tblTouch(event) {\n   if (event.touches.length == 1) {\n      TblX = event.touches[0].pageX;\n      TblY = event.touches[0].pageY;\n   }\n   return true;\n}\n\nfunction tblMove(table, event) {\n   if (event.touches.length == 1) {\n      var dx = event.touches[0].pageX - TblX;\n      var dy = event.touches[0].pageY - TblY;\n\n      TblX = event.touches[0].pageX;\n      if (Math.abs(dx) > Math.abs(dy))\n         return true;\n      if (Math.abs(dy) > 12) {\n         TblY = event.touches[0].pageY;\n         for (var obj = table.parentNode;  obj;  obj = obj.parentNode)\n            if (obj.tagName == \"FORM\")\n               return post(obj, false,\n                  [dy > 6? \"jsUp\" : \"jsDn\", \"+\" + table.getAttribute(\"chart\")],\n                  null );\n      }\n      return false;\n   }\n   return true;\n}\n\n/*** Lisp calls ***/\nfunction lisp(form, fun) {\n   if (form) {\n      var exe = [fun];\n\n      for (var i = 2; i < arguments.length; ++i)\n         if (typeof arguments[i] === \"number\")\n            exe[i-1] = \"+\" + arguments[i];\n         else\n            exe[i-1] = \".\" + encodeURIComponent(arguments[i]);\n      return post(form, false, exe, null);\n   }\n   if (arguments.length > 2) {\n      fun += \"?\" + lispVal(arguments[2]);\n      for (var i = 3; i < arguments.length; ++i)\n         fun += \"&\" + lispVal(arguments[i]);\n   }\n   var req = new XMLHttpRequest();\n   try {req.open(\"GET\", SesId + \"!\" + fun);}\n   catch (e) {return true;}\n   req.onload = function() {\n      if (req.responseText)\n         eval(req.responseText);\n   }\n   try {req.send(null);}\n   catch (e) {\n      req.abort();\n      return true;\n   }\n   return false;\n}\n\nfunction lispVal(x) {\n   if (typeof x === \"number\")\n      return \"+\" + x;\n   if (x.charAt(0) == \"-\")\n      return \"%2D\" + encodeURIComponent(x.substr(1));\n   return encodeURIComponent(x);\n}\n\nfunction ping(min) {\n   if (SesId)\n      setTimeout(function() {ping1(min)}, 20000);\n}\n\nfunction ping1(min) {\n   lisp(null, \"ping\", min);\n   setTimeout(function() {ping1(min)}, 20000);\n}\n"
  },
  {
    "path": "lib/form.l",
    "content": "# 20feb26 Software Lab. Alexander Burger\n\n# *PRG *Top *Gui *Btn *Get *Got *Form *FormIx *FormLst *Evt\n# *Lock *Spans *AlwaysAsk\n\n(private) (*Chart *App *Ix *Err *Foc *Post2 *Stat *Cho *TZO)\n\n(allow \"@img/\" T)\n(push1 '*JS (allow \"@lib/form.js\"))  #! @lib\n(mapc allow\n   (quote\n      *Gui *Get *Got *Form \"!jsForm\" *Evt *Drop\n      *JsHint \"!jsHint\" jsUp jsDn *JsArgs \"!tzOffs\" ) )\n\n(default *FormIx 1)\n\n(de *Go.png . \"@img/go.png\")\n(de *No.png . \"@img/no.png\")\n\n(de *Throbber\n   (\"+---\" \"-+--\" \"--+-\" \"---+\" \"--+-\" \"-+--\" .) )\n\n(de tzOffs (Min)\n   (setq *TZO (* Min 60))\n   (respond) )\n\n(private) (Attr Prg App Lst F L)\n\n# Define GUI form\n(de form (Attr . Prg)\n   (when (=1 *Form)\n      ( \"window.addEventListener('pagehide', function(event) {document.forms[0].reset()});\") )\n   (inc '*Form)\n   (let App\n      (if *PRG\n         (get *FormLst (- *FormIx *Get) *Form)\n         (prog1\n            (setq *Top (new NIL NIL 'able T 'evt 0))\n            ~(as *Dbg\n               (when (file)\n                  (put *Top '*Dbg\n                     (list (cons (cddr @) (pack (car @) (cadr @)))) ) ) )\n            (put *Top 'home *Top)\n            (and (nth *FormLst (- *FormIx *Get)) (queue @ *Top)) ) )\n      (let Lst (get *FormLst (- *FormIx *Get) 1)\n         (for (F . L) Lst\n            (let *Form (- F (length Lst))\n               (cond\n                  ((and (== *PRG (car L)) (memq App (; *PRG top)))\n                     (apply \"form\" L) )\n                  ((or (== *PRG App) (memq App (; *PRG top)))\n                     (if (; L 1 top)\n                        (apply \"form\" L)\n                        (put L 1 'top (cons *PRG (; *PRG top)))\n                        (let *PRG NIL (apply \"form\" L)) ) ) ) ) ) )\n      (\"form\" App Attr Prg) ) )\n\n(de \"form\" (*App Attr Prg)\n   (with *App\n      (job (: env)\n         ( Attr (urlMT *Url *Menu *Tab *ID)\n            ( '*Get *Get)\n            ( '*Form *Form)\n            ( '*Evt (: evt))\n            (zero *Ix)\n            (if *PRG\n               (let gui\n                  '(()\n                     (with (get *App 'gui (inc '*Ix))\n                        (for E *Err\n                           (when (== This (car E))\n                              (
 'error\n                                 (if (atom (cdr E))\n                                    (ht:Prin (eval (cdr E) 1))\n                                    (eval (cdr E) 1) ) ) ) )\n                        (if (: id)\n                           (let *Gui (val *App)\n                              (show> This (cons '*Gui @)) )\n                           (setq *Chart This) )\n                        This ) )\n                  (and (== *PRG *App) (setq *Top *App))\n                  (htPrin Prg) )\n               (set *App)\n               (let gui\n                  '((X . @)\n                     (inc '*Ix)\n                     (with\n                        (cond\n                           ((pair X) (pass new X))\n                           ((not X) (pass new))\n                           ((num? X)\n                              (ifn *Chart\n                                 (quit \"no chart\" (rest))\n                                 (with *Chart\n                                    (let L (last (: gui))\n                                       (when (get L X)\n                                          (inc (:: rows))\n                                          (queue (:: gui) (setq L (need (: cols)))) )\n                                       (let Fld (pass new)\n                                          (set (nth L X) Fld)\n                                          (put Fld 'chart (list This (: rows) X))\n                                          (and (; Fld chg) (; Fld able) (=: lock))\n                                          (set> Fld\n                                             (get\n                                                ((: put)\n                                                   (get (nth (: data) (: ofs)) (: rows))\n                                                   (+ (: ofs) (: rows) -1) )\n                                                X )\n                                             T )\n                                          Fld ) ) ) ) )\n                           ((get *App X) (quit \"gui conflict\" X))\n                           (T (put *App X (pass new))) )\n                        (queue (:: home gui) This)\n                        (unless (: chart) (init> This))\n                        (when (: id)\n                           (let *Gui (val *App)\n                              (show> This (cons '*Gui (: id))) ) )\n                        This ) )\n                  (htPrin Prg) ) ) )\n         (off *Chart)\n         (--)\n         (and\n            (: show)\n            (info @)\n            (in (: show) (echo)) ) ) ) )\n\n# Disable form\n(de disable (Flg)\n   (and Flg (=: able)) )\n\n(private) Prg\n\n# Handle form actions\n(de action Prg\n   (off *Chart *Foc)\n   (or *PRG *Post2 (off *Err))\n   (catch 'stop\n      (nond\n         (*Post\n            (unless (and *PRG (= *Form (car *Got)) (= *Get (cadr *Got)))\n               (pushForm (cons)) )\n            (if *Port%\n               (let *JS NIL (_doForm))\n               (_doForm) )\n            (off *PRG *Got) )\n         (*PRG\n            (with (postForm)\n               (ifn (= *Evt (: evt))\n                  (noContent)\n                  (postGui)\n                  (redirect\n                     (baseHRef)\n                     *SesId\n                     (urlMT *Url *Menu *Tab *ID)\n                     \"&*Evt=+\" (inc (:: evt))\n                     \"&*Got=_+\" *Form \"_+\" *Get ) ) ) )\n         (NIL\n            (off *PRG)\n            (pushForm (cons))\n            (_doForm) ) ) ) )\n\n(de pushForm (L)\n   (push '*FormLst L)\n   (and (nth *FormLst 99) (con @))\n   (setq *Get *FormIx)\n   (inc '*FormIx) )\n\n(de _doForm ()\n   (one *Form)\n   (run Prg)\n   (setq *Stat\n      (cons\n         (pair *Err)\n         (copy (get *FormLst (- *FormIx *Get))) ) ) )\n\n(de jsForm (Url)\n   (if (or *PRG (not *Post))\n      (noContent)\n      (setq *Url Url  Url (chop Url))\n      (let action\n         '(Prg\n            (off *Err)\n            (with (postForm)\n               (ifn (= *Evt (: evt))\n                  (respond)\n                  (catch 'stop\n                     (postGui)\n                     (httpHead \"text/plain; charset=utf-8\")\n                     (if\n                        (and\n                           (= (car *Stat) *Err)\n                           (= (cdr *Stat) (get *FormLst (- *FormIx *Get))) )\n                        (ht:Out *Chunked\n                           (prin (setq *Evt (inc (:: evt))) \"&\")\n                           (when (: auto)\n                              (prin \"i\" *Form \"-\" (: auto 1 id) \":\" (: auto -1))\n                              (=: auto) )\n                           (for S *Spans\n                              (prin \"&\" (car S) \"&\" (run (cdr S))) )\n                           (for This (: gui)\n                              (if (: id)\n                                 (prin \"&i\" *Form \"-\" @ \"&\" (js> This))\n                                 (setq *Chart This) ) ) )\n                        (setq *Post2 (cons *Get *Form *PRG))\n                        (ht:Out *Chunked (prin T)) ) ) ) )\n            (off *PRG) )\n         (use @X\n            (cond\n               ((match '(\"-\" @X \".\" \"h\" \"t\" \"m\" \"l\") Url)\n                  (try 'html> (extern (ht:Pack @X T))) )\n               ((disallowed)\n                  (notAllowed *Url)\n                  (http404) )\n               ((= \"!\" (car Url))\n                  ((intern (cdr Url))) )\n               ((tail '(\".\" \"l\") Url)\n                  (load *Url) ) ) ) ) ) )\n\n(de postForm ()\n   (when (num? (format *Get))\n      (let? Lst (get *FormLst (- *FormIx (setq *Get @)))\n         (and\n            (setq *Form (format *Form))\n            (setq *Evt (format *Evt))\n            (setq *PRG\n               (cond\n                  ((and\n                        (= *Get (car *Post2))\n                        (= *Form (cadr *Post2)) )\n                     (cddr *Post2) )\n                  ((off *Post2))\n                  ((gt0 *Form) (get Lst *Form))\n                  (T (get Lst 1 (+ (length (car Lst)) *Form) 1)) ) )\n            (val *PRG)\n            *PRG ) ) ) )\n\n(de postGui ()\n   (if *Post2\n      (off *Gui *Post2)\n      (let (*Btn NIL  \"Fun\")\n         (for G *Gui\n            (if (=0 (car G))\n               (setq \"Fun\" (cdr G))\n               (and (lt0 (car G)) (setq *Btn (cdr G)))\n               (con (assoc (car G) (val *PRG)) (cdr G)) ) )\n         (off *Gui)\n         (and (: lock) (n== @ *Lock) (=: able))\n         (job (: env)\n            (for This (: gui)\n               (cond\n                  ((not (: id)) (setq *Chart This))\n                  ((chk> This) (error @))\n                  ((or (: rid) (: home able))\n                     (set> This (val> This) T) ) ) )\n            (unless *Err\n               (for This (: gui)\n                  (cond\n                     ((: id))\n                     ((chk> (setq *Chart This)) (error @))\n                     ((or (: rid) (: home able))\n                        (set> This (val> This)) ) ) ) )\n            (if (pair *Err)\n               (when *Lock\n                  (=: lock (with (caar *Err) (tryLock *Lock))) )\n               (finally\n                  (when *Lock\n                     (if (lock @)\n                        (=: able (=: lock (off *Lock)))\n                        (let *Run NIL\n                           (sync)\n                           (tell) ) ) )\n                  (when \"Fun\"\n                     (when (and *Allow (not (idx *Allow \"Fun\")))\n                        (notAllowed \"Fun\")\n                        (throw 'stop) )\n                     (apply (intern \"Fun\")\n                        (mapcar\n                           '((X)\n                              ((if (= \"+\" (car (setq X (chop (cdr X))))) format pack)\n                                 (cdr X) ) )\n                           *JsArgs ) ) )\n                  (for This (: gui)\n                     (nond\n                        ((: id) (setq *Chart This))\n                        ((ge0 (: id))\n                           (let? A (assoc (: id) (val *PRG))\n                              (when (cdr A)\n                                 (con A)\n                                 (act> This) ) ) ) ) ) )\n               (for This (: gui)\n                  (or (: id) (setq *Chart This))\n                  (upd> This) ) ) ) ) ) )\n\n(de error (Exe)\n   (cond\n      ((=T Exe) (on *Err))\n      ((nT *Err) (queue '*Err (cons This Exe))) ) )\n\n(de url (Url . @)\n   (when Url\n      (off *PRG)\n      (when *Timeout\n         (timeout `(* 3600 1000)) )\n      (redirect (baseHRef) *SesId Url\n         (and (args) \"?\")\n         (pack\n            (make\n               (loop\n                  (let A (next)\n                     (and\n                        (sym? A)\n                        (= `(char '*) (char A))\n                        (link A \"=\")\n                        (setq A (next)) )\n                     (link (ht:Fmt A)) )\n                  (NIL (args))\n                  (link \"&\") ) ) ) )\n      (throw 'stop) ) )\n\n(de post Prg\n   (run Prg)\n   (url *Uri) )\n\n# Active  elements\n(de span Args\n   (def (car Args)\n      (list NIL\n         (list '\n            (lit (cons 'id (car Args)))\n            (cons 'ht:Prin (cdr Args)) ) ) )\n   (push '*Spans Args) )\n\n(span expires\n   (pack\n      `(char 8230)  # Ellipsis\n      (let Tim (+ (time T) (/ (cadr (assoc -1 *Run)) 1000))\n         (if *TZO\n            (tim$ (% (- Tim -86400 @) 86400))\n            (\n               \"lisp(null, 'tzOffs', (new Date()).getTimezoneOffset())\" )\n            (pack (tim$ (% Tim 86400)) \" UTC\") ) ) ) )\n\n# Return chart property\n(de chart @\n   (pass get *Chart) )\n\n# Table extension\n(daemon '
\n   (with *Chart\n      (setq ATTR\n         (make\n            (link\n               (cons \"chart\" (index This (: home chart)))\n               '(\"ontouchstart\" . \"return tblTouch(event)\")\n               '(\"ontouchmove\" . \"return tblMove(this,event)\")\n               (and ATTR (link @)) ) ) ) ) )\n\n# REPL form\n(private) Str\n\n(de repl (Attr DX DY)\n   (default DX 80  DY 25)\n   (form Attr\n      (=: repl (tmp \"repl\"))\n      (gui 'view '(+Able +FileField)\n         '(<> (: file) (: home repl))\n         (: repl)\n         DX DY )\n      (--)\n      (gui '(+View +SymField) '(car (symbols)))\n      ()\n      (gui 'line '(+Focus +Able +Hint1 +TextField)\n         '(= (: home view file) (: home repl))\n         '*ReplH\n         (*/ DX 4 5) )\n      (----)\n      (gui '(+JS +Able +Button) '(= (: home view file) (: home repl)) \"Eval\"\n         '(let Str (val> (: home line))\n            (out (pack \"+\" (: home repl))\n               (if (= `(char \"!\") (char Str))\n                  (err NIL\n                     (prinl Str)\n                     (flush)\n                     (in (list \"sh\" \"-c\" (cdr (chop Str)))\n                        (echo) ) )\n                  (err NIL\n                     (prinl (car (symbols)) \": \" Str)\n                     (flush)\n                     (catch '(NIL)\n                        (in \"/dev/null\"\n                           (up 99 @@@ \"@3\")\n                           (up 99 @@ \"@2\")\n                           (up 99 @ \"@1\")\n                           (setq  \"@3\" \"@2\"  \"@2\" \"@1\"  \"@1\" (run (str Str) 99)) )\n                        (println '-> \"@1\") ) )\n                  (when @@\n                     (prin \"!? \")\n                     (println ^)\n                     (prinl *Msg) ) ) )\n            (push1 '*ReplH Str)\n            (clr> (: home line)) ) )\n      (gui '(+JS +Button)\n         '(if (= (: home view file) (: home repl)) ,\"Edit\" ,\"Done\")\n         '(file> (: home view)\n            (if (= (: home view file) (: home repl))\n               (if (val> (: home line))\n                  (setq *ReplF (push1 '*ReplH @))\n                  (set> (: home line) *ReplF)\n                  *ReplF )\n               (clr> (: home line))\n               (: home repl) ) ) ) ) )\n\n(private) (dlg Attr Env Lst Prg)\n\n# Dialogs\n(de dlg (Attr Env Prg)\n   (let? L (get *FormLst (- *FormIx *Get))\n      (while (and (car L) (n== *PRG (caar @)))\n         (pop L) )\n      (push L\n         (list\n            (new NIL NIL  'btn This  'able T  'evt 0  'env Env)\n            Attr\n            Prg ) )\n      (pushForm L) ) )\n\n(de dialog (Env . Prg)\n   (dlg 'dialog Env Prg) )\n\n(de alert (Env . Prg)\n   (dlg 'alert Env Prg) )\n\n(de note (Str Lst)\n   (alert (env '(Str Lst))\n      ( 'note Str)\n      (--)\n      (for S Lst (
 S))\n      (okButton) ) )\n\n(de ask (Str . Prg)\n   (alert (env '(Str Prg))\n      ( 'ask Str)\n      (--)\n      (yesButton (cons 'prog Prg))\n      (noButton) ) )\n\n(de diaform (Lst . Prg)\n   (cond\n      ((num? (caar Lst))  # Dst\n         (gui (gt0 (caar Lst)) '(+ChoButton)\n            (cons 'diaform\n               (list 'cons\n                  (list 'cons (lit (car Lst)) '(field 1))\n                  (lit (env (cdr Lst))) )\n               Prg ) ) )\n      ((and *PRG (not (: diaform)))\n         (dlg 'dialog (env Lst) Prg) )\n      (T\n         (=: env (env Lst))\n         (=: diaform T)\n         (run Prg 1) ) ) )\n\n(de saveButton (Exe)\n   (gui '(+Button) ,\"Save\" Exe) )\n\n(de closeButton (Lbl Exe)\n   (when (; *App top)\n      (gui '(+Rid +Close +Button) Lbl Exe) ) )\n\n(de okButton (Exe)\n   (when (; *App top)\n      (if (=T Exe)\n         (gui '(+Force +Close +Button) T \"OK\")\n         (gui '(+Close +Button) \"OK\" Exe) ) ) )\n\n(de cancelButton ()\n   (when (; *App top)\n      (gui '(+Force +Close +Button) T ',\"Cancel\") ) )\n\n(de yesButton (Exe)\n   (gui '(+Close +Button) ',\"Yes\" Exe) )\n\n(de noButton (Exe)\n   (gui '(+Close +Button) ',\"No\" Exe) )\n\n(de choButton (Exe)\n   (gui '(+Rid +Tip +Button)\n      ,\"Find or create an object of the same type\"\n      ',\"Select\" Exe ) )\n\n\n(class +Force)\n# force\n\n(dm T (Exe . @)\n   (=: force Exe)\n   (pass extra) )\n\n(dm chk> ()\n   (when\n      (and\n         (cdr (assoc (: id) (val *PRG)))\n         (eval (: force)) )\n      (for A (val *PRG)\n         (and\n            (lt0 (car A))\n            (<> (: id) (car A))\n            (con A) ) )\n      T ) )\n\n\n(class +Close)\n\n(dm act> ()\n   (when (able)\n      (and\n         (get *FormLst (- *FormIx *Get))\n         (pushForm\n            (cons\n               (filter\n                  '((L) (memq (car L) (: home top)))\n                  (car @) )\n               (cdr @) ) ) )\n      (extra)\n      (for This (: home top)\n         (for This (: gui)\n            (or (: id) (setq *Chart This))\n            (upd> This) ) ) ) )\n\n\n# Choose a value\n(class +ChoButton +Tiny +Tip +Button)\n\n(dm T (Exe)\n   (super  ,\"Choose a suitable value\" \"+\" Exe)\n   (=: chg T) )\n\n\n(class +PickButton +Tiny +Tip +Button)\n\n(dm T (Exe)\n   (super ,\"Adopt this value\" \"@\" Exe) )\n\n\n(class +DstButton +Set +Able +Close +PickButton)\n# msg obj\n\n(dm T (Dst Msg)\n   (=: msg (or Msg 'url>))\n   (super\n      '((Obj) (=: obj Obj))\n      '(: obj)\n      (when Dst\n         (or\n            (pair Dst)\n            (list 'chgDst (lit Dst) '(: obj)) ) ) ) )\n\n(de chgDst (This Val)\n   (set> This (if (: new) (@ Val) Val)) )\n\n(dm js> ()\n   (cond\n      ((: act) (super))\n      ((try (: msg) (: obj) 1 This)\n         (pack \"@&+\" (ht:Fmt (sesId (mkUrl @)))) )\n      (T \"@\") ) )\n\n(dm show> (Var)\n   (if (: act)\n      (super Var)\n      (\") )\n\n(de  (X Y . Prg)\n   (prin \"\")\n   (htPrin Prg 2)\n   (prinl \"\") )\n\n(de font (X . Prg)\n   (ifn Prg\n      (cond\n         ((num? X) (setq *FontSize X))\n         ((sym? X) (setq *FontFamily X))\n         (T (setq *FontSize (car X)  *FontFamily (fin X))) )\n      (cond\n         ((num? X)\n            (let *FontSize X\n               (run Prg 1) ) )\n         ((sym? X)\n            (let *FontFamily X\n               (run Prg 1) ) )\n         (T\n            (let (*FontSize (car X)  *FontFamily (fin X))\n               (run Prg 1) ) ) ) ) )\n\n(de width (N . Prg)\n   (ifn Prg\n      (setq *StrokeWidth N)\n      (let *StrokeWidth N\n         (run Prg 1) ) ) )\n\n(de italic Prg\n   (let *FontStyle 'italic\n      (run Prg) ) )\n\n(de bold Prg\n   (let *FontWeight 'bold\n      (run Prg) ) )\n\n(de indent (X . Prg)\n   (prinl \"\")\n   (dec '*DX X)\n   (prog1\n      (run Prg)\n      (prinl \"\") ) )\n\n(de rotate (A . Prg)\n   (prinl \"\")\n   (prog1\n      (run Prg)\n      (prinl \"\") ) )\n\n(de scale (X Y . Prg)\n   (prinl \"\")\n   (prog1\n      (run Prg)\n      (prinl \"\") ) )\n\n(de window (X Y *DX *DY . Prg)\n   (prinl \"\")\n   (let *Pos 0\n      (prog1\n         (run Prg)\n         (prinl \"\") ) ) )\n\n(de ps @\n   (let A (arg 1)\n      (if (memq A (0 NIL T))\n         (next)\n         (off A) )\n      (prin\n         \"\")\n   (let H NIL\n      (while (args)\n         (let X (next)\n            (cond\n               ((pair X)\n                  (casq (++ X)\n                     (B  # Bold\n                        (prin (if X \"\" \"\")) )\n                     (I  # Italic\n                        (prin (if X \"\" \"\")) )\n                     (S  # Superscript\n                        (prin (if X \"\" \"\")) )\n                     (U  # Underline\n                        (prin (if X \"\" \"\")) )\n                     (L  # Line through\n                        (prin (if X \"\" \"\")) )\n                     (C  # Color\n                        (if X\n                           (prin \"\")\n                           (prin \"\") ) ) ) )\n               ((=0 X)  # Newline\n                  (prin\n                     \"\\8203\\\" ) )  # ZERO WIDTH SPACE\n               ((=T X)  # Horizontal line\n                  (push 'H (- *Pos (/ *FontSize 2)))\n                  (prin\n                     \"\\8203\\\" ) )  # ZERO WIDTH SPACE\n               (T (ht:Prin X)) ) ) )\n      (prinl \"\")\n      (for Y H\n         (polyline \"black\" 0 Y *DX Y) ) ) )\n\n(de height @\n   (let H *FontSize\n      (while (args)\n         (let X (next)\n            (cond\n               ((=0 X) (inc 'H *FontSize))  # Newline\n               ((=T X) (inc 'H (*/ *FontSize 2 3))) ) ) )  # Horizontal line\n      H ) )\n\n(local) (down table hline vline)\n(private) (Fmt Prg)\n\n(de down (N)\n   (inc '*Pos (or N *FontSize)) )\n\n(de table (Fmt . Prg)\n   (let (PosX 0  Max *FontSize)\n      (ifn (=T Fmt)\n         (mapc\n            '((N Exe)\n               (when\n                  (or\n                     (nT (car (pair Exe)))\n                     (setq Exe (run (cdr Exe) 2)) )\n                  (window PosX *Pos N Max\n                     (if (atom Exe)\n                        (ps NIL (eval Exe 3))\n                        (eval Exe 3) )\n                     (inc 'PosX N)\n                     (setq Max (max *Pos Max)) ) ) )\n            Fmt\n            Prg )\n         (for\n            (N (co 'table (run Prg) (yield))\n               N\n               (window PosX *Pos N Max\n                  (prog1\n                     (co 'table T)\n                     (inc 'PosX N)\n                     (setq Max (max *Pos Max)) ) ) ) )\n         (co 'table) )\n      (inc '*Pos Max) ) )\n\n(de hline (Y X2 X1)\n   (inc 'Y *Pos)\n   (polyline \"black\" (or X2 *DX) Y (or X1 0) Y) )\n\n(de vline (X Y2 Y1)\n   (polyline \"black\" X (or Y2 *DY) X (or Y1 0)) )\n\n(local) brief\n(private) (Flg Font Abs Prg)\n\n(de brief (Flg Font Abs . Prg)\n   (when Flg\n      (polyline \"black\" 10 265  19 265)         # Faltmarken\n      (polyline \"black\" 10 421  19 421) )\n   (polyline \"black\" 50 106  50 103  53 103)    # Fenstermarken\n   (polyline \"black\" 50 222  50 225  53 225)\n   (polyline \"black\" 288 103  291 103  291 106)\n   (polyline \"black\" 288 225  291 225  291 222)\n   (polyline \"black\" 50 114  291 114)           # Absender\n   (window 60 102 220 10\n      (font Font (ps 0 Abs)) )\n   (window 65 125 210 90\n      (run Prg 2) ) )\n\n(local) (svgOut svgPages page page.svg svgPdf pdf)\n(private) (Src Dst Prg Prg2)\n\n# Direct SVG display\n(de svgOut Prg\n   (httpHead \"image/svg+xml\" 0)\n   (ht:Out *Chunked (run Prg)) )\n\n# Multipage SVG\n(de svgPages (*DX *DY Dst . Prg)\n   (zero *Page)\n   (out Dst\n      (let page\n         '(Prg2\n            (prin \"<\" (inc '*Page) \">\")\n            ( *DX *DY \"pt\"\n               (run Prg2) ) )\n         (run Prg) ) )\n   (allow Dst) )\n\n(de page.svg (File N)\n   (in File\n      (from (pack \"<\" N \">\"))\n      (echo (pack \"<\" (inc N) \">\")) ) )\n\n# Convert to PDF\n(de svgPdf (Dst . Prg)\n   (let Src (tmp \"pdf.svg\")\n      (out Src (run Prg))\n      (call \"rsvg-convert\" \"-f\" \"pdf\" \"-o\" Dst Src) )\n   (allow Dst) )\n\n# Multipage PDF\n# (pdf \"src\" \"dst\")\n# (pdf 'dx 'dy \"dst\" . prg)\n(de pdf (*DX *DY Dst . Prg)\n   (if Dst\n      (let page  # Generate SVG files\n         '(Prg2\n            (out (tmp \"page\" (inc '*Page) \".svg\")\n               ( *DX *DY \"pt\"\n                  (run Prg2) ) ) )\n         (zero *Page)\n         (run Prg) )\n      (in *DX  # Multipage SVG file\n         (when (echo (pack \"<\" (one *Page) \">\"))\n            (while\n               (out (tmp \"page\" *Page \".svg\")\n                  (when (echo (pack \"<\" (inc *Page) \">\"))\n                     (inc '*Page) ) ) ) ) )\n      (setq Dst *DY) )\n   (apply call\n      (make\n         (for I *Page\n            (link (tmp \"page\" I \".svg\")) ) )\n      \"rsvg-convert\"\n      \"--dpi-x\" 72\n      \"--dpi-y\" 72\n      \"-f\" \"pdf\"\n      \"-o\" Dst )\n   (allow Dst) )\n\n### Debug ###\n`*Dbg\n\n(noLint 'page)\n"
  },
  {
    "path": "lib/term.l",
    "content": "# 29aug23 Software Lab. Alexander Burger\n\n(sysdefs \"terminal\")\n\n(local) (ULINE U-OFF REVERS)\n\n(de ULINE . \"4\")\n(de U-OFF . \"24\")\n(de REVERS . \"7\")\n\n(local) (RED GREEN BROWN BLUE PURPLE CYAN YELLOW)\n\n(de RED . \"0;31\")\n(de GREEN . \"0;32\")\n(de BROWN . \"0;33\")\n(de BLUE . \"0;34\")\n(de PURPLE . \"0;35\")\n(de CYAN . \"0;36\")\n(de YELLOW . \"1;33\")\n\n(local) (*AttrA *AttrU)\n\n(off *AttrA *AttrU)\n\n(local) (*Lines *Columns xterm getTerm setTerm getSize)\n\n(de xterm ()\n   (member (sys \"TERM\") '(\"xterm\" \"screen\")) )\n\n(de getTerm ()\n   (use Lst\n      (and\n         (=0\n            (%@ \"ioctl\" 'I 1 TIOCGWINSZ\n               '(Lst (`winsize W W W W)) ) )\n         Lst ) ) )\n\n(de setTerm (Term Rows Cols DX DY)\n   (sys \"TERM\" Term)\n   (sys \"LINES\" Rows)\n   (sys \"COLUMNS\" Cols)\n   (%@ \"ioctl\" 'I 1 TIOCSWINSZ\n      (cons NIL (`winsize)\n         (cons Rows 2)  # ws_row\n         (cons Cols 2)  # ws_col\n         (cons DX 2)  # ws_xpixel\n         (cons DY 2) ) )  # ws_ypixel\n   (%@ \"rl_reset_terminal\" 'I 0) )\n\n(de getSize ()\n   (if (getTerm)\n      (setq *Lines (car @)  *Columns (cadr @))\n      (quit \"Can't get terminal size\") ) )\n\n(local) (attr cup clreol hideCsr showCsr screen1 screen2)\n\n(de attr (A U)\n   (if2 (<> A *AttrA) (<> U *AttrU)\n      (prin \"\\e[\"\n         (or (setq *AttrA A) 0)\n         \";\"\n         (if (setq *AttrU U) ULINE U-OFF)\n         \"m\" )\n      (prin \"\\e[\" (or (setq *AttrA A) 0) \"m\")\n      (prin \"\\e[\" (if (setq *AttrU U) ULINE U-OFF) \"m\") ) )\n\n(de cup (Y X)\n   (prin \"\\e[\" Y \";\" X \"H\") )\n\n(de clreol ()\n   (prin \"\\e[0K\") )\n\n(de clear ()\n   (prin \"\\e[H\\e[J\") )\n\n(de hideCsr ()\n   (prin \"\\e[?25l\") )\n\n(de showCsr ()\n   (prin \"\\e[?25h\") )\n\n(de screen1 ()\n   (if (xterm)\n      (prin \"\\e[?1049l\")\n      (cup *Lines 1) )\n   (flush) )\n\n(de screen2 ()\n   (and (xterm) (prin \"\\e[?1049h\")) )\n\n### Debug ###\n`*Dbg\n\n(noLint 'RED)\n"
  },
  {
    "path": "lib/test.l",
    "content": "# 04jul21 Software Lab. Alexander Burger\n\n### Unit Tests ###\n# Local usage:\n# ./pil lib/test.l -bye +\n\n# Global usage:\n# pil @lib/test.l -bye +\n\n(unless *Dbg\n   (quit \"Needs debug mode '+'\") )\n\n(setq\n   *CMD (cmd)\n   *PWD (in '(pwd) (line T)) )\n\n(load\n   \"@test/src/main.l\"\n   \"@test/src/apply.l\"\n   \"@test/src/flow.l\"\n   \"@test/src/sym.l\"\n   \"@test/src/subr.l\"\n   \"@test/src/big.l\"\n   \"@test/src/io.l\"\n   \"@test/src/db.l\"\n   \"@test/src/net.l\"\n   \"@test/src/ext.l\"\n   \"@test/src/ht.l\" )\n\n(load \"@test/lib.l\")\n(load \"@test/lib/db.l\")\n(load \"@test/lib/misc.l\")\n\n(load \"@test/lib/lint.l\")\n\n(load \"@test/lib/math.l\")\n\n(msg 'OK)\n"
  },
  {
    "path": "lib/too.l",
    "content": "# 27oct23 Software Lab. Alexander Burger\n\n(private) (Prg C Q X Y Cls Name)\n\n(de admin Prg\n   (out 2\n      (prinl *Pid \" + Admin \" (stamp))\n      (tell 'bye)\n      (for (F . @) (or *Dbs (2))\n         (when (dbck F)\n            (quit \"DB Check\" (cons F @)) ) )\n      (run Prg)\n      (when (load \"@lib/dbgc.l\")\n         (prinl \"dbgc \" @) )\n      (prinl *Pid \" - Admin \" (stamp)) ) )\n\n### Local Backup ###\n(de snapshot (Dst . @)\n   (when (info (pack Dst \"/1\"))\n      (for (L (flip (sort (extract format (dir Dst))))  L)\n         (let N (++ L)\n            (call \"mv\" (pack Dst '/ N) (pack Dst '/ (inc N)))\n            (when (> (car L) (*/ N 59 60))\n               (call \"rm\" \"-rf\" (pack Dst '/ (++ L))) ) ) ) )\n   (when (call \"mkdir\" (pack Dst \"/1\"))\n      (let Ign NIL\n         (while (args)\n            (let A (next)\n               (if (pre? \"-\" A)\n                  (push 'Ign (pack (cdr (chop A))))\n                  (let\n                     (Lst (filter bool (split (chop A) '/))\n                        Src (car Lst)\n                        Old (pack Dst \"/2/\" Src)\n                        New (pack Dst \"/1/\" Src) )\n                     (recur (Lst Src Old New)\n                        (ifn (cdr Lst)\n                           (recur (Src Old New)\n                              (unless (member Src Ign)\n                                 (cond\n                                    ((=T (car (info Src T)))  # Directory\n                                       (call \"mkdir\" \"-p\" New)\n                                       (for F (dir Src T)\n                                          (unless (member F '(\".\" \"..\"))\n                                             (recurse\n                                                (pack Src '/ F)\n                                                (pack Old '/ F)\n                                                (pack New '/ F) ) ) )\n                                       (call \"touch\" \"-r\" Src New) )\n                                    ((= (info Src T) (info Old T))  # Same\n                                       (%@ \"link\" 'I Old New) )\n                                    (T (call \"cp\" \"-a\" Src New)) ) ) )  # Changed or new\n                           (call \"mkdir\" \"-p\" New)\n                           (recurse\n                              (cdr Lst)\n                              (pack Src '/ (cadr Lst))\n                              (pack Old '/ (cadr Lst))\n                              (pack New '/ (cadr Lst)) )\n                           (call \"touch\" \"-r\" Src New) ) ) ) ) ) ) ) ) )\n\n(de purge (Dst N)\n   (for D (dir Dst)\n      (when (>= (format D) N)\n         (call \"rm\" \"-rf\" (pack Dst '/ D)) ) ) )\n\n### DB Garbage Collection ###\n(de dbgc ()\n   (load \"@lib/dbgc.l\") )\n\n### DB Mapping ###\n(private) (ObjFun TreeFun Hook Base)\n\n(de dbMap (ObjFun TreeFun)\n   (default ObjFun quote TreeFun quote)\n   (finally (mark 0)\n      (_dbMap *DB)\n      (dbMapT *DB) ) )\n\n(de _dbMap (Hook)\n   (unless (mark Hook T)\n      (ObjFun Hook)\n      (for X (getl Hook)\n         (when (pair X)\n            (if\n               (and\n                  (ext? (car X))\n                  (not (isa '+Entity (car X)))\n                  (sym? (cdr X))\n                  (find\n                     '((X) (isa '+relation (car X)))\n                     (getl (cdr X)) ) )\n               (let (Base (car X)  Cls (cdr X))\n                  (dbMapT Base)\n                  (for X (getl Base)\n                     (when\n                        (and\n                           (pair X)\n                           (sym? (cdr X))\n                           (pair (car X))\n                           (num? (caar X))\n                           (ext? (cdar X)) )\n                        (TreeFun Base (car X) (cdr X) Cls Hook)\n                        (iter (tree (cdr X) Cls Hook) _dbMap) ) )\n                  (wipe Base) )\n               (dbMapV (car X)) ) ) )\n      (wipe Hook) ) )\n\n(de dbMapT (Base)\n   (let X (val Base)\n      (when\n         (and\n            (pair X)\n            (num? (car X))\n            (ext? (cdr X)) )\n         (TreeFun Base X)\n         (iter Base dbMapV) ) ) )\n\n(de dbMapV (X)\n   (while (pair X)\n      (dbMapV (++ X)) )\n   (and (ext? X) (_dbMap X)) )\n\n(de refObj (Obj Flg)\n   (make\n      (recur (Obj)\n         (for (F . @) (or *Dbs (2))\n            (for (This (seq F) This (seq This))\n               (when\n                  (or\n                     (fish == (val This) NIL Obj)\n                     (fish == (getl This) NIL Obj) )\n                  (if (and Flg (: T))\n                     (recurse This)\n                     (link This) ) ) ) ) )\n      (for L *ExtDBs  # (\"path/\"  )\n         (let ((P N E) L  Lck)\n            (for I N\n               (let (Fd (open (pack P (hax (dec I))))  (Cnt . Siz) (blk Fd 0))\n                  (and (=1 I) (setq Lck Fd))\n                  (for Blk (dec Cnt)\n                     (let B (ext E (blk Fd Blk Siz Lck))\n                        (when (fish == B NIL Obj)\n                           (link (cons P (id I Blk))) ) ) )\n                  (close Fd) ) ) ) ) ) )\n\n### DB Check ###\n(de dbCheck ()\n   (for (F . N) (or *Dbs (2))  # Low-level integrity check\n      (unless (pair (println F N (dbck F T)))\n         (quit 'dbck @) ) )\n   (dbSync)\n   (dbMap  # Check tree structures\n      NIL\n      '((Base Root Var Cls Hook)\n         (println Base Root Var Cls Hook)\n         (unless (= (car Root) (chkTree (cdr Root)))\n            (quit \"Tree size mismatch\") )\n         (when Var\n            (scan (tree Var Cls Hook)\n               '((K V)\n                  (or\n                     (isa Cls V)\n                     (isa '+Alt (meta V Var))\n                     (quit \"Bad Type\" V) )\n                  (unless (has> V Var (if (pair K) (car K) K))\n                     (quit \"Bad Value\" K) ) )\n               NIL T T ) ) ) )\n   (and *Dbs (dbfCheck))  # Check DB file assignments\n   (and (dangling) (println 'dangling @))  # Show dangling index references\n   (and (badECnt) (println 'badECnt @))  # Show entity count mismatches\n   (rollback) )\n\n# Check Index References\n(de dangling ()\n   (make\n      (for (F . @) (or *Dbs (2))\n         (for (Obj (seq F) Obj (seq Obj))\n            (and\n               (isa '+Entity Obj)\n               (dangle Obj)\n               (link @) )\n            (wipe Obj) ) ) ) )\n\n(de dangle (This)\n   (unless (: T)\n      (and\n         (make\n            (for X (getl This)\n               (let V (or (atom X) (++ X))\n                  (unless (rel?> This X V)\n                     (link X) ) ) ) )\n         (cons This @) ) ) )\n\n# Entity Counts\n(de badECnt ()\n   (let Cnt NIL\n      (for (F . @) (or *Dbs (2))\n         (for (This (seq F) This (seq This))\n            (and\n               (isa '+Entity This)\n               (not (: T))\n               (for Cls (type This)\n                  (recur (Cls)\n                     (or\n                        (== '+Entity Cls)\n                        (when (isa '+Entity Cls)\n                           (for C (type Cls)\n                              (recurse C) )\n                           (accu 'Cnt Cls 1) ) ) ) ) ) ) )\n      (filter\n         '((X)\n            (<> (cdr X) (get *DB (car X) 0)) )\n         Cnt ) ) )\n\n(de fixECnt ()\n   (for X (getl *DB)\n      (and (pair X) (set (car X) 0)) )\n   (for (F . @) (or *Dbs (2))\n      (for (This (seq F) This (seq This))\n         (and\n            (isa '+Entity This)\n            (not (: T))\n            (incECnt This) )\n         (at (0 . 10000) (commit)) ) )\n   (commit) )\n\n(de badDep (X Var)\n   (let Lst (get (fin X) Var 'dep)\n      (make\n         (forall X\n            (unless (get This Var)\n               (when\n                  (extract\n                     '((S) (and (get This S) S))\n                     Lst )\n                  (link (cons This @)) ) ) ) ) ) )\n\n### Rebuild tree ###\n(de rebuild (X Var Cls Hook)\n   (let Lst NIL\n      (let? Base (get (or Hook *DB) Cls)\n         (unless X\n            (setq Lst\n               (if (; (treeRel Var Cls) hook)\n                  (collect Var Cls Hook)\n                  (collect Var Cls) ) ) )\n         (zapTree (get Base Var -1))\n         (put Base Var NIL)\n         (commit) )\n      (nond\n         (X\n            (let Len (length Lst)\n               (recur (Lst Len)\n                  (unless (=0 Len)\n                     (let (N (>> 1 (inc Len))  L (nth Lst N))\n                        (re-index (car L) Var Hook)\n                        (recurse Lst (dec N))\n                        (recurse (cdr L) (- Len N)) ) ) ) ) )\n         ((atom X)\n            (for Obj X\n               (re-index Obj Var Hook) ) )\n         (NIL\n            (for (Obj (seq X) Obj (seq Obj))\n               (and (isa Cls Obj) (re-index Obj Var Hook)) ) ) )\n      (commit) ) )\n\n(de re-index (Obj Var Hook)\n   (unless (get Obj T)\n      (when (get Obj Var)\n         (rel> (meta Obj Var) Obj NIL\n            (put> (meta Obj Var) Obj NIL @)\n            Hook )\n         (at (0 . 10000) (commit)) ) ) )\n\n### Database file management ###\n(de dbfCheck ()\n   (for Cls (all)\n      (when\n         (and\n            (= `(char \"+\") (char Cls))\n            (isa '+Entity Cls)\n            (not (isa '+Remote Cls)) )\n         (or\n            (; Cls Dbf)\n            (meta Cls 'Dbf)\n            (println 'dbfCheck Cls) )\n         (for Rel (getl Cls)\n            (and\n               (pair Rel)\n               (isa '+relation (car Rel))\n               (or\n                  (isa '+index (car Rel))\n                  (isa '+Swap (car Rel))\n                  (find\n                     '((B)\n                        (or\n                           (isa '+index B)\n                           (isa '+Swap B) ) )\n                     (; Rel 1 bag) ) )\n               (not (; @ dbf))\n               (println 'dbfCheck (cdr Rel) Cls) ) ) ) ) )\n\n(de displaced ()\n   (make\n      (for (F . @) *Dbs\n         (for (Obj (seq F) Obj (seq Obj))\n            (when\n               (or\n                  (isa '+Remote Obj)\n                  (and\n                     (isa '+Entity Obj)\n                     (<>\n                        (meta Obj 'Dbf 1)\n                        (car (id Obj T)) ) ) )\n               (link Obj) )\n            (wipe Obj) ) ) ) )\n\n### Relocate Object ###\n(dm (move!> . +Entity) (Dbf)\n   (for L *ExtDBs  # (\"path/\"  )\n      (let ((P N E) L  Lck)\n         (for I N\n            (let (Fd (open (pack P (hax (dec I))))  (Cnt . Siz) (blk Fd 0))\n               (finally (close Fd)\n                  (and (=1 I) (setq Lck Fd))\n                  (for Blk (dec Cnt)\n                     (let B (ext E (blk Fd Blk Siz Lck))\n                        (when (fish == B NIL This)\n                           (quit \"Can't move\" (cons P (id I Blk))) ) ) ) ) ) ) ) )\n   (dbSync)\n   (let New\n      (new\n         (or Dbf (meta This 'Dbf 1))\n         (val This) )\n      (for X (getl This)\n         (if (atom X)\n            (ifn (meta This X)\n               (put New X T)\n               (let Rel @\n                  (if (isa '+Blob Rel)\n                     (let F (blob This X)\n                        (put> New X F)\n                        (blob+ New X)\n                        (%@ \"unlink\" NIL F) )\n                     (lose> Rel This T)\n                     (put> New X T) ) ) )\n            (ifn (meta This (cdr X))\n               (put New (cdr X) (car X))\n               (lose> @ This (car X))\n               (put> New (cdr X) (car X)) ) ) )\n      (decECnt This)\n      (=: T T)\n      (for (F . @) *Dbs\n         (for (Obj (seq F) Obj (seq Obj))\n            (let L (getl Obj)\n               (when (fish == L This)\n                  (for X L\n                     (let? Rel (and (pair X) (meta Obj (cdr X)))\n                        (put> Obj (cdr X)\n                           (fill\n                              (if (isa '+Swap Rel)\n                                 (val (car X))\n                                 (car X) )\n                              This\n                              New ) ) ) ) ) ) ) )\n      (commit 'upd)\n      New ) )\n\n### Dump Objects ###\n(zero *DumpBlob)\n\n(dm (dumpKey> . +Entity) ()\n   (unless (: T)\n      (pick\n         '((X)\n            (when (isa '+Key (meta This (fin X)))\n               (if (meta This (fin X) 'hook)\n                  (cons (fin X) (get This @) X)\n                  (cons (fin X) X) ) ) )\n         (getl This) ) ) )\n\n(dm (dumpType> . +Entity) ()\n   (type This) )\n\n(dm (dumpValue> . +Entity) (X)\n   X )\n\n(de dump @\n   (let C (cons 0 10000)\n      (for (Q (pass search) (search Q))\n         (let (Obj @  K (fin (dumpExt Obj)))\n            (for X (getl Obj)\n               (unless (or (= K (fin X)) (= `(char \"+\") (char (fin X))))\n                  (let? Y (dumpValue> Obj X)\n                     (cond\n                        ((pair Y)\n                           (prinl)\n                           (space 3)\n                           (if (atom (cdr Y))\n                              (printsp (cdr Y))\n                              (printsp (cadr Y))\n                              (prin \"`\") )\n                           (dumpVal (car Y)) )\n                        ((isa '+Blob (meta Obj X))\n                           (let F (blob Obj X)\n                              (ifn (info F)\n                                 (msg F \" no blob\")\n                                 (prinl)\n                                 (space 3)\n                                 (prin Y \" `(tmp \" (inc '*DumpBlob) \")\")\n                                 (call \"cp\" \"-a\" F (tmp *DumpBlob)) ) ) )\n                        (T\n                           (prinl)\n                           (space 3)\n                           (print Y T) ) ) ) ) )\n            (prinl \" )\") )\n         (at C (println '(commit))) )\n      (println '(commit)) ) )\n\n(de dumpExt (Obj)\n   (prin \"(obj \")\n   (let K (dumpKey> Obj)\n      (ifn (last K)\n         (print (dumpType> Obj) (id Obj T))\n         (prin \"(\")\n         (printsp (dumpType> Obj) (car K))\n         (dumpVal (cadr K))\n         (when (pair (cddr K))\n            (space)\n            (dumpVal (car @)) )\n         (prin \")\") )\n      K ) )\n\n(de dumpVal (X)\n   (nond\n      ((atom X)\n         (prin \"(\")\n         (dumpVal (++ X))\n         (while (pair X)\n            (space)\n            (dumpVal (++ X)) )\n         (when X (prin \" . \") (dumpVal X))\n         (prin \")\") )\n      ((ext? X) (print X))\n      ((type X) (print (val X)))\n      (NIL (prin \"`\") (dumpExt X) (prin \")\")) ) )\n\n# Dump/load data and blobs\n(de dumpDB (Name . Prg)\n   (out (pack Name \".l\") (run Prg))\n   (when (dir (tmp))\n      (out (pack Name \".tgz\")\n         (chdir (tmp)\n            (in (append '(\"tar\" \"cfz\" \"-\") (filter format @))\n               (echo) ) ) ) ) )\n\n(de loadDB (Name)\n   (let Tgz (pack Name \".tgz\")\n      (when (and (info Tgz) (n0 (car @)))\n         (in Tgz\n            (chdir (tmp)\n               (out '(\"tar\" \"xfz\" \"-\") (echo)) ) ) ) )\n   (load (pack Name \".l\") ) )\n"
  },
  {
    "path": "lib/ulimit.l",
    "content": "# 27aug25 Software Lab. Alexander Burger\n\n(symbols 'ulimit 'pico)\n\n(local) (RLIMIT_STACK RLIMIT_NOFILE RLIMIT_NPROC stack files nproc)\n(private) (error rlimit)\n\n(sysdefs \"ulimit\")\n\n(de error ()\n   (quit (%@ \"strErrno\" 'S) 'ulimit) )\n\n(de rlimit (Res Val U)\n   (use Lim\n      (nond\n         ((=0\n               (%@ \"getrlimit\" 'I Res '(Lim (16 P P))) )\n            (error) )\n         (Val\n            (cons\n               (*/ (car Lim) U)\n               (*/ (cadr Lim) U) ) )\n         ((=0\n               (%@ \"setrlimit\" 'I Res\n                  (list NIL (16)\n                     (cons (* Val U) 8)\n                     (cons (cadr Lim) 8) ) ) )\n            (error) )\n         (NIL Val) ) ) )\n\n# (ulimit~stack ['cnt))\n(de stack (KiB)\n   (prog1\n      (rlimit RLIMIT_STACK KiB 1024)\n      (%@ \"ulimStk\") ) )\n\n# (ulimit~files ['cnt))\n(de files (N)\n   (rlimit RLIMIT_NOFILE N 1) )\n\n# (ulimit~nproc ['cnt))\n(de nproc (N)\n   (rlimit RLIMIT_NPROC N 1) )\n"
  },
  {
    "path": "lib/user.l",
    "content": "# 18oct21 Software Lab. Alexander Burger\n\n(must \"User Administration\" UserAdmin (== *Login *ID))\n\n(menu ,\"User Administration\"\n   (idForm ,\"User\" '(choUser) 'nm '+User\n      '(or (may UserAdmin) (== *Login (: home obj)))\n      '(or (may Delete) (== *Login (: home obj)))\n      '((: nm) )\n      ( 2\n         ,\"Login Name\" (gui '(+E/R +Cue +TextField) '(nm : home obj) ,\"User\" 30)\n         ,\"Password\"\n         (gui '(+Able +PasswdField)\n            '(or (may Password) (== *Login (: home obj)))\n            30 )\n         ,\"Role\"\n         (gui '(+Able +E/R +Obj +TextField)\n            '(may RoleAdmin)\n            '(role : home obj)\n            '(nm +Role)\n            T ) )\n      (--)\n      (gui> (: obj) This) ) )\n"
  },
  {
    "path": "lib/vip/cal.rc.l",
    "content": "# 26mar26 Software Lab. Alexander Burger\n\n(symbols '(pico)\n   (load \"@lib/misc.l\") )\n\n(private) (*Cal *Pat slot entry calFile patFile findCal drawCal loadCal)\n\n(de *Cal . \"~/.pil/cal/\")\n\n(cmd \"cal\" (L Lst Cnt)\n   (let\n      (D (date (date))\n         M (car (setq L (str L)))\n         Y (cadr L) )\n      (drawCal\n         (or (index M *Mon) M (cadr D))\n         (ifn Y\n            (car D)\n            (if\n               (and\n                  (>= 99 Y)\n                  (>= (inc 'Y 2000) (+ 9 (car D))) )\n               (- Y 100)\n               Y ) ) ) )\n   (setq *Search\n      '((L C)\n         (or\n            (head '(\"·\" \"=\") L)\n            (and (sp? C) (= \"=\" (car L))) ) ) )\n   (=: buffer keys\n      (quote\n         (\"K\"  # Edit\n            (if (get (: buffer text) (: posY) (: posX) 'cal)\n               (loadCal @)\n               (beep) ) )\n         (\"w\" (move 'goForward 'slot *Cnt))  # Slot forward\n         (\"b\" (move 'goBackward 'slot *Cnt))  # Slot backward\n         (\"W\" (move 'goForward 'entry *Cnt))  # Entry forward\n         (\"B\" (move 'goBackward 'entry *Cnt))  # Entry backward\n         (\"\\e[A\"  # UP\n            (findCal flip\n               (P) (and (=0 (dec P)) (set P 12)) ) )\n         (\"\\e[B\"  # DOWN\n            (findCal prog\n               (P) (and (== 13 (inc P)) (set P 1)) ) )\n         (\"\\e[C\"  # RIGHT\n            (if (== 12 (: buffer mon))\n               (drawCal 1 (inc (: buffer year)))\n               (drawCal (inc (: buffer mon)) (: buffer year)) ) )\n         (\"\\e[D\"  # LEFT\n            (if (=1 (: buffer mon))\n               (drawCal 12 (dec (: buffer year)))\n               (drawCal (dec (: buffer mon)) (: buffer year)) ) ) ) )\n   (let *Class (: buffer)\n      (dm search> (Win Pat)\n         (setq *Pat (append '(@) Pat '(@)))\n         '((L)\n            (and\n               (= \"·\" (car L))\n               (; L 1 cal)\n               (info (calFile @))\n               (patFile @@) ) ) ) )\n   (let *Class This\n      (dm status> (A F Z)\n         (let? Dat\n            (get\n               (: buffer text)\n               (: posY)\n               (: posX)\n               'cal )\n            (when (and (: buffer mon) (member NIL (: buffer text)))\n               (con @\n                  (make\n                     (for I 7\n                        (let D (+ Dat I -1)\n                           (link\n                              (conc\n                                 (chop (day D *Day))\n                                 (list \" \")\n                                 (chop (datSym D)) ) )\n                           (when (info (calFile D))\n                              (for L (in @@ (rdLines))\n                                 (link (append '(\" \" \" \" \" \") L)) ) )\n                           (link NIL) ) ) ) )\n               (drawin)\n               (setq F (day Dat)  Z (dat$ Dat \"-\")) ) )\n         (super A F Z) ) ) )\n\n(de slot (L C)\n   (and (sp? C) (; L 1 cal)) )\n\n(de entry (L)\n   (= \"·\" (car L)) )\n\n(de calFile (Dat)\n   (pack *Cal (glue \"/\" (date Dat))) )\n\n(de patFile (F)\n   (find\n      '((L) (match *Pat L))\n      (in F (rdLines)) ) )\n\n(de findCal (Fun1 . Fun2)\n   (let\n      (Y\n         (member\n            (format (: buffer year))\n            (Fun1 (sort (dir *Cal))) )\n         M (: buffer mon) )\n      (loop\n         (T (and (Fun2 'M) (not (shift 'Y)))\n            (beep) )\n         (T\n            (and\n               (info (pack *Cal (car Y) \"/\" M))\n               (find\n                  '((F)\n                     (patFile (pack *Cal (car Y) \"/\" M \"/\" F)) )\n                  (dir @@) ) )\n            (goto 4 3)\n            (keys '(\"n\"))\n            (drawCal M (format (car Y))) ) ) ) )\n\n(de drawCal (Mon Year)\n   (with\n      (scratch (tmp \"cal\")\n         (let\n            (Dat (date Year Mon 1)\n               Skip (% (inc Dat) 7)\n               Day 1 )\n            (make\n               (link\n                  (chop (pack \"              \" (get *Mon Mon) \" \" Year))\n                  (chop \"    Mon Tue Wed Thu Fri Sat Sun\") )\n               (loop\n                  (link\n                     (make\n                        (chain (chop (align 2 (week Dat))))\n                        (link (name \" \"))\n                        (do 7\n                           (NIL\n                              (if (ge0 (dec 'Skip))\n                                 (chain (chop \"    \"))\n                                 (link (name \" \"))\n                                 (let L\n                                    (chop\n                                       (pack\n                                          (and (info (calFile Dat)) \"·\")\n                                          (if (= (date) Dat) \"==\" Day) ) )\n                                    (or (cdr L) (link (name \" \")))\n                                    (or (cddr L) (link (name \" \")))\n                                    (mapc put (chain L) 'cal Dat) )\n                                 (setq Dat (date Year Mon (inc 'Day)))) ) ) ) )\n                  (NIL Dat) )\n               (link NIL) ) )\n         3 )\n      (=: mon Mon)\n      (=: year Year) ) )\n\n(de loadCal (Dat)\n   (reload (calFile Dat))\n   (evCmd (day (=: buffer cal Dat) *Day))\n   (=: buffer keys\n      (quote\n         (\"\\e[C\"  # RIGHT\n            (let B (: buffer)\n               (loadCal (+ (: buffer cal) *Cnt))\n               (delBuf B)\n               (repaint) ) )\n         (\"\\e[D\"  # LEFT\n            (let B (: buffer)\n               (loadCal (- (: buffer cal) *Cnt))\n               (delBuf B)\n               (repaint) ) ) ) )\n   (let *Class (: buffer)\n      (dm save> (Win)\n         (call \"mkdir\" \"-p\" (dirname (: file)))\n         (super Win)\n         (unless (: text)\n            (call \"rm\" (: file)) )\n         (let ((Y M) (date (: cal)))\n            (with Win (drawCal M Y)) ) ) ) )\n\nNIL\n\nThe above code implements a \":cal\" (calendar) command for Vip.\n\nTo enable it, include the line\n\n   (load \"@lib/vip/cal.rc.l\")\n\nin your \"~/.pil/viprc\" (or in a local \".viprc\") file.\n\n\nThe calendar opens in a new buffer with\n\n   :cal\n\nto display the current month. You can pass a month name (starting with\nan uppercase letter) or a number to display another month of the current\nyear:\n\n   :cal Nov\n   :cal 11\n\nYou can also specify a year:\n\n   :cal Jan 2026\n   :cal 1 2026\n\nIf you enter only two digits for the year, the corresponding year within\nthe range −90 .. +10 years from the current year is chosen:\n\n   :cal Jan 26\n\n\nUse the RIGHT and LEFT arrow keys to skip to the next or previous month.\n\n\"Today\" is indicated by \"==\". The editor's search pattern is initialized\nto this marker, so pressing \"n\" (the Vip command for “search next”)\njumps to today’s date.\n\nThe editor commands \"w\" (move word forward) and \"b\" (move word backward)\nare redefined for this buffer to move to the next or previous day,\nrespectively.\n\nPressing \"K\" on a day opens a new buffer for that date’s file in the\n\"~/.pil/cal/\" directory tree. The file is automatically created when you\nadd text and save it (e.g. with \":w\" or \":x\"), and it is deleted if the\ntext is empty. While editing a day, the RIGHT and LEFT arrow keys move\ndirectly to the next or previous day.\n\nIn the calendar window, days that have an associated file (i.e. contain\ntext) are marked with a \"·\" character. The \"W\" (move long word forward)\nand \"B\" (move long word backward) commands move to the next or previous\nnon-empty day.\n\nWhen you move the cursor to a day, the text contents of the following\nweek are displayed below the calendar.\n\nIf you enter a new search pattern using the \"/\" or \"?\" command, the\ninitial search for \"today\" is replaced by a search through the daily\ntext files of that month. Using the DOWN and UP arrow keys then\ncontinues the search in the next or previous months, jumping directly to\nmatching days.\n"
  },
  {
    "path": "lib/vip/draw.l",
    "content": "# 19oct23 Software Lab. Alexander Burger\n\n(symbols 'vip~draw 'vip 'pico)\n\n(local) (*DX *DY *PX *PY *Draw *Boxes)\n\n(zero *DX *DY)\n\n# Drawing primitives\n(local) (point hline vline go up down left right rect label)\n\n(de point (X Y C)\n   (inc 'X *DX)\n   (inc 'Y *DY)\n   (let P\n      (or\n         (nth *Draw Y)\n         (nth (setq *Draw (need (- Y) *Draw)) Y) )\n      (set\n         (or\n            (nth (car P) X)\n            (nth\n               (set P (need (- X) (car P) (name \" \")))\n               X ) )\n         (name C) ) ) )\n\n(de hline (C X Y X2 A)\n   (point X Y C)\n   (if (> X2 X)\n      (do (- X2 X)\n         (point (inc 'X) Y \"-\") )\n      (do (- X X2)\n         (point (dec 'X) Y \"-\") ) )\n   (and A (point X Y A)) )\n\n(de vline (C X Y Y2 A)\n   (point X Y C)\n   (if (> Y2 Y)\n      (do (- Y2 Y)\n         (point X (inc 'Y) \"|\") )\n      (do (- Y Y2)\n         (point X (dec 'Y) \"|\") ) )\n   (and A (point X Y A)) )\n\n(de go (X Y C)\n   (point (setq *PX X) (setq *PY Y) C) )\n\n(de up (N C)\n   (vline \"|\" *PX (dec *PY) (dec '*PY N) C) )\n\n(de down (N C)\n   (vline \"|\" *PX (inc *PY) (inc '*PY N) C) )\n\n(de left (N C)\n   (hline \"-\" (dec *PX) *PY (dec '*PX N) C) )\n\n(de right (N C)\n   (hline \"-\" (inc *PX) *PY (inc '*PX N) C) )\n\n(de rect (X Y X2 Y2)\n   (hline \"+\" X Y (dec X2))\n   (vline \"+\" X2 Y (dec Y2))\n   (hline \"+\" X2 Y2 (inc X))\n   (vline \"+\" X Y2 (inc Y)) )\n\n(de label (X Y Txt)\n   (for C (chop Txt)\n      (point X Y C)\n      (inc 'X) ) )\n\n# Box\n(local) (+Box mx> my> hv>)\n\n(class +Box)\n# id x y x2 y2 dx dy h v\n\n(dm mx> ()\n   (*/ (+ (: x) (: x2)) 2) )\n\n(dm my> ()\n   (*/ (+ (: y) (: y2)) 2) )\n\n(dm hv> ()\n   (for L (: h)\n      (loop\n         (apply hline (++ L))\n         (NIL L)\n         (apply vline (++ L))\n         (NIL L) ) )\n   (for L (: v)\n      (loop\n         (apply vline (++ L))\n         (NIL L)\n         (apply hline (++ L))\n         (NIL L) ) ) )\n\n\n# Draw box\n(local) (block box)\n(private) (X Y DX DY Txt Prg)\n\n(de block (X Y . Prg)\n   (let (*DX (dec X)  *DY (dec Y))\n      (run Prg) ) )\n\n(de box (X Y DX DY Txt . Prg)\n   (with\n      (new '(+Box)\n         'id (if (atom Txt) Txt (car Txt))\n         'x (inc 'X *DX)\n         'y (inc 'Y *DY)\n         'x2 (+ X DX)\n         'y2 (+ Y DY)\n         'dx DX\n         'dy DY )\n      (queue '*Boxes This)\n      (let (*DX 0  *DY 0)\n         (rect (: x) (: y) (: x2) (: y2))\n         (when (fin Txt)\n            (label\n               (+ (: x) (*/ (- (: dx) (length @)) 2))\n               (+ (: y) (*/ (: dy) 2))\n               @ ) ) )\n      (let (*DX X  *DY Y)\n         (run Prg) ) ) )\n\n# Draw arrow\n(local) arrow\n\n(de arrow (Id1 Id2)\n   (with\n      (if (num? Id1)\n         (get *Boxes Id1)\n         (find '((This) (= Id1 (: id))) *Boxes) )\n      (let? B\n         (if (num? Id2)\n            (get *Boxes Id2)\n            (find '((This) (= Id2 (: id))) *Boxes) )\n         (let (X (mx> This)  Y (my> This)  X2 (mx> B)  Y2 (my> B))\n            (cond\n               ((> (; B y) (: y2))  # Above\n                  (cond\n                     ((or\n                           (>= 3 (- (; B y) (: y2)))\n                           (>= (inc X2) X (dec X2)) )\n                        (push (:: v)\n                           (list\n                              (list \"+\" X (: y2) (dec (; B y)) \"v\") ) ) )\n                     ((> (; B y) (+ 4 (: y2)))\n                        (push (:: v)\n                           (let M (/ (+ (: y2) (; B y)) 2)\n                              (list\n                                 (list \"+\" X (: y2) (dec M))\n                                 (list \"+\" X M X2)\n                                 (list \"+\" X2 M (dec (; B y)) \"v\") ) ) ) )\n                     ((> (; B x) (+ 2 X))  # Left\n                        (push (:: v)\n                           (list\n                              (list \"+\" X (: y2) (dec Y2))\n                              (list \"+\" X Y2 (dec (; B x)) \">\") ) ) )\n                     ((> X (+ 2 (; B x2)))  # Right\n                        (push (:: v)\n                           (list\n                              (list \"+\" X (: y2) (dec Y2))\n                              (list \"+\" X Y2 (inc (; B x2)) \"<\") ) ) ) ) )\n               ((> (: y) (; B y2))  # Below\n                  (cond\n                     ((or\n                           (>= 3 (- (: y) (; B y2)))\n                           (>= (inc X2) X (dec X2)) )\n                        (push (:: v)\n                           (list\n                              (list \"+\" X (: y) (inc (; B y2)) \"\\^\") ) ) )\n                     ((> (: y) (+ 4 (; B y2)))\n                        (push (:: v)\n                           (let M (*/ (+ (: y) (; B y2)) 2)\n                              (list\n                                 (list \"+\" X (: y) (inc M))\n                                 (list \"+\" X M X2)\n                                 (list \"+\" X2 M (inc (; B y2)) \"\\^\") ) ) ) )\n                     ((> (; B x) (+ 2 X))  # Left\n                        (push (:: v)\n                           (list\n                              (list \"+\" X (: y) (inc Y2))\n                              (list \"+\" X Y2 (dec (; B x)) \">\") ) ) )\n                     ((> X (+ 2 (; B x2)))  # Right\n                        (push (:: v)\n                           (list\n                              (list \"+\" X (: y) (inc Y2))\n                              (list \"+\" X Y2 (inc (; B x2)) \"<\") ) ) ) ) )\n               (T  # Besides\n                  (cond\n                     ((> (; B x) (: x2))  # Left\n                        (push (:: h)\n                           (if (= Y Y2)\n                              (list\n                                 (list \"+\" (: x2) Y (dec (; B x)) \">\") )\n                              (let M (*/ (+ (: x2) (; B x)) 2)\n                                 (list\n                                    (list \"+\" (: x2) Y (dec M))\n                                    (list \"+\" M Y Y2)\n                                    (list \"+\" M Y2 (dec (; B x)) \">\") ) ) ) ) )\n                     ((> (: x) (; B x2))  # Right\n                        (push (:: h)\n                           (if (= Y Y2)\n                              (list\n                                 (list \"+\" (: x) Y (inc (; B x2)) \"<\") )\n                              (let M (*/ (+ (: x) (; B x2)) 2)\n                                 (list\n                                    (list \"+\" (: x) Y (inc M))\n                                    (list \"+\" M Y Y2)\n                                    (list \"+\" M Y2 (inc (; B x2)) \"<\") ) ) ) ) ]\n\n# Draw cell structures\n(local) (cell cells)\n\n(de cell (X Y Car Cdr)\n   (let A (max 6 (+ 3 (length (setq Car (sym Car)))))\n      (box X Y A 2\n         (cons\n            (pack (+ X *DX) \"/\" (+ Y *DY))\n            Car )\n         (let B 6\n            (setq Cdr\n               (cond\n                  ((pair Cdr) \"  ---\")\n                  (Cdr\n                     (prog1\n                        (sym @)\n                        (setq B (max 6 (+ 3 (length @)))) ) )\n                  (T \"/\") ) )\n            (box A 0 B 2\n               (cons (pack X \"/\" Y \"+\") Cdr) )\n            (+ A B) ) ) ) )\n\n(de cells (X Y Any)\n   (let Pos (list X)\n      (recur (Any Y Pos)\n         (let (Y2 (+ Y *DY)  Last)\n            (while (pair Any)\n               (use D\n                  (if (atom (car Any))\n                     (setq D (cell (car Pos) Y (++ Any) Any))\n                     (ifn (cdr Pos)\n                        (con Pos (list (car Pos)))\n                        (let (P @  M (car Pos))\n                           (for (A (car Any) (pair A) (car A))\n                              (setq M (max M (++ P))) )\n                           (map\n                              '((L) (set L (max M (car L))))\n                              Pos ) ) )\n                     (setq D\n                        (cell (car Pos) Y '| (cdr Any)) )\n                     (recurse (++ Any) (+ Y 5) (cdr Pos))\n                     (let X2 (+ (car Pos) *DX)\n                        (arrow\n                           (pack X2 \"/\" Y2)\n                           (pack X2 \"/\" (+ Y2 5)) ) ) )\n                  (let X2 (+ (car Pos) *DX)\n                     (when Last\n                        (arrow @ (pack X2 \"/\" Y2)) )\n                     (setq Last (pack X2 \"/\" Y2 \"+\")) )\n                  (inc Pos (+ 6 D)) ) ) ) ) ) )\n\n# Override +Buffer methods in object\n(let? *Class (isa '+Buffer This)\n   (dm view> (Win)\n      (=: view T)\n      (off *Draw *Boxes)\n      (symbols '(vip~draw vip pico)\n         (evCmd (load (fName (: file)))) )\n      (mapc 'hv> *Boxes)\n      (with Win\n         (scratch (tmp \"draw\") *Draw) ) )\n   (dm save> (Win)\n      (super Win)\n      (when (: view)\n         (view> This Win) ) ) )\n\n### Debug ###\n`*Dbg\n\n(de pico~cells @\n   (off *Draw *Boxes)\n   (let Y 1\n      (while (args)\n         (let V (next)\n            (cond\n               ((pair V)\n                  (cells 1 Y V)\n                  (setq Y (+ 3 (length *Draw))) )\n               (V\n                  (label 1 Y V)\n                  (inc 'Y) ) ) ) ) )\n   (mapc 'hv> *Boxes)\n   (out (tmp \"cells\") (mapc prinl *Draw))\n   (pico~vi (tmp \"cells\")) )\n"
  },
  {
    "path": "lib/vip/html.l",
    "content": "# 29oct23 Software Lab. Alexander Burger\n\n# View HTML buffers\n(let? *Class (isa '+Buffer This)\n   (dm view> (Win)\n      (=: view T)\n      (with Win\n         (let\n            (Y (- (: posY) 13)\n               N (- (length (: buffer text)) 15) )\n            (scratch (tmp \"html\")\n               (in (list \"w3m\" \"-cols\" *Columns (: buffer file))\n                  (rdLines) ) )\n            (unless (: buffer view)\n               (goto 1 (*/ Y (length (: buffer text)) N)) ) ) ) )\n   (dm save> (Win)\n      (super Win)\n      (when (: view)\n         (view> This Win) ) ) )\n"
  },
  {
    "path": "lib/vip/load.l",
    "content": "# 10dec24 Software Lab. Alexander Burger\n\n# View output of 'load'ing the file\n(let? *Class (isa '+Buffer This)\n   (dm view> (Win)\n      (=: view T)\n      (with Win\n         (scratch (tmp \"xml\")\n            (pipe (load (: buffer file))\n               (rdLines) ) ) ) )\n   (dm save> (Win)\n      (super Win)\n      (when (: view)\n         (view> This Win) ) ) )\n"
  },
  {
    "path": "lib/vip.l",
    "content": "# 11dec25 Software Lab. Alexander Burger\n\n(symbols 'vip 'pico)\n\n(sysdefs \"unistd\")\n\n(load \"@lib/term.l\")\n\n(local) (*Ns *Shell *CmdWin *StatNm *Chr *Complete *Repeat *Change\n*Count *Cnt *Search *Clip *TagStack *Spell *CmdMap *Keys *KeyMap\n*KeyMap-g *KeyMap-q *F7 *F8 *F9 *F10 *F11 *F12 *@ *@@)\n\n(def '*Shell (or (sys \"SHELL\") \"sh\"))\n\n### VIP Editor ###\n(local) (*Buffers +Buffer mkLoc fName prName rplFile fileBuffer rdLines\ndelim delimNs markup min1 undo redo evCmd dirty> load> save> syms>\nsearch> view> status> status delwin cursor addLine chgLine drawin redraw\nrepaint scLeft scRight goto chgwin eqwin getch getch2 reload scratch\nsyms pushTag tag done change jmp@@ cnt@@ goCol goLeft goRight goUp\ngoDown goAbs goFind word lword tword end lend getWord _forward goForward\n_backward goBackward goPFore goPBack shiftN shiftY indent cutX cutN paste\njoin tglCase insChar incNum overwrite _bs insMode cmdMode cmdPipe evRpt\nmove chgRight jmpMark wordFun moveSearch patMatch parMatch braces spell\npipeN nextBuf delBuf shell shFile prCmd cmd keys _map map+ map+g map+q\nreset posChar getText s-expr command vipA vipZ vi)\n\n\n(class +Buffer)\n# text file cmd symbols key undo redo dirt cmds keys\n# posX posY lastX lastY subd flat fmt syms \n\n(dm T (File Y)\n   (and (=: file File) (queue '*Buffers This))\n   (=: symbols (symbols))\n   (=: posX 1)\n   (=: posY (or Y 1))\n   (=: lastX (=: lastY 1))\n   (=: fmt 72) )\n\n(de mkLoc (File)\n   (let P (conc (chop (pwd)) '(\"/\"))\n      (when (head P File)\n         (setq File (cdr (nth File (length P)))) ) )\n   (if (pat? (car File))\n      (cons (name \".\") (name \"/\") File)\n      File ) )\n\n(de fName (File)\n   (let? F (chop (setq File (path File)))\n      (use R\n         (pack\n            (mkLoc\n               (if (info File)\n                  (if (=0 (%@ \"realpath\" 'N File '(R (`PATH_MAX C . `PATH_MAX))))\n                     F R )\n                  (let L (rot (split F \"/\"))\n                     (if\n                        (and\n                           (cdr L)\n                           (n0 (%@ \"realpath\" 'N (glue \"/\" @) '(R (`PATH_MAX C . `PATH_MAX)))) )\n                        (conc R (list \"/\") (car L))\n                        F ) ) ) ) ) ) ) )\n\n(de prName (File)\n   (if (pre? (sys \"HOME\") File)\n      (pack \"~/\" (cddr (nth (chop File) (length (sys \"HOME\")))))\n      File ) )\n\n(de rplFile (File)\n   (pack\n      (replace (chop File) \"%\"\n         (if (== This *CmdWin)\n            (: next buffer file)\n            (: buffer file) ) ) ) )\n\n(de fileBuffer (File Y)\n   (let F (fName File)\n      (prog1\n         (or\n            (find '((This) (= F (: file))) *Buffers)\n            (new '(+Buffer) F Y) )\n         (put @ 'subd (<> \"/\" (last (chop File)))) ) ) )\n\n(de rdLines ()\n   (make (until (eof) (link (line)))) )\n\n(de delim (C)\n   (member C\n      '`(cons NIL (chop \" \\t\\n\\r\\\"'(),[]`\")) ) )\n\n(de delimNs (C)\n   (or (delim C) (= \"~\" C)) )\n\n(de markup (Lst)\n   (let (S 'text  N 1)\n      (for L Lst\n         (let P NIL\n            (while L\n               (let? C (++ L)\n                  (state 'S\n                     (text (and (= \"\\\"\" C) 'string)\n                        (set C 0) )\n                     (text\n                        (and\n                           (= \"#\" C)\n                           (delim P)\n                           (if L 'comment 'text) )\n                        (set C N)\n                        (when (= \"{\" (car L))\n                           (set (++ L) (inc 'N)) ) )\n                     (text 'text\n                        (or\n                           (set (setq P C)\n                              (and (sp? C) (not L)) )\n                           (when (= \"\\\\\" C)\n                              (let? C (++ L)\n                                 (set C (and (sp? C) (not L))) ) ) ) )\n                     (string (and (= \"\\\"\" C) 'text)\n                        (set (setq P C) 0) )\n                     (string (and (= \"\\\\\" C) (not L) 'skip)\n                        (set C T) )\n                     (string 'string\n                        (set C T)\n                        (and (= \"\\\\\" C) L (++ L) (set @ T)) )\n                     (skip (and (sp? C) 'skip)\n                        (set C) )\n                     (skip (and (= \"\\\"\" C) 'text)\n                        (set (setq P C) 0) )\n                     (skip 'string\n                        (set C T) )\n                     (comment\n                        (cond\n                           ((=1 (set (setq P C) N))\n                              (if L\n                                 'comment\n                                 (and (sp? C) (not L) (set P T))\n                                 'text ) )\n                           ((and\n                                 (= \"}\" C)\n                                 (= \"#\" (car L))\n                                 (=1 (set (++ L) (dec 'N))) )\n                              'text )\n                           (T\n                              (and\n                                 (= \"#\" C)\n                                 (= \"{\" (car L))\n                                 (set (++ L) (inc 'N)) )\n                              'comment ) ) ) ) ) ) ) ) ) )\n\n(de min1 (A B)\n   (max 1 (min A B)) )\n\n(dm dirty> (Win)\n   (<> (: undo) (: dirt)) )\n\n(dm load> (Win)\n   (markup\n      (=: text\n         (let? File (: file)\n            (let? I (info File)\n               (if (=T (car I))\n                  (mapcar\n                     '((X)\n                        (let (S (cdddr X)  F (caddr X))\n                           (conc\n                              (mkLoc F)\n                              (cond\n                                 ((=T S) (chop \"/  \"))\n                                 ((not S)\n                                    (conc\n                                       (chop \" -> \")\n                                       (in (list \"readlink\" F) (line))\n                                       (chop \"  \") ) )\n                                 (T\n                                    (conc\n                                       (chop \" (\")\n                                       (chop (/ (+ S 1023) 1024))\n                                       (chop \")  \") ) ) )\n                              (chop (dat$ (- (car X)) \"-\"))\n                              (chop \" \")\n                              (chop (tim$ (- (cadr X)) T)) ) ) )\n                     (sort\n                        (make\n                           (unless (= \"/\" (last (setq File (chop File))))\n                              (conc File (chop \"/\")) )\n                           (recur (File)\n                              (for F (dir File T)\n                                 (unless (member F '(\".\" \"..\"))\n                                    (let? I (info (setq F (append File (chop F))) 0)\n                                       (if (and (=T (car I)) (: subd))\n                                          (recurse (conc F (chop \"/\")))\n                                          (link\n                                             (cons\n                                                (- (cadr I))\n                                                (- (cddr I))\n                                                F\n                                                (car I) ) ) ) ) ) ) ) ) ) )\n                  (gc (+ 4 (*/ (car I) 32768)))  # 2 cells / char\n                  (if (sys \"CCRYPT\" (: key))\n                     (in (list \"ccrypt\" \"-c\" \"-ECCRYPT\" File)\n                        (rdLines) )\n                     (in File (rdLines)) ) ) ) ) ) )\n   (=: symbols (symbols))\n   (=: undo (=: redo (=: dirt)))\n   (=: posX\n      (min1\n         (: posX)\n         (length\n            (get\n               (: text)\n               (=: posY (min1 (: posY) (length (: text)))) ) ) ) )\n   (let? L\n      (nth\n         (find\n            '((L) (head '`(chop \"# VIP \") L))\n            (head 3 (: text)) )\n         7 )\n      (evCmd\n         (symbols '(vip pico)\n            (case (car L)\n               (\"\\\"\" (keys (chop (any L))))\n               (\"(\" (run (str (pack L))))\n               (T\n                  (setq L (split L \" \"))\n                  (apply script\n                     (str (glue \" \" (cdr L)))\n                     (path (car L)) ) ) ) ) ) ) )\n\n(dm save> (Win)\n   (when (: file)\n      (unless (=T (car (info @)))\n         (if (sys \"CCRYPT\" (: key))\n            (pipe\n               (out '(\"ccrypt\" \"-e\" \"-ECCRYPT\")\n                  (mapc prinl (: text)) )\n               (out (: file) (echo)) )\n            (out (: file) (mapc prinl (: text))) ) )\n      (=: dirt (: undo))\n      (for (This *CmdWin (this (: next)))\n         (status) )\n      (when (: syms)\n         (and (find ext? @ T) (pico~dbSync))\n         (in (: file)\n            (while (and (setq \"*X\" (read)) (atom @))\n               (unless (= (val \"*X\") (setq \"*V\" (read)))\n                  (set \"*X\" \"*V\") )\n               (until (= '(=======) (setq \"*K\" (read)))\n                  (unless (= (get \"*X\" \"*K\") (setq \"*V\" (read)))\n                     (put \"*X\" \"*K\" \"*V\") ) ) ) )\n         (when (find ext? (: syms) T)\n            (commit 'pico~upd)\n            (syms> This (: syms)) ) ) )\n   (on *StatNm) )\n\n(dm syms> (\"Lst\")\n   (out (: file)\n      (for \"S\" (=: syms \"Lst\")\n         (if\n            (and\n               (ext? \"S\" T)\n               (not (rank (car (id \"S\" T)) *Ext))\n               (lock \"S\") )\n            (prinl \"# \" \"S\" \" locked\")\n            (printsp \"S\")\n            (fish\n               '((\"X\")\n                  (if (circ? \"X\")\n                     \"skip\"\n                     (and\n                        (str? \"X\")\n                        (or\n                           (and (val \"X\") (n== @ \"X\"))\n                           (getl \"X\") )\n                        (intern \"X\" 'priv) )\n                     NIL ) )\n               (cons (val \"S\") (getl \"S\"))\n               \"skip\" )\n            (pretty (val \"S\"))\n            (prinl)\n            (for \"X\" (sort (getl \"S\"))\n               (space 3)\n               (if (atom \"X\")\n                  (print \"X\" T)\n                  (printsp (cdr \"X\"))\n                  (pretty (setq \"X\" (car \"X\")) -3) )\n               (remark \"X\")\n               (prinl) ) )\n         (prinl)\n         (println '(=======))\n         (prinl) ) ) )\n\n(dm search> (Win @Pat)\n   (ifn (= \"\\\\\" (car @Pat))\n      (let @Lst 'L\n         (when (= \"~\" (car @Pat))\n            (setq\n               @Pat (mapcar lowc (cdr @Pat))\n               @Lst '(mapcar lowc L) ) )\n         (if\n            (nor\n               (= \"\\^\" (car @Pat))\n               (= \"$\" (last @Pat))\n               (find pat? @Pat) )\n            (curry (@Pat @Lst) (L)\n               (head '@Pat @Lst) )\n            (setq @Pat\n               (if (= \"$\" (last @Pat))\n                  (head -1 @Pat)\n                  (append @Pat '(@)) ) )\n            (ifn (= \"\\^\" (car @Pat))\n               (curry (@Pat @Lst) (L)\n                  (match '@Pat @Lst) )\n               (++ @Pat)\n               (curry (@Pat @Lst) (L C)\n                  (unless C (match '@Pat @Lst)) ) ) ) )\n      (++ @Pat)\n      (curry (@Pat) (L)\n         (head '@Pat L) ) ) )\n\n(dm view> (Win)\n   (beep) )\n\n\n(local) (*Window +Window)\n\n(class +Window)\n# buffer top lines winX winY posX posY prev next last mark sc\n\n(dm T (Buffer Top Lines WinX WinY PosX PosY Prev Mark)\n   (=: buffer Buffer)\n   (=: top Top)\n   (=: lines Lines)\n   (when (=: prev Prev)\n      (when (=: next (: prev next))\n         (=: next prev This) )\n      (=: prev next This) )\n   (=: winX WinX)\n   (=: winY WinY)\n   (=: posX PosX)\n   (=: posY PosY)\n   (=: mark Mark)\n   (=: sc 0) )\n\n(dm view> ()\n   (view> (: buffer) This) )\n\n(dm status> (A F Z)\n   (cup (+ (: top) (: lines) 1) 1)\n   (attr REVERS)\n   (let N (- *Columns (length (prin A)))\n      (cond\n         ((ge0 (- N (length F) (length Z)))\n            (prin F (need @ \" \") Z) )\n         ((onOff *StatNm) (prin (tail N (chop F))))\n         (T (prin (need (- N (length Z)) \" \") Z)) ) )\n   (attr) )\n\n(de delwin ()\n   (when (=: prev next (: next))\n      (=: next prev (: prev)) ) )\n\n(de cursor ()\n   (cup\n      (+ (: top) (- (: posY) (: winY) -1))\n      (- (: posX) (: winX) -1) ) )\n\n(de addLine (Y L N)\n   (cup (+ (: top) Y) 1)\n   (clreol)\n   (for C (nth L (: winX))\n      (T (lt0 (dec 'N)))\n      (cond\n         ((: buffer flat))\n         ((=T (val C))\n            (cond\n               ((= \"^?\" C)\n                  (setq C \"?\")\n                  (attr RED T) )\n               ((>= \"^_\" C \"^A\")\n                  (setq C (char (+ 64 (char C))))\n                  (attr RED T) )\n               (T (attr NIL T)) ) )\n         ((= \"^?\" C)\n            (setq C \"?\")\n            (attr RED) )\n         ((>= \"^_\" C \"^A\")\n            (setq C (char (+ 64 (char C))))\n            (attr RED) )\n         ((gt0 (val C))\n            (attr CYAN) )\n         (T (attr)) )\n      (prin C) )\n   (attr) )\n\n(de chgLine (L)\n   (addLine (- (: posY) (: winY) -1) L *Columns)\n   (cursor) )\n\n(de status ()\n   (unless (== This *CmdWin)\n      (status> This\n         (pack\n            (index (: buffer) *Buffers)\n            \"/\"\n            (length *Buffers)\n            (if (dirty> (: buffer) This) \" * \" \" \") )\n         (or (: buffer cmd) (prName (: buffer file)))\n         (let N (length (: buffer text))\n            (pack\n               (and (: mark) (cons @ \" \"))\n               (casq (: buffer symbols 1)\n                  (pico)\n                  (T (cons @ \" \")) )\n               (: posX) \",\" (: posY) \"/\" N \" \"\n               (if (gt0 (dec N))\n                  (*/ 100 (dec (: posY)) @)\n                  0 )\n               \"%\" ) ) )\n      (flush) ) )\n\n(de drawin ()\n   (let L (nth (: buffer text) (: winY))\n      (for Y (: lines)\n         (addLine Y (++ L) *Columns) ) ) )\n\n(de redraw ()\n   (hideCsr)\n   (drawin)\n   (showCsr)\n   (status) )\n\n(de repaint ()\n   (for (This *CmdWin This (: next))\n      (redraw) ) )\n\n(de scLeft ()\n   (and\n      (if (=1 (: winX))\n         (> (: posX) 1)\n         (>= (- (: posX) (dec (:: winX))) *Columns) )\n      (dec (:: posX)) ) )\n\n(de scRight ()\n   (cond\n      ((> (: posX) (: winX))\n         (inc (:: winX)) )\n      ((cdr (nth (: buffer text) (: posY) (: posX)))\n         (inc (:: posX))\n         (inc (:: winX)) )\n      (T\n         (for (Y . L) (cdr (nth (: buffer text) (: posY)))\n            (T (cdr (nth L (: posX)))\n               (inc (:: posY) Y) )\n            (T (= Y (: lines))) ) ) ) )\n\n(de goto (X Y F)\n   (=: buffer posX (=: posX X))\n   (setq X\n      (cond\n         ((and F\n               (>= (inc (: posY)) Y (dec (: posY)))\n               (>= (+ (: winX) *Columns -1) X (: winX)) )\n            (: winX) )\n         ((>= (*/ *Columns 3 4) X) 1)\n         (T (- X (/ *Columns 2))) ) )\n   (=: buffer posY (=: posY Y))\n   (setq Y\n      (min1\n         (- Y (/ (: lines) 2))\n         (- (length (: buffer text)) (: lines) -1) ) )\n   (if (and F (= X (: winX)) (= Y (: winY)))\n      (status)\n      (=: winX X)\n      (=: winY Y)\n      (redraw) ) )\n\n(de chgwin (Lines Top)\n   (=: lines Lines)\n   (and Top (=: top @))\n   (=: winY\n      (min1\n         (- (: posY) (/ (: lines) 2))\n         (- (length (: buffer text)) (: lines) -1) ) )\n   (redraw) )\n\n(de eqwin ()\n   (let\n      (H (dec *Lines)\n         D (*/ H\n            (let N 0\n               (for (This *CmdWin (: next) @)\n                  (inc 'N) ) ) ) )\n      (with *CmdWin (chgwin 1 H))\n      (when (>= D 3)\n         (for (This *CmdWin (this (: next)))\n            (if (: next)\n               (chgwin (dec D) (dec 'H D))\n               (chgwin (dec H) 0) ) ) )\n      (cursor) ) )\n\n(de getch ()\n   (symbols *Ns\n      (if (= \"\\e\" (setq *Chr (or (++ *Keys) (key))))\n         (when (or (++ *Keys) (key 120))\n            (loop\n               (setq *Chr (pack *Chr @))\n               (T (member *Chr '(\"\\e[A\" \"\\e[B\" \"\\e[C\" \"\\e[D\")) *Chr)\n               (NIL (or (++ *Keys) (key 120)) *Chr) ) )\n         *Chr ) ) )\n\n(de getch2 (C)\n   (if (= \"^V\" C)\n      (or (++ *Keys) (symbols *Ns (key)))\n      C ) )\n\n(de reload (File Y X)\n   (unless (== This *CmdWin)\n      (when File\n         (let B (fileBuffer File)\n            (unless (== B (: buffer))\n               (=: mark)\n               (=: last (: buffer))\n               (=: buffer B) ) ) )\n      (load> (: buffer) This)\n      (off *StatNm)\n      (goto\n         (or X (: buffer posX))\n         (or Y (: buffer posY)) )\n      (repaint) ) )\n\n(de scratch (File Lst Y)\n   (out (setq File (fName File))\n      (mapc prinl Lst) )\n   (prog1\n      (if (find '((This) (= File (: file))) *Buffers)\n         (with @\n            (markup\n               (=: text Lst)\n               (=: undo (=: redo (=: dirt))) )\n            This )\n         (=: mark)\n         (=: last (: buffer))\n         (prog1\n            (=: buffer (new '(+Buffer) File Y))\n            (put @ 'text Lst)\n            (markup (: buffer text))\n            (goto 1 (: buffer posY)) ) )\n      (repaint) ) )\n\n(de pushTag (File)\n   (push '*TagStack (: posX) (: posY) File (symbols)) )\n\n(de tag (S C)\n   (ifn\n      (if C\n         (or\n            (get C '*Dbg -1 S)\n            (meta C '*Dbg -1 S) )\n         (get S '*Dbg 1) )\n      (beep)\n      (pushTag (: buffer file))\n      (symbols (cddr @))\n      (reload (cadr @) (car @) 1) ) )\n\n(de done (Flg)\n   (and Flg\n      (dirty> (: buffer) This)\n      (save> (: buffer) This) )\n   (=: mark)\n   (nond\n      ((; *CmdWin next next)\n         (throw 'done Flg) )\n      ((n== This *CmdWin))\n      ((== This (; *CmdWin next))\n         (delwin)\n         (let (N (: lines)  Top (: top))\n            (with (setq *Window (: prev))\n               (chgwin (+ 1 N (: lines)) Top) ) ) )\n      (NIL\n         (delwin)\n         (let N (: lines)\n            (with (setq *Window (: next))\n               (chgwin (+ 1 N (: lines))) ) ) ) ) )\n\n(de change Prg\n   (let\n      (Pos (nth (: buffer text) (: posY))\n         Env\n         (env\n            'PosX1 (: posX)  'PosY1 (: posY)\n            'OldA (car Pos)  'OldD (cdr Pos)\n            'NewD (: buffer text)\n            '(Pos PosX2 PosY2 NewA) ) )\n      (let? Res\n         (job Env\n            (prog1\n               (run Prg)\n               (setq\n                  PosX2 (: posX)  PosY2 (: posY)\n                  NewA (if Pos (car @) (: buffer text)) )\n               (and Pos (setq NewD (cdr @))) ) )\n         (=: buffer redo NIL)\n         (push (:: buffer undo)\n            (cons Env\n               '(ifn Pos\n                  (=: buffer text NewD)\n                  (set Pos OldA)\n                  (con Pos OldD) )\n               '(ifn Pos\n                  (=: buffer text NewA)\n                  (set Pos NewA)\n                  (con Pos NewD) ) ) )\n         (markup (: buffer text))\n         (goto (: posX) (: posY))\n         (repaint)\n         Res ) ) )\n\n(de undo ()\n   (ifn (pop (:: buffer undo))\n      (beep)\n      (let U @\n         (push (:: buffer redo) U)\n         (bind (car U)\n            (eval (cadr U))\n            (markup (: buffer text))\n            (goto PosX1 PosY1)\n            (repaint) ) ) ) )\n\n(de redo ()\n   (ifn (pop (:: buffer redo))\n      (beep)\n      (let R @\n         (push (:: buffer undo) R)\n         (bind (car R)\n            (eval (cddr R))\n            (markup (: buffer text))\n            (goto PosX2 PosY2)\n            (repaint) ) ) ) )\n\n(de jmp@@ (Y)\n   (=: buffer lastX (: posX))\n   (=: buffer lastY (: posY))\n   (setq *@@ Y) )\n\n(de cnt@@ ()\n   (- *@@ (: posY) -1) )\n\n(de goCol (N)\n   (setq *@@ (: posY))\n   N )\n\n(de goLeft (N)\n   (goCol (max 1 (- (: posX) N))) )\n\n(de goRight (N I)\n   (goCol\n      (min1\n         (or (=T N) (+ (: posX) N))\n         (+\n            (or I 0)\n            (length (get (: buffer text) (: posY))) ) ) ) )\n\n(de goUp (N)\n   (setq *@@ (max 1 (- (: posY) N)))\n   (min1 (: posX) (length (get (: buffer text) *@@))) )\n\n(de goDown (N I)\n   (setq *@@\n      (min1\n         (or (=T N) (+ (: posY) N))\n         (+ (or I 0) (length (: buffer text))) ) )\n   (min1 (: posX) (length (get (: buffer text) *@@))) )\n\n(de goAbs (X Y I)\n   (jmp@@\n      (min1 Y\n         (+ (or I 0) (length (: buffer text))) ) )\n   (min1 X (length (get (: buffer text) *@@))) )\n\n(de goFind (C D N I)\n   (setq *@@ (: posY))\n   (let (Lst (get (: buffer text) (: posY))  L (nth Lst (: posX)))\n      (do N (setq L (member C (cdr L))))\n      (if L\n         (+ D (or I 0) (offset L Lst))\n         (beep) ) ) )\n\n(de word (L C)\n   (and\n      (delim C)\n      (or\n         (sub? (car L) \"\\\"()[]\")\n         (not (delim (car L))) ) ) )\n\n(de lword (L C)\n   (and (sp? C) (not (sp? (car L))) ) )\n\n(de tword (L)\n   (and\n      (sp? (car L))\n      (not (sp? (cadr L))) ) )\n\n(de end (L)\n   (and (not (delim (car L))) (delim (cadr L))) )\n\n(de lend (L)\n   (and (not (sp? (car L))) (sp? (cadr L))) )\n\n(de getWord (Flg)\n   (make\n      (let Lst (get (: buffer text) (: posY))\n         (unless Flg\n            (for C (nth Lst (: posX))\n               (T (delim C))\n               (link C) ) )\n         (for\n            (L (nth Lst (dec (: posX)))\n               (not (delim (car L)))\n               (prior L Lst) )\n            (yoke (car L)) ) ) ) )\n\n(de _forward (Lst C)\n   (for ((X . L) Lst  L  (cdr L))\n      (T (and (Fun L C) (=0 (dec 'N)))\n         (jmp@@ Y)\n         (+ (or I 0) X) )\n      (setq C (car L))\n      NIL ) )\n\n(de goForward (Fun N I)\n   (let (Y (: posY)  Pos (nth (: buffer text) Y)  L (nth (++ Pos) (: posX)))\n      (if (_forward (cdr L) (car L))\n         (+ (: posX) @)\n         (loop\n            (NIL Pos (beep))\n            (inc 'Y)\n            (T (_forward (++ Pos)) @) ) ) ) )\n\n(de _backward (Lst L)\n   (use P\n      (loop\n         (NIL L)\n         (setq P (prior L Lst))\n         (T (and (Fun L (car P)) (=0 (dec 'N)))\n            (jmp@@ Y)\n            (offset L Lst) )\n         (setq L P)\n         NIL ) ) )\n\n(de goBackward (Fun N)\n   (let (Y (: posY)  Pos (nth (: buffer text) Y))\n      (or\n         (_backward\n            (car Pos)\n            (nth (car Pos) (dec (: posX))) )\n         (loop\n            (NIL (setq Pos (prior Pos (: buffer text)))\n               (beep) )\n            (dec 'Y)\n            (T (_backward (car Pos) (tail 1 (car Pos))) @ ) ) ) ) )\n\n(de goPFore (Cnt D I)\n   (let (Y (: posY)  Pos (nth (: buffer text) Y))\n      (loop\n         (NIL (cdr Pos)\n            (jmp@@ Y)\n            (max 1 (+ (or I 0) (length (car Pos)))) )\n         (inc 'Y)\n         (T\n            (and\n               (car Pos)\n               (not (cadr Pos))\n               (=0 (dec 'Cnt)) )\n            (jmp@@ (+ Y D))\n            1 )\n         (++ Pos) ) ) )\n\n(de goPBack (Cnt)\n   (let (Y (: posY)  Pos (nth (: buffer text) Y))\n      (loop\n         (NIL (setq Pos (prior Pos (: buffer text))))\n         (dec 'Y)\n         (T\n            (and\n               (not (car Pos))\n               (cadr Pos)\n               (=0 (dec 'Cnt)) ) ) )\n      (jmp@@ Y)\n      1 ) )\n\n(de shiftN (Cnt Flg)\n   (change\n      (let? P Pos\n         (do Cnt\n            (when (car P)\n               (if Flg\n                  (do 3 (push P (name \" \")))\n                  (do 3\n                     (NIL (sp? (caar P)))\n                     (pop P) ) ) )\n            (NIL (cdr P))\n            (setq P (con P (cons (car @) (cdr @)))) )\n         (=: posX 1) ) ) )\n\n(de shiftY (X Flg)\n   (shiftN (cnt@@) Flg) )\n\n(de indent ()\n   (change\n      (let? P Pos\n         (when (clip (car P))\n            (let (N (*/ (offset @ (trim (car P))) 3)  Sup N)\n               (set P @)\n               (loop\n                  (do (* N 3) (push P (name \" \")))\n                  (for C (car P)\n                     (unless (val C)\n                        (case C\n                           (\"(\" (inc 'N))\n                           (\")\" (dec 'N))\n                           (\"[\" (push 'Sup N) (inc 'N))\n                           (\"]\" (setq N (++ Sup))) ) ) )\n                  (while (val (caadr P))\n                     (++ P) )\n                  (NIL (clip (cadr P)) T)\n                  (setq P (con P (cons @ (cddr P)))) ) ) ) ) ) )\n\n(de cutX (X Flg)\n   (when X\n      (let Y *@@\n         (unless (> (list Y X) (list (: posY) (: posX)))\n            (xchg 'X (:: posX)  'Y (:: posY)) )\n         (change\n            (when Pos\n               (let (L (car Pos)  DX (: posX))\n                  (and\n                     (set *Clip\n                        (make\n                           (if Flg\n                              (set Pos (cut (dec DX) 'L))\n                              (setq L (nth L DX)) )\n                           (while (>= (dec 'Y) (: posY))\n                              (link L)\n                              (setq L (cadr Pos))\n                              (if Flg\n                                 (con Pos (cddr Pos))\n                                 (++ Pos) )\n                              (one DX) )\n                           (link (cut (- X DX) 'L))\n                           (when Flg\n                              (set Pos (conc (car Pos) L))\n                              (=: posX (min1 (: posX) (length (car Pos)))) )\n                           (setq *@@ (unless L 1)) ) )\n                     Flg ) ) ) ) ) ) )\n\n(de cutN (N)\n   (change\n      (when Pos\n         (off *@@)\n         (set *Clip\n            (cons T\n               (if (setq Pos (prior Pos (: buffer text)))\n                  (make\n                     (setq OldA (car @)  OldD (cdr @))\n                     (do N\n                        (link (cadr Pos))\n                        (NIL (con Pos (cddr Pos))\n                           (one *@@)\n                           (dec (:: posY)) ) )\n                     (=: posX 1) )\n                  (cut N (:: buffer text)) ) ) ) ) ) )\n\n(de paste (Lst Flg)\n   (change\n      (let P (or Pos (=: buffer text (cons)))\n         (ifn (=T (car Lst))\n            (let L (car P)\n               (cond\n                  ((=0 Flg) (setq PosX1 (=: posX 1)))\n                  ((=1 Flg)\n                     (and\n                        (get (: buffer text) (: posY) 1)\n                        (get (: buffer text) (: posY) (inc (:: posX)))\n                        (inc 'PosX1) ) )\n                  (Flg\n                     (=: posX\n                        (max 1\n                           (inc (length (get (: buffer text) (: posY)))) ) ) ) )\n               (set P\n                  (conc (cut (dec (: posX)) 'L) (mapcar name (++ Lst))) )\n               (for S Lst\n                  (setq P (con P (cons (mapcar name S) (cdr P))))\n                  (inc (:: posY)) )\n               (=: posX (max 1 (length (car P))))\n               (set P (append (car P) L)) )\n            (=: posX 1)\n            (ifn Flg\n               (for L (cdr Lst)\n                  (con P (cons (car P) (cdr P)))\n                  (set P (mapcar name L))\n                  (setq P (cdr P)) )\n               (inc (:: posY))\n               (for L (cdr Lst)\n                  (setq P (con P (cons (mapcar name L) (cdr P)))) ) ) )\n         T ) ) )\n\n(de join (Cnt)\n   (change\n      (do Cnt\n         (NIL (cdr Pos))\n         (set Pos\n            (append\n               (car Pos)\n               (cons (name \" \") (clip (cadr Pos))) ) )\n         (con Pos (cddr Pos)) )\n      T ) )\n\n(de tglCase (Cnt)\n   (change\n      (let? C (get Pos 1 (: posX))\n         (do Cnt\n            (set Pos\n               (place (: posX) (car Pos)\n                  ((if (upp? C) lowc uppc) C) ) )\n            (NIL (setq C (get Pos 1 (inc (: posX)))))\n            (inc (:: posX)) )\n         T ) ) )\n\n(de insChar (C Cnt)\n   (change\n      (when (car Pos)\n         (do Cnt\n            (set Pos (place (: posX) (car Pos) (name C)))\n            (NIL (get Pos 1 (inc (:: posX)))) )\n         (dec (:: posX)) ) ) )\n\n(de incNum (Cnt)\n   (change\n      (let (I (: posX)  L (car Pos)  S (get L I))\n         (ifn (format S)\n            (set Pos\n               (place (: posX) L (char (+ Cnt (char S)))) )\n            (while\n               (and\n                  (gt0 (dec 'I))\n                  (format (get L @)) )\n               (setq S (pack @ S)) )\n            (inc (:: posX)\n               (-\n                  (length\n                     (set Pos\n                        (conc\n                           (head I L)\n                           (need\n                              (if (= `(char \"0\") (char S)) (length S) 1)\n                              (chop (max 0 (+ Cnt (format S))))\n                              (name \"0\") )\n                           (tail (- (: posX)) L) ) ) )\n                  (length L) ) ) ) ) ) )\n\n(de overwrite (Lst)\n   (change\n      (let\n         (P (or Pos (=: buffer text (cons)))\n            L (conc (cut (dec (: posX)) P) (car Lst)) )\n         (set P\n            (append L\n               (cdr (nth (car P) (length (++ Lst)))) ) )\n         (=: posX (max 1 (length L))) ) ) )\n\n(de _bs ()\n   (++ Chg)\n   (dec (:: posX))\n   (unless Rpl\n      (set P (remove (: posX) (car P))) ) )\n\n(de insMode (Flg Win Rpl . @)\n   (change\n      (let (P (or Pos (=: buffer text (cons)))  Chg)\n         (cond\n            ((=0 Flg)\n               (con P (cons (car P) (cdr P)))\n               (set P)\n               (goto 1 (: posY)) )\n            ((=1 Flg))\n            (Flg\n               (setq P (con P (cons NIL (cdr P))))\n               (goto 1 (inc (: posY)))\n               (setq Chg (0)) ) )\n         (cursor)\n         (off *Complete)\n         (while\n            (case (or (next) (getch))\n               (NIL)\n               ((\"\\n\" \"\\r\")\n                  (cond\n                     (Rpl (beep) T)\n                     ((== This *CmdWin)\n                        (nil (command (or Win This) (car P))) )\n                     (T\n                        (push 'Chg 0)\n                        (con P\n                           (cons (nth (car P) (: posX)) (cdr P)) )\n                        (set P (head (dec (: posX)) (car P)))\n                        (setq P (cdr P))\n                        (goto 1 (inc (: posY)))\n                        (cursor)\n                        T ) ) )\n               ((\"\\b\" \"^?\")  # [BACKSPACE]\n                  (when (and Chg (n0 (car Chg)))\n                     (_bs)\n                     (chgLine (car P))\n                     (off *Complete) )\n                  T )\n               (T\n                  (let (S (list @)  L (get (: buffer text) (: posY)))\n                     (cond\n                        ((<> @ \"\\t\") (off *Complete))\n                        ((and\n                              (== This *CmdWin)\n                              (member L '((\"/\") (\"?\") (\"&\") (\":\") (\":\" \" \"))) )\n                           (setq S\n                              (chop\n                                 (car\n                                    (rot\n                                       (setq *Complete\n                                          (conc\n                                             (and (cdr L) (history))\n                                             (extract\n                                                '((B)\n                                                   (and\n                                                      (head L B)\n                                                      (cddddr B)\n                                                      (pack ((if (cdr L) cddr cdr) B)) ) )\n                                                (: buffer text) ) ) ) ) ) ) ) )\n                        ((or Rpl (nor *Complete (setq S (pack (getWord T)))))\n                           (setq S\n                              (make\n                                 (do (- 3 (% (dec (: posX)) 3))\n                                    (link (name \" \")) ) ) ) )\n                        (T\n                           (default *Complete\n                              (cons S\n                                 (if\n                                    (or\n                                       (n== This *CmdWin)\n                                       (<> \":\" (car L))\n                                       (find sp? L) )\n                                    (flip\n                                       (all* S\n                                          (when (== This *CmdWin)\n                                             (pick\n                                                '((P F) (and (head P L) F))\n                                                '`(mapcar chop '(\":tag \" \":v \" \":e \" \":E \" \":r \" \":w \"))\n                                                '(T T 0 0 0 0) ) ) ) )\n                                    (extract\n                                       '((Cmd)\n                                          (when (head (cdr L) (setq Cmd (chop Cmd)))\n                                             (if (pre? \":\" S)\n                                                (cons (name \":\") Cmd)\n                                                Cmd ) ) )\n                                       (conc\n                                          (mapcar car *CmdMap)\n                                          '(\"cp\" \"bak\" \"kab\" \"ls\" \"key\" \"tag\" \"bx\" \"bd\" \"map\") ) ) ) ) )\n                           (do (length (car *Complete)) (_bs))\n                           (setq S (chop (car (rot *Complete)))) ) )\n                     (when (= \"^V\" (car S))\n                        (set S (or (next) (getch2 \"^V\"))) )\n                     (for C S\n                        (push 'Chg C)\n                        (set P\n                           ((if (and Rpl (car P)) place insert)\n                              (: posX)\n                              (car P)\n                              C ) )\n                        (inc (:: posX)) )\n                     (goto (: posX) (: posY) T) )\n                  (chgLine (car P))\n                  T ) ) )\n         (=: posX (max 1 (dec (: posX))))\n         (cond\n            ((=0 Flg) (push 'Chg 0))\n            ((=1 Flg) (and (> PosX1 1) (dec 'PosX1))) )\n         (split (reverse Chg) 0) ) ) )\n\n(de cmdMode @\n   (let Win (if (== This *CmdWin) (: next) This)\n      (with *CmdWin\n         (pass insMode (: buffer text) Win NIL) ) ) )\n\n(de cmdPipe (N)\n   (apply cmdMode (chop (pack \":\" N \"!\"))) )\n\n(de evRpt (Exe)\n   (eval (setq *Repeat Exe) 1) )\n\n(de move @\n   (let M (conc (rest) (1))\n      (case *Change\n         (NIL\n            (when (eval (rest))\n               (goto @ *@@ T)\n               (when (: mark)\n                  (out @ (println (: posX) (: posY))) ) ) )\n         (\"!\" (eval (rest)) (cmdPipe (cnt@@)))  # External filter\n         (\">\" (evRpt (list 'shiftY M T)))  # Shift right\n         (\"<\" (evRpt (list 'shiftY M)))  # Shift left\n         (\"c\"  # Change\n            (when (cutX (eval M) T)\n               (and *@@\n                  (get (: buffer text) (: posY) 1)\n                  (inc (:: posX)) )\n               (let L (insMode *@@)\n                  (setq *Repeat\n                     (list 'prog\n                        (list 'cutX M T)\n                        (list 'paste (lit L) '*@@)) ) ) ) )\n         (\"d\" (evRpt (list 'cutX M T)))  # Delete\n         (\"y\" (cutX (eval M)))  # Yank\n         (T (beep)) ) ) )\n\n(de chgRight (X)\n   (setq *Change \"c\")\n   (move 'goRight X) )\n\n(de jmpMark (C D X)\n   (cond\n      ((= C D)\n         (move 'goAbs\n            (or X (: buffer lastX))\n            (: buffer lastY) ) )\n      ((get (: buffer) (intern C 'vip))\n         (move 'goAbs (default X (car @)) (cdr @)) ) ) )\n\n(de wordFun (@W)\n   (setq *Search\n      (let @N (inc (length @W))\n         (curry (@W @N) (L C)\n            (and\n               (delimNs C)\n               (head '@W L)\n               (delimNs (get L @N)) ) ) ) ) )\n\n(de moveSearch (Fun1 Fun2)\n   (move Fun1 (lit Fun2) *Cnt) )\n\n(de patMatch (Fun Pat)\n   (moveSearch Fun (setq *Search (search> (: buffer) This Pat))) )\n\n(de parMatch (Fun1 @Par1 @Sup1 @ParO @ParC @SupO @SupC)\n   (moveSearch Fun1\n      (let (Par @Par1  Sup @Sup1)\n         (curry (Par Sup @Par1 @Sup1 @ParO @ParC @SupO @SupC) (L C)\n            (unless (caar L)\n               (and\n                  (case (car L)\n                     (@ParO (nil (inc 'Par)))\n                     (@ParC (or (not C) (= (dec 'Par) 0 Sup)))\n                     (@SupO (nil (push 'Sup Par) (zero Par)))\n                     (@SupC\n                        (or\n                           (not C)\n                           (= (setq Par (++ Sup)) 0 Sup) ) ) )\n                  (setq Par @Par1  Sup @Sup1) ) ) ) ) ) )\n\n(de braces (Fun1 @ParO @ParC)\n   (moveSearch Fun1\n      (let Par 1\n         (curry (Par @ParO @ParC) (L C)\n            (case (car L)\n               (@ParO (nil (inc 'Par)))\n               (@ParC (or (not C) (=0 (dec 'Par)))) ) ) ) ) )\n\n(de *Spell\n   \"hunspell\" \"-l\" \"-d\" \"en_US,de_DE\" )\n\n(de spell ()\n   (let? @W\n      (pipe\n         (out *Spell\n            (let Pos (nth (: buffer text) (: posY))\n               (prinl\n                  (seek\n                     '((L) (not (fold (car L))))\n                     (nth (++ Pos) (: posX)) ) )\n               (mapc prinl Pos) ) )\n         (line) )\n      (let @N (inc (length @W))\n         (moveSearch 'goForward\n            (setq *Search\n               (curry (@W @N) (L C)\n                  (and\n                     (not (fold C))\n                     (head '@W L)\n                     (not (fold (get L @N))) ) ) ) ) ) ) )\n\n(de pipeN (Cnt Line)\n   (evRpt\n      (fill\n         '(when (cdr (cutN Cnt))\n            (pipe (out (list *Shell \"-c\" Line) (mapc prinl @))\n               (paste (cons T (rdLines)) *@@) ) )\n         '(Line Cnt) ) ) )\n\n(de nextBuf (B)\n   (let? M (member (: buffer) *Buffers)\n      (when (flg? B)\n         (setq B\n            (car\n               (if B\n                  (or (prior M *Buffers) (tail 1 *Buffers))\n                  (or (cdr M) *Buffers) ) ) ) )\n      (=: mark)\n      (unless (== B (: buffer))\n         (=: last (: buffer))\n         (=: buffer B)\n         (unless (: buffer text)\n            (load> (: buffer) This) ) )\n      (off *StatNm)\n      (goto (: buffer posX) (: buffer posY)) ) )\n\n(de delBuf (Buf)\n   (for (This *CmdWin (this (: next)))\n      (cond\n         ((== Buf (: last))\n            (=: last) )\n         ((== Buf (: buffer))\n            (nextBuf (: last))\n            (=: last) ) ) )\n   (del Buf '*Buffers)\n   (=: last) )\n\n(de shell (S)\n   (vipZ)\n   (do *Columns (prin \"#\"))\n   (call *Shell \"-c\" S)\n   (prin \"[====] \")\n   (flush)\n   (getch)\n   (prinl)\n   (vipA)\n   (repaint) )\n\n(de shFile (S)\n   (when (: buffer file)\n      (shell (text S @ *Cnt)) ) )\n\n(de prCmd (L)\n   (with *CmdWin\n      (paste (cons T L) (: buffer text))\n      (inc (:: posY) (dec (length L))) ) )\n\n(de evCmd Prg\n   (out (tmp \"repl\")\n      (err NIL\n         (catch '(NIL)\n            (setq *@ (run Prg 1)  *Msg)\n            (print '-> *@)\n            (remark *@)\n            (prinl) ) )\n      (when @@\n         (prin \"!? \")\n         (println ^)\n         (prinl *Msg) ) )\n   (in (tmp \"repl\")\n      (prCmd (rdLines)) ) )\n\n(de cmd (Cmd . Fun)\n   (if (assoc Cmd *CmdMap)\n      (con @ Fun)\n      (push '*CmdMap (cons Cmd Fun)) ) )\n\n(de keys (Lst)\n   (setq *Keys Lst) )\n\n(de _map (@Map @C @S)\n   (macro\n      (push1 '@Map '(@C (keys (chop @S)))) ) )\n\n(de map+ (C . X)\n   (if (str? (car X))\n      (_map '*KeyMap C @)\n      (push1 '*KeyMap (cons C X)) ) )\n\n(de map+g (C . X)\n   (if (str? (car X))\n      (_map '*KeyMap-g C @)\n      (push1 '*KeyMap-g (cons C X)) ) )\n\n(de map+q (C . X)\n   (if (str? (car X))\n      (_map '*KeyMap-q C @)\n      (push1 '*KeyMap-q (cons C X)) ) )\n\n(de posChar ()\n   (get (: buffer text) (: posY) (: posX)) )\n\n(de getText Prg\n   (let (*Change \"y\"  *Clip (box))\n      (run Prg 1)\n      (glue \"\\n\" (val *Clip)) ) )\n\n(de s-expr ()\n   (any\n      (getText\n         (case (posChar)\n            (\"\\\"\" (move 'goFind \"\\\"\" 0 1))\n            (\"(\" (parMatch 'goForward 1 0 \"(\" \")\" \"[\" \"]\"))\n            (\"[\" (parMatch 'goForward 0 (0 . 0) \"(\" \")\" \"[\" \"]\"))\n            (T (move 'goForward 'end 1)) ) ) ) )\n\n(de reset ()\n   (off *Count *Change)\n   (setq *Clip '\\\"\\\") )\n\n(private) (Lst Ns L C S X)\n\n### Commands ###\n(de command (This Line)\n   (case (++ Line)\n      (\"/\" (patMatch 'goForward Line))  # Search forward\n      (\"?\" (patMatch 'goBackward Line))  # Search backward\n      (\"&\" (moveSearch 'goForward (wordFun Line)))  # Search word\n      (\":\"\n         (let Cnt 0\n            (while (format (car Line))\n               (setq Cnt (+ @ (* 10 Cnt)))\n               (++ Line) )\n            (let C (++ Line)\n               (when (>= \"z\" C \"a\")\n                  (until (sp? (car Line))\n                     (setq C (pack C (++ Line))) ) )\n               (let L (pack (clip Line))\n                  (if (or (assoc C (: buffer cmds)) (assoc C *CmdMap))\n                     ((cdr @) L Line Cnt)\n                     (case C\n                        (\" \"  # Eval\n                           (setq @ *@)\n                           (evCmd (run (str L))) )\n                        (\"$\"  # Shell command\n                           (cond\n                              (L\n                                 (scratch (tmp \"cmd\" (inc (0)))\n                                    (in (list *Shell \"-c\" (setq L (rplFile L)))\n                                       (rdLines) ) )\n                                 (=: buffer cmd L) )\n                              ((: buffer cmd)\n                                 (scratch (: buffer file)\n                                    (in (list *Shell \"-c\" @)\n                                       (rdLines) ) ) ) ) )\n                        (\"!\"  # External filter\n                           (when L\n                              (if (=0 Cnt)\n                                 (shell (rplFile L))\n                                 (pipeN Cnt L) ) ) )\n                        (\"cp\"  # Copy to system clipboard\n                           (out '(\"copy\")  # System dependent script\n                              (let V (val *Clip)\n                                 (if (=T (car V))\n                                    (mapc prinl (cdr V))\n                                    (map\n                                       '(((S . L)) (prin S (and L \"\\n\")))\n                                       V ) ) ) ) )\n                        (\"bak\" (shFile \"mv @1 @1- && cp -p @1- @1\"))  # Backup to -\n                        (\"kab\"  # Restore from -\n                           (shFile \"mv @1- @1 && cp -p @1 @1-\")\n                           (reload) )\n                        (\"ls\"  # List buffers\n                           (prCmd\n                              (make\n                                 (for (I . This) *Buffers\n                                    (link\n                                       (chop (pack \":\" I \" \" (prName (: file)))) ) ) ) ) )\n                        (\"key\" (=: buffer key L) (reload))\n                        (\"m\"\n                           (if L\n                              (when (info (=: mark (path (rplFile L))))\n                                 (in (: mark) (move 'goAbs (read) (read))) )\n                              (=: mark) ) )\n                        (\"n\" (nextBuf))  # Next buffer\n                        (\"N\" (nextBuf T))  # Previous buffer\n                        (\"tag\" (apply tag (str L)))\n                        (\"v\" (reload (syms (str L)) 1 1))\n                        (\"e\" (reload (rplFile L)))  # (Edit) Reload buffer\n                        (\"E\"  # (Edit) Toggle subdir recursion and reload buffer\n                           (=: buffer subd (not (: buffer subd)))\n                           (reload (rplFile L)) )\n                        (\"r\"  # Read file contents\n                           (let F (path (rplFile L))\n                              (when (info F)\n                                 (in F (paste (cons T (rdLines)) 1)) ) ) )\n                        (\"w\"  # (Write) Save buffer\n                           (if L\n                              (out (path (rplFile @))\n                                 (mapc prinl (: buffer text)) )\n                              (save> (: buffer) This) ) )\n                        (\"l\"  # (load) Save and load\n                           (when (: buffer file)\n                              (when (dirty> (: buffer) This)\n                                 (save> (: buffer) This) )\n                              (evCmd (load (: buffer file))) ) )\n                        ((\"x\" \"wq\") (done T))  # (Exit) Save buffer and close window\n                        (\"q\" (done))  # (Quit) Close window\n                        (\"bx\"  # Buffer exchange\n                           (let X (memq (: buffer) *Buffers)\n                              (if (cdr X)\n                                 (xchg X @)\n                                 (beep) ) ) )\n                        (\"bd\"  # Buffer delete\n                           (and\n                              (cdr *Buffers)\n                              (if (=0 Cnt) (: buffer) (get *Buffers Cnt))\n                              (delBuf @) ) )\n                        (\"map\"  # Add/remove key mappings\n                           (++ Line)\n                           (let C (++ Line)\n                              (until (sp? (car Line))\n                                 (setq C (pack C (++ Line))) )\n                              (if Line\n                                 (push '*KeyMap\n                                    (list C\n                                       (list 'keys\n                                          (lit (mapcar name (cdr Line))) ) ) )\n                                 (del (assoc C *KeyMap) '*KeyMap) ) ) )\n                        (T\n                           (if (get *Buffers Cnt)\n                              (nextBuf @)\n                              (beep) ) ) ) ) ) ) )\n         (with *CmdWin\n            (redraw) ) )\n      (T (beep)) ) )\n\n(de syms (Lst)\n   (prog1\n      (tmp \"syms\")\n      (syms> (fileBuffer @) Lst) ) )\n\n(de vipA ()\n   (screen2)\n   (raw T) )\n\n(de vipZ ()\n   (raw NIL)\n   (screen1) )\n\n### VIP Entry Point ###\n(de vi (Lst Ns)  # (file (pat . file) (99 . file) (T . file) (sym [sym ..])\n   (getSize)\n   (and Lst (co 'vip))\n   (co 'vip\n      (setq *Ns (symbols))\n      (and Ns (symbols @))\n      (off *Buffers)\n      (when (=0 (%@ \"isatty\" 'I 0))\n         (with (fileBuffer (tmp \"stdin\"))\n            (out (: file) (in 0 (echo))) )\n         (ctty \"/dev/tty\") )\n      (for X Lst\n         (cond\n            ((not X))\n            ((atom X) (fileBuffer X))  # Path name\n            ((pair (car X))  # Pattern\n               (wordFun @)\n               (fileBuffer (cdr X)) )\n            ((or (num? (car X)) (=T (car X)))  # Line number\n               (fileBuffer (cdr X) @) )\n            (T (syms X)) ) )  # List of symbols\n      (unless *Buffers\n         (fileBuffer (tmp \"empty\")) )\n      (vipA)\n      (let\n         (*Winch '((getSize) (eqwin) (flush))\n            *TStp1 '((vipZ))\n            *TStp2 '((vipA) (repaint) (cursor) (flush)) )\n         (reset)\n         (setq *CmdWin\n            (new '(+Window) (new '(+Buffer)) (dec *Lines) 1 1 1 1 1) )\n         (with (car *Buffers)\n            (load> This)\n            (setq *Window\n               (new '(+Window) This\n                  0 (- *Lines 2)\n                  1\n                  (min1\n                     (- (: posY) (/ (- *Lines 2) 2))\n                     (- (length (: text)) *Lines -3) )\n                  1 (: posY)\n                  *CmdWin ) ) )\n         (with *Window (redraw))\n         (finally (prog (rollback) (vipZ))\n            (catch 'done\n               (loop\n                  (setq *Cnt (max 1 (format *Count)))\n                  (with *Window\n                     (=: posX\n                        (min1 (: posX)\n                           (length\n                              (get (: buffer text)\n                                 (=: posY\n                                    (min1 (: posY) (length (: buffer text))) ) ) ) ) )\n                     (symbols (: buffer symbols))\n                     (when\n                        (or\n                           (> (: winX) (: posX))\n                           (> (: winY) (: posY)) )\n                        (=: winX (min1 (: posX) (: winX)))\n                        (=: winY (min1 (: posY) (: winY)))\n                        (redraw) )\n                     (cursor)\n                     (case (getch)\n                        (\"0\"\n                           (if *Count\n                              (queue '*Count \"0\")\n                              (move 'goAbs 1 (: posY))  # Go to beginning of line\n                              (off *Change) ) )\n                        ((\"1\" \"2\" \"3\" \"4\" \"5\" \"6\" \"7\" \"8\" \"9\")  # [\"Count\" prefix]\n                           (queue '*Count *Chr) )\n                        (\"\\\"\" (setq *Clip (intern (pack '\"\\\"\" (getch)) 'vip)))  # \"Register\" prefix\n                        ((\"!\" \"<\" \">\" \"c\" \"d\" \"y\")  # [\"Change\" prefix]\n                           (cond\n                              ((= *Chr *Change)\n                                 (case *Chr\n                                    (\"!\" (cmdPipe *Cnt))  # [!!] External filter\n                                    (\">\" (evRpt (list 'shiftN *Cnt T)))  # [>>] Shift line(s) right\n                                    (\"<\" (evRpt (list 'shiftN *Cnt)))  # [<<] Shift line(s) left\n                                    (\"c\" (=: posX 1) (chgRight T))  # [cc] Change whole line\n                                    (\"d\" (evRpt (list 'cutN *Cnt)))  # [dd] Delete line(s)\n                                    (\"y\"  # [yy] Yank line(s)\n                                       (set *Clip\n                                          (cons T\n                                             (head *Cnt (nth (: buffer text) (: posY))) ) ) ) )\n                                 (reset) )\n                              (*Change (off *Change))\n                              (T (setq *Change *Chr)) ) )\n                        (T\n                           (if (or (assoc *Chr (: buffer keys)) (assoc *Chr *KeyMap))\n                              (run (cdr @))\n                              (case *Chr\n                                 (\"\\e\")\n                                 ((\"\\n\" \"\\r\")\n                                    (if (== This *CmdWin)\n                                       (command (: next) (get (: buffer text) (: posY)))\n                                       (goto 1 (inc (: posY)) T)  # Go to next line\n                                       (do (: sc) (scRight))\n                                       (redraw) ) )\n                                 (\".\" (if *Repeat (eval @) (beep)))  # Repeat last change\n                                 ((\"j\" \"\\e[B\") (move 'goDown *Cnt))  # [DOWN] Move down\n                                 ((\"^F\" \"\\e[6~\") (move 'goDown (: lines)))  # [PGDOWN] Page down\n                                 ((\"k\" \"\\e[A\") (move 'goUp *Cnt))  # [UP] Move up\n                                 ((\"^B\" \"\\e[5~\") (move 'goUp (: lines)))  # [PGUP] Page up\n                                 (\"h\" (move 'goLeft *Cnt))  # Move left\n                                 (\"l\" (move 'goRight *Cnt))  # Move right\n                                 (\"\\e[D\" (do 2 (scLeft)) (redraw))  # [LEFT] Scroll left\n                                 (\"\\e[C\" (do 2 (scRight)) (redraw))  # [RIGHT] Scroll right\n                                 (\"z\" (do 3 (scRight)) (redraw))  # Scroll right 3 columns\n                                 (\"Z\" (do 3 (scLeft)) (redraw))  # Scroll left 3 columns\n                                 (\"|\" (move 'goCol *Cnt))  # Go to column\n                                 (\"$\" (move 'goRight T))  # Go to end of line\n                                 ((\"\\e[1~\" \"\\e[H\") (move 'goAbs 1 1))  # [HOME] Go to beginning of text\n                                 ((\"\\e[4~\" \"\\e[F\") (move 'goAbs 1 T))  # [END] Go to end of text\n                                 (\"G\" (move 'goAbs 1 (or (format *Count) T)))  # [G] Go to end of text or line number\n                                 (\"f\" (and (getch2 (getch)) (move 'goFind @ 0 *Cnt)))  # Find character\n                                 (\"t\" (and (getch2 (getch)) (move 'goFind @ -1 *Cnt)))  # Till character\n                                 (\"\\t\" (move 'goForward 'tword *Cnt))  # TAB word forward\n                                 (\"w\" (move 'goForward 'word *Cnt))  # Word forward\n                                 (\"W\" (move 'goForward 'lword *Cnt))  # Long word forward\n                                 (\"b\" (move 'goBackward 'word *Cnt))  # Word backward\n                                 (\"B\" (move 'goBackward 'lword *Cnt))  # Long word backward\n                                 (\"e\" (move 'goForward 'end *Cnt))  # End of word\n                                 (\"E\" (move 'goForward 'lend *Cnt))  # End of long word\n                                 (\"{\" (move 'goPBack *Cnt))  # Paragraph(s) backward\n                                 (\"}\" (move 'goPFore *Cnt 0))  # Paragraph(s) forward\n                                 (\"'\" (jmpMark (getch) \"'\" 1))  # Jump to mark line\n                                 (\"`\" (jmpMark (getch) \"`\")) # Jump to mark position\n                                 (\"~\" (evRpt (list 'tglCase *Cnt)))  # Toggle case\n                                 ((\":\" \" \") (cmdMode (name \":\")))  # Command\n                                 (\"/\" (cmdMode (name \"/\")))  # Search forward\n                                 (\"?\" (cmdMode (name \"?\")))  # Search backward\n                                 (\"&\" (cmdMode (name \"&\")))  # Search word\n                                 (\"n\"  # Search next\n                                    (if *Search\n                                       (move 'goForward (lit @) *Cnt)\n                                       (beep) ) )\n                                 (\"N\"  # Search previous\n                                    (if *Search\n                                       (move 'goBackward (lit @) *Cnt)\n                                       (beep) ) )\n                                 (\"*\"  # Search word under cursor\n                                    (and (getWord) (moveSearch 'goForward (wordFun @))) )\n                                 (\"#\"  # Search word under cursor backward\n                                    (and (getWord) (moveSearch 'goBackward (wordFun @))) )\n                                 (\"%\"  # Matching parenthesis\n                                    (case (posChar)\n                                       (\"(\" (parMatch 'goForward 1 0 \"(\" \")\" \"[\" \"]\"))\n                                       (\"[\" (parMatch 'goForward 0 (0 . 0) \"(\" \")\" \"[\" \"]\"))\n                                       (\"{\" (braces 'goForward \"{\" \"}\"))\n                                       (\")\" (parMatch 'goBackward 1 0 \")\" \"(\" \"]\" \"[\"))\n                                       (\"]\" (parMatch 'goBackward 0 (0 . 0) \")\" \"(\" \"]\" \"[\"))\n                                       (\"}\" (braces 'goBackward \"}\" \"{\"))\n                                       (T (beep)) ) )\n                                 (\"i\"  # Insert\n                                    (when (insMode)\n                                       (setq *Repeat (list 'paste (lit @))) ) )\n                                 (\"I\"  # Insert at beginning of line\n                                    (goto 1 (: posY))\n                                    (when (insMode)\n                                       (setq *Repeat (list 'paste (lit @) 0)) ) )\n                                 (\"a\"  # Append\n                                    (when (get (: buffer text) (: posY) 1)\n                                       (inc (:: posX)) )\n                                    (when (insMode 1)\n                                       (setq *Repeat (list 'paste (lit @) 1)) ) )\n                                 (\"A\"  # Append to end of line\n                                    (goto\n                                       (inc (length (get (: buffer text) (: posY))))\n                                       (: posY)\n                                       T )\n                                    (when (insMode 1)\n                                       (setq *Repeat (list 'paste (lit @) T)) ) )\n                                 (\"o\"  # Open new line below current line\n                                    (setq *Repeat (list 'paste (lit (insMode T)) T)) )\n                                 (\"O\"  # Open new line above current line\n                                    (setq *Repeat (list 'paste (lit (insMode 0)) 0)) )\n                                 (\"x\" (setq *Change \"d\") (move 'goRight *Cnt))  # Delete characters\n                                 (\"X\" (setq *Change \"d\") (move 'goLeft *Cnt))  # Delete characters left\n                                 (\"D\" (setq *Change \"d\") (move 'goRight T))  # Delete rest of line\n                                 (\"p\" (evRpt (list 'paste (lit (val *Clip)) 1)))  # Paste after current position\n                                 (\"P\" (evRpt (list 'paste (lit (val *Clip)))))  # Paste before current position\n                                 (\"J\" (evRpt (list 'join *Cnt)))  # Join lines\n                                 (\"m\"  # Set mark\n                                    (put (: buffer) (intern (getch) 'vip)\n                                       (cons (: posX) (: posY)) ) )\n                                 (\"M\" (=: sc (dec (: winX))))  # Mark horizontal scroll position\n                                 (\"r\"  # Replace character(s)\n                                    (and (getch2 (getch)) (evRpt (list 'insChar @ *Cnt))) )\n                                 (\"R\"  # Replace\n                                    (when (insMode NIL NIL T)\n                                       (setq *Repeat (list 'overwrite (lit @))) ) )\n                                 (\"s\" (chgRight 1))  # Substitute character\n                                 (\"C\" (chgRight T))  # Change rest of line\n                                 (\"S\" (=: posX 1) (chgRight T))  # Change whole line\n                                 (\",\" (evRpt '(indent)))  # Fix indentation\n                                 (\"^A\" (evRpt (list 'incNum *Cnt)))\n                                 (\"^X\" (evRpt (list 'incNum (- *Cnt))))\n                                 (\"u\" (undo))  # Undo\n                                 (\"^R\" (redo))  # Redo\n                                 (\"^E\" (evCmd (eval (s-expr))))  # Evaluate expression\n                                 (\"g\"  # [\"Go\" prefix]\n                                    (if (assoc (getch) *KeyMap-g)\n                                       (run (cdr @))\n                                       (case *Chr\n                                          (\"f\"  # [gf] Edit file under cursor\n                                             (pushTag (: buffer file))\n                                             (reload (pack (getWord))) )\n                                          (\"w\"  # [gw] Web page\n                                             (scratch (tmp \"web\" (inc (0)))\n                                                (in (list \"w3m\" \"-cols\" *Columns (getWord))\n                                                   (rdLines) ) ) )\n                                          (\"h\"  # [gh] HTTP code\n                                             (scratch (tmp \"http\" (inc (0)))\n                                                (in (list \"w3m\" \"-dump_both\" (getWord))\n                                                   (rdLines) ) ) )\n                                          (\"b\"  # [gb] Browser\n                                             (vipZ)\n                                             (call (or (sys \"BROWSER\") \"w3m\") (getWord))\n                                             (vipA)\n                                             (repaint) )\n                                          (\"g\" (move 'goAbs 1 (or (format *Count) 1)))  # [gg] Go to beginning of text\n                                          (\"s\" (spell))\n                                          (T (beep)) ) ) )\n                                 (\"+\"  # Increase window size\n                                    (loop\n                                       (NIL (this (: prev))\n                                          (for (This (; *Window next) This (: next))\n                                             (T (> (: lines) 1)\n                                                (with *Window\n                                                   (chgwin (inc (: lines)) (dec (: top)))\n                                                   (for (This (: next) (=1 (: lines)) (: next))\n                                                      (chgwin 1 (dec (: top))) ) )\n                                                (chgwin (dec (: lines))) ) ) )\n                                       (T (> (: lines) 1)\n                                          (with *Window\n                                             (chgwin (inc (: lines)))\n                                             (for (This (: prev) (=1 (: lines)) (: prev))\n                                                (chgwin 1 (inc (: top))) ) )\n                                          (chgwin (dec (: lines)) (inc (: top))) ) ) )\n                                 (\"-\"  # Decrease window size\n                                    (cond\n                                       ((=1 ( : lines)))\n                                       ((: prev)\n                                          (chgwin (dec (: lines)))\n                                          (with (: prev)\n                                             (chgwin (inc (: lines)) (dec (: top))) ) )\n                                       (T\n                                          (chgwin (dec (: lines)) (inc (: top)))\n                                          (with (: next)\n                                             (chgwin (inc (: lines))) ) ) ) )\n                                 (\"=\" (eqwin))  # Set all windows to equal size\n                                 (\"K\"  # Edit symbol\n                                    (let S (any (getWord))\n                                       (ifn (: buffer syms)\n                                          (tag S)\n                                          (pushTag @)\n                                          (syms> (: buffer) (cons S @))\n                                          (reload (: buffer file) 1 1) ) ) )\n                                 (\"^]\"  # Edit symbol definition\n                                    (tag (any (getWord))) )\n                                 ((\"Q\" \"^T\")  # Pop tag stack\n                                    (ifn *TagStack\n                                       (beep)\n                                       (symbols (++ *TagStack))\n                                       (if (atom (car *TagStack))\n                                          (reload (++ *TagStack) (++ *TagStack) (++ *TagStack))\n                                          (syms> (: buffer) (++ *TagStack))\n                                          (reload (: buffer file) (++ *TagStack) (++ *TagStack)) ) ) )\n                                 ((\"\\eOP\" \"\\e[[A\")  # [F1] Highlight on/off\n                                    (=: buffer flat (not (: buffer flat)))\n                                    (repaint) )\n                                 ((\"\\eOQ\" \"\\e[[B\")  # [F2] Show chages to -\n                                    (shFile\n                                       (if (sys \"CCRYPT\" (: buffer key))\n                                          \"diff -Bb <(ccrypt -c -ECCRYPT @1-) <(ccrypt -c -ECCRYPT @1)\"\n                                          \"diff -Bb @1- @1\" ) ) )\n                                 ((\"\\eOR\" \"\\e[[C\")  # [F3] Custom dif\n                                    (shFile \"dif @1 @2\") )\n                                 ((\"\\eOS\" \"\\e[[D\")  # [F4] Format paragraph\n                                    (and *Count (=: buffer fmt @))\n                                    (goPFore 1 -1)\n                                    (pipeN (cnt@@) (pack \"fmt -\" (: buffer fmt))) )\n                                 ((\"\\e[15~\" \"\\e[[E\")  # [F5] Previous buffer\n                                    (nextBuf T) )\n                                 (\"\\e[17~\"  # [F6] Next buffer\n                                    (nextBuf) )\n                                 (\"\\e[18~\" (run *F7))  # [F7] Custom key\n                                 (\"\\e[19~\" (run *F8))  # [F8] Custom key\n                                 (\"\\e[20~\" (run *F9))  # [F9] Custom key\n                                 (\"\\e[21~\" (run *F10))  # [F10] Custom key\n                                 (\"\\e[23~\" (run *F11))  # [F11] Custom key\n                                 (\"\\e[24~\" (run *F12))  # [F12] Custom key\n                                 (\"\\\\\"  # Select or toggle buffer\n                                    (nextBuf\n                                       (if *Count\n                                          (get *Buffers (format @))\n                                          (or (: last) (car *Buffers)) ) ) )\n                                 ((\"q\" \"^W\")  # [\"Window\" prefix]\n                                    (if (assoc (getch) *KeyMap-q)\n                                       (run (cdr @))\n                                       (case *Chr\n                                          (\"s\"  # [qs] Split window\n                                             (unless (== This *CmdWin)\n                                                (let (Old (inc (: lines))  New (/ Old 2))\n                                                   (with\n                                                      (new (val This) (: buffer)\n                                                         (+ (: top) New) (- Old New 1)\n                                                         (: winX) (: winY)\n                                                         (: posX) (: posY)\n                                                         (: prev)\n                                                         (: mark) )\n                                                      (goto (: posX) (: posY)) )\n                                                   (=: mark)\n                                                   (chgwin (dec New)) ) ) )\n                                          (\"x\"  # [qx] Exchange windows\n                                             (and\n                                                (; *CmdWin next next)\n                                                (n== This *CmdWin)\n                                                (let W (if (== (: prev) *CmdWin) (: next) (: prev))\n                                                   (for P '(buffer winX winY posX posY last mark sc)\n                                                      (xchg (prop This P) (prop W P)) )\n                                                   (goto (: posX) (: posY))\n                                                   (with W\n                                                      (goto (: posX) (: posY)) ) ) ) )\n                                          (\"k\" (and (: next) (setq *Window @)))  # [qk] Above window\n                                          (\"j\" (and (: prev) (setq *Window @)))  # [qj] Below window\n                                          (\"q\" (done))  # [qq] (Quit) Close window\n                                          (\"z\" (run *TStp1) (yield) (run *TStp2))  # [qz] Suspend\n                                          (T (beep)) ) ) )\n                                 (\"v\" (view> This))  # View hook\n                                 (T (beep)) ) )\n                           (reset) ) ) ) ) ) ) ) ) )\n\n(and (info \"~/.pil/viprc\") (load @@))\n\n### Debug ###\n`*Dbg\n\n(de pico~vi (X C)\n   (setq C\n      (if C\n         (or\n            (get C '*Dbg -1 X)\n            (meta C '*Dbg -1 X) )\n         (get X '*Dbg 1) ) )\n   (and\n      (vi\n         (list\n            (cond\n               ((pair X) @)\n               (C (cons (car @) (cadr @)))\n               (T X) ) )\n         (cddr C) )\n      X ) )\n\n(de pico~v Lst\n   (cond\n      (Lst (vi (list @)))\n      ((asoq 'vip (stack)) (vi)) ) )\n"
  },
  {
    "path": "lib/xhtml/area",
    "content": "\n"
  },
  {
    "path": "lib/xhtml/field",
    "content": "\n"
  },
  {
    "path": "lib/xhtml/grid",
    "content": "
\n\n¦(run PRG)¦\n\n
\n"
  },
  {
    "path": "lib/xhtml/html",
    "content": "\n\n\n   \n   ¦(run PRG)¦\n\n   ¦(run PRG)¦\n\n"
  },
  {
    "path": "lib/xhtml/input",
    "content": "\n"
  },
  {
    "path": "lib/xhtml/layout",
    "content": ""
  },
  {
    "path": "lib/xhtml/menu",
    "content": "<>\n\n<>\n"
  },
  {
    "path": "lib/xhtml/select",
    "content": "\n¦(run (cdr PRG))¦\n\n\n"
  },
  {
    "path": "lib/xhtml/submit",
    "content": "\n"
  },
  {
    "path": "lib/xhtml/tab",
    "content": "\n\n\n
¦(run PRG)¦¦(run PRG)¦
\n"
  },
  {
    "path": "lib/xhtml/table",
    "content": "\n¦(run PRG)¦\n\n¦(run PRG)¦\n\n\n¦(run PRG)¦\n\n\n"
  },
  {
    "path": "lib/xhtml.l",
    "content": "# 11mar25 Software Lab. Alexander Burger\n\n(de xhtml (Path)\n   (for X\n      (quote\n         (\"html\" . *XhtmlHtml)\n         (\"table\" . *XhtmlTable)\n         (\"grid\" . *XhtmlGrid)\n         (\"layout\" . *XhtmlLayout)\n         (\"menu\" . *XhtmlMenu)\n         (\"tab\" . *XhtmlTab)\n         (\"input\" . *XhtmlInput)\n         (\"field\" . *XhtmlField)\n         (\"area\" . *XhtmlArea)\n         (\"select\" . *XhtmlSelect)\n         (\"submit\" . *XhtmlSubmit) )\n      (when (info (pack Path (++ X)))\n         (set X\n            (in @@\n               (make\n                  (until (eof)\n                     (let? L (clip (line))\n                        (while (= \" \" (peek))\n                           (conc L (list \"\\n\") (clip (line))) )\n                        (setq L (split (replace L \"~\" *SesId) \"¦\"))\n                        (link\n                           (unless (= L '((\"<\" \">\")))\n                              (make\n                                 (loop\n                                    (link (pack (++ L)))\n                                    (NIL L)\n                                    (link (any (++ L)))\n                                    (NIL L) ) ) ) ) ) ) ) ) ) ) ) )\n\n(private) Lst\n\n(de micro (Lst . PRG)\n   (when Lst\n      (loop\n         (prin (++ Lst))\n         (NIL Lst)\n         (if (atom (car Lst))\n            (ht:Prin (eval (++ Lst)))\n            (eval (++ Lst)) )\n         (NIL Lst) )\n      (prinl) ) )\n\n(xhtml \"@lib/xhtml/\")\n\n(mapc allow '(*JS *Menu *Tab *ID \"!ping\"))\n(setq *Menu 0  *Tab 1)\n(off \"*JS\")\n\n(private) (Prg Ofs X Attr Cls Var Val Nm JS)\n\n(de htPrin (Prg Ofs)\n   (default Ofs 1)\n   (for X Prg\n      (if (atom X)\n         (ht:Prin (eval X Ofs))\n         (eval X Ofs) ) ) )\n\n(de htJs ()\n   (for X \"*JS\"\n      (prin \" \" (car X) \"=\\\"\")\n      (ht:Prin (cdr X))\n      (prin \"\\\"\") ) )\n\n(de htStyle (Attr)\n   (cond\n      ((atom Attr)\n         (prin \" class=\\\"\")\n         (ht:Prin Attr)\n         (prin \"\\\"\") )\n      ((and (atom (car Attr)) (atom (cdr Attr)))\n         (prin \" \" (car Attr) \"=\\\"\")\n         (ht:Prin (cdr Attr))\n         (prin \"\\\"\") )\n      (T (mapc htStyle Attr)) ) )\n\n(de dfltCss (Cls)\n   (htStyle\n      (cond\n         ((not *Style) Cls)\n         ((atom *Style) (pack *Style \" \" Cls))\n         ((and (atom (car *Style)) (atom (cdr *Style)))\n            (list Cls *Style) )\n         ((find atom *Style)\n            (replace *Style @ (pack @ \" \" Cls)) )\n         (T (cons Cls *Style)) ) ) )\n\n(de tag (Nm Attr Ofs Prg)\n   (prin \"<\" Nm)\n   (and Attr (htStyle @))\n   (prin \">\")\n   (if (atom Prg)\n      (ht:Prin (eval Prg Ofs))\n      (for X Prg\n         (if (atom X)\n            (ht:Prin (eval X Ofs))\n            (eval X Ofs) ) ) )\n   (prin \"\") )\n\n(de  (Nm Attr . Prg)\n   (tag Nm Attr 2 Prg) )\n\n(de  (JS . Prg)\n   (let \"*JS\" (append \"*JS\" JS)\n      (run Prg) ) )\n\n(de style (X S)\n   (nond\n      (X S)\n      (S X)\n      ((pair X)\n         (cond\n            ((atom S) (pack S \" \" X))\n            ((and (atom (car S)) (atom (cdr S)))\n               (list X S) )\n            ((find atom S)\n               (replace S @ (pack @ \" \" X)) )\n            (T (cons X S)) ) )\n      ((or (pair (car X)) (pair (cdr X)))\n         (cond\n            ((atom S) (list S X))\n            ((and (atom (car S)) (atom (cdr S)))\n               (if (= (car X) (car S))\n                  X\n                  (list S X) ) )\n            (T\n               (cons X (delete (assoc (car X) S) S)) ) ) )\n      (NIL\n         (for Y X\n            (setq S (style Y S)) ) ) ) )\n\n(de \") ) ) )\n            (and *SesId ( \"SesId='\" @ \"'\"))\n            (mapc javascript *JS) )\n         (micro Body\n            (htPrin Prg 3) )\n         (micro End) ) ) )\n\n(de css (Css)\n   (prinl \"\") )\n\n(de javascript (JS . @)\n   (when JS\n      (prinl \"\") )\n   (and (rest) ( @)) )\n\n(de serverSentEvent (Id Var . Prg)\n   (allow \"!ssEvt\")\n   (\n      \"(new EventSource(SesId+'!ssEvt?'+'\"\n      Id\n      \"')).onmessage = function(ev) {if (ev.data.charAt(0) == '&') document.title = ev.data.substr(1); else document.getElementById('\"\n      Id\n      \"').\"\n      (if (lst? (car Prg)) \"innerHTML\" (++ Prg))\n      \" = ev.data;}\" )\n   (if (assoc Id *SsEvts)\n      (con @ (cons Var (unless (val Var) Prg)))\n      (push '*SsEvts (cons Id Var Prg)) ) )\n\n(de ssEvt (Id)\n   (when (assoc Id *SsEvts)\n      (let ((@Var . Prg) (cdr @))\n         (task *HtSock)\n         (macro\n            (and @Var (task (close @Var)))\n            (task (setq @Var *HtSock)\n               (in @\n                  (unless (char)\n                     (task (close @Var))\n                     (off @Var) ) ) ) )\n         (httpHead \"text/event-stream\" 0)\n         (run Prg) ) ) )\n\n(private) Sock\n\n(de serverSend (Sock . Prg)\n   (when Sock\n      (out @\n         (ht:Out T\n            (prin \"data: \")\n            (output\n               (cond\n                  ((<> \"\\n\" @@) (prin @@))\n                  (@@@ (prin \"\\ndata: \")) )\n               (htPrin Prg 2) )\n            (prinl \"\\n\") ) ) ) )\n\n(de ping (Min)\n   (timeout (setq *Timeout (* Min `(* 60 1000))))\n   (respond) )\n\n(de  (Min)\n   ( \"onload=ping(\" Min \")\") )\n\n(de  (Val Max)\n   (ifn Val\n      (
 '(id . \"progress\")\n         ( \"progress\" '((value . 0) (max . 99)))\n         (serverSentEvent \"progress\" '*Progress) )\n      (wait 1)\n      (serverSend *Progress\n         (unless (=T Val)\n            ( \"progress\"\n               (list\n                  (cons 'value Val)\n                  (cons 'max Max) ) )\n            ( \"center\"\n               (prin  \"
\" (*/ Val 100 Max) \" %\") ) ) ) ) ) \n\n(de 
 (Attr . Prg)\n   (tag \"div\" Attr 2 Prg)\n   (prinl) )\n\n(de  (Attr . Prg)\n   (tag \"span\" Attr 2 Prg) )\n\n(de 
 Prg\n   (htPrin Prg 2)\n   (prinl \"
\") )\n\n(de -- ()\n   (prinl \"
\") )\n\n(de ---- ()\n   (prinl \"

\") )\n\n(de 
 ()\n   (prinl \"
\") )\n\n(de  (N)\n   (do (or N 1) (prin \" \")) )\n\n(de  Prg\n   (tag \"small\" NIL 2 Prg) )\n\n(de  Prg\n   (tag \"big\" NIL 2 Prg) )\n\n(de  Prg\n   (tag \"em\" NIL 2 Prg) )\n\n(de  Prg\n   (tag \"strong\" NIL 2 Prg) )\n\n(de 
 (Attr . Prg)\n   (tag \"h1\" Attr 2 Prg)\n   (prinl) )\n\n(de 
 (Attr . Prg)\n   (tag \"h2\" Attr 2 Prg)\n   (prinl) )\n\n(de 
 (Attr . Prg)\n   (tag \"h3\" Attr 2 Prg)\n   (prinl) )\n\n(de 
 (Attr . Prg)\n   (tag \"h4\" Attr 2 Prg)\n   (prinl) )\n\n(de 
 (Attr . Prg)\n   (tag \"h5\" Attr 2 Prg)\n   (prinl) )\n\n(de 
 (Attr . Prg)\n   (tag \"h6\" Attr 2 Prg)\n   (prinl) )\n\n(de 
 (Attr . Prg)\n   (tag \"p\" Attr 2 Prg)\n   (prinl) )\n\n(de 
 (Attr . Prg)\n   (tag \"pre\" Attr 2 Prg)\n   (prinl) )\n\n(de 
     (Attr . Prg)\n   (tag \"ol\" Attr 2 Prg)\n   (prinl) )\n\n(de 
       (Attr . Prg)\n   (tag \"ul\" Attr 2 Prg)\n   (prinl) )\n\n(de 
    •  (Attr . Prg)\n   (tag \"li\" Attr 2 Prg)\n   (prinl) )\n\n(de 
       (Attr . Prg)\n   (tag \"dl\" Attr 2 Prg)\n   (prinl) )\n\n(de 
       (Attr . Prg)\n   (tag \"dt\" Attr 2 Prg)\n   (prinl) )\n\n(de 
       (Attr . Prg)\n   (tag \"dd\" Attr 2 Prg)\n   (prinl) )\n\n(de  (Nm . Prg)\n   (prin \"\")\n   (htPrin Prg 2)\n   (prinl  \"\") )\n\n(de  (Str Url Tar)\n   (prin \"\")\n   (ht:Prin Str)\n   (prin \"\") )\n\n(de  (Src Alt Url DX DY)\n   (when Url\n      (prin \"\" ) )\n   (prin \"\\\"\")\n\")\n   (and Url (prin \"\")) )\n\n(de  (Var Val . Prg)\n   (prin \"\")\n   (htPrin Prg 2)\n   (prin \"\") )\n\n(private) (Attr Prg)\n\n(de  (Attr . Prg)\n   (tag \"th\" Attr 2 Prg) )\n\n(de  (Attr . Prg)\n   (tag \"tr\" Attr 2 Prg) )\n\n(de  (Attr . Prg)\n   (tag \"td\" Attr 2 Prg) )\n\n(de  (Attr . Prg)\n   (tag \"thead\" Attr 2 Prg) )\n\n(de  (Attr . Prg)\n   (tag \"tbody\" Attr 2 Prg) )\n\n(private) (Attr Ttl Head Prg *RowF Beg BegR Row EndR End C H L Y A N)\n\n(de  (ATTR Ttl Head . Prg)\n   (on *RowF)\n   (let ((Beg C BegR Row EndR NIL NIL NIL End) *XhtmlTable)\n      (micro Beg)\n      (when Ttl\n         (micro C\n            (ht:Prin (eval Ttl 2)) ) )\n      (when (find cdr Head)\n         (micro BegR)\n         (for H Head\n            (let ATTR (car H)\n               (micro Row\n                  (htPrin (cdr H) 3) ) ) )\n         (micro EndR) )\n      (htPrin Prg 3)\n      (micro End) ) )\n\n(de alternating ()\n   (onOff *RowF) )\n\n(de  (Attr . Prg)\n   (let ((Beg C NIL NIL NIL BegR Row EndR End) *XhtmlTable  H Head)\n      (micro BegR)\n      (while Prg\n         (let (Y (++ Prg)  A (car (++ H))  N 1)\n            (while (== '- (car Prg))\n               (inc 'N)\n               (++ Prg)\n               (++ H) )\n            (let ATTR\n               (style Attr\n                  (style\n                     (and (> N 1) (cons \"colspan\" N))\n                     (if (== 'align A) '(align (align . right)) A) ) )\n               (micro Row\n                  (if (atom Y)\n                     (ht:Prin (eval Y 2))\n                     (eval Y 2) ) ) ) ) )\n      (micro EndR) ) )\n\n(private) (Y Lst L E N)\n\n(de  (Y . Lst)\n   (let ((Beg BegR Row EndR End) *XhtmlGrid)\n      (micro Beg)\n      (while Lst\n         (micro BegR)\n         (use Y\n            (let L (and (sym? Y) (chop Y))\n               (do (or (num? Y) (length Y))\n                  (let\n                     (ATTR\n                        (cond\n                           ((pair Y) (++ Y))\n                           ((= \".\" (++ L)) \"align\") )\n                        E (++ Lst) )\n                     (unless (== '- E)\n                        (when (== '- (car Lst))\n                           (let N 1\n                              (for (P Lst (and P (== '- (++ P))))\n                                 (inc 'N) )\n                              (push 'N \"colspan\")\n                              (setq ATTR (if ATTR (list ATTR N) N)) ) )\n                        (micro Row\n                           (if (atom E)\n                              (ht:Prin (eval E 2))\n                              (eval E 2) ) ) ) ) ) ) )\n         (micro EndR) )\n      (micro End) ) )\n\n(de  Lst\n   (
       '(width . \"100%\") NIL NIL\n      ( NIL\n         (
       '((width . \"33%\") (align . left))\n            (eval (car Lst) 1) )\n         ( '((width . \"34%\") (align . center))\n            (eval (cadr Lst) 1) )\n         ( '((width . \"33%\") (align . right))\n            (eval (caddr Lst) 1) ) ) ) )\n\n(de  Lst\n   ( '(width . \"100%\") NIL '((norm) (align))\n      ( NIL\n         (eval (car Lst) 5)\n         (run (cdr Lst) 5) ) ) )\n\n(private) (X Txt Prg)\n\n(de tip (X Txt)\n   ( (cons 'title (glue \"\\n\" X)) Txt) )\n\n(de  (X . Prg)\n   (let *Style (style (cons 'title (glue \"\\n\" X)) *Style)\n      (run Prg) ) )\n\n(private) (Lst P LayX LayY L Args DX DY Cls Style)\n\n# Layout\n(de  Lst\n   (let\n      (Lay *XhtmlLayout\n         P (and (=T (car Lst)) (++ Lst))\n         LayX 0\n         LayY 0 )\n      (ifn Lay\n         (recur (Lst LayX)\n            (use (LayX LayY)\n               (for L Lst\n                  (let\n                     (Args (mapcar eval (cddar L))\n                        DX (eval (caar L))\n                        DY (eval (cadar L))\n                        Cls (unless (sub? \":\" (car Args)) (++ Args))\n                        Style\n                        (cons 'style\n                           (glue \"; \"\n                              (cons\n                                 \"position:absolute\"\n                                 (pack \"top:\" LayY (if P \"%\" \"px\"))\n                                 (pack \"left:\" LayX (if P \"%\" \"px\"))\n                                 (cond\n                                    ((=0 DX) \"min-width:100%\")\n                                    (DX (pack \"width:\" DX (if P \"%\" \"px\"))) )\n                                 (cond\n                                    ((=0 DY) \"min-height:100%\")\n                                    (DY (pack \"height:\" DY (if P \"%\" \"px\"))) )\n                                 Args ) ) ) )\n                     (prog1\n                        (if Cls (list Cls Style) Style)  # -> '@'\n                        (eval (cadr L)) )\n                     (recurse (cddr L) (+ LayX DX))\n                     (inc 'LayY DY) ) ) ) )\n         (recur (Lst)\n            (for L Lst\n               (micro (++ Lay)\n                  (run (cddadr L)) )\n               (recurse (cddr L)) ) ) ) ) )\n\n(private) (Url Str)\n\n(de