application/octet-stream
•
4.26 KB
•
83 lines
; Subroutines and macros for formatted text output
[def fmt/tmp 123]
[defun fmt/valid-argument? [argument]
[or [int? argument] [symbol? argument]]]
[def fmt/expr/count 0]
[defun fmt/expr [expr arguments-used]
[when-not [string? expr]
[throw [list :format-error "fmt needs a string literal as a first argument, since it is implemented as a macro" expr [current-lambda]]]]
[def split-expr [split expr ":"]]
[def argument [car split-expr]]
[def format-spec [or [cadr split-expr] ""]]
[if [== "" argument]
[do [array/set! arguments-used [-- fmt/expr/count] #t]
[str->sym [string fmt/expr/count]]]
[let [[read-vals [read argument]]]
[when [cdr read-vals]
[throw [list :format-error "Format argument specifier contains more than a single atom" argument [current-lambda]]]]
[when-not [fmt/valid-argument? [car read-vals]]
[throw [list :format-error "Format argument specifier should be either an integer or a symbol" argument [current-lambda]]]]
[when [int? [car read-vals]]
[when [or [< [car read-vals] 0] [>= [car read-vals] [array/length arguments-used]]]
[throw [list :format-error "fmt numbered argument is out of bounds" argument [current-lambda]]]]
[array/set! arguments-used [car read-vals] #t]]
[str->sym [string [car read-vals]]]]]]
[def fmt/args/map-fun/count 0]
[defun fmt/args/map-fun [arg]
[def s [str->sym [string fmt/args/map-fun/count]]]
[++ fmt/args/map-fun/count]
[list 'def s arg]]
[defmacro fmt [format-string . args]
"Return a formatted string"
[when-not [string? format-string]
[throw [list :type-error "fmt needs a string literal as a first argument, since it is implemented as a macro" format-string [current-lambda]]]]
[def cuts #nil]
[for [i 0 [string/length format-string]]
[case [char-at format-string i]
[#\{ [do [when [int? [car cuts]] [throw [list :format-error "fmt placeholders can't be nested" format-string [current-lambda]]]]
[set! cuts [cons i cuts]]]]
[#\} [do [when-not [int? [car cuts]] [throw [list :format-error "fmt expects all brackets to be closed" format-string [current-lambda]]]]
[set! cuts [cons [cons [car cuts] i] [cdr cuts]]]]]]]
[when [int? [car cuts]] [throw [list :format-error "fmt placeholders can't be nested" format-string [current-lambda]]]]
[def expr-list #nil]
[def last-pos [string/length format-string]]
[def arguments-used [-> [array/allocate [length args]] [array/fill! #f]]]
[set! fmt/expr/count [array/length arguments-used]]
[for-in [c cuts]
[def lit [substr format-string [+ [cdr c] 1] last-pos]]
[when-not [== "" lit] [set! expr-list [cons lit expr-list]]]
[def expr [fmt/expr [substr format-string [+ 1 [car c]] [cdr c]] arguments-used]]
[set! expr-list [cons expr expr-list]]
[set! last-pos [car c]]]
[when [> last-pos 0]
[def lit [substr format-string 0 last-pos]]
[set! expr-list [cons lit expr-list]]]
[for [i 0 [array/length arguments-used]]
[when-not [array/ref arguments-used i]
[throw [list :format-error "fmt expects all arguments to be used" [list format-string [list/ref args i]] [current-lambda]]]]]
[def expr [if [cdr expr-list]
[cons 'cat expr-list]
[if [string? [car expr-list]]
[car expr-list]
[cons 'string expr-list]]]]
[set! fmt/args/map-fun/count 0]
[if args
`[let* ~@[map args fmt/args/map-fun]
~expr]
expr]]
[defmacro pfmt [format-string . args]
"Print a formatted string"
`[print [fmt ~format-string ~@args]]]
[defmacro efmt [format-string . args]
"Print a formatted string"
`[error [fmt ~format-string ~@args]]]
