# PicoLisp has no special string type. Instead, symbols are used. Syntactically, # "transient" symbols resemble strings in other languages. Also, there is no # separate character type. Instead, characters are represented by strings of # length 1 (using 1 .. 3 bytes (UTF-8)). #----------------------------- (setq String "^J") # a newline character (setq String "\^J") # two characters, '^' and 'J' #----------------------------- : "Jon \"Maddog\" Orwant" # literal double quotes -> "Jon \"Maddog\" Orwant" # Single quotes do not delimit strings, and are not special inside strings #----------------------------- : "This is a multiline string containing a newline" -> "This is a multiline string^Jcontaining a newline" : "This is a multiline string \ without a newline" -> "This is a multiline string without a newline" #----------------------------- |
# First 'chop' the string to convert it to a list of characters, and then use # the rich set of list processing functions. Optionally, you can 'pack' the # result to a string (not necessary in many cases, as many functions that expect # a string also accept a list of characters). #----------------------------- # get a 5-byte string, skip 3, then grab 2 8-byte strings, then the rest : (let S (chop "This is a suitable string") (prinl (cut 5 'S)) (cut 3 'S) (prinl (cut 8 'S)) (prinl (cut 8 'S)) (prinl S) ) This a suitab le strin g #----------------------------- # split at five byte boundaries : (make (for (S (chop "This is what you have") S) (link (pack (cut 5 'S))) ) ) -> ("This " "is wh" "at yo" "u hav" "e") #----------------------------- (let S (chop "This is what you have") (prinl (car S)) (prinl (tail 2 (head 4 S))) (prinl (tail -13 S)) (prinl (tail 1 S)) (prinl (tail 4 S)) (prinl (head 3 (tail 8 S))) ) T is you have e have you #----------------------------- # You can test for substrings with 'pre?' and 'sub?' : (pre? "a" "abc") -> "abc" : (sub? "bc" "abcdef") -> "abcdef" : (sub? "x" "abc") -> NIL # or use the 'match' function : (match '("a" "b" @X "d" "e") (chop "abcde")) -> T : @X -> ("c") #----------------------------- # substitute "at" for "is", restricted to first five characters : (match '(@A "i" "s" @Z) (head 5 (chop "Me is You"))) (pack @A "at" @Z) -> "Me at" #----------------------------- # exchange the first and last letters in a string : (let S (chop "make a hat") (xchg S (tail 1 S)) (pack S) ) -> "take a ham" #----------------------------- # extract column : (pack (tail 6 (head 12 (chop "To be or not to be")))) -> "or not" #----------------------------- # skip every second character : (pack (filter prog2 (chop "To be or not to be") '(T NIL .))) -> "T eo o ob" #----------------------------- |
#----------------------------- # Use B if B is true, else C (setq A (or B C)) # set X to Y unless X is already true (default X Y) #----------------------------- # use B if B is defined, else C (setq A (or (fun? B) C)) (def 'A (or (fun? B) C)) #----------------------------- (setq Dir (or (opt) "/tmp")) #----------------------------- (setq Dir (if (argv) (car @) "/tmp")) #----------------------------- # find the user name on Unix systems (setq User (or (sys "USER") (sys "LOGNAME") (native "@" "getlogin" 'S) # 'native' only in 64-bits (car (native "@" "getpwuid" '(S) UserID)) (pack "Unknown uid number " UserID) ) ) #----------------------------- : (default StartingPoint "Greenwich") -> "Greenwich" #----------------------------- (setq A (if B B C)) # assign B if nonempty, else C #----------------------------- |
#----------------------------- (xchg 'Var1 'Var2) #----------------------------- (setq Temp A A B B Temp) #----------------------------- (setq A "alpha" B "omega") (xchg 'A 'B) #----------------------------- : (setq Alpha 'January Beta 'March Production 'August) -> August : (setq Alpha Beta Beta Production Production Alpha) -> March : Alpha -> March : Beta -> August #----------------------------- |
#----------------------------- (char Character) -> Number (char Number) -> Character #----------------------------- : (let Num 101 (prinl "Number " Num " is character " (char Num)) ) Number 101 is character e -> "e" #----------------------------- : (mapcar char (chop "sample")) -> (115 97 109 112 108 101) : (pack (mapcar char (115 97 109 112 108 101))) -> "sample" #----------------------------- : (pack (mapcar '((C) (char (inc (char C)))) (chop "HAL") ) ) -> "IBM" #----------------------------- |
#----------------------------- (for Char (chop String) (doSomethingWith Char) ) #----------------------------- : (prinl "unique chars are: " (sort (uniq (chop "an apple a day")))) unique chars are: adelnpy # Analog to Perl : (let Seen NIL (for C (chop "an apple a day") (accu 'Seen C 1) ) (pack (sort (mapcar car Seen))) ) -> " adelnpy" #----------------------------- : (sum char (chop "an apple a day")) -> 1248 #----------------------------- # download the following standalone program #!/usr/bin/picolisp /usr/lib/picolisp/lib.l # sum - compute 16-bit checksum of all input files (let Sum 0 (while (opt) (in @ (while (char) (inc 'Sum (char @))) ) ) (println (% Sum 65535)) ) (bye) #----------------------------- $ ./sum lib.l lib/misc.l 52659 #----------------------------- # download the following standalone program #!/usr/bin/picolisp /usr/lib/picolisp/lib.l # slowcat - emulate a s l o w line printer # usage: slowcat [-DELAY] [files ...] (let Delay (ifn (lt0 (format (car (argv)))) 1 (opt) (- @)) (for F (argv) (for C (in F (till)) (prin C) (wait (* 5 Delay)) ) ) ) (bye) #----------------------------- |
#----------------------------- (setq RevChars (flip (chop String)) RevWords (glue " " (flip (split (chop String) " "))) ) #----------------------------- # reverse word order : (glue " " (flip (split (chop "Yoda said, \"can you see this?\"") " ") ) ) -> "this?\" see you \"can said, Yoda" #----------------------------- : (de palindrome? (S) (= (setq S (chop S)) (reverse S)) ) : (palindrome? "reviver") -> T #----------------------------- : (in "/usr/share/dict/words" (until (eof) (let L (line) (and (> (length L) 5) (= L (reverse L)) (prinl L) ) ) ) ) deified redder #----------------------------- |
#----------------------------- (let Str (line) (use (@A @Z) # Expand tabs (while (match '(@A "^I" @Z) Str) (setq Str (conc @A (need (- 8 (% (length @A) 8)) " ") @Z ) ) ) ) Str ) #----------------------------- (let Str (line) (make # Compress tabs (while (nth Str 9) (let S (trim (cut 8 'Str)) (chain S) (or (= 8 (length S)) (link "^I")) ) ) (and Str (chain @)) ) ) #----------------------------- |
#----------------------------- : (let Dept 123 (prinl "You owe " Dept " to me.") (pack "You owe " Dept " to me.") ) You owe 123 to me. -> "You owe 123 to me." #----------------------------- : (text "I am @1 high and @2 long" 24 80) -> "I am 24 high and 80 long" #----------------------------- (let (@Rows 24 @Cols 80) (fill '(I am @Rows high and @Cols long)) ) -> (I am 24 high and 80 long) #----------------------------- # expand variables in 'Lst', but put an error message in # if the variable isn't defined (let (@Rows 24 Lst '(I am @Rows high and @Cols long)) (for Var (fish pat? Lst) (unless (val Var) (set Var (pack "[NO VARIABLE: " Var "]")) ) ) (fill Lst) ) -> (I am 24 high and "[NO VARIABLE: @Cols]" long) #----------------------------- |
#----------------------------- : (uppc "bo peep") -> "BO PEEP" : (lowc "JOHN") -> "john" : (let S (chop "dromedary") (pack (uppc (car S)) (cdr S))) -> "Dromedary" #----------------------------- # capitalize each word's first character, downcase the rest (let Str "thIS is a loNG liNE" (glue " " (mapcar '((W) (cons (uppc (car W)) (mapcar lowc (cdr W)))) (split (chop Str) " ") ) ) ) -> "This Is A Long Line" #----------------------------- (when (= (uppc A) (uppc B)) (prinl "A and B are the same") ) #----------------------------- # download the following standalone program #!/usr/bin/picolisp /usr/lib/picolisp/lib.l # randcap: filter to randomly capitalize 20% of the letters (in NIL (while (char) (let C @ (prin (if (=0 (rand 0 4)) (uppc C) C)) ) ) ) (bye) #----------------------------- |
#----------------------------- : (let N 7 (prinl "I have " (+ N 2) " guanacos.") (pack "I have " (+ N 2) " guanacos.") ) I have 9 guanacos. -> "I have 9 guanacos." #----------------------------- : (let N 7 (text "I have @1 guanacos." (+ N 2)) ) #----------------------------- (mail "localhost" 25 "Your Bank" Naughty "Subject" (prinl "Dear " Naughty) "" (prinl "Today, you bounced check number " (+ 500 (rand 0 99)) " to us.") "Your account is now closed." "" "Sincerely," "the management" ) #----------------------------- |
#----------------------------- (de myhere (Target) # The built-in 'here' cannot be used (char) (setq Target (chop Target)) (make (for (L (line) (and L (<> L Target)) (line)) (link L) ) ) ) #----------------------------- (setq Var (mapcar clip (myhere "HERE_TARGET"))) your text goes here HERE_TARGET # or with two steps (setq Var (myhere "HERE_TARGET")) your text goes here HERE_TARGET (setq Var (mapcar clip Var)) #----------------------------- (prinl "Here's your poem:") (prinl) (let (Str (prog (char) (line)) Cnt 1) (for (S Str (and S (sp? (car S))) (cdr S)) (inc 'Cnt) ) (loop (prinl (nth Str Cnt)) (T (eof)) (setq Str (line)) (T (= '`(chop "EVER_ON_AND_ON") Str)) ) ) Now far ahead the Road has gone, And I must follow, if I can, Pursuing it with eager feet, Until it joins some larger way Where many paths and errands meet. And whither then? I cannot say. --Bilbo in /usr/src/perl/pp_ctl.c EVER_ON_AND_ON #----------------------------- |
#----------------------------- # download the following standalone program #!/usr/bin/picolisp /usr/lib/picolisp/lib.l (load "@lib/misc.l") (let Input (chop (wrap 17 (conc (need 4 " ") (chop "Folding and splicing is the work of an editor, \ not a mere collection of silicon \ and \ mobile electrons!" ) ) ) ) (prinl (replace Input "^J" "^J ")) ) (bye) #----------------------------- |
#----------------------------- # backslash : (let (CharList '(a d g) Str "abcdefghi") (pack (mapcar '((C) (pack (and (member C CharList) "\\") C)) (chop Str) ) ) ) -> "\\abc\\def\\ghi" # double : (let (CharList '(a d g) Str "abcdefghi") (pack (mapcar '((C) (pack (and (member C CharList) C) C)) (chop Str) ) ) ) -> "aabcddefgghi" #----------------------------- |
#----------------------------- (trim (chop String)) # Remove trailing white space (clip (chop String)) # Remove white space from both ends #----------------------------- # print what's typed, but surrounded by >< symbols (in NIL (until (eof) (prinl ">" (clip (line)) "<") ) ) #----------------------------- |
#----------------------------- (for (I . Line) (let *Uni T (str "XYZZY,\"\",\"O'Reilly, Inc\",\"Wall, Larry\",\"a \ \\\"glug\\\" bit,\",5, \"Error, Core Dumped\"" ) ) (prinl I " : " Line) ) 1 : XYZZY 2 : 3 : O'Reilly, Inc 4 : Wall, Larry 5 : a "glug" bit, 6 : 5 7 : Error, Core Dumped #----------------------------- |
#----------------------------- # download the following standalone program #!/usr/bin/picolisp /usr/lib/picolisp/lib.l (load "@lib/misc.l") (de soundex (Str) (pack (pad -4 (cons (uppc (char (char Str))) (head 3 (let Last NIL (extract '((C) (and (setq C (case (uppc C) (`(chop "BFPV") "1") (`(chop "CGJKQSXZ") "2") (("D" "T") "3") ("L" "4") (("M" "N") "5") ("R" "6") ) ) (<> Last C) (setq Last C) ) ) (cdr (chop Str)) ) ) ) ) ) ) ) (prin "Lookup user: ") (flush) (let (User (clip (in NIL (line T))) Code (soundex User)) (while (native "@" "getpwent" '(S S I I S S S)) # 'native' only in 64-bits (let Lst @ (when (or (= Code (soundex (car Lst))) (= Code (soundex (get Lst 5)))) (println Lst) ) ) ) ) (bye) #----------------------------- $ ./soundexUsers Lookup user: sshd ("sshd" "x" 71 65 "SSH daemon" "/var/lib/sshd" "/bin/false") #----------------------------- |
#----------------------------- # download the following standalone program #!/usr/bin/picolisp /usr/lib/picolisp/lib.l # Use: ./fixstyle [-v] <infile >outfile (and (= "-v" (opt)) (on *Verbose)) (de Data ("analysed" . "analyzed") ("built-in" . "builtin") ("chastized" . "chastised") ("commandline" . "command-line") ("de-allocate" . "deallocate") ("dropin" . "drop-in") ("hardcode" . "hard-code") ("meta-data" . "metadata") ("multicharacter" . "multi-character") ("multiway" . "multi-way") ("non-empty" . "nonempty") ("non-profit" . "nonprofit") ("non-trappable" . "nontrappable") ("pre-define" . "predefine") ("preextend" . "pre-extend") ("re-compiling" . "recompiling") ("reenter" . "re-enter") ("turnkey" . "turn-key") ) (in NIL (while (apply echo '`(mapcar car Data)) (let (Key @ Val (get Data Key)) (when *Verbose (out 2 (prinl Key " => " Val)) ) (prin Val) ) ) ) (bye) #----------------------------- |
#----------------------------- # download the following standalone program #!/usr/bin/picolisp /usr/lib/picolisp/lib.l # Use: psgrep 'lisp-expression' # # Takes a single optional argument: # An arbitrary lisp expression without the outermost parentheses # # For example: # psgrep '= "Ss+" STAT' # psgrep 'and (> SIZE 10000) (= TT "tty1")' # psgrep 'member UID (101 102 104 106)' # # The variables (case-sensitive!) have the # same names as the column headers (load "@lib/misc.l") (de PsFields (F 1 "flags" NIL (read)) (UID 6 "uid" NIL (read)) (PID 6 "pid" NIL (read)) (PPID 6 "ppid" NIL (read)) (PRI 4 "pri" NIL (read)) (NI 4 "nice" NIL (read)) (NIL 1) (SIZE 5 "size" NIL (read)) (NIL 1) (RSS 5 "rss" NIL (read)) (NIL 1) (WCHAN -7 "wchan" NIL (skip) (till " " T)) (STAT -5 "stat" NIL (skip) (till " " T)) (TT -9 "tty" NIL (skip) (till " " T)) (TIME 8 "time" (tim$ TIME T) (skip) ($tim (till " " T))) (NIL 1) (COMMAND -30 "command" NIL (char) (line T)) ) (let Cond (or (str (opt)) T) (in (list 'ps "hax" "-o" (glue "," (extract caddr PsFields))) (let Fmt (mapcar cadr PsFields) (apply tab (mapcar car PsFields) Fmt) (bind (mapcar car PsFields) (until (eof) (for Fld PsFields (when (car Fld) (set @ (run (cddddr Fld))) ) ) (when (eval Cond) (apply tab (mapcar '((Fld) (or (eval (cadddr Fld)) (val (car Fld)))) PsFields ) Fmt ) ) ) ) ) ) ) (bye) #----------------------------- |