*

1 files changed, 165 insertions, 0 deletions

diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Lib/pronounce.scm b/js/games/nluqo.github.io/~bh/61a-pages/Lib/pronounce.scm
new file mode 100644
index 0000000..638e160
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/61a-pages/Lib/pronounce.scm
@@ -0,0 +1,165 @@
+; How to pronounce cxr-family function names
+
+(define (say name)
+  (accent (pronounce name)))
+
+; PRONOUNCE takes a cxr-family word as argument and returns a sentence
+; of syllables.
+
+(define (pronounce name)
+  (cond ((eq? name 'car) '(car))
+	((eq? name 'caar) '(cuh are))
+	((empty? name) '())
+	((eq? (first-two name) 'ca) (se 'caa (pronounce (bf-two name))))
+	((eq? (first name) 'c) (se 'cuh (pronounce (bf name))))
+	((eq? (last-three name) 'dar) (se (pronounce (bl-three name)) 'dar))
+	((eq? (last-two name) 'ar) (se (pronounce (bl-two name)) 'are))
+	((eq? (last-two name) 'dr) (se (pronounce (bl-two name)) 'der))
+	((eq? (first-two name) 'da) (se 'daa (pronounce (bf-two name))))
+	((eq? (first name) 'a) (se 'aa (pronounce (bf name))))
+	(else (se 'de (pronounce (bf name))))))
+
+; ACCENT takes a sentence of syllables (as returned by PRONOUNCE) and inserts
+; an exclamation point at the emphasized syllable.  I'm less sure that these
+; rules are universally agreed to than for PRONOUNCE.
+
+; In particular, all my life I've said "CUH de der" for cddr, but apparently
+; to be consistent I should be saying "cuh DE der."  I think I have heard people
+; say it that way, though, so I'm reluctant to special-case it like the first
+; syllable of caar in PRONOUNCE.
+
+(define (accent syls)
+  (define (help prev rest)
+    (if (null? rest)
+	(se (word prev '!))
+	(let ((winover (assoc prev '((caa . (daa dar de der))
+				     (cuh . (der))
+				     (aa  . (dar de der))
+				     (daa . (aa are daa dar de der))
+				     (de  . (de der))))))
+	  (if (member? (car rest) (cdr winover))
+	      (cons (word prev '!) rest)
+	      (cons prev (help (car rest) (cdr rest)))))))
+  (if (null? (cdr syls))
+      syls
+      (help (car syls) (cdr syls))))
+
+; Utility functions to get a table of pronunciations of all names up to length n
+
+(define (table n)
+  (for-each (lambda (w) (print (list w (say w)))) (cr n)))
+
+(define (cr n)
+  (if (= n 0)
+      '()
+      (append (cr (- n 1))
+	      (map (lambda (w) (word 'c w 'r)) (cross n)))))
+
+(define (cross n)
+  (if (= n 0)
+      '("")
+      (let ((small (cross (- n 1))))
+	(append (map (lambda (w) (word w 'a)) small)
+		(map (lambda (w) (word w 'd)) small)))))
+
+; Helper functions are obvious except to note that they test for too-short
+; arguments so that we can make more specific tests first in PRONOUNCE above.
+; ("More specific" means that we test for long substrings before short ones.)
+
+(define (first-two wd)
+  (if (< (count wd) 2)
+      wd
+      (word (first wd) (first (bf wd)))))
+
+(define (bf-two wd)
+  (if (< (count wd) 2)
+      ""
+      (bf (bf wd))))
+
+(define (last-two wd)
+  (if (< (count wd) 2)
+      wd
+      (word (last (bl wd)) (last wd))))
+
+(define (bl-two wd)
+  (if (< (count wd) 2)
+      ""
+      (bl (bl wd))))
+
+(define (last-three wd)
+  (if (< (count wd) 3)
+      wd
+      (word (last (bl (bl wd))) (last (bl wd)) (last wd))))
+
+(define (bl-three wd)
+  (if (< (count wd) 3)
+      ""
+      (bl (bl (bl wd)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Results:
+
+; > (table 5)
+; (car (car))
+; (cdr (cuh! der))
+; (caar (cuh are!))
+; (cdar (cuh dar!))
+; (cadr (caa! der))
+; (cddr (cuh de! der))
+; (caaar (caa aa are!))
+; (cdaar (cuh daa! are))
+; (cadar (caa! dar))
+; (cddar (cuh de dar!))
+; (caadr (caa aa! der))
+; (cdadr (cuh daa! der))
+; (caddr (caa! de der))
+; (cdddr (cuh de! de der))
+; (caaaar (caa aa aa are!))
+; (cdaaar (cuh daa! aa are))
+; (cadaar (caa! daa are))
+; (cddaar (cuh de daa! are))
+; (caadar (caa aa! dar))
+; (cdadar (cuh daa! dar))
+; (caddar (caa! de dar))
+; (cdddar (cuh de! de dar))
+; (caaadr (caa aa aa! der))
+; (cdaadr (cuh daa! aa der))
+; (cadadr (caa! daa der))
+; (cddadr (cuh de daa! der))
+; (caaddr (caa aa! de der))
+; (cdaddr (cuh daa! de der))
+; (cadddr (caa! de de der))
+; (cddddr (cuh de! de de der))
+; (caaaaar (caa aa aa aa are!))
+; (cdaaaar (cuh daa! aa aa are))
+; (cadaaar (caa! daa aa are))
+; (cddaaar (cuh de daa! aa are))
+; (caadaar (caa aa daa! are))
+; (cdadaar (cuh daa! daa are))
+; (caddaar (caa! de daa are))
+; (cdddaar (cuh de! de daa are))
+; (caaadar (caa aa aa! dar))
+; (cdaadar (cuh daa! aa dar))
+; (cadadar (caa! daa dar))
+; (cddadar (cuh de daa! dar))
+; (caaddar (caa aa! de dar))
+; (cdaddar (cuh daa! de dar))
+; (cadddar (caa! de de dar))
+; (cddddar (cuh de! de de dar))
+; (caaaadr (caa aa aa aa! der))
+; (cdaaadr (cuh daa! aa aa der))
+; (cadaadr (caa! daa aa der))
+; (cddaadr (cuh de daa! aa der))
+; (caadadr (caa aa daa! der))
+; (cdadadr (cuh daa! daa der))
+; (caddadr (caa! de daa der))
+; (cdddadr (cuh de! de daa der))
+; (caaaddr (caa aa aa! de der))
+; (cdaaddr (cuh daa! aa de der))
+; (cadaddr (caa! daa de der))
+; (cddaddr (cuh de daa! de der))
+; (caadddr (caa aa! de de der))
+; (cdadddr (cuh daa! de de der))
+; (caddddr (caa! de de de der))
+; (cdddddr (cuh de! de de de der))