Small snippets of Guile Scheme
There’s a lot of implicit knowledge among Guile developers. Here I gather some useful snippets I found along the way.
More useful stuff to get things done in Guile is available in guile-basics and py2guile.
log-expression: print variable name and value
During debugging I often want to display variables by name and value. I used to print name and value by hand, but this quickly becomes tedious:
(define foo 'bar) (format #t "foo: ~a\n" foo) ;; or (display 'foo)(display foo)(newline)
Therefore I build me something simpler:
(define-syntax-rule (log-exprs exp ...) (begin (format #t "~a: ~S\n" (quote exp) exp) ...))
Now I can simply log variables like this:
(define foo 'bar) (log-exprs foo) ;; => foo: bar (define bar 'baz) (log-exprs foo bar (list "hello")) ;; foo: bar ;; bar: baz ;; (list hello): ("hello")
Use Guile-yaml to search for the first match in a yaml file
This uses guile-libyaml to parse the yaml file and (ice-9 match) to recursively search within the file.
The example file is demo1.yml from the guile-yaml repo:
---
doe: "a deer, a female deer"
ray: "a drop of golden sun"
pi: 3.14159
xmas: true
french-hens: 3
calling-birds:
- huey
- dewey
- louie
- fred
xmas-fifth-day:
calling-birds: four
french-hens: 3
golden-rings: 5
partridges:
count: 1
location: "a pear tree"
turtle-doves: two
I’m searching for the first match to "partridges":
(import (yaml) (ice-9 match)) (define demo (read-yaml-file "demo1.yml")) (let match-demo ((demo demo)) (match demo ((("partridges" . b) c ...) b) (else (if (pair? demo) (or (match-demo (cdr demo)) (match-demo (car demo))) #f)))) ;; => (("count" . "1") ("location" . "a pear tree"))
To use this snippet, start guile as guile -L . in the guile-libyaml repo.
Count occurences of each key in an alist
This was asked by fnstudio in the #guile channel.
Given a list of pairs (like xy-coordinates), count how often the first element appears.
(define xydata '((1 . 1)(1 . 2)(1 . 3)(2 . 1)(2 . 2))) (define (assoc-increment! key alist) "Increment the value of the key in the alist, set it to 1 if it does not exist." (define res (assoc key alist)) (assoc-set! alist key (or (and=> (and=> res cdr) 1+) 1))) (fold assoc-increment! '() (map car xydata)) ;; => ((2 . 2) (1 . 3))
Common Substrings and Somewhat Cheap String Similarity
Getting the longest common substring is a traditional task, a simplification of actual edit distance like the Levenshtein distance (which actually has fast estimators).
But maybe you want all common substrings without duplicates.
The following code is not optimized, but it works.
Get all common substrings
Usage
Different from the requirements in in Rosetta Code, this returns not the longest common substring, but all non-consecutive substrings.
(longest-common-substrings "thisisatest" "testing123testing") ;; => ("test" "i") (longest-common-substrings "thisisatestrun" "thisisatestunseen") ;; => ("thisisatest" "un")
Implementation
Warning: This is NOT fast. It takes a few seconds when run over two text documents with around 2000 characters each.
(import (srfi srfi-1)) (define (longest-common-substrings s1 s2) (define c1 (string->list s1)) (define c2 (string->list s2)) (define (common-prefix a b) (let loop ((prefix '()) (a a) (b b)) (cond ((or (null? a) (null? b)) (reverse! prefix)) ((not (equal? (car a) (car b))) (reverse! prefix)) (else (loop (cons (car a) prefix) (cdr a) (cdr b)))))) (define (longer a b) (if (> (length a) (length b)) a b)) (define (common-substrings a b) (define substrings '()) (let loop ((a2 a) (b b) (longest '())) (let ((prefix (common-prefix a2 b))) (let ((anew (drop a2 (length prefix)))) (when (not (null? prefix)) (let ((str (apply string prefix))) (when (not (member str substrings)) (set! substrings (cons str substrings))))) (cond ((null? b) #t) ;; done ((null? anew) (loop a (cdr b) '())) ((null? prefix) (loop (cdr anew) b longest)) (else (loop (cdr anew) b (longer prefix longest))))))) substrings) (let ((substrings (common-substrings c1 c2))) (define (contained-in-any-other s) (any identity (map (λ (s2) (and (not (equal? s s2)) (string-contains s2 s))) substrings))) (reverse! (remove contained-in-any-other substrings))))
Somewhat Cheap String Similarity
Usage
(cheap-similarity "thisisatest" "thisisatest") ;; => 3.0454545454545454 (cheap-similarity "thisisatest" "thisisatestrun") ;; => 2.68 (cheap-similarity "thisisatest" "testing123testing") ;; => 1.2142857142857142 (cheap-similarity "thisisatest" "criecriecriecrie") ;; => 0.4444444444444444
Implementation
Warning: This is NOT well defined and is mostly untested, so it might have ugly unforseed edge-cases and might give bad results for large classes of problems. It seems to do what I want (get the similarity of filenames for ordering streams by similarity for the guile media site), and it was interesting no write, but that’t about it. Use with caution!
(import (srfi srfi-1)) (define (all-common-substrings s1 s2) (define c1 (string->list s1)) (define c2 (string->list s2)) (define (common-prefix a b) (let loop ((prefix '()) (a a) (b b)) (cond ((or (null? a) (null? b)) (reverse! prefix)) ((not (equal? (car a) (car b))) (reverse! prefix)) (else (loop (cons (car a) prefix) (cdr a) (cdr b)))))) (define (longer a b) (if (> (length a) (length b)) a b)) (define (common-substrings a b) (define substrings '()) (let loop ((a2 a) (b b) (longest '())) (let ((prefix (common-prefix a2 b))) (let ((anew (drop a2 (length prefix)))) (when (not (null? prefix)) (let ((str (apply string prefix))) (set! substrings (cons str substrings)))) (cond ((null? b) #t) ;; done ((null? anew) (loop a (cdr b) '())) ((null? prefix) (loop (cdr anew) b longest)) (else (loop (cdr anew) b (longer prefix longest))))))) substrings) (let ((substrings (common-substrings c1 c2))) (define (contained-in-any-other s) (any identity (map (λ (s2) (and (not (equal? s s2)) (string-contains s2 s))) substrings))) substrings)) (define (cheap-similarity s1 s2) (define common-length (apply + (map string-length (all-common-substrings s1 s2)))) (define total-length (+ (string-length s1) (string-length s2))) (/ common-length total-length 1.))
pivot a table
(apply map list '((1 2) (1 3)))
((1 1) (2 3))
Explanation: Apply moves map list into the list, so this changes to
(map list '(1 2) (1 3))
Map takes the elements from each of the arguments to call the function, so the result is
(list (list 1 1) (list 2 3))
Or in shorthand notation:
'((1 1) (2 3))
Script with minimal startup time
To create a script that starts fast, you’ll want to avoid the parsing time.
If you have a script in a file named hello-world.scm, use the following:
#!/usr/bin/env bash d=$(realpath -e "$0") || exit 127 d=${d%/*} exec -a "$0" guile -L "$d" -C "$d" -e '(hello-world)' -c '' "$@" # terminate the inline comment "started" with the #! line: !# (define-module (hello-world) #:export (main)) (define (main args) (format #t "Hello ~a\n" (cdr args)))
Then make it executable and run it as script:
chmod +x hello-world.scm ./hello-world.scm World # => Hello (World)
As a benchmark, run it 100 times:
# exclude single-time auto-compilation ./hello-world.scm World >/dev/null { time for i in {1..100}; do ./hello-world.scm World > /dev/null done } 2>&1
I get:
real 0m1,601s user 0m0,944s sys 0m0,721s
So on my machine, startup time is 16ms.
You can speed it up around 3% by replacing /usr/bin/env bash with
/bin/sh, but that sacifices portability between different Unix
systems.
Thanks for a 12% speedup goes to graywolf!
Shell scripts in Guile
Similar to the script above, but with a bit more convenience.
You can write shell scripts in Guile, but you’ll need to make sure you to do it in a way which has low startup times.
The fastest I found which stays fast with larger scripts is shell-indirection calling your scripts as modules:
====== scriptname.scm ======
#!/usr/bin/env bash # -*- scheme -*- # set Guile if unset GUILE="${GUILE:-guile}" d=$(realpath -e "$0") || exit 127 d=${d%/*} exec -a "$0" "${GUILE}" -L "$d" -C "$d" -e '(scriptname)' -c '' "$@" ; !# (define-module (scriptname) ;; same as filename! #:export (main)) (define (main args) (display args) (newline))
Copy this into ~/.local/bin/, make it executable with chmod +x ~/.local/bin/scriptname.scm, and you have powerful scripting with low
startup timme.
time for i in {1..100}; do scriptname.scm >/dev/null ; done real 0m3,202s user 0m2,683s sys 0m1,110s
⇒ 32ms runtime. Not as fast as perl or bash (calling bash from bash
just takes 3ms), but pretty good.
define-typed
Moved to its own page: define-typed: efficient typechecks for Guile Scheme.
It got too big for a snippet.
Guile imports in Makefiles
Use modules in the guile-session of Makefiles:
output: .guile-session touch $(guile (list-ec (: i 2) "$@")) # => touch output output .PHONY: .guile-session .guile-session: $(guile (import (srfi :42 eager-comprehensions)))
The import runs only once, but is guaranteed to run at every execution (due to .PHONY).
Importing srfi :42 provides Eager Comprehensions which are similar
to Python’s list-comprehensions.
minimal syntax rule that uses homoiconicity
(define-syntax-rule (writer (code ...)) (apply write (cdr (list code ...)))) (writer (display "Hello World")) ;; => "Hello World" ;; while (display "Hello World") ;; => Hello World ;; ^ no quotes
Generator functions with state
A generator is no magic: It just uses let to create a scope with a
variable and then defines a procedure that can access the scope.
(define (counter-init) (let ((i 0)) (define (counter) (set! i (1+ i)) i) counter)) (define a-counter (counter-init)) (list (a-counter) (a-counter) (a-counter))
| 1 | 2 | 3 |