From 73a4bfc3d8e9bb5365e33a11a6ad3b8340d5195b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 12 Jun 2022 21:09:35 +0200 Subject: Remove custom let*. While it was nice, the most important part was the multi-valued let from srfi-71 (which is implemented in srfi-71)). The minor pattern matching structures could often be replaced with car+cdr, or a propper match. --- module/text/flow.scm | 13 +++++++------ module/text/markup.scm | 29 +++++++++++++++-------------- module/text/numbers/sv.scm | 21 +++++++++++---------- 3 files changed, 33 insertions(+), 30 deletions(-) (limited to 'module/text') diff --git a/module/text/flow.scm b/module/text/flow.scm index f7e08e1b..3b958480 100644 --- a/module/text/flow.scm +++ b/module/text/flow.scm @@ -7,6 +7,7 @@ :use-module (hnh util) :use-module (text util) :use-module (srfi srfi-1) + :use-module (srfi srfi-71) ) @@ -23,12 +24,12 @@ ;; str -> (str) (define* (justify-line line #:key (width 70)) (let recur ((lst (words line))) - (let* ((head tail (span - (let ((w 0)) - (lambda (word) ; Take words until we are above the limit. - (< (set/r! w = (+ 1 (true-string-length word))) - width))) - lst))) + (let ((head tail (span + (let ((w 0)) + (lambda (word) ; Take words until we are above the limit. + (< (set/r! w = (+ 1 (true-string-length word))) + width))) + lst))) (cond ((null? tail) (list (unwords head))) ; Don't justify last line. ((null? head) ;; an empty head implies that we found a word longer diff --git a/module/text/markup.scm b/module/text/markup.scm index 295ca198..53dab321 100644 --- a/module/text/markup.scm +++ b/module/text/markup.scm @@ -1,6 +1,7 @@ (define-module (text markup) :use-module (hnh util) :use-module (srfi srfi-1) + :use-module (srfi srfi-71) :use-module (ice-9 match) :use-module (ice-9 pretty-print) :use-module (text util) @@ -70,20 +71,20 @@ [(br) "\n"] [(hr) (string-append " " (make-string 60 #\─) " \n")] [(dl) - (let* ((dts dds (partition (lambda (x) (eq? 'dt (car x))) body))) - (let* ((dts* (map sxml->ansi-text dts)) - (m (if (null? dts*) 0 (apply max (map true-string-length dts*))))) - (string-concatenate - (map (lambda (dt dd) - (let ((dds (string-split dd #\newline))) - (string-concatenate - (map (lambda (left right) - (string-append (true-string-pad left m) " │ " right "\n")) - (cons dt (map (const "") (iota (1- (length dds))))) - dds)))) - dts* - (map (compose sxml->ansi-text (add-attributes `((width ,(- 70 m 5))))) - dds)))))] + (let* ((dts dds (partition (lambda (x) (eq? 'dt (car x))) body)) + (dts* (map sxml->ansi-text dts)) + (m (if (null? dts*) 0 (apply max (map true-string-length dts*))))) + (string-concatenate + (map (lambda (dt dd) + (let ((dds (string-split dd #\newline))) + (string-concatenate + (map (lambda (left right) + (string-append (true-string-pad left m) " │ " right "\n")) + (cons dt (map (const "") (iota (1- (length dds))))) + dds)))) + dts* + (map (compose sxml->ansi-text (add-attributes `((width ,(- 70 m 5))))) + dds))))] [(dt) (string-concatenate (map (compose sxml->ansi-text (add-attributes args)) body))] [(dd) diff --git a/module/text/numbers/sv.scm b/module/text/numbers/sv.scm index 2a032525..b70412fb 100644 --- a/module/text/numbers/sv.scm +++ b/module/text/numbers/sv.scm @@ -1,4 +1,5 @@ (define-module (text numbers sv) + :use-module (srfi srfi-71) :use-module (hnh util)) ;; only used in number->string-cardinal @@ -41,37 +42,37 @@ [(= n 20) "tjugo"] [(<= 21 n 29) (format #f "tjugo~a" (number->string-cardinal (- n 20)))] - [(<= 30 n 79) (let* ((big small (floor/ n 10))) + [(<= 30 n 79) (let ((big small (floor/ n 10))) (format #f "~atio~a" (number->string-cardinal big) (number->string-cardinal small)))] [(= n 80) "åttio"] - [(<= 81 n 89) (let* ((_ small (floor/ n 10))) + [(<= 81 n 89) (let ((_ small (floor/ n 10))) (format #f "åttio~a" (number->string-cardinal small)))] [(= n 90) "nittio"] - [(<= 91 n 99) (let* ((_ small (floor/ n 10))) + [(<= 91 n 99) (let ((_ small (floor/ n 10))) (format #f "nittio~a" (number->string-cardinal small)))] [(= n 100) "hundra"] - [(< 100 n 200) (let* ((_ small (floor/ n 100))) + [(< 100 n 200) (let ((_ small (floor/ n 100))) (format #f "hundra~a" (number->string-cardinal small)))] [(= n 200) "tvåhundra"] - [(< 200 n 1000) (let* ((big small (floor/ n 100))) + [(< 200 n 1000) (let ((big small (floor/ n 100))) (format #f "~ahundra~a" (number->string-cardinal big) (number->string-cardinal small)))] [(<= 1000 n 999999) - (let* ((big small (floor/ n 1000))) + (let ((big small (floor/ n 1000))) (format #f "~a tusen ~a~a" (number->string-cardinal big) (if (<= 100 small 199) "ett " "") (number->string-cardinal small)))] [(<= #e10e6 n (1- #e10e66)) - (let* ((e (inexact->exact (floor (log10 n)))) - (big small (floor/ n #e1e6))) + (let ((e (inexact->exact (floor (log10 n)))) + (big small (floor/ n #e1e6))) (if (zero? big) (number->string-cardinal small) (format #f "~a ~a~a~a ~a" @@ -121,7 +122,7 @@ (- n 20) a-form?: a-form?)))] [(<= 30 n 99) - (let* ((big small (floor/ n 10))) + (let ((big small (floor/ n 10))) (format #f "~atio~a" (case big [(8) "åt"] @@ -134,7 +135,7 @@ [(= n 100) "hundrade"] [(= n 1000) "tusende"] [else - (let* ((big small (floor/ n 100))) + (let ((big small (floor/ n 100))) (string-append (number->string-cardinal (* big 100)) (if (zero? small) "de" -- cgit v1.2.3