# To associate keys with values, PicoLisp uses (besides the built-in database) # 1. Symbol properties ('put', 'get', ':' etc.) # 2. Association lists ('assoc', 'asoq', 'get') # 3. Binary trees ('idx', 'lup') # For the examples in this section we use association lists #----------------------------- (de Age (Nat . 24) (Jules . 25) (Josh . 17) ) #----------------------------- (push 'Age (cons 'Nat 24) (cons 'Jules 25) (cons 'Josh 17) ) #----------------------------- (de FoodColor (Apple . "red") (Banana . "yellow") (Lemon . "yellow") (Carrot . "orange") ) #----------------------------- |
#----------------------------- # FoodColor defined per the introduction (push 'FoodColor '(Raspberry . "pink")) : (prinl "Known foods:") (for F FoodColor (println (car F))) Known foods: Raspberry Apple Banana Lemon Carrot #----------------------------- |
#----------------------------- # FoodColor per the introduction : (for Name '("Banana", "Martini") (prinl Name (if (assoc Name FoodColor) " is a food." " is a drink.")) ) Banana is a food. Martini is a drink. #----------------------------- |
#----------------------------- (del Key Var) #----------------------------- # FoodColor per the introduction (de printFoods () (prin "Keys: ") (apply println (mapcar car FoodColor)) (prin "Values: ") (apply println (mapcar cdr FoodColor)) ) (prinl "Initially:") (printFoods) (prinl) (prinl "With Banana undef:") (del (assoc 'Banana FoodColor) 'FoodColor) (printFoods) #----------------------------- Initially: Keys: Raspberry Apple Banana Lemon Carrot Values: "pink" "red" "yellow" "yellow" "orange" With Banana undef: Keys: Raspberry Apple Lemon Carrot Values: "pink" "red" "yellow" "orange" #----------------------------- |
#----------------------------- # FoodColor as per the introduction : (for F FoodColor (prinl (car F) " is " (cdr F)) ) Apple is red Banana is yellow Lemon is yellow Carrot is orange : (mapc '((Food Color) (prinl Food " is " Color)) (mapcar car FoodColor) (mapcar cdr FoodColor) ) Apple is red Banana is yellow Lemon is yellow Carrot is orange #----------------------------- : (for F (sort FoodColor) (prinl (car F) " is " (cdr F)) ) Apple is red Banana is yellow Carrot is orange Lemon is yellow #----------------------------- # download the following standalone program #!/usr/bin/picolisp /usr/lib/picolisp/lib.l (load "@lib/misc.l") (in (opt) (until (eof) (when (match '(~(chop "From: ") @From) (line)) (accu 'From @From 1) ) ) ) (for Person (sort From) (prinl (car Person) ": " (cdr Person)) ) (bye) #----------------------------- |
#----------------------------- # FoodColor as per the introduction : FoodColor -> ((Apple . "red") (Banana . "yellow") (Lemon . "yellow") (Carrot . "orange")) : (mapc println FoodColor) (Apple . "red") (Banana . "yellow") (Lemon . "yellow") (Carrot . "orange") : (for X FoodColor (prinl (car X) " => " (cdr X)) ) Apple => red Banana => yellow Lemon => yellow Carrot => orange #----------------------------- |
#----------------------------- (queue 'FoodColor (cons 'Banana "Yellow")) (queue 'FoodColor (cons 'Apple "Green")) (queue 'FoodColor (cons 'Lemon "Yellow")) : FoodColor -> ((Banana . "Yellow") (Apple . "Green") (Lemon . "Yellow")) # In insertion order, the foods are: : (for Food FoodColor (prinl " " (car Food)) ) In insertion order, the foods are: Banana Apple Lemon # Still in insertion order, the foods' colors are: : (for Food FoodColor (prinl (car Food) " is colored " (cdr Food) ".") ) Banana is colored Yellow. Apple is colored Green. Lemon is colored Yellow. #----------------------------- |
#----------------------------- : (setq Ttys (sort (group (in '(who) (make (while (read) (link (cons @ (read))) (line) ) ) ) ) ) ) -> ((abu tty1 pts/1 pts/3 pts/4 pts/5) (root tty2)) : (for U Ttys (prin (car U) ": ") (apply println (cdr U)) ) abu: tty1 pts/1 pts/3 pts/4 pts/5 root: tty2 #----------------------------- (for U Ttys (prinl (car U) ": " (length (cdr U)) " ttys.") (for Tty (sort (cdr U)) (prinl "^I" Tty " (owned by " (car U) ")") ) ) #----------------------------- # Delete all pts/3 .. pts/5 (for U Ttys (con U (diff (cdr U) '(pts/3 pts/4 pts/5))) ) : Ttys -> ((abu tty1 pts/1) (root tty2)) #----------------------------- |
#----------------------------- (setq Surname '((Mickey . Mantle) (Babe . Ruth)) FirstName (mapcar '((X) (cons (cdr X) (car X))) Surname) ) : (get FirstName 'Mantle) -> Mickey #----------------------------- # download the following standalone program #!/usr/bin/picolisp /usr/lib/picolisp/lib.l (ifn (argv Given) (out 2 (prinl "usage: foodfind food_or_color")) (de Color ("Apple" . "red") ("Banana" . "yellow") ("Lemon" . "yellow") ("Carrot" . "orange") ) (when (assoc Given Color) (prinl Given " is a food with color " (cdr @) ".") ) (when (find '((X) (= Given (cdr X))) Color) (prinl (car @) " is a food with color " Given ".") ) ) (bye) #----------------------------- # FoodColor as per the introduction : (extract '((F) (and (= "yellow" (cdr F)) (car F))) FoodColor ) -> (Banana Lemon) #----------------------------- |
#----------------------------- : (setq FoodColor (sort FoodColor)) -> ((Apple . "red") (Banana . "yellow") (Carrot . "orange") (Lemon . "yellow")) : (setq FoodColor (by cdr sort FoodColor)) -> ((Carrot . "orange") (Apple . "red") (Banana . "yellow") (Lemon . "yellow")) #----------------------------- |
#----------------------------- # FoodColor per the introduction (setq DrinkColor '((Galliano . "yellow") ("Mai Tai" . "blue")) IngestedColor (append FoodColor DrinkColor) ) #----------------------------- : (setq AllColors (uniq (mapcar cdr IngestedColor))) -> ("red" "yellow" "orange" "blue") #----------------------------- |
#----------------------------- # FoodColor per the introduction # CitrusColor is a hash mapping citrus food name to its color. (de CitrusColor (Lemon . "yellow") (Orange . "orange") (Lime . "green") ) # build up a list of non-citrus foods : (filter '((F) (not (assoc (car F) CitrusColor))) FoodColor) -> ((Apple . "red") (Banana . "yellow") (Carrot . "orange")) #----------------------------- |
#----------------------------- (setq Files (extract '((File) (and (info File) (cons File (car @)))) '("/etc/termcap", "/vmunix", "/bin/cat") ) ) (prinl "open files " (glue ", " (mapcar car Files))) (for F Files (prinl (car F) " is " (cdr F) " bytes long.") ) #----------------------------- |
#----------------------------- # Has no meaning in PicoLisp. All data structures grow dynamically. #----------------------------- |
#----------------------------- : (off Count) -> NIL : (for Element '(a b c b c d) (accu 'Count Element 1) ) -> (d . 1) : Count -> ((d . 1) (c . 2) (b . 2) (a . 1)) #----------------------------- |
#----------------------------- (de Father (Cain . Adam) (Abel . Adam) (Seth . Adam) (Enoch . Cain) (Irad . Enoch) (Mehujael . Irad) (Methusael . Mehujael) (Lamech . Methusael) (Jubal . Lamech) (Tubalcain . Lamech) (Enos . Seth) ) (de ancestor (Name) (while (assoc Name Father) (setq Name (cdr @)) ) Name ) # Always 'Adam' (setq Children (mapcar '((L) (cons (cdar L) (mapcar car L))) (by cdr group Father) ) ) (de children (Name) (prinl Name " begat " (if (get Children Name) (glue ", " @) "nobody" ) ) ) #----------------------------- : (children 'Adam) Adam begat Cain, Abel, Seth : (children 'Enos) Enos begat nobody #----------------------------- |
#----------------------------- # download the following standalone program #!/usr/bin/picolisp /usr/lib/picolisp/lib.l # dutree - print sorted indented rendition of du output (load "@lib/misc.l") # Run du, read input, save directories and sizes (setq *Dirsize # ((name size kids ..) ..) (by length sort (in (list 'du (opt)) (make (while (read) (skip) (link (list (split (line) "/") @)) ) ) ) ) ) # Assign kids (for D *Dirsize (when (assoc (head -1 (car D)) *Dirsize) (conc @ (cons (car D))) ) ) (let Root (car *Dirsize) # Figure out how much is taken up in each directory # that isn't stored in subdirectories. add a new # fake kid called "." containing that much (recur (Root) (let (Size (cadr Root) Cursize Size) (for Kid (cddr Root) (when (assoc Kid *Dirsize) (dec 'Cursize (cadr @)) (recurse @) ) ) (unless (= Size Cursize) (let Dot (append (car Root) '(("."))) (push '*Dirsize (list Dot Cursize)) (conc Root (cons Dot)) ) ) ) ) # Recursively output everything (let (Prefix NIL Width (length (cadr Root))) (recur (Root Prefix Width) (let Name (last (car Root)) (prinl Prefix (align Width (cadr Root)) " " Name) (let? Kids (flip (by cadr sort (mapcar '((K) (assoc K *Dirsize)) (cddr Root)) ) ) (setq Prefix (pack Prefix (align Width "|"))) (setq Width (+ 1 (length Name) (length (cadar Kids)))) (for Kid Kids (recurse Kid Prefix Width) ) ) ) ) ) ) (bye) #----------------------------- |