(setq String "^J") (setq String "\^J") : "Jon \"Maddog\" Orwant" -> "Jon \"Maddog\" Orwant"
: "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"
: (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
: (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
: (pre? "a" "abc")
-> "abc"
: (sub? "bc" "abcdef")
-> "abcdef"
: (sub? "x" "abc")
-> NIL
: (match '("a" "b" @X "d" "e") (chop "abcde"))
-> T
: @X
-> ("c")
: (match '(@A "i" "s" @Z) (head 5 (chop "Me is You"))) (pack @A "at" @Z)
-> "Me at"
: (let S (chop "make a hat")
(xchg S (tail 1 S))
(pack S) )
-> "take a ham"
: (pack (tail 6 (head 12 (chop "To be or not to be"))))
-> "or not"
: (pack (filter prog2 (chop "To be or not to be") '(T NIL .)))
-> "T eo o ob"
(setq A (or B C))
(default X Y)
(setq A (or (fun? B) C))
(def 'A (or (fun? B) C))
(setq Dir (or (opt) "/tmp"))
(setq Dir (if (argv) (car @) "/tmp"))
(setq User
(or
(sys "USER")
(sys "LOGNAME")
(native "@" "getlogin" 'S) (car (native "@" "getpwuid" '(S) UserID))
(pack "Unknown uid number " UserID) ) )
: (default StartingPoint "Greenwich")
-> "Greenwich"
(setq A (if B B 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
: (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
(let Sum 0
(while (opt)
(in @
(while (char) (inc 'Sum (char @))) ) )
(println (% Sum 65535)) )
(bye)
$ ./sum lib.l lib/misc.l
52659
(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) " "))) )
: (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) (while (match '(@A "^I" @Z) Str)
(setq Str
(conc
@A
(need (- 8 (% (length @A) 8)) " ")
@Z ) ) ) )
Str )
(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 @)) ) )
: (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)
(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"
(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") )
(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) (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
(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
(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)
: (let (CharList '(a d g) Str "abcdefghi")
(pack
(mapcar
'((C) (pack (and (member C CharList) "\\") C))
(chop Str) ) ) )
-> "\\abc\\def\\ghi"
: (let (CharList '(a d g) Str "abcdefghi")
(pack
(mapcar
'((C) (pack (and (member C CharList) C) C))
(chop Str) ) ) )
-> "aabcddefgghi"
(trim (chop String)) (clip (chop String)) (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
(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)) (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")
(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)
(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)
: (format "12345")
-> 12345 : (format "123a5")
-> NIL : (format "1234.5678")
-> 1235
: (format "1234,5678" 2 ",")
-> 123457
: (format "-1,234.5" 2 "." ",")
-> -123450
: (= (format "1234.5678" 2) (format "1234.572" 2))
-> T
: (format "1234.5678")
-> 1235
: (format "1234.5678" 2)
-> 123457
: (scl 3)
-> 3
: (setq A 0.255)
-> 255
: (prinl "Unrounded: " (format A *Scl) "^JRounded: " (round A 2))
Unrounded: 0.255
Rounded: 0.26
-> "0.26"
: (scl 1)
-> 1
: (let Fmt (7 7 7 7)
(tab Fmt "number" "int" "floor" "ceil")
(for N (3.3 3.5 3.7 -3.3)
(tab Fmt
(format N *Scl)
(format (* 1.0 (/ N 1.0)) *Scl)
(format (* 1.0 (*/ (- N 0.5) 1.0)) *Scl)
(format (* 1.0 (*/ (+ N 0.5) 1.0)) *Scl) ) ) )
number int floor ceil
3.3 3.0 3.0 4.0
3.5 3.0 3.0 4.0
3.7 3.0 3.0 4.0
-3.3 -3.0 -4.0 -3.0
-> NIL
: (bin 54)
-> "110110"
: (bin "110110")
-> 54
: (prin "Infancy is: ") (for N 3 (printsp (dec N))) (prinl)
Infancy is: 0 1 2
: (prin "Toddling is: ") (println 3 4)
Toddling is: 3 4
: (prin "Childhood is: ") (apply println (range 5 12))
Childhood is: 5 6 7 8 9 10 11 12
: (prin "Childhood is: ") (mapc printsp (range 5 12)) (prinl)
Childhood is: 5 6 7 8 9 10 11 12
: (prin "Childhood is: ") (for (N 5 (>= 12 N) (inc N)) (printsp N)) (prinl)
: (de roman (N)
(pack
(make
(mapc
'((C D)
(while (>= N D)
(dec 'N D)
(link C) ) )
'(M CM D CD C XC L XL X IX V IV I)
(1000 900 500 400 100 90 50 40 10 9 5 4 1) ) ) ) )
-> roman
: (prinl "Roman for fifteen is " (roman 15))
Roman for fifteen is XV
-> "XV"
: (de arabic (R)
(let N 0
(for (L (chop (uppc R)) L)
(find
'((C D)
(when (head C L)
(cut (length C) 'L)
(inc 'N D) ) )
'`(mapcar chop '(M CM D CD C XC L XL X IX V IV I))
(1000 900 500 400 100 90 50 40 10 9 5 4 1) ) )
N ) )
-> arabic
: (prinl "Converted back, " (roman 15) " is " (arabic (roman 15)))
Converted back, XV is 15
-> 15
: (rand)
-> 643875838651014379
: (rand 1 6) -> 3
: (rand 900000 999999)
-> 989901
: (rand T) -> NIL
: (rand T)
-> T
: (setq Password
(pack
(head 8
(by '(NIL (rand)) sort
(conc
(chop "!@$%\^&*")
(mapcar char
(conc
(range `(char "A") `(char "Z"))
(range `(char "a") `(char "z"))
(range `(char "0") `(char "9")) ) ) ) ) ) ) )
: (seed 42)
-> 62419389940
: (seed "Hello world")
-> -967786026117696633
: (seed (time))
-> -54340987292621
: (in "/dev/urandom" (rd 12))
-> 50416291644794614409246112035
(load "@lib/math.l")
(de rand2 ()
(rand `(inc -1.0) `(dec 1.0)) )
(de gaussianRand ()
(use (U1 U2 W)
(while
(>=
(setq W
(+
(*/ (setq U1 (rand2)) U1 1.0)
(*/ (setq U2 (rand2)) U2 1.0) ) )
1.0 ) )
(setq W (sqrt (*/ 1.0 -2.0 (log W) W)))
(*/ U2 W 1.0) ) )
(prinl
"You have been hired at $"
(round (+ 25.0 (* 2 (gaussianRand))) 2) )
(load "@lib/math.l")
(de deg2rad (Deg)
(*/ Deg pi 180.0) )
(de rad2deg (Rad)
(*/ Rad 180.0 pi) )
(load "@lib/math.l")
: (format (cos 0.333333) *Scl)
-> "0.944957"
: (format (acos 0.944957) *Scl)
-> "0.333333"
: (format (tan pi/2) *Scl)
-> "3060023.306953"
(load "@lib/math.l")
: (format (log 10.0) *Scl)
-> "2.302585"
(de logBase(Base Val)
(*/ (log Val) 1.0 (log Base)) )
: (format (logBase 10.0 10000.0) *Scl)
-> "4.000000"
(de mmult (Mat1 Mat2)
(unless (= (length Mat1) (length (car Mat2)))
(quit "IndexError: matrices don't match") )
(mapcar
'((Row)
(apply mapcar Mat2
'(@ (apply + (mapcar * Row (rest)))) ) )
Mat1 ) )
: (mmult
'((3 2 3) (5 9 8))
'((4 7) (9 3) (8 8)) )
-> ((54 51) (165 126))
(load "@lib/math.l")
(de addComplex (A B)
(cons
(+ (car A) (car B)) (+ (cdr A) (cdr B)) ) )
(de mulComplex (A B)
(cons
(-
(*/ (car A) (car B) 1.0)
(*/ (cdr A) (cdr B) 1.0) )
(+
(*/ (car A) (cdr B) 1.0)
(*/ (cdr A) (car B) 1.0) ) ) )
(de invComplex (A)
(let Denom
(+
(*/ (car A) (car A) 1.0)
(*/ (cdr A) (cdr A) 1.0) )
(cons
(*/ (car A) 1.0 Denom)
(- (*/ (cdr A) 1.0 Denom)) ) ) )
(de negComplex (A)
(cons (- (car A)) (- (cdr A))) )
(de sqrtComplex (A)
(let
(R (sqrt (+ (* (car A) (car A)) (* (cdr A) (cdr A))))
Y (sqrt (* (- R (car A)) 0.5))
X (*/ (cdr A) 0.5 Y) )
(cons (cons X Y)
(cons (- X) (- Y)) ) ) )
(de fmtComplex (A)
(pack
(round (car A) (dec *Scl))
(and (gt0 (cdr A)) "+")
(round (cdr A) (dec *Scl))
"i" ) )
: (let (A (3.0 . 5.0) B (2.0 . -2.0))
(prinl "c = " (fmtComplex (mulComplex A B))) )
c = 16.00000+4.00000i
: (let D (3.0 . 4.0)
(prinl "sqrt(" (fmtComplex D) ") = " (fmtComplex (car (sqrtComplex D)))) )
sqrt(3.00000+4.00000i) = 2.00000+1.00000i
(prin "Gimme a number in decimal, octal, or hex: ")
(let Num (in NIL (clip (line)))
(setq Num
(if2 (= "0" (car Num)) (= "x" (cadr Num))
(hex (cddr Num))
(oct (cdr Num))
NIL
(format Num) ) )
(prinl Num " " (hex Num) " " (oct Num)) )
(prin "Enter file permission in octal: ")
(let Permissions (oct (in NIL (clip (line))))
(prinl "The decimal value is " Permissions) )
: (let Cnt -1740525205
(prinl
"Your web page received "
(format Cnt 0 "." ",")
" accesses last month." ) )
Your web page received -1,740,525,205 accesses last month.
(prinl "It took " Time " hour" (unless (= 1 Time) "s"))
(prinl
Time
" hour" (unless (= 1 Time) "s")
(if (= 1 Time) " is" " are")
" enough." )
(prinl "It took " Time " centur" (if (= 1 Time) "y" "ies"))
(de nounPlural (Str)
(let (S (chop Str) @A)
(cond
((find tail '((s s) (p h) (s h) (c h) (z)) (circ S))
(pack Str "es") )
((tail '(f f) S) (pack S "s"))
((match '(@A f) S) (pack @A "ves"))
((tail '(e y) S) (pack S "s"))
((match '(@A y) S) (pack @A "ies"))
((match '(@A i x) S) (pack @A "ices"))
((or (tail '(s) S) (tail '(x) S))
(pack S "es") )
(T (pack S "s")) ) ) )
(for S
(quote
fish fly ox
species genus phylum
cherub radius jockey
index matrix mythos
phenomenon formula )
(prinl "One " S ", two " (nounPlural S) ".") )
(load "@lib/misc.l")
(de factor (N)
(make
(let (D 2 L (1 2 2 . (4 2 4 2 4 6 2 6 .)) M (sqrt N))
(while (>= M D)
(if (=0 (% N D))
(setq M (sqrt (setq N (/ N (link D)))))
(inc 'D (pop 'L)) ) )
(link N) ) ) )
(while (opt)
(let? N (format @)
(let Factors (factor N)
(tab (-11 1 -60)
N
" "
(ifn (cdr Factors)
"PRIME"
(glue " "
(mapcar
'((L)
(if (cdr L)
(pack (car L) "**" (length L))
(car L) ) )
(by prog group Factors) ) ) ) ) ) ) )
(bye)
$ ./bigfact 17 60 125 239322000000000000000000
17 PRIME
60 2**2 3 5
125 5**3
239322000000000000000000 2**19 3 5**18 39887
: (prinl
"Today is day "
(- (date) (date (car (date (date))) 1 1) -1)
" of the current year." )
Today is day 365 of the current year.
: (date (date))
-> (2010 12 31)
: (prinl "The current date is " (dat$ (date) " "))
The current date is 2010 12 31
: (prinl "The current date is " (dat$ (date) "-"))
The current date is 2010-12-31
: (prinl (stamp))
2010-12-31 13:31:27
: (- (+ (* 86400 (date T)) (time T)) (* 86400 (date 1970 1 1)))
-> 1293799342
: (- (+ (* 86400 (date 2010 12 30)) (time 6 57 52)) (* 86400 (date 1970 1 1)))
-> 1293692272
: (- (+ (* 86400 ($dat "20101230")) ($tim "6:57:52")) (* 86400 (date 1970 1 1)))
-> 1293692272
: (let
(Secs (+ 1293692272 (* 86400 (date 1970 1 1)))
Date (/ Secs 86400)
Time (% Secs 86400) )
(prinl "Date: " (datSym Date) ", time: " (tim$ Time T)) )
Date: 30dec10, time: 06:57:52
: (let D (date)
(prinl
"Today: " (day D) ", " (datStr D)
" -> next week: " (day (inc 'D 7)) ", " (datStr D) ) )
Today: Friday, 2010-12-31 -> next week: Friday, 2011-01-07
: (prinl
"Today Jimi Hendrix would be "
(- (date) (date 1942 11 27))
" days old" )
Today Jimi Hendrix would be 24871 days old
: (prinl "Today is " (day (date)))
Today is Friday
: (prinl "Jimi Hendrix was born on a " (day (date 1942 11 27)))
Jimi Hendrix was born on a Friday
: (prinl "This is the " (week (date)) "th week")
This is the 52th week
: (prinl "This is the " (cadr (date (date))) "th month")
This is the 12th month
: (prinl "This is the year " (car (date (date))))
This is the year 2010
: (- (date) ($dat "1998-06-03" "-"))
-> 4594
: (date (expDat "31"))
-> (2010 12 31)
: (date (expDat "3112"))
-> (2010 12 31)
: (date (expDat "311210"))
-> (2010 12 31)
: (date (expDat "31.12.10"))
-> (2010 12 31)
: (date (expDat "31.12"))
-> (2010 12 31)
(load "@lib/http.l")
: (httpDate (date T) (time T))
Fri, 31 Dec 2010 13:21:03 GMT
: (stamp)
-> "2010-12-31 14:21:47"
: (datStr (date))
-> "2010-12-31"
: (locale "DE" "de")
: (datStr (date))
-> "31.12.2010"
: (locale "JP" "jp")
: (datStr (date))
-> "2010/12/31"
: (usec) -> 250502252
: (let U (usec)
(prin "Press return when ready: ")
(line)
(prinl "You took " (format (- (usec) U) 6) " seconds") )
Press return when ready:
You took 2.711455 seconds
: (bench (prin "Press return when ready: ") (line))
Press return when ready:
1.332 sec
: (bench (length (sort (make (do 1000000 (link (rand)))))))
2.839 sec
-> 1000000
(wait 250) : (key 4000) -> "a"
: (key 4000)
-> NIL
(load "@lib/misc.l")
(in NIL
(let (Fmt (-21 -21 -9 -10 10) Sender "Start" LastSecs NIL)
(tab Fmt "Sender" "Recipient" "Time" NIL "Delta")
(tab Fmt "------" "---------" "----" NIL "-----")
(for Lst
(flip
(make
(while (from "^JReceived: from ")
(let Recipient (till " ^J" T)
(from "; ")
(from ",")
(let
(Day (read)
Mon (index (till " " T) *Mon)
Year (read)
Tim (till " " T)
Offs (read)
Secs (+ (* 86400 (date Year Mon Day)) ($tim Tim)) )
(when (num? Offs)
(inc 'Secs (*/ 3600 Offs 100)) )
(link
(list
Recipient
Tim
(dat$ (date Year Mon Day) "/")
Secs ) ) ) ) ) ) )
(tab Fmt
Sender
(car Lst)
(cadr Lst)
(caddr Lst)
(tim$ (- (cadddr Lst) LastSecs) T) )
(setq Sender (car Lst) LastSecs (cadddr Lst)) ) ) )
(bye)
$ ./hopdelta <header
Sender Recipient Time Delta
------ --------- ---- -----
Start app 15:44:34 2010/12/31
app mo-p00-ob.rzone.de 15:44:34 2010/12/31 00:00:00
mo-p00-ob.rzone.de post.strato.de 15:44:39 2010/12/31 00:00:05
post.strato.de localhost 15:46:09 2010/12/31 00:01:30
(setq Nested '(this that the other))
(setq Nested '(this that (the other)))
(setq Tune '("The" "Star-Spangled" "Banner"))
(setq A '("quick" "brown" "fox"))
(setq A '(Why are you teasing me?))
: (setq Lines (make (char) (while (line T) (link @))))
The boy stood on the burning deck,
It was as hot as glass.
-> ("The boy stood on the burning deck," "It was as hot as glass.")
(setq Bigarray
(in "mydatafile"
(make
(until (eof)
(link (line T)) ) ) ) )
(setq
PerlHost "www.perl.com"
HostInfo (in (list 'nslookup PerlHost) (till NIL T)) )
: (split (chop "Costs only $4.95") " ")
-> (("C" "o" "s" "t" "s") ("o" "n" "l" "y") ("$" "4" "." "9" "5"))
: (mapcar pack (split (chop "Costs only $4.95") " "))
-> ("Costs" "only" "$4.95")
(setq Ships '("Niña" "Pinta" "Santa María"))
: (pack "The " (glue ", " '(big brown dirty hungry)) " fox")
-> "The big, brown, dirty, hungry fox"
(setq Array '(red yellow green))
: (prinl "I have " Array " marbles.")
I have redyellowgreen marbles.
: (prinl "I have " (glue " " Array) " marbles.")
I have red yellow green marbles.
(de Lists
("just one thing")
("Mutt" "Jeff")
("Peter" "Paul" "Mary")
("To our parents" "Mother Theresa" "God")
("pastrami" "ham and cheese" "peanut butter and jelly" "tuna")
("recycle tired, old phrases" "ponder big, happy thoughts")
("recycle tired, old phrases"
"ponder big, happy thoughts"
"sleep and dream peacefully") )
(de commifySeries (Lst)
(ifn (cddr Lst)
(glue " and " Lst)
(glue (if (find '((S) (sub? "," S)) Lst) "; " ", ")
(conc
(head -1 Lst)
(cons (pack "and " (last Lst))) ) ) ) )
(for L Lists
(prinl "The list is: " (commifySeries L) ".") )
(bye)
The list is: just one thing.
The list is: Mutt and Jeff.
The list is: Peter, Paul, and Mary.
The list is: To our parents, Mother Theresa, and God.
The list is: pastrami, ham and cheese, peanut butter and jelly, and tuna.
The list is: recycle tired, old phrases and ponder big, happy thoughts.
The list is: recycle tired, old phrases; ponder big, happy thoughts; and sleep and dream peacefully.
(de whatAboutThatArray ()
(prinl "The array now has " (length People) " elements.")
(prinl "Element #4 is `" (get People 4) "'.") )
(de People
Crosby Stills Nash Young )
: (whatAboutThatArray)
The array now has 4 elements.
Element (con (tail 2 People))
: (whatAboutThatArray)
The array now has 3 elements.
Element (setq People (need -10000 People))
: (whatAboutThatArray)
The array now has 10000 elements.
Element
(for Item List
(doSomething Item) )
(for User BadUsers
(complain User) )
(for User AllUsers
(let DiskSpace (getUsage User)
(when (> DiskSpace MAX_QUOTA)
(complain User) ) ) )
(in '(who)
(while (line T)
(and (sub? "tchrist" @) (prinl @)) ) )
(until (eof)
(prinl (glue " " (flip (split (line) " ")))) )
(for Item Array
(prinl "i = " Item) )
(setq Array (1 2 3))
(map dec Array)
: Array
-> (0 1 2)
(map
'((L)
(foo (car L)) (set L) ) List )
(for I (length List)
(doSomethingWith (get List I)) )
(setq
Fruits '(Apple Blackberry)
FruitRef 'Fruits )
: (for Fruit (val FruitRef)
(prinl Fruit " tastes good in a pie.") )
Apple tastes good in a pie.
Blackberry tastes good in a pie.
: (let Uniq NIL
(for Item '(a b c b c d c d e d e f)
(unless (memq Item Uniq)
(push 'Uniq Item) ) )
Uniq )
-> (f e d c b a)
: (let Seen NIL
(for Item '(a b c b c d c d e d e f)
(accu 'Seen Item 1) )
Seen )
-> ((f . 1) (e . 2) (d . 3) (c . 3) (b . 2) (a . 1))
: (uniq '(a b c b c d c d e d e f))
-> (a b c d e f)
: (in '(who)
(uniq
(make
(while (split (line) " ")
(link (pack (car @))) ) ) ) )
-> ("tim" "abu" "ben")
: (println 'Users 'logged 'in: (sort @))
Users logged in: ("abu" "ben" "tim")
: (sect '(a b c d e f) '(a c f h))
-> (a c f)
: (setq key1 1 key2 2)
-> 2
: key1
-> 1
: key2
-> 2
: (put 'Hash 'key1 1)
-> 1
: (put 'Hash 'key2 2)
-> 2
: (get 'Hash 'key1)
-> 1
: (de Hash (key1 . 1) (key2 . 2))
-> Hash
: (assoc 'key1 Hash)
-> (key1 . 1)
: (asoq 'key1 Hash)
-> (key1 . 1)
: (get Hash 'key1)
-> 1
: (idx 'Hash '(key1 . 1) T)
-> NIL
: (idx 'Hash '(key2 . 2) T)
-> NIL
: (lup Hash 'key1)
-> (key1 . 1)
(setq
A (1 3 5 6 7 8)
B (2 3 5 7 9) )
: (uniq (append A B))
-> (1 3 5 6 7 8 2 9)
: (sect A B)
-> (3 5 7)
: (diff A B)
-> (1 6 8)
(setq
Members '(Time Flies)
Initiates '(An Arrow) )
: (append Members Initiates) -> (Time Flies An Arrow)
: (conc Members Initiates) -> (Time Flies An Arrow)
: (insert 3 Members 'Like) -> (Time Flies Like An Arrow)
: (set Members 'Fruit) -> Fruit
: (set (tail 1 Members) 'Banana)
-> Banana
: Members
-> (Fruit Flies An Banana)
(reverse List) (flip List) : (sort (2 8 3 7 5 9 6))
-> (2 3 5 6 7 8 9)
: (by - sort (2 8 3 7 5 9 6))
-> (9 8 7 6 5 3 2)
: (flip (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)
: (setq List '(a b c d e f g))
-> (a b c d e f g)
: (cut 3 'List)
-> (a b c)
: List
-> (d e f g)
: (setq List '(a b c d e f g))
-> (a b c d e f g)
: (tail 3 List)
-> (e f g)
: (con (nth List 4))
-> NIL
: List
-> (a b c d)
(setq
Friends '(Peter Paul Mary Jim Tim)
This (pop 'Friends)
Thas (pop 'Friends) )
: This
-> Peter
: That
-> NIL
: Friends
-> (Mary Jim Tim)
(setq
Beverages '(Dew Jolt Cola Sprite Fresca)
Pair (tail 2 Beverages)
Beverages (head 3 Beverages) )
: Pair
-> (Sprite Fresca)
: Beverages
-> (Dew Jolt Cola)
(with
(find
'((This) (== 'engineer (: category)))
Employees )
(prinl "Highest paid engineer is: " (: name)) )
(de Nums 84598 4439223 248749 2488711 233716 3375644 211118)
: (filter '((N) (> N 1000000)) Nums)
-> (4439223 2488711 3375644)
: (filter > Nums (1000000 .))
-> (4439223 2488711 3375644)
(filter '((This) (== 'Engineer (: position))) Employees)
(sort Pids)
: (flip (sort (4 19 8 4)))
-> (19 8 4 4)
: (sort (4 19 8 4) >)
-> (19 8 4 4)
: (by - sort (4 19 8 4))
-> (19 8 4 4)
: (by cdr sort '((4 . 7) (19 . 3) (8 . 1) (4 . 2))) -> ((8 . 1) (4 . 2) (19 . 3) (4 . 7))
: (sort '((4 . 7) (19 . 3) (8 . 1) (4 . 2))
'((X Y) (> (cdr Y) (cdr X))) )
-> ((8 . 1) (4 . 2) (19 . 3) (4 . 7))
(for This (by '((This) (: name)) sort Employees)
(prinl (: name) " earns $" (: salary)) )
(by '((This) (cons (: name) (: age))) sort Employees)
(by '((S) (cadr (chop S))) sort Names)
(by length sort Strings)
(sort
(in "/etc/passwd"
(make
(while (split (line) ":")
(link (mix @ 4 3 1)) ) ) ) )
: (circ 'a)
-> (a .)
: (circ 'a 'b 'c)
-> (a b c .)
: (rot @)
-> (c a b .)
(by '(NIL (rand)) sort Lst)
(setq
Data (in NIL
(make
(until (eof)
(link (line T)) ) ) )
Maxlen (inc (length (maxi length Data)))
Cols (max (/ (or (format (sys "COLUMNS")) 80) Maxlen) 1)
Rows (/ (+ (length Data) Cols) Cols)
Data (make (while Data (link (cut Rows 'Data)))) )
(while (find bool Data)
(map
'((D) (space (- Maxlen (length (prin (pop D))))))
Data )
(prinl) )
(bye)
(de permute (Lst)
(ifn (cdr Lst)
(cons Lst)
(mapcan
'((X)
(mapcar
'((Y) (cons X Y))
(permute (delete X Lst)) ) )
Lst ) ) )
: (mapc println (permute '(man bites dog)))
(man bites dog)
(man dog bites)
(bites man dog)
(bites dog man)
(dog man bites)
(dog bites man)
(de factorial (N)
(apply * (range 1 N)) )
: (for N 15 (tab (-20 -10) N (factorial N)))
1 1
2 2
3 6
4 24
5 120
6 720
7 5040
8 40320
9 362880
10 3628800
11 39916800
12 479001600
13 6227020800
14 87178291200
15 1307674368000
: (factorial 500)
-> 12201368259911100687...00000000000000000000
: (length @)
-> 1135
(load "@lib/simul.l")
(in NIL
(until (eof)
(for F (permute (split (line) " "))
(prinl (glue " " F)) ) ) )
(bye)
(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") )
(push 'FoodColor '(Raspberry . "pink"))
: (prinl "Known foods:") (for F FoodColor (println (car F)))
Known foods:
Raspberry
Apple
Banana
Lemon
Carrot
: (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)
(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"
: (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
(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
-> ((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"))
: (for Food FoodColor
(prinl " " (car Food)) )
In insertion order, the foods are:
Banana
Apple
Lemon
: (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) ")") ) )
(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
(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)
: (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"))
(setq
DrinkColor '((Galliano . "yellow") ("Mai Tai" . "blue"))
IngestedColor (append FoodColor DrinkColor) )
: (setq AllColors (uniq (mapcar cdr IngestedColor)))
-> ("red" "yellow" "orange" "blue")
(de CitrusColor
(Lemon . "yellow")
(Orange . "orange")
(Lime . "green") )
: (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.") )
: (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 )
(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
(load "@lib/misc.l")
(setq *Dirsize (by length sort
(in (list 'du (opt))
(make
(while (read)
(skip)
(link (list (split (line) "/") @)) ) ) ) ) )
(for D *Dirsize
(when (assoc (head -1 (car D)) *Dirsize)
(conc @ (cons (car D))) ) )
(let Root (car *Dirsize)
(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)) ) ) ) )
(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)
(match Pattern List)
(fill Pattern [Symbol|List])
: (match '(@Name had a @Adj lamb) '(Mary had a little lamb))
-> T
: @Name
-> (Mary)
: @Adj
-> (little)
: (replace '(here in this town) 'this 'that 'town 'village)
-> (here in that village)
: (let F (chop "abc/def/ghi")
(prinl (last (split F '/))) (prinl (stem F '/)) ) ghi
ghi
: (mapcar
'((W) (pack (uppc (car W)) (cdr W)))
(split (chop "Mary had a little lamb") " ") )
-> ("Mary" "Had" "A" "Little" "Lamb")
: (glue '/
(replace
(split (chop "/usr/man/man3/foo.1") "/")
'("m" "a" "n" "3")
'("c" "a" "t" "3") ) )
-> "/usr/man/cat3/foo.1"
: (mapcar
'((S) (pack (glue '/ (head -1 (split (chop S) '/))) "/lib"))
'("/usr/bin" "/bin" "/usr/local/bin") )
-> ("/usr/lib" "/lib" "/usr/local/lib")
(not
(find
'((C) (nor (>= "Z" C "A") (>= "z" C "a")))
List ) )
: (make (find '((C) (or (sp? C) (nil (link C)))) (chop "abcd efg")))
-> ("a" "b" "c" "d")
: (make
(find
'((C)
(nand
(or (>= "Z" C "A") (>= "z" C "a") (sub? C "`-"))
(link C) ) )
(chop "ab`c-d/e") ) )
-> ("a" "b" "`" "c" "-" "d")
(in "/usr/local/widgets/data"
(until (eof)
(and (sub? "blue" (line T)) (prinl @)) ) )
(setq Var (in NIL (till NIL T))) (out LogFile ...)
(setq Fd (open LogFile))
...
(close Fd)
(out "+LogFile" (prinl "Countdown initiated ...") )
(prinl "You have 30 seconds to reach minimum safety distance.")
(in "file" .. )
(out "file" .. )
(out "+file" .. )