From 402e3c8fb18df367f7a90092fe2c242c981576dd Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Wed, 17 Jun 2020 23:39:24 +0900 Subject: [PATCH] making (chibi show) an alias of (srfi 166) --- lib/chibi/show-test.sld | 2 +- lib/chibi/show.sld | 14 +---- lib/chibi/show/base.sld | 32 +--------- lib/chibi/show/c.scm | 80 ++++++++++++++++++++---- lib/chibi/show/c.sld | 2 +- lib/chibi/show/color.sld | 8 +-- lib/chibi/show/column.sld | 11 +--- lib/chibi/show/pretty.sld | 8 +-- lib/chibi/show/unicode.sld | 11 +--- lib/{chibi/show => srfi/159}/base.scm | 0 lib/srfi/159/base.sld | 33 +++++++--- lib/srfi/159/color.sld | 5 +- lib/srfi/159/columnar.sld | 7 ++- lib/srfi/159/unicode.sld | 9 ++- lib/srfi/166/base.sld | 4 +- lib/{chibi/show => srfi/166}/color.scm | 0 lib/srfi/166/color.sld | 2 +- lib/{chibi/show => srfi/166}/column.scm | 0 lib/srfi/166/columnar.sld | 2 +- lib/{chibi/show => srfi/166}/pretty.scm | 0 lib/srfi/166/pretty.sld | 4 +- lib/{chibi/show => srfi/166}/show.scm | 0 lib/{chibi/show => srfi/166}/unicode.scm | 0 lib/srfi/166/unicode.sld | 4 +- lib/{chibi/show => srfi/166}/width.scm | 0 lib/{chibi/show => srfi/166}/write.scm | 0 26 files changed, 123 insertions(+), 115 deletions(-) rename lib/{chibi/show => srfi/159}/base.scm (100%) rename lib/{chibi/show => srfi/166}/color.scm (100%) rename lib/{chibi/show => srfi/166}/column.scm (100%) rename lib/{chibi/show => srfi/166}/pretty.scm (100%) rename lib/{chibi/show => srfi/166}/show.scm (100%) rename lib/{chibi/show => srfi/166}/unicode.scm (100%) rename lib/{chibi/show => srfi/166}/width.scm (100%) rename lib/{chibi/show => srfi/166}/write.scm (100%) diff --git a/lib/chibi/show-test.sld b/lib/chibi/show-test.sld index f337bfc8..5a2596ed 100644 --- a/lib/chibi/show-test.sld +++ b/lib/chibi/show-test.sld @@ -734,7 +734,7 @@ def | 6 (test "\x1B;[31mred\x1B;[34mblue\x1B;[31mred\x1B;[0m" (show #f (as-red "red" (as-blue "blue") "red"))) (test "\x1b;[31m1234567\x1b;[0m col: 7" - (show #f (as-unicode (as-red "1234567") (fn ((col)) (each " col: " col))))) + (show #f (as-unicode (as-red "1234567") (fn (col) (each " col: " col))))) ;; unicode (test "〜日本語〜" diff --git a/lib/chibi/show.sld b/lib/chibi/show.sld index f87471ae..e3b52901 100644 --- a/lib/chibi/show.sld +++ b/lib/chibi/show.sld @@ -1,14 +1,2 @@ -(define-library (chibi show) - (export - show fn forked with with! each each-in-list call-with-output - displayed written written-shared written-simply - numeric numeric/comma numeric/si numeric/fitted - nothing nl fl space-to tab-to escaped maybe-escaped - padded padded/left padded/right padded/both - trimmed trimmed/left trimmed/right trimmed/both trimmed/lazy - fitted fitted/left fitted/right fitted/both - joined joined/prefix joined/suffix joined/last joined/dot joined/range) - (import (scheme base) (scheme char) (scheme write) - (chibi show base)) - (include "show/show.scm")) +(define-library (chibi show) (alias-for (srfi 166))) diff --git a/lib/chibi/show/base.sld b/lib/chibi/show/base.sld index 36fd9fc6..dfd55519 100644 --- a/lib/chibi/show/base.sld +++ b/lib/chibi/show/base.sld @@ -1,32 +1,2 @@ -(define-library (chibi show base) - (export - show fn forked with with! each each-in-list call-with-output - displayed written written-shared written-simply numeric nothing - escaped maybe-escaped numeric/si numeric/fitted numeric/comma - ;; internal - output-default extract-shared-objects write-to-string write-with-shares - call-with-shared-ref call-with-shared-ref/cdr) - (import (scheme base) (scheme write) (scheme complex) (scheme inexact) - (srfi 1) (srfi 69) (chibi string) (chibi monad environment) - (chibi show shared)) - (cond-expand - (chibi - (import (only (chibi) let-optionals*))) - (else - (begin - (define-syntax let-optionals* - (syntax-rules () - ((let-optionals* opt-ls () . body) - (begin . body)) - ((let-optionals* (op . args) vars . body) - (let ((tmp (op . args))) - (let-optionals* tmp vars . body))) - ((let-optionals* tmp ((var default) . rest) . body) - (let ((var (if (pair? tmp) (car tmp) default)) - (tmp2 (if (pair? tmp) (cdr tmp) '()))) - (let-optionals* tmp2 rest . body))) - ((let-optionals* tmp tail . body) - (let ((tail tmp)) . body))))))) - (include "base.scm") - (include "write.scm")) +(define-library (chibi show base) (alias-for (srfi 166 base))) diff --git a/lib/chibi/show/c.scm b/lib/chibi/show/c.scm index 6678f53d..395ed073 100644 --- a/lib/chibi/show/c.scm +++ b/lib/chibi/show/c.scm @@ -2,10 +2,24 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; additional state information +(define-syntax define-state-variables + (syntax-rules () + ((define-state-variables var ...) + (begin + (define var + (make-computation-environment-variable 'var #f #f)) + ...)))) + +(define-state-variables + expression? in-cond? in-macro? return? non-spaced-ops? + braceless-bodies? newline-before-brace? no-wrap? macro-vars + expr-writer switch-indent-space indent-space + indent default-type dot op) + (define (c-in-expr proc) (with ((expression? #t)) (c-expr proc))) (define (c-in-stmt proc) (with ((expression? #f)) (c-expr proc))) (define (c-in-test proc) (with ((in-cond? #t)) (c-in-expr proc))) -(define (c-with-op op proc) (with ((op op)) proc)) +(define (c-with-op new-op proc) (with ((op new-op)) proc)) (define nl-str (call-with-output-string newline)) (define (make-nl-space n) (string-append nl-str (make-string n #\space))) @@ -26,6 +40,11 @@ (define (write-to-string x) (call-with-output-string (lambda (out) (write x out)))) +(define (string-find/index str pred i) + (string-cursor->index + str + (string-find str pred (string-index->cursor str i)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; be smart about operator precedence @@ -76,9 +95,9 @@ (each "(" x ")")) (define (c-maybe-paren x-op x) - (fn (op) + (fn ((orig-op op)) (let ((x (with ((op x-op)) x))) - (if (c-op<= op x-op) + (if (c-op<= orig-op x-op) (c-paren x) x)))) @@ -244,6 +263,42 @@ (else (c-literal x)))) +(define (try-fitted2 proc fail) + (fn (width (orig-output output)) + (let ((out (open-output-string))) + (call-with-current-continuation + (lambda (abort) + ;; Modify output to accumulate to an output string port, + ;; and escape immediately with failure if we exceed the + ;; column width. + (define (output* str) + (fn (col) + (let lp ((i 0) (col col)) + (let ((nli (string-find/index str #\newline i)) + (len (string-length str))) + (if (< nli len) + (if (> (+ (- nli i) col) width) + (abort fail) + (lp (+ nli 1) 0)) + (let ((col (+ (- len i) col))) + (cond + ((> col width) + (abort fail)) + (else + (output-default str))))))))) + (forked + (with ((output output*) + (port out)) + proc) + ;; fitted successfully + (fn () (orig-output (get-output-string out))))))))) + +(define (try-fitted proc . fail) + (let lp ((proc proc) (ls fail)) + (if (null? ls) + proc + (try-fitted2 proc (lp (car ls) (cdr ls)))))) + (define (c-apply ls) (c-wrap-stmt (with ((op 'comma)) @@ -261,7 +316,7 @@ (joined c-expr (cdr ls) sep)))))))))))) (define (c-expr x) - (fn (gen) ((or gen c-expr/sexp) x))) + (fn (expr-writer) ((or expr-writer c-expr/sexp) x))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; comments, with Emacs-friendly escaping of nested comments @@ -291,33 +346,32 @@ (lp (string-cursor-next str j)))))))))) (define (c-comment . args) - (each "/*" (fn (output) - (with ((output (make-comment-writer output))) + (each "/*" (fn ((orig-output output)) + (with ((output (make-comment-writer orig-output))) (each-in-list args))) "*/")) (define (make-block-comment-writer) (lambda (str) - (fn (col output) - (with ((output (make-comment-writer output))) + (fn (col (orig-output output)) + (with ((output (make-comment-writer orig-output))) (let ((end (string-cursor-end str)) (indent (string-append (make-nl-space (+ col 1)) "* "))) (let lp ((i (string-cursor-start str))) (let ((j (string-find str #\newline i))) - (output indent) - (output (substring-cursor str i j)) + (each indent (substring-cursor str i j)) (if (string-cursorline-generator - tabular columnar show-columns wrapped wrapped/list wrapped/char - justified line-numbers from-file) - (include "column.scm")) +(define-library (chibi show column) (alias-for (srfi 166 columnar))) diff --git a/lib/chibi/show/pretty.sld b/lib/chibi/show/pretty.sld index c1becd6e..0b2f00ff 100644 --- a/lib/chibi/show/pretty.sld +++ b/lib/chibi/show/pretty.sld @@ -1,8 +1,2 @@ -(define-library (chibi show pretty) - (export pretty pretty-shared pretty-simply - joined/shares try-fitted - ) - (import (scheme base) (scheme write) (chibi show) (chibi show base) - (srfi 1) (srfi 69) (chibi string)) - (include "pretty.scm")) +(define-library (chibi show pretty) (alias-for (srfi 166 pretty))) diff --git a/lib/chibi/show/unicode.sld b/lib/chibi/show/unicode.sld index 44687324..93f6f8af 100644 --- a/lib/chibi/show/unicode.sld +++ b/lib/chibi/show/unicode.sld @@ -1,11 +1,2 @@ -(define-library (chibi show unicode) - (import (scheme base) - (scheme char) - (chibi show base) - (srfi 130) - (srfi 151)) - (export as-unicode - unicode-terminal-width unicode-terminal-width/wide - upcased downcased) - (include "width.scm" "unicode.scm")) +(define-library (chibi show unicode) (alias-for (srfi 166 unicode))) diff --git a/lib/chibi/show/base.scm b/lib/srfi/159/base.scm similarity index 100% rename from lib/chibi/show/base.scm rename to lib/srfi/159/base.scm diff --git a/lib/srfi/159/base.sld b/lib/srfi/159/base.sld index 8926d53b..d5677ee2 100644 --- a/lib/srfi/159/base.sld +++ b/lib/srfi/159/base.sld @@ -1,12 +1,29 @@ (define-library (srfi 159 base) - (import (chibi show) (chibi show pretty)) (export show fn forked with with! each each-in-list call-with-output - displayed written written-simply pretty pretty-simply - numeric numeric/comma numeric/si numeric/fitted - nothing nl fl space-to tab-to escaped maybe-escaped - padded padded/right padded/both - trimmed trimmed/right trimmed/both trimmed/lazy - fitted fitted/right fitted/both - joined joined/prefix joined/suffix joined/last joined/dot joined/range)) + displayed written written-shared written-simply numeric nothing + escaped maybe-escaped numeric/si numeric/fitted numeric/comma) + (import (scheme base) (scheme write) (scheme complex) (scheme inexact) + (srfi 1) (srfi 69) (chibi string) (chibi monad environment) + (chibi show shared)) + (cond-expand + (chibi + (import (only (chibi) let-optionals*))) + (else + (begin + (define-syntax let-optionals* + (syntax-rules () + ((let-optionals* opt-ls () . body) + (begin . body)) + ((let-optionals* (op . args) vars . body) + (let ((tmp (op . args))) + (let-optionals* tmp vars . body))) + ((let-optionals* tmp ((var default) . rest) . body) + (let ((var (if (pair? tmp) (car tmp) default)) + (tmp2 (if (pair? tmp) (cdr tmp) '()))) + (let-optionals* tmp2 rest . body))) + ((let-optionals* tmp tail . body) + (let ((tail tmp)) . body))))))) + (include "../166/base.scm") + (include "../166/write.scm")) diff --git a/lib/srfi/159/color.sld b/lib/srfi/159/color.sld index a2e5bca1..2c77fb8e 100644 --- a/lib/srfi/159/color.sld +++ b/lib/srfi/159/color.sld @@ -1,6 +1,7 @@ (define-library (srfi 159 color) - (import (chibi show color)) + (import (scheme base) (srfi 159 base)) (export as-red as-blue as-green as-cyan as-yellow as-magenta as-white as-black - as-bold as-underline)) + as-bold as-underline) + (include "../166/color.scm")) diff --git a/lib/srfi/159/columnar.sld b/lib/srfi/159/columnar.sld index 76d4af4e..12e486db 100644 --- a/lib/srfi/159/columnar.sld +++ b/lib/srfi/159/columnar.sld @@ -1,8 +1,11 @@ (define-library (srfi 159 columnar) - (import (chibi show column)) + (import (scheme base) (scheme char) (scheme file) (scheme write) + (srfi 1) (srfi 117) (srfi 130) (srfi 159 base) + (chibi optional)) (export call-with-output-generator call-with-output-generators string->line-generator tabular columnar show-columns wrapped wrapped/list wrapped/char - justified line-numbers from-file)) + justified line-numbers from-file) + (include "../166/column.scm")) diff --git a/lib/srfi/159/unicode.sld b/lib/srfi/159/unicode.sld index b6a26215..fec02052 100644 --- a/lib/srfi/159/unicode.sld +++ b/lib/srfi/159/unicode.sld @@ -1,4 +1,9 @@ (define-library (srfi 159 unicode) - (import (chibi show unicode)) - (export as-unicode unicode-terminal-width)) + (import (scheme base) + (scheme char) + (chibi show base) + (srfi 130) + (srfi 151)) + (export as-unicode unicode-terminal-width) + (include "../166/width.scm" "../166/unicode.scm")) diff --git a/lib/srfi/166/base.sld b/lib/srfi/166/base.sld index fa1e5d93..b74d7859 100644 --- a/lib/srfi/166/base.sld +++ b/lib/srfi/166/base.sld @@ -50,5 +50,5 @@ comma-sep comma-rule word-separator? ambiguous-is-wide? ) (include "base.scm") - (include "../../chibi/show/write.scm") - (include "../../chibi/show/show.scm")) + (include "write.scm") + (include "show.scm")) diff --git a/lib/chibi/show/color.scm b/lib/srfi/166/color.scm similarity index 100% rename from lib/chibi/show/color.scm rename to lib/srfi/166/color.scm diff --git a/lib/srfi/166/color.sld b/lib/srfi/166/color.sld index c5769974..8448a6bb 100644 --- a/lib/srfi/166/color.sld +++ b/lib/srfi/166/color.sld @@ -8,4 +8,4 @@ (begin (define color (make-computation-environment-variable 'color #f #f))) - (include "../../chibi/show/color.scm")) + (include "color.scm")) diff --git a/lib/chibi/show/column.scm b/lib/srfi/166/column.scm similarity index 100% rename from lib/chibi/show/column.scm rename to lib/srfi/166/column.scm diff --git a/lib/srfi/166/columnar.sld b/lib/srfi/166/columnar.sld index 03fdffe7..af507952 100644 --- a/lib/srfi/166/columnar.sld +++ b/lib/srfi/166/columnar.sld @@ -10,4 +10,4 @@ (chibi optional) ) (export-all) - (include "../../chibi/show/column.scm")) + (include "column.scm")) diff --git a/lib/chibi/show/pretty.scm b/lib/srfi/166/pretty.scm similarity index 100% rename from lib/chibi/show/pretty.scm rename to lib/srfi/166/pretty.scm diff --git a/lib/srfi/166/pretty.sld b/lib/srfi/166/pretty.sld index 417506ee..d5667b1f 100644 --- a/lib/srfi/166/pretty.sld +++ b/lib/srfi/166/pretty.sld @@ -8,5 +8,5 @@ (srfi 1) (srfi 69) (srfi 166 base)) - (export-all) - (include "../../chibi/show/pretty.scm")) + (export pretty pretty-shared pretty-simply pretty-color) + (include "pretty.scm")) diff --git a/lib/chibi/show/show.scm b/lib/srfi/166/show.scm similarity index 100% rename from lib/chibi/show/show.scm rename to lib/srfi/166/show.scm diff --git a/lib/chibi/show/unicode.scm b/lib/srfi/166/unicode.scm similarity index 100% rename from lib/chibi/show/unicode.scm rename to lib/srfi/166/unicode.scm diff --git a/lib/srfi/166/unicode.sld b/lib/srfi/166/unicode.sld index 0c06dc13..b1aea83d 100644 --- a/lib/srfi/166/unicode.sld +++ b/lib/srfi/166/unicode.sld @@ -8,5 +8,5 @@ (export as-unicode unicode-terminal-width unicode-terminal-width/wide upcased downcased) - (include "../../chibi/show/width.scm" - "../../chibi/show/unicode.scm")) + (include "width.scm" + "unicode.scm")) diff --git a/lib/chibi/show/width.scm b/lib/srfi/166/width.scm similarity index 100% rename from lib/chibi/show/width.scm rename to lib/srfi/166/width.scm diff --git a/lib/chibi/show/write.scm b/lib/srfi/166/write.scm similarity index 100% rename from lib/chibi/show/write.scm rename to lib/srfi/166/write.scm