PLEAC examples - 1. Strings

1.0. Introduction

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)).

1.0.1. The Newline character

   : (setq String "^J")
   -> "^J"

References setq

1.0.2. The Escape character

   : (setq String "^[")
   -> "^["

References setq

1.0.3. Literal strings go in double quotes

   : "Jon Maddog Orwant"
   -> "Jon Maddog Orwant"

1.0.4. Single quotes

Single quotes don't delimit strings and are not special inside strings

   : "This is a ' single quote!"
   -> "This is a ' single quote!"

1.0.5. Multiline 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"

1.1. Accessing substrings

You want to access or modify just a portion of a string, not the whole thing. For instance, you've read a fixed-width record and want to extract the individual fields.

1.1.1. Example

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).

   : (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
   -> ("g")

References chop cut let prinl

1.1.2. 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")

References chop cut for link make pack

1.1.3. Usage of 'car', 'head' and 'tail' to get a substring

   : (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
   -> ("y" "o" "u")

References car chop head let prinl tail

1.1.4. Test for substrings with 'pre?' and 'sub?'

   : (pre? "a" "abc")
   -> "abc"

   : (sub? "bc" "abcdef")
   -> "abcdef"

   : (sub? "x" "abc")
   -> NIL

References pre? sub?

1.1.5. Use the 'match' function

   : (match '("a" "b" @X "d" "e") (chop "abcde"))
   -> T

   : @X
   -> ("c")

Note: the '@' character is a 'wildcard" used by 'match'.

References chop match pat?

1.1.6. 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"

Note: the '@' character is a 'wildcard" used by 'match'.

References chop head match pack pat?

1.1.7. 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"

References chop let pack tail xchg

1.1.8. Extract column

   : (pack (tail 6 (head 12 (chop "To be or not to be"))))
   -> "or not"

References chop head pack tail

1.1.9. Skip every second character

   : (pack (filter prog2 (chop "To be or not to be") '(T NIL .)))
   -> "T eo o ob"

References chop filter pack prog2

1.1.10. Defining a sub-string function: A silly/fun exercise

Before we get to the definitions, here are some usage examples.

   : (substring "Hello, world" 8)
   -> "world"
   : (substring "Hello, world" 8 3)
   -> "wor"

First attempt at a definition.

   (de substring (Str Start Len)
      (pack
         (head
            (or Len (length Str))
            (nth (chop Str) Start) ) ) )

References pack head length nth chop

After consulting with abu, who mentioned that head and length are expensive and should be avoided if possible (to make the function more performant), here is another attempt (mostly abu's ideas: e.g., the use of con).

   (de substring (Str Start Len)
      (let L (nth (chop Str) Start)
         (and Len (con (nth L Len)))
         (pack L) ) )

References pack nth chop con

1.2. Establishing a Default Value

You would like to give a default value to a scalar variable, but only if it doesn't already have one. It often happens that you want a hard-coded default value for a variable that can be overridden from the command-line or through an environment variable.

1.2.1. Use B if B is true, else C

   : (setq B NIL)
   -> NIL

   : (setq C NIL)
   -> NIL

   : (setq A (or B C))
   -> NIL

   : (setq B T)
   -> T

   : (setq A (or B C))
  -> T

References or setq

1.2.2. Set X to Y unless X is already true

   : X
   -> NIL

   : Y
   -> NIL

   : (setq Y 42)
   -> 42

   : (default X Y)
   -> 42

   : X
   -> 42

   : (setq Y 11)
   -> 11

   : (default X Y)
   -> 42

   : X
   -> 42

References default setq

1.2.3. Use function B if it is a valid function, else use C

   : B
   -> NIL

   : C
   -> NIL

   : (setq A (or (fun? B) C))
   -> NIL                 # The value of C, because B is not a valid function

   : (de B (x) (println x))
   -> B

   : (de C (y) (println y))
   -> C

   : (setq A (or (fun? B) C))
   -> (x)                 # Argument list of B, because it is a valid function

   : A
   -> (x)

   : (setq B NIL)
   -> NIL

   : (setq A (or (fun? B) C))
   -> ((y) (println y))

   : A
   -> ((y) (println y))   # Value of C, since B is not a valid function

   : (def 'A (or (fun? B) C))
   -> A

   : A
   -> ((y) (println y))   # Value of C, since B is not a valid function

References de def fun? or println setq

1.2.4. Use a value if (an) argument(s) is/are specified to the script

   : (opt)
   -> NIL

   : (setq Dir (or (opt) "/tmp"))
   -> "/tmp"

   : Dir
   -> "/tmp"

   : (setq Dir (if (argv) (car @) "/tmp"))
   -> "/tmp"

   : Dir
   -> "/tmp"

References argv car if opt or setq

1.2.5. Find the user name on Unix systems, depending on values

   : (sys "USER")
   -> "arie"

   : (sys "LOGNAME")
   -> "arie"

   : (native "@" "getlogin" 'S)
   -> NIL

   : (car (native "@" "getpwuid" '(S) UserID))
   -> NIL

   : (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) ) )
   -> "arie"

References car native or pack setq sys

1.2.6. Use defaults for uninitialized function parameters

   : (de foo (A B)
      (default  A 1  B 2)
      (list A B) )
   -> foo

   : (foo)
   -> (1 2)

   : (foo NIL NIL)
   -> (1 2)

   : (foo 11)
   -> (11 2)

   : (foo 11 NIL)
   -> (11 2)

   : (foo NIL 12)
   -> (1 12)

   : (foo 11 12)
   -> (11 12)

References de default list

1.2.7. Bind value depending on "empty" or NIL status of a variable

   : B
   -> NIL

   : C
   -> NIL

   : (setq A (if B B C))
   -> NIL

   : A
   -> NIL

   : (setq B 100)
   -> 100

   : (setq A (if B B C))
   -> 100

   : A
   -> 100

   : (setq B NIL)
   -> NIL

   : (setq C 300)
   -> 300

   : (setq A (if B B C))
   -> 300

   : A
   -> 300

References if setq

1.3. Exchange values without using temporary variables

You want to exchange the values of two scalar variables, but don't want to use a temporary variable.

1.3.1. Using the 'xchg' function

   : (setq Var1 "first")
   -> "first"

   : (setq Var2 "second")
   -> "second"

   : (xchg 'Var1 'Var2)
   -> "first"

   : Var1
   -> "second"

   : Var2
   -> "first"

References setq xchg

1.3.2. Using 'setq' (now we need a temporary variable)

   : (setq A "first")
   -> "first"

   : (setq B "second")
   -> "second"

   : (setq Temp A  A B  B Temp)
   -> "first"

   : Temp
   -> "first"

   : A
   -> "second"

   : B
   -> "first"

References setq

1.4. Converting Between ASCII Characters and Values

You want to print out the number represented by a given ASCII character, or you want to print out an ASCII character given a number.

1.4.1. Simple conversion

   : (char "x")
   -> 120

   : (char 120)
   -> "x"

References char

1.4.2. Convert a string of characters

   : (mapcar char (chop "sample"))
   -> (115 97 109 112 108 101)

   : (pack (mapcar char (115 97 109 112 108 101)))
   -> "sample"

   # Remember the movie "Space Odyssee"?
   : (pack
      (mapcar
         '((C) (char (inc (char C))))
         (chop "HAL") ) )
   -> "IBM"

References char chop inc mapcar pack

1.5. Processing a String One Character at a Time

You want to process a string one character at a time.

1.5.1. Iterate over a string

   : (setq S "google")
   -> "google"

   : (for Char (chop S)
      (println Char))
   "g"
   "o"
   "o"
   "g"
   "l"
   "e"
   -> "e"

References chop for println setq

1.5.2. Find unique chars in a string

   : (prinl "unique chars are: " (sort (uniq (chop "an apple a day"))))
   unique chars are:  adelnpy
   -> (" " "a" "d" "e" "l" "n" "p" "y")

   : (let Seen NIL
      (for C (chop "an apple a day")
         (accu 'Seen C 1) )
      (pack (sort (mapcar car Seen))) )
   -> " adelnpy"

References accu car chop for let mapcar pack prinl sort uniq

1.5.3. Total ASCII value of a string

   : (sum char (chop "an apple a day"))
   -> 1248

References char chop sum

1.5.4. Compute 16-bit checksum of all input files

Store the script below in a script file named "sum":

#!/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)

Then execute the following commands in the shell:

chmod 777 sum
./sum /usr/lib/picolisp/lib.l /usr/share/picolisp/lib/misc.l

This sums the ASCII values of all characters in the 2 files "lib.l" and "misc.l". The outcome may vary, because PicoLisp is actively being updated!

References bye char in inc let opt println while

1.5.5. Emulate a slow line printer

Store the script below in a script file named "slowcat":

#!/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 (* 30 Delay)) ) ) )

(bye)

Then execute the following commands in the shell:

chmod 777 slowcat
./slowcat /usr/lib/picolisp/lib.l /usr/share/picolisp/lib/misc.l

This *slowly* prints the files "lib.l" and "misc.l". Note: you always can use Ctrl-c :-)

References * argv car for format ifn in let lt0 opt prin till wait

1.6. Reversing a String by Word or Character

You want to reverse the characters or words of a string.

1.6.1. Example

(setq
   RevChars (flip (chop String))
   RevWords (glue " " (flip (split (chop String) " "))) )

References chop flip glue setq split

1.6.2. Reverse word order

   : (glue " "
      (flip
         (split (chop "Yoda said, "can you see this?"") " ") ) )
   -> "this?" see you "can said, Yoda"

References chop flip glue split

1.6.3. Check if a word is a valid palindrome

   : (de palindrome? (S)
      (= (setq S (chop S)) (reverse S)) )
   -> palindrome?

   : (palindrome? "reviver")
   -> T

   # The longest Dutch palindrome I know of ... :)
   : (palindrome? "nelliplaatstopnparterretrapnpotstaalpillen")
   -> T

References = chop de reverse setq

1.6.4. Fetch palindromes from file (skip lines < 5 characters

Create the example file pfiletest (source):

abc
asantadoglivedasadevilgodatnasa
peep
amenicycinema
level
godlivesevildog
madamenotonemanisselflessInamenotonemadam

Use it for the example:

   : (in "pfiletest"
      (until (eof)
         (let L (line)
            (and
               (> (length L) 5)
               (= L (reverse L))
               (prinl L) ) ) ) )
   asantadoglivedasadevilgodatnasa
   amenicycinema
   godlivesevildog
   -> NIL

References = > and eof in length let line prinl reverse until

1.7. Expanding and Compressing Tabs

You want to convert tabs in a string to the appropriate number of spaces, or vice versa. Converting spaces into tabs can be used to reduce file size when the file has many consecutive spaces. Converting tabs into spaces may be required when producing output for devices that don't understand tabs or think they're at different positions than you do.

1.7.1. Expand tabs

Note that the 'line' function reads a line from the current input channel. In this case that is STDIN.

   : (let Str (line)
         (use (@A @Z)
            (while (match '(@A "^I" @Z) Str)
               (setq Str
                  (conc
                     @A
                     (need (- 8 (% (length @A) 8)) " ")
                     @Z ) ) ) )
         Str )
      a    b    c
   -> (" " " " " " "a" " " " " " " " " "b" " " " " " " " " "c")

References - % conc let line match need setq use while

1.7.2. Compress tabs

   : (let Str (line)
        (make
           (while (nth Str 9)
              (let S (trim (cut 8 'Str))
                 (chain S)
                 (or (= 8 (length S)) (link "^I")) ) )
        (and Str (chain @)) ) )
           a        b        c
   -> ("^I" "a" "^I" "b" "^I" "c")

References = and chain cut length let line link make or trim while

1.8. Expanding Variables in User Input

You've read in a string like "You owe $debt to me" and you want to replace $debt in the string with the value of a variable named '$debt'.

1.8.1. Using 'prinl' or 'pack'

   : (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."

References let pack prinl

1.8.2. Using 'text'

   : (text "I am @1 high and @2 long" 24 80)
   -> "I am 24 high and 80 long"

References text

1.8.3. Using 'fill'

   : (let (@Rows 24  @Cols 80)
      (fill '(I am @Rows high and @Cols long)) )
   -> (I am 24 high and 80 long)

References fill let

1.8.4. With as extra a check for uninitialized variables

   : (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)

References fill fish for let pack pat? set unless

1.9. Controlling Case

A string in uppercase needs converting to lowercase, or vice versa.

1.9.1. Example

   : (uppc "bo peep")
   -> "BO PEEP"

   : (lowc "JOHN")
   -> "john"

References lowc uppc

1.9.2. Make first letter of string uppercase

   : (let S (chop "dromedary") (pack (uppc (car S)) (cdr S)))
   -> "Dromedary"

References car cdr chop let pack uppc

1.9.3. Make first letter of each word uppercase and the rest lowercase

   : (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"

References car cdr chop cons glue let lowc mapcar split uppc

1.9.4. Compare two strings ignoring their case

   : (setq A "Elephant")
   -> "Elephant"

   : (setq B "ElEpHaNt")
   -> "ElEpHaNt"

   : (when (= (uppc A) (uppc B))
      (prinl "A and B are the same") )
   A and B are the same
   -> "A and B are the same"

References = prinl setq uppc when

1.9.5. Randowmly capitalize 20% of the letters in a file

Create the example file 'captest':

Curtains forcing their will
against the wind,
children sleep,
exchanging dreams with
seraphim. The city
drags itself awake on
subway straps; and
I, an alarm, awake as a
rumor of war,
lie stretching into dawn,
unasked and unheeded.
-- Poem by Maya Angelou

Use it for the example:

   :    (in "captest"
         (while (char)
            (let C @
               (prin (if (=0 (rand 0 4)) (uppc C) C)) ) ) )
   CurtaiNs fOrcing their will
   aGAINST the wiNd,
   chilDreN sleep,
   Exchanging drEAms wiTh
   serAphim. The city
   drags itseLf awake on
   sUbwAy strAPs; and
   I, an alarM, awAke as a
   rumor of war,
   lIE strEtching iNto dawn,
   unasked and UnheEded.
   -- PoeM by Maya AngeloU
   -> "^J"

References =0 if in let prin rand uppc while

1.10. Interpolating Functions and Expressions

You want a function call or expression to expand within a string. This lets you construct more complex templates than with simple scalar variable interpolation.

1.10.1. Using 'prinl' and 'pack'

   : (let N 7
      (prinl "I have " (+ N 2) " guanacos.")
      (pack "I have " (+ N 2) " guanacos.") )
   I have 9 guanacos.
   -> "I have 9 guanacos."

References + let pack prinl

1.10.2. Using 'text'

   : (let N 7
      (text "I have @1 guanacos." (+ N 2)) )
   -> "I have 9 guanacos."

References + let text

1.11. Indenting Here Documents

When using the multiline quoting mechanism called a here document, the text must be flush against the margin, which looks out of place in the code. You would like to indent the here document text in the code, but not have the indentation appear in the final string value.

1.11.1. Using our own function definition

   : (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) ) ) )
   -> myhere

   # In one step ...

   : (setq Var (mapcar clip (myhere "HERE_TARGET")))
   line 1
   line 2
   line 3
   HERE_TARGET
   -> (("i" "n" "e" " " "1") ("l" "i" "n" "e" " " "2") ("l" "i" "n" "e" " " "3"))

   # In two steps ...

   # Step 1
   : (setq Var (myhere "HERE_TARGET"))
   line 1
   line 2
   line 3
   HERE_TARGET
   -> (("i" "n" "e" " " "1") ("l" "i" "n" "e" " " "2") ("l" "i" "n" "e" " " "3"))

   # Step 2
   : (setq Var (mapcar clip Var))
   -> (("i" "n" "e" " " "1") ("l" "i" "n" "e" " " "2") ("l" "i" "n" "e" " " "3"))

References <> and char chop clip de for line link make mapcar setq

1.11.2. Echo the poem until end of doc

   : (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,
   Now far ahead the Road has gone,
      And I must follow, if I can,
      And I must follow, if I can,
   Pursuing it with eager feet,
   Pursuing it with eager feet,
      Until it joins some larger way
      Until it joins some larger way
   Where many paths and errands meet.
   Where many paths and errands meet.
      And whither then? I cannot say.
      And whither then? I cannot say.
            --Bilbo in /usr/src/perl/pp_ctl.c
            --Bilbo in /usr/src/perl/pp_ctl.c
EVER_ON_AND_ON
-> NIL

References = and car cdr char chop eof for inc let line loop prinl prog sp?

1.12. Reformatting Paragraphs

Your string is too big to fit the screen, and you want to break it up into lines of words, without splitting a word between lines. For instance, a style correction script might read a text file a paragraph at a time, replacing bad phrases with good ones. Replacing a phrase like utilizes the inherent functionality of with uses will change the length of lines, so it must somehow reformat the paragraphs when they're output.

1.12.1. Example

   : (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  ")) )
       Folding and
     splicing is the
     work of an
     editor, not a
     mere collection
     of silicon and
     mobile electrons!
   -> (" " " " " " " " "F" "o" "l" "d" "i" "n" "g" " " "a" "n" "d" "^J  " "s" "p" "l" "i" "c" "i" "n" "g" " " "i" "s" " " "t" "h" "e" "^J  " "w" "o" "r" "k" " " "o" "f" " " "a" "n" "^J  " "e" "d" "i" "t" "o" "r" "," " " "n" "o" "t" " " "a" "^J  " "m" "e" "r" "e" " " "c" "o" "l" "l" "e" "c" "t" "i" "o" "n" "^J  " "o" "f" " " "s" "i" "l" "i" "c" "o" "n" " " "a" "n" "d" "^J  " "m" "o" "b" "i" "l" "e" " " "e" "l" "e" "c" "t" "r" "o" "n" "s" "!")

References chop conc let need prinl replace wrap

1.13. Escaping Characters

You need to output a string with certain characters (quotes, commas, etc.) escaped. For instance, you're producing a format string for sprintf and want to convert literal % signs into %%.

1.13.1. Add in front of characters in Str that are also in CharList

   : (let (CharList '(a d g)  Str "abcdefghi")
      (pack
         (mapcar
            '((C) (pack (and (member C CharList) "\") C))
            (chop Str) ) ) )
   -> "\abc\def\ghi"

References and chop let mapcar member pack

1.13.2. Duplicate each character in Str that is also present in Charlist

   : (let (CharList '(a d g)  Str "abcdefghi")
      (pack
         (mapcar
            '((C) (pack (and (member C CharList) C) C))
            (chop Str) ) ) )
   -> "aabcddefgghi"

References and chop let mapcar member pack

1.14. Trimming Blanks from the End of a String

You have read a string that may have leading or trailing whitespace, and you want to remove it.

1.14.1. Remove trailing whitespace

   : (setq String "  abcde   ")
   -> "  abcde   "

   : (trim (chop String))
   -> (" " " " "a" "b" "c" "d" "e")

References chop setq trim

1.14.2. Echo the typed input between > and <

   : (in NIL
      (until (eof)
         (prinl ">" (clip (line)) "<") ) )
   abc
   >abc<
                 def
   >def<

References clip in eof line prinl until

1.15. Parsing Comma-Separated Data

You have a data file containing comma-separated values that you need to read in, but these data fields may have quoted commas or escaped quotes in them.

Most spreadsheets and database programs use comma-separated values as a common interchange format.

1.15.1. Example

   : (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
   -> "Error, Core Dumped"

References for let prinl str

1.16. Soundex Matching

You have two English surnames and want to know whether they sound somewhat similar, regardless of spelling.

This would let you offer users a "fuzzy search" of names in a telephone book or with a search engine like Google, to catch "Smith" and "Smythe" and others within the set, such as "Smite" and "Smote."

Note that the soundex algoritm differs for each human language!

Note that PicoLisp also has a builtin soundex function (ext:snx). But here another version is shown.

1.16.1. Example

   : (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)) ) ) ) ) ) ) )
   -> soundex

   # Check soundex for a few similar sounding strings

   : (soundex "Hello World")
   -> "H464"

   : (soundex "Hallo World")
   -> "H464"

   : (soundex "Smith")
   -> "S530"

   : (soundex "Smithe")
   -> "S530"

   : (soundex "Smyithe")
   -> "S530"

   # The following example calls the native Linux function 'getenv'
   # in order to fetch the hostname from it (env variable = NAME).
   # Then it reads user input (a guess for the hostname) in this case 'hp-erie'.
   # Then it shows if it is a Soundex match or not!

   : (flush)
   -> T

   : (let (InHostname (clip (in NIL (line T))) InHostnameSoundex (soundex InHostname))
      (println "InHostname:" InHostname " InHostnameSoundex:" InHostnameSoundex)
      (when (native "@" "getenv" 'S "NAME")
         (let (EnvHostname @ EnvHostnameSoundex (soundex EnvHostname))
            (if (= InHostnameSoundex EnvHostnameSoundex)
               (println "MATCH!!!: EnvHostname:" EnvHostname "EnvHostnameSoundex:" EnvHostnameSoundex)
               (println "NO MATCH: EnvHostname:" EnvHostname "EnvHostnameSoundex:" EnvHostnameSoundex)))))
   hp-erie
   "InHostname:" "hp-erie" " InHostnameSoundex:" "H160"
   "MATCH!!!: EnvHostname:" "HP-Arie" "EnvHostnameSoundex:" "H160"
   -> "H160"

Note: (sys "NAME") == (native "@" "getenv" 'S "NAME")

References <> and case cdr char chop cons de extract head let pack pad setq uppc

1.17. Fix spelling of words in a file given a map (here called Data)

Words are often written in a wrong way. Here we show a word together with its correct spelling.

1.17.1. Example

First create the following script and name it 'fixstyle'.

#!/usr/bin/picolisp /usr/lib/picolisp/lib.l
# Use: ./fixstyle [-v]

(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)

Then execute the following in the Linux shell:

chmod 777 fixstyle
./fixstyle

The program waits for input. Enter a few words, also some in the Data list above on the left side, e.g.:

hello
reenter
trash
pre-define
exit

Also try in the shell:

./fixstyle -v

and see what happens!

References = and apply bye car de echo get in let mapcar on opt out prin prinl when while

1.18. Use Lisp expressions to 'grep' lines from output of Linux 'ps' command

Create a program which extract specific lines of the output of the Linux command 'ps', which shows Linux processes.

1.18.1. Example

First create the following script and name it 'psgrep'.

#!/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)

Then execute the following commands in the Linux shell:

chmod 777 psgrep
psgrep '= "Ss+" STAT'
psgrep 'and (> SIZE 10000) (= TT "tty1")'
psgrep 'member UID (101 102 104 106)'

Note: results on Windows WSL are not valid.

References apply bind bye cadddr caddr cadr car cddddr cond de eof eval extract for glue in let list load mapcar opt or run set str tab until val when

http://picolisp.com/wiki/?pcepleacstrings

19nov18

rick