S

*Scl
A global variable holding the current fixpoint input scale. See also Numbers and scl.
: (str "123.45")  # Default value of '*Scl' is 0
-> (123)
: (setq *Scl 3)
-> 3
: (str "123.45")
-> (123450)

: 123.4567
-> 123457
: 12.3456
-> 12346
*Sig1
*Sig2
Global variables holding (possibly empty) prg bodies, which will be executed when a SIGUSR1 signal (or a SIGUSR2 signal, respectively) is sent to the current process. See also alarm, *Hup, sigio, *TStp[12], *Winch and *Term.
: (de *Sig1 (msg 'SIGUSR1))
-> *Sig1
*Solo
A global variable indicating exclusive database access. Its value is 0 initially, set to T (or NIL) during cooperative database locks when lock is successfully called with a NIL (or non-NIL) argument. See also *Zap.
: *Solo
-> 0
: (lock *DB)
-> NIL
: *Solo
-> NIL
: (rollback)
-> T
: *Solo
-> 0
: (lock)
-> NIL
: *Solo
-> T
: (rollback)
-> T
: *Solo
-> T
+Sn
Prefix class for maintaining indexes according to a modified soundex algorithm, for tolerant name searches, to +String relations. Typically used in combination with the +Idx prefix class. See also Database.
(rel nm (+Sn +Idx +String))  # Name
+String
Class for string (transient symbol) relations, a subclass of +Symbol. Accepts an optional argument for the string length (currently not used). See also Database.
(rel nm (+Sn +Idx +String))  # Name, indexed by soundex and substrings
+Swap
Prefix class for +relations where the data are to be stored in the value of a separate external symbol instead of the relation's object. Typically used for data which are relatively large and/or rarely accessed. Doesn't work with bidirectional relations (+Joint or +index). See also Database.
(rel pw (+Swap +String))               # Password
(rel nr (+Swap +List +Number))         # List of bignums
+Symbol
Class for symbolic relations, a subclass of +relation. Objects of that class typically maintain internal symbols, as opposed to the more often-used +String for transient symbols. See also Database.
(rel perm (+List +Symbol))  # Permission list
same/3
Pilog predicate that succeeds if the first argument matches the result of applying the get algorithm to the following arguments. Typically used as filter predicate in select/3 database queries. See also isa/2, bool/3, range/3, head/3, fold/3, part/3 and tolr/3.
: (?
   @Nr 2
   @Nm "Spare"
   (select (@Item)
      ((nr +Item @Nr) (nm +Item @Nm))
      (same @Nr @Item nr)
      (head @Nm @Item nm) ) )
 @Nr=2 @Nm="Spare" @Item={B2}
(scan 'tree ['fun] ['any1] ['any2] ['flg])
Scans through a database tree by applying fun to all key-value pairs. fun should be a function accepting two arguments for key and value. It defaults to println. any1 and any2 may specify a range of keys. If any2 is greater than any1, the traversal will be in opposite direction. Note that the keys need not to be atomic, depending on the application's index structure. If flg is non-NIL, partial keys are skipped. See also tree, iter, init and step.
: (scan (tree 'nm '+Item))
("ASLRSNSTRSTN" {B3} . T) {B3}
("Additive" {B4}) {B4}
("Appliance" {B6}) {B6}
("Auxiliary Construction" . {B3}) {B3}
("Construction" {B3}) {B3}
("ENNSNNTTTF" {B4} . T) {B4}
("Enhancement Additive" . {B4}) {B4}
("Fittings" {B5}) {B5}
("GTSTFLNS" {B6} . T) {B6}
("Gadget Appliance" . {B6}) {B6}
...

: (scan (tree 'nm '+Item) println NIL T T)  # 'flg' is non-NIL
("Auxiliary Construction" . {B3}) {B3}
("Enhancement Additive" . {B4}) {B4}
("Gadget Appliance" . {B6}) {B6}
("Main Part" . {B1}) {B1}
("Metal Fittings" . {B5}) {B5}
("Spare Part" . {B2}) {B2}
-> NIL
(scl 'num [. prg]) -> num
If prg is given, it binds *Scl dynamically to num during the execution of prg. Otherwise, it sets *Scl globally to num. See also Numbers.
: (scl 0)
-> 0
: (str "123.45")
-> (123)
: (scl 1)
-> 1
: (read)
123.45
-> 1235
: (scl 3)
-> 3
: (str "123.45")
-> (123450)
: (scl 1 (str "123.45"))
-> (1235)
: *Scl
-> 3
(script 'any ..) -> any
The first any argument is loaded, with the remaining arguments passed as variable arguments. They can be accessed with next, arg, args and rest. With that, the syntax in the script is the same as that in the body of a function with variable arguments (see lambda expressions, "when the CAR is the symbol @").
$ cat x
(* (next) (next))

$ pil +
: (script "x" 3 4)
-> 12
(search 'any 'lst ['any 'lst ..] ['fun]) -> lst
(search 'lst) -> obj | NIL
Searches the database for an arbitrary number of any criteria. The first form returns a list holding a query structure according to the corresponding lst lists of relation specifications. A search criterion can be an atom for an exact search, or a cons pair for a range search. A relation specification can be a list (var cls [hook]) for an index search, a cons pair (sym . sym) for the two endpoints of a +Joint, or - only instead of the first specification in lst - two functions: A generator function and a filter function. The final fun argument may optionally filter and possibly modify each result. The second form takes a query structure as returned from the first form, and returns the next result (an object) or NIL (if there are no more matching results). search is described in detail in The 'search' Function. See also init, step and collect.
: (for
   (Q
      (search
         (2 . 5) '((nr +Item))  # Select all items with numbers between 2 and 5
         "Active" '((nm +CuSu) (sup +Item)) )  # and suppliers matching "Active"
      (search Q) )
   (show @) )
{B3} (+Item)
   sup {C1}
   nr 3
   pr 15700
   inv 100
   nm "Auxiliary Construction"
{B5} (+Item)
   sup {C1}
   nr 5
   pr 7980
   inv 100
   nm "Metal Fittings"
-> {B5}
(sect 'lst1 'lst2) -> lst
Returns the intersection of list arguments, all elements which are both in lst1 and in lst2. See also diff.
: (sect (1 2 3 4) (3 4 5 6))
-> (3 4)
: (sect (1 2 3) (4 5 6))
-> NIL
(seed 'any) -> cnt
Initializes the random generator's seed, and returns a pseudo random number in the range -2147483648 .. +2147483647. See also rand and hash.
: (seed "init string")
-> -417605464
: (rand)
-> -1061886707
: (rand)
-> 822065436

: (seed (time))
-> 128285383
(seek 'fun 'lst ..) -> lst
Applies fun to lst and all successive CDRs, until non-NIL is returned. Returns the tail of lst starting with that element (and stores the non-NIL value in the global variable @@), or NIL if fun did not return non-NIL for any element of lst. When additional lst arguments are given, they are passed to fun in the same way. See also find, pick.
: (seek '((X) (> (car X) 9)) (1 5 8 12 19 22))
-> (12 19 22)
(select [var ..] cls [hook] [var val ..]) -> obj | NIL
(Debug mode only) Interactive database function, loosely modelled after the SQL 'SELECT' command. A front-end to search. When called with only a cls argument, select steps through all objects of that class, and shows their complete contents (this is analog to 'SELECT * from CLS'). If cls is followed by attribute/value specifications, the search is limited to these values (this is analog to 'SELECT * from CLS where VAR = VAL'). If before cls one or several attribute names are supplied, only these attribute (instead of the full show) are printed. These attribute specifications may also be lists, then those will be evaluated to retrieve related data. After each step, select waits for a key, and terminates when ESC is pressed. The global variable This is set to the last result. See also Database and Pilog.
: (select +Item)                       # Show all items
{B1} (+Item)
   nr 1
   nm "Main Part"
   pr 29900
   inv 100
   sup {C1}
{B2} (+Item)
   nr 2
   nm "Spare Part"
   pr 1250
   inv 100
   sup {C2}
-> {B2}                                # ESC was pressed

: (select +Item nr 3)                  # Show only item 3
{B3} (+Item)
   nr 3
   sup {C1}
   pr 15700
   nm "Auxiliary Construction"
   inv 100
-> NIL

# Show selected attributes for items 3 through 3
: (select nr nm pr (: sup nm) +Item nr (3 . 5))
3 "Auxiliary Construction" 157.00 "Active Parts Inc." {B3}
4 "Enhancement Additive" 9.99 "Seven Oaks Ltd." {B4}
5 "Metal Fittings" 79.80 "Active Parts Inc." {B5}
-> NIL
select/3
Pilog database predicate that allows combined searches over +index and other relations. It takes a list of Pilog variables, a list of generator clauses, and an arbitrary number of filter clauses. The functionality is described in detail in The 'select' Predicate. See also db/3, isa/2, same/3, bool/3, range/3, head/3, fold/3, part/3, tolr/3 and remote/2.
: (?
   @Nr (2 . 5)          # Select all items with numbers between 2 and 5
   @Sup "Active"        # and suppliers matching "Active"
   (select (@Item)                                  # Bind results to '@Item'
      ((nr +Item @Nr) (nm +CuSu @Sup (sup +Item)))  # Generator clauses
      (range @Nr @Item nr)                          # Filter clauses
      (part @Sup @Item sup nm) ) )
 @Nr=(2 . 5) @Sup="Active" @Item={B3}
 @Nr=(2 . 5) @Sup="Active" @Item={B5}
-> NIL
(send 'msg 'obj ['any ..]) -> any
Sends the message msg to the object obj, optionally with arguments any. If the message cannot be located in obj, its classes and superclasses, an error "Bad message" is issued. See also OO Concepts, try, method, meth, super and extra.
: (send 'stop> Dlg)  # Equivalent to (stop> Dlg)
-> NIL
(seq 'cnt|sym1) -> sym | NIL
Sequential single step: Returns the first external symbol in the cnt'th database file, or the next external symbol following sym1 in the database, or NIL when the end of the database is reached. See also free.
: (pool "db")
-> T
: (seq *DB)
-> {2}
: (seq @)
-> {3}
(set 'var 'any ..) -> any
Stores new values any in the var arguments. See also setq, val, swap, con and def.
: (set 'L '(a b c)  (cdr L) 999)
-> 999
: L
-> (a 999 c)
(set! 'obj 'any) -> any
Transaction wrapper function for set. Note that for setting the value of entities typically the set!> message is used. See also new!, request!, put! and inc!.
(set! Obj (* Count Size))  # Setting a non-entity object to a numeric value
(setq var 'any ..) -> any
Stores new values any in the var arguments. See also set, val and def.
: (setq  A 123  B (list A A))  # Set 'A' to 123, then 'B' to (123 123)
-> (123 123)
(shadows ['flg]) -> lst
(Debug mode only) Returns a list of all symbols shadowing other symbols in the current namespace search order. When flg non-NIL, these and the overshadowed symbols are printed as a side effect. See also symbols and namespaces.
: (symbols '(vip pico))
-> (pico)
vip: (shadows T)
   vi pico~vi
   cmd pico~cmd
   shift pico~shift
-> (vi cmd shift)
vip: (symbols '(pico))
-> (vip pico)

$ pty  # After starting "chess" in PilBox
chess: (shadows T)
   field pico~field
   wake android~wake
   queue pico~queue
   alarm pico~alarm
-> (field wake queue alarm)
chess: (nsp 'field)
-> chess
chess: (nsp 'wake)
-> simul
chess: (nsp 'alarm)
-> android
(shift 'var) -> any
Sets the list in var to its CDR. (shift 'var) is equivalent to (set 'var (cdr (val 'var))). See also push and pop.
: (setq A (1 2 3))
-> (1 2 3)
: (shift 'A)
-> (2 3)
: A
-> (2 3)
(show 'any ['sym|cnt ..]) -> any
Shows the name, value and property list of a symbol found by applying the get algorithm to any and the following arguments. See also view.
: (setq A 123456)
-> 123456
: (put 'A 'x 1)
-> 1
: (put 'A 'lst (9 8 7))
-> (9 8 7)
: (put 'A 'flg T)
-> T

: (show 'A)
A 123456
   flg
   lst (9 8 7)
   x 1
-> A

: (show 'A 'lst 2)
-> 8
show/1
Pilog predicate that always succeeds, and shows the name, value and property list of the argument symbol. See also show.
: (? (db nr +Item 2 @Item) (show @Item))
{B2} (+Item)
   nm "Spare Part"
   nr 2
   pr 1250
   inv 100
   sup {C2}
 @Item={B2}
-> NIL
(sigio 'cnt . prg) -> cnt
Sets a signal handler prg for SIGIO on the file descriptor cnt. Returns the file descriptor. See also alarm, *Hup, *Winch, *Sig[12], *TStp[12] and *Term.
# First session
: (sigio (setq *SigSock (port T 4444))  # Register signal handler at UDP port
   (while (udp *SigSock)                # Queue all received data
      (fifo '*SigQueue @) ) )
-> 3

# Second session
: (for I 7 (udp "localhost" 4444 I))  # Send numbers to first session

# First session
: (fifo '*SigQueue)
-> 1
: (fifo '*SigQueue)
-> 2
(size 'any) -> cnt
Returns the "size" of any. For numbers this is the number of bytes needed for the value, for external symbols it is the number of bytes it would occupy in the database, for other symbols it is the number of bytes occupied by the UTF-8 representation of the name, and for lists it is the total number of cells in this list and all its sublists. See also length and bytes.
: (size "abc")
-> 3
: (size "äbc")
-> 4
: (size 127)  # One byte
-> 1
: (size 128)  # Two bytes (eight bits plus sign bit!)
-> 2
: (size (1 (2) 3))
-> 4
: (size (1 2 3 .))
-> 3
Skips all whitespace (and comments if any is given) in the input stream. Returns the next available character, or NIL upon end of file. See also peek and eof.
$ cat a
# Comment
abcd
$ pil +
: (in "a" (skip "#"))
-> "a"
(solve 'lst [. prg]) -> lst
Evaluates a Pilog query and, returns the list of result sets. If prg is given, it is executed for each result set, with all Pilog variables bound to their matching values, and returns a list of the results. See also pilog, ?, goal and prove.
: (solve '((append @X @Y (a b c))))
-> (((@X) (@Y a b c)) ((@X a) (@Y b c)) ((@X a b) (@Y c)) ((@X a b c) (@Y)))

: (solve '((append @X @Y (a b c))) @X)
-> (NIL (a) (a b) (a b c))
(sort 'lst ['fun]) -> lst
Returns a sorted list by destructively exchanging the elements of lst. If fun is given, it is used as a "less than" predicate for comparisons. Typically, sort is used in combination with by, giving shorter and often more efficient solutions than with the predicate function. See also Comparing, group, maxi, mini and uniq.
: (sort '(a 3 1 (1 2 3) d b 4 T NIL (a b c) (x y z) c 2))
-> (NIL 1 2 3 4 a b c d (1 2 3) (a b c) (x y z) T)
: (sort '(a 3 1 (1 2 3) d b 4 T NIL (a b c) (x y z) c 2) >)
-> (T (x y z) (a b c) (1 2 3) d c b a 4 3 2 1 NIL)
: (by cadr sort '((1 4 3) (5 1 3) (1 2 4) (3 8 5) (6 4 5)))
-> ((5 1 3) (1 2 4) (1 4 3) (6 4 5) (3 8 5))
(space ['cnt]) -> cnt
Prints cnt spaces, or a single space when cnt is not given. See also beep, prin and char.
: (space)
 -> 1
: (space 1)
 -> 1
: (space 2)
  -> 2
(sp? 'any) -> flg
Returns T when the argument any is NIL, or if it is a string (symbol) that consists only of whitespace characters.
: (sp? "  ")
-> T
: (sp? "ABC")
-> NIL
: (sp? 123)
-> NIL
(split 'lst 'any ..) -> lst
Splits lst at all places containing an element any and returns the resulting list of sublists. See also stem.
: (split (1 a 2 b 3 c 4 d 5 e 6) 'e 3 'a)
-> ((1) (2 b) (c 4 d 5) (6))
: (mapcar pack (split (chop "The quick brown fox") " "))
-> ("The" "quick" "brown" "fox")
(sqrt 'num ['flg|num]) -> num
Returns the square root of the num argument. If flg is given and non-NIL, the result will be rounded. If in addition to that flg is a number, the first argument will be multiplied with it before doing the square root calculation. See also */.
: (sqrt 64)
-> 8
: (sqrt 1000)
-> 31
: (sqrt 1000 T)
-> 32
: (sqrt 10000000000000000000000000000000000000000)
-> 100000000000000000000

: (scl 6)
-> 6
: (sqrt 2.0 1.0)
-> 1414214
(ssl 'host 'path . prg) -> any
Executes prg in an input stream (using in) from "@bin/ssl" requesting path from host.
: (ssl "picolisp.com" "wiki/?home" (line T))
-> "<!DOCTYPE html>"
(stack ['cnt ['cnt]]) -> cnt | (.. (any . cnt) . cnt)
Maintains the stack segment sizes for coroutines. By default, coroutine sizes are 64 kB each, and the main stack segment size is 256 kB. These sizes can only be changed before starting any coroutine. If called with at least one argument and no coroutine running, the stack segment size is set to the first cnt argument, and optionally the main segment size is set to the second cnt argument. Otherwise, the current size in kilobytes is returned and - if there are running coroutines - pairs of their tags and unused stack spaces are consed in front of the size. See also heap.
$ ulimit -s unlimited  &&  pil +  # Guarantee stack space
: (stack)        # Current size
-> 64            # 64 kB
: (stack 20 80)  # Reduce to 20 kB
-> 20
: (co 'inc (let N 0 (loop (yield (inc 'N)))))  # Create two coroutines
-> 1
: (co 'dec (let N 0 (loop (yield (dec 'N)))))
-> -1
: (stack)
-> ((dec . 19) (inc . 19) (T . 75) . 20)
(stamp ['dat 'tim]|['T]) -> sym
Returns a date-time string in the form "YYYY-MM-DD HH:MM:SS". If dat and tim is missing, the current date and time is used. If T is passed, the current Coordinated Universal Time (UTC) is used instead. See also date and time.
: (stamp)
-> "2000-09-12 07:48:04"
: (stamp (date) 0)
-> "2000-09-12 00:00:00"
: (stamp (date 2000 1 1) (time 12 0 0))
-> "2000-01-01 12:00:00"
(state 'var (sym|lst exe [. prg]) ..) -> any
Implements a finite state machine. The variable var holds the current state as a symbolic value. When a clause is found that contains the current state in its CAR sym|lst value, and where the exe in its CADR evaluates to non-NIL, the current state will be set to that value, the body prg in the CDDR will be executed, and the result returned. T is a catch-all for any state. If no state-condition matches, NIL is returned. See also case, cond and job.
: (de tst ()
   (job '((Cnt . 4))
      (state '(start)
         (start 'run
            (printsp 'start) )
         (run (and (gt0 (dec 'Cnt)) 'run)
            (printsp 'run) )
         (run 'stop
            (printsp 'run) )
         (stop 'start
            (setq Cnt 4)
            (println 'stop) ) ) ) )
-> tst
: (do 12 (tst))
start run run run run stop
start run run run run stop
-> stop
: (pp 'tst)
(de tst NIL
   (job '((Cnt . 4))
      (state '(start)
      ...
-> tst
: (do 3 (tst))
start run run -> run
: (pp 'tst)
(de tst NIL
   (job '((Cnt . 2))
      (state '(run)
      ...
-> tst
(stem 'lst 'any ..) -> lst
Returns the tail of lst that does not contain any of the any arguments. (stem 'lst 'any ..) is equivalent to (last (split 'lst 'any ..)). See also tail and split.
: (stem (chop "abc/def\\ghi") "/" "\\")
-> ("g" "h" "i")
(step 'lst ['flg]) -> any
Single-steps iteratively through a database tree. lst is a structure as received from init. If flg is non-NIL, partial keys are skipped. The key for each returned value is stored in the global variable @@. See also tree, scan, iter, leaf and fetch.
: (setq Q (init (tree 'nr '+Item) 3 5))
-> (((3 . 5) ((3 NIL . {B3}) (4 NIL . {B4}) (5 NIL . {B5}) (6 NIL . {B6}))))
: (get (step Q) 'nr)
-> 3
: (get (step Q) 'nr)
-> 4
: (get (step Q) 'nr)
-> 5
: (get (step Q) 'nr)
-> NIL
(store 'tree 'any1 'any2 ['(num1 . num2)])
Stores a value any2 for the key any1 in a database tree. num1 is a database file number, as used in new (defaulting to 1), and num2 a database block size (defaulting to 256). When any2 is NIL, the corresponding entry is deleted from the tree. See also tree and fetch.
: (store (tree 'nr '+Item) 2 '{B2})
(str 'sym ['sym1]) -> lst
(str 'lst) -> sym
In the first form, the string sym is parsed into a list. This mechanism is also used by load. If sym1 is given, it should specify a set of characters, and str will then return a list of tokens analog to read. The second form does the reverse operation by building a string from a list. See also any, name and sym.
: (str "a (1 2) b")
-> (a (1 2) b)
: (str '(a "Hello" DEF))
-> "a \"Hello\" DEF"
: (str "a*3+b*4" "_")
-> (a "*" 3 "+" b "*" 4)
(str? 'any) -> sym | NIL
Returns the argument any when it is a transient symbol (string), otherwise NIL. See also sym?, box? and ext?.
: (str? 123)
-> NIL
: (str? '{ABC})
-> NIL
: (str? 'abc)
-> NIL
: (str? "abc")
-> "abc"
(strDat 'sym) -> dat
Converts a string sym in the date format of the current locale to a date. See also expDat, $dat and datStr.
: (strDat "2007-06-01")
-> 733134
: (strDat "01.06.2007")
-> NIL
: (locale "DE" "de")
-> NIL
: (strDat "01.06.2007")
-> 733134
: (strDat "1.6.2007")
-> 733134
(strip 'any) -> any
Strips all leading quote calls from any. See also lit.
: (strip 123)
-> 123
: (strip '''(a))
-> (a)
: (strip (quote quote a b c))
-> (a b c)
(struct 'num 'any 'any ..) -> any
Creates or extracts data structures, suitable to be passed to or returned from native functions. The first num argument should be a native value, either a scalar, or a pointer obtained by calling functions like malloc(). The second argument any is a result specification, while all following initialization items are stored in the structure pointed to by the first argument. See also Native C Calls.
: (scl 2)
-> 2

## /* We assume the following C structure */
## typedef struct value {
##    int x, y;
##    double a, b, c;
##    long z;
##    char nm[4];
## } value;

# Allocate structure
: (setq P (%@ "malloc" 'N 56))
-> 498324676928

# Store two integers, three doubles, one long, and four characters
: (struct P NIL -7 -4 (1.0 0.11 0.22 0.33) (7 . 8) 65 66 67 0)
-> NIL

# Extract the structure
: (struct P '((I . 2) (1.0 . 3) N (C . 4)))
-> ((7 4) (11 22 33) 7 ("A" "B" "C"))

# Do both in a single call (allowing conversions of data types)
: (struct P
   '((I . 2) (1.0 . 3) N (C . 4))
   -7 -4 (1.0 0.11 0.22 0.33) (7 . 8) 65 66 67 0 )
-> ((7 4) (11 22 33) 7 ("A" "B" "C"))

# De-allocate structure
: (%@ "free" NIL P)
-> NIL
(sub? 'any1 'any2) -> any2 | NIL
Returns any2 when the string representation of any1 is a substring of the string representation of any2. See also pre?, offset and index.
: (sub? "def" "abcdefg")
-> "abcdefg"
: (sub? "abb" "abcdefg")
-> NIL
: (sub? NIL "abcdefg")
-> "abcdefg"

: (sub? "def" '(a b c d e f g))
-> "abcdefg"
: (sub? '(d e f) "abcdefg")
-> "abcdefg"
(subr 'sym) -> num
Converts a Lisp-function that was previously converted with expr back to a SUBR function.
: car
-> 67313448
: (expr 'car)
-> (@ (pass $385260187))
: (subr 'car)
-> 67313448
: car
-> 67313448
(sum 'fun 'lst ..) -> num
Applies fun to each element of lst. When additional lst arguments are given, their elements are also passed to fun. Returns the sum of all numeric values returned from fun.
: (setq A 1  B 2  C 3)
-> 3
: (sum val '(A B C))
-> 6
: (sum * (3 4 5) (5 6 7))        # Vector dot product
-> 74
: (sum                           # Total size of symbol list values
   '((X)
      (and (pair (val X)) (size @)) )
   (what) )
-> 32021
(super ['any ..]) -> any
Can only be used inside methods. Sends the current message to the current object This, this time starting the search for a method at the superclass(es) of the class where the current method was found. See also OO Concepts, extra, method, meth, send and try.
(dm stop> ()         # 'stop>' method of current class
   (super)           # Call the 'stop>' method of the superclass
   ... )             # other things
(swap 'var 'any) -> any
Set the value of var to any, and return the previous value. See also xchg and set.
: (setq A 7  L (1 2 3))
-> (1 2 3)
: (swap (cdr L) (swap 'A 'xyz))
-> 2
: A
-> xyz
: L
-> (1 7 3)
(sym 'any) -> sym
Generate the printed representation of any into the name of a new symbol sym. This is the reverse operation of any. See also name and str.
: (sym '(abc "Hello" 123))
-> "(abc \"Hello\" 123)"
(sym? 'any) -> flg
Returns T when the argument any is a symbol. See also num?, atom, pair, str?, box? and ext?.
: (sym? 'a)
-> T
: (sym? NIL)
-> T
: (sym? 123)
-> NIL
: (sym? '(a b))
-> NIL
(symbols) -> lst
(symbols 'lst) -> lst
(symbols 'lst . prg) -> any
(symbols 'sym1 'sym2 ..) -> lst
Creates and manages namespaces of internal symbols: In the first form, the current list of namespaces is returned. In the second form, the current namespace list is set to lst, and the previous namespace list is returned. In the third form, the current namespace list is set to lst during the execution of prg, and the result is returned. In the fourth form, sym1 is initialized to a new namespace if its value is NIL and not modified otherwise, sym1, sym2 and all following arguments are set as the current namespace list, and if the value of the global variable *Dbg is non-NIL, the current line number and file name (if any) are stored in the *Dbg property of sym1. See also pico, nsp, -symbols, private, local, namespaces, shadows, export, import, intern and load.
: (symbols 'myLib 'pico)
-> (pico)
myLib: (de foo (X)
   (bar (inc X)) )
-> foo
myLib: (symbols 'pico)
-> (myLib pico)
: (pp 'foo)
(de foo . NIL)
-> foo
: (pp 'myLib~foo)
(de "foo" (X)
   ("bar" (inc X)) )
-> "foo"
: (symbols '(myLib pico))
-> (pico)
myLib: (pp 'foo)
(de foo (X)
   (bar (inc X)) )
-> foo
myLib:
(-symbols) -> lst
Command line frontend to symbols. Inserts the next command line argument as the first namespace into the current search order. --symbols myLib on the command line (see Invocation) is equivalent to -"symbols '(myLib ...)". See also opt.
$ ./pil lib/gis.l lib/simul.l  --symbols gis  --symbols simul  +
simul: (symbols)
-> (simul gis pico)
simul:
(sync) -> flg
Waits for pending data from all family processes. While other processes are still sending data (via the tell mechanism), a poll(2) system call is executed for all file descriptors and timers in the VAL of the global variable *Run. When used in a non-database context, (tell) should be called in the end to inform the parent process that it may grant synchronization to other processes waiting for sync. In a database context, where sync is usually called by dbSync, this is not necessary because it is done internally by commit or rollback. See also key and wait.
: (or (lock) (sync))       # Ensure database consistency
-> T                       # (numeric process-id if lock failed)
(sys 'any ['any]) -> sym
Returns or sets a system environment variable.
: (sys "TERM")  # Get current value
-> "xterm"
: (sys "TERM" "vt100")  # Set new value
-> "vt100"
: (sys "TERM")
-> "vt100"
(sysdefs 'sym1 '[sym2])
Loads system-dependent definitions for all symbols in the section named sym1 from the file "@lib/sysdefs" (or an alternative file given by sym2). All symbols in that section are defined to their given values. See also native.
: (sysdefs "networking")  # Load networking system definitions