diff options
Diffstat (limited to 'stdlib')
-rw-r--r-- | stdlib/pic.tl | 54 |
1 files changed, 51 insertions, 3 deletions
diff --git a/stdlib/pic.tl b/stdlib/pic.tl index 57497152..96e78f2a 100644 --- a/stdlib/pic.tl +++ b/stdlib/pic.tl @@ -48,6 +48,51 @@ ,str))) code)))) +(defun comma-positions (fmt) + (let* ((fmtx (regsub #/,./ #\, fmt)) + (len (len fmtx)) + (ppos (or (pos #\. fmtx) len)) + (out (vec))) + (each ((i len..0)) + (if (meql [fmtx i] #\,) + (vec-push out (- ppos i)))) + out)) + +(defun insert-commas (num positions) + (let* ((len (len num)) + (pn (len positions)) + (ppos (or (pos #\. num) len)) + (out (mkstring 0)) + (j 0) + (comma #\,)) + (each ((i len..0) + (p (- ppos len -1))) + (cond + ((meq comma #\- #\+ #\space) + (string-extend out comma) + (set comma #\space)) + (t + (string-extend out [num i]))) + (when (plusp i) + (when (< j pn) + (if (meq [num (pred i)] #\space #\- #\+) + (set comma [num (pred i)])) + (let ((pj [positions j])) + (cond + ((eql pj p) + (string-extend out comma) + (if (neq comma #\,) + (set comma #\space)) + (inc j)) + ((< pj p) + (inc j))))))) + (nreverse out))) + +(defun expand-pic-num-commas (fmt val) + (let* ((fmt-nc (remq #\, fmt)) + (exp-nc (expand-pic-num fmt-nc val))) + ^(insert-commas ,exp-nc ,(comma-positions fmt)))) + (defun expand-pic-align (chr fmt val) ^(fmt ,`~@(if chr chr)@(len fmt)a` ,val)) @@ -73,17 +118,20 @@ (unless (stringp fmt) (compile-error f "~s is required to be a format string" fmt)) (cond - ([m^$ #/\~[~#<>\|\-+0.!]/ fmt] [fmt 1..2]) + ([m^$ #/\~[~#<>\|\-+0.!,]/ fmt] [fmt 1..2]) ([m^$ #/\~./ fmt] (compile-error f "unrecognized escape sequence ~a" fmt)) ([m^$ #/\~/ fmt] (compile-error f "incomplete ~~ escape")) - ([m^$ #/[+\-]?0?#+([.!]#+|!)?/ fmt] (expand-pic-num fmt val)) + ([m^$ #/[+\-]?(0,?)?#+(,#+)*([.!]#+(,#+)*|!)?/ fmt] + (if (contains "," fmt) + (expand-pic-num-commas fmt val) + (expand-pic-num fmt val))) ([m^$ #/<+/ fmt] (expand-pic-align "<" fmt val)) ([m^$ #/>+/ fmt] (expand-pic-align nil fmt val)) ([m^$ #/\|+/ fmt] (expand-pic-align "^" fmt val)) (t (compile-error f "unrecognized format string ~s" fmt)))) (defmacro pic (:form f :env e bigfmt . args) - (let* ((regex #/[+\-]?0?#+([.!]#+|!)?| \ + (let* ((regex #/[+\-]?(0,?)?#+(,#+)*([.!]#+(,#+)*|!)?| \ <+| \ >+| \ \|+| \ |