application/octet-stream
•
7.44 KB
•
200 lines
;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;; This project uses the MIT license, a copy should be included under /LICENSE
;;
;; Some nujel string λs
[defn string->keyword [α] :inline
"Return string α as a keyword"
[symbol->keyword [string->symbol α]]]
[defn println [str]
"Print STR on a single line"
[print [cat str "\r\n"]]]
[defn errorln [str]
"Print to stderr STR on a single line"
[error [cat str "\r\n"]]]
[defn br [num]
"Return NUM=1 linebreaks"
[if [or [nil? num] [<= [int num] 1]]
"\n"
[cat "\n" [br [+ -1 num]]]]]
[defn path/ext?! [ext]
"Return a predicate that checks if a path ends on EXT"
[case [type-of ext]
[:string [fn [path]
[= ext [lowercase [path/extension path]]]]]
[:pair [fn [path]
[def cext [lowercase [path/extension path]]]
[reduce ext [fn [α β] [or α [= β cext]]]]]]
[otherwise [throw [list :type-error "Expected a :string or :list" ext]]]]]
[defn path/extension [path]
"Return the extension of PATH"
[def last-period [last-index-of path "."]]
[if [>= last-period 0]
[string/cut path [+ 1 last-period] [buffer/length path]]
path]]
[defn path/without-extension [path]
"Return PATH, but without the extension part"
[def last-period [last-index-of path "."]]
[if [>= last-period 0]
[string/cut path 0 last-period]
path]]
[defn string/pad-start [text goal-length char]
"Pad out TEXT with CHAR at the start until it is GOAL-LENGTH chars long, may also truncate the string"
[when-not char [set! char " "]]
[when-not [string? text] [set! text [string text]]]
[when-not [string? char]
[throw [list :type-error "string/pad-start needs char as a string, so that one can pad with multiple characters" char [current-lambda]]]]
[while [< [buffer/length text] goal-length]
[set! text [cat char text]]]
[if [> [buffer/length text] goal-length]
[string/cut text [- [buffer/length text] goal-length] [buffer/length text]]
text]]
[defn string/pad-end [text goal-length char]
"Pad out TEXT with CHAR at the end until it is GOAL-LENGTH chars long, may also truncate the string"
[when-not char [set! char " "]]
[when-not [string? text] [set! text [string text]]]
[when-not [string? char]
[throw [list :type-error "string/pad-start needs char as a string, so that one can pad with multiple characters" char [current-lambda]]]]
[while [< [buffer/length text] goal-length]
[set! text [cat text char]]]
[if [> [buffer/length text] goal-length]
[string/cut text 0 goal-length]
text]]
[defn string/pad-middle [text goal-length char]
"Pad out TEXT with CHAR at the end until it is GOAL-LENGTH chars long, may also truncate the string"
[when-not char [set! char " "]]
[when-not [string? text] [set! text [string text]]]
[when-not [string? char]
[throw [list :type-error "string/pad-middle needs char as a string, so that one can pad with multiple characters" char [current-lambda]]]]
[while [< [buffer/length text] goal-length]
[set! text [cat char text char]]]
[if [> [buffer/length text] goal-length]
[let [[end-overflow [div/int [- [buffer/length text] goal-length] 2]]
[start-overflow [- [- [buffer/length text] goal-length] end-overflow]]]
[string/cut text start-overflow [+ start-overflow goal-length]]]
text]]
[defn string/round [text decimal-digits]
"Round the floating point representation in TEXT to have at most DECIMAL-DIGITS after the period"
[def pos [last-index-of text "."]]
[if [>= pos 0]
[string/cut text 0 [+ pos 1 decimal-digits]]
text]]
[defn split/empty [str separator]
[def slen [buffer/length str]]
[def start 0]
[def ret #nil]
[while [< start slen]
[set! ret [cons [string/cut str start [+ 1 start]] ret]]
[inc! start]]
[reverse ret]]
[defn split/string [str separator start]
[when-not start [set! start 0]]
[def pos-found [index-of str separator start]]
[if [>= pos-found 0]
[cons [string/cut str start pos-found]
[split/string str separator [+ pos-found [buffer/length separator]]]]
[cons [string/cut str start [buffer/length str]]
#nil]]]
[defn split [str separator]
"Splits STR into a list at every occurunse of SEPARATOR"
[typecheck/only str :string]
[typecheck/only separator :string]
[case [buffer/length separator]
[0 [split/empty str]]
[otherwise [split/string str separator 0]]]]
[defn read/single [text]
"Uses the reader and returns the first single value read from string TEXT"
[typecheck/only text :string]
[car [read text]]]
[defn read/int [text]
"Reads the first string from TEXT"
[int [read/single text]]]
[defn read/float [text]
"Reads the first float from TEXT"
[float [read/single text]]]
[defn buffer/length?! [chars]
[fn [a] [= chars [buffer/length a]]]]
[defn contains-any? [str chars]
[apply or [map [split chars ""]
[fn [a] [>= [index-of str a] 0]]]]]
[defn contains-all? [str chars]
[apply and [map [split chars ""]
[fn [a] [>= [index-of str a] 0]]]]]
[defn from-char-code l
"Turn the provided char codes into a string and return it"
[def buf [buffer/allocate [list/length l]]]
[dotimes [i [buffer/length buf] [buffer->string buf]]
[when [or [not [int? [car l]]]
[> [car l] 255]
[< [car l] 0]]
[exception :type-error "[from-char-code] expects :int arguments from 0 to 255, not: " [car l]]]
[buffer/set! buf i [car l]]
[cdr! l]]]
[defn char/whitespace? [c]
"Return #t if C is a whitespace char"
:inline
[<= c 33]]
[defn trim [s]
"Trim all whitespace off the beginning and end of S"
[def start 0]
[def end [buffer/length s]]
[while [and [< start end] [char/whitespace? [buffer/ref s start]]] [set! start [+ start 1]]]
[while [and [> end 0] [char/whitespace? [buffer/ref s [- end 1]]]] [set! end [- end 1]]]
[string/cut s start end]]
[defn lowercase/char [c]
[if [< c 65]
c
[if [> c 90]
c
[+ c 32]]]]
[defn uppercase/char [c]
[if [< c 97]
c
[if [> c 122]
c
[+ c -32]]]]
[defn uppercase [s]
"Uppercase a string S"
[def ret [buffer/allocate [buffer/length s]]]
[dotimes [i [buffer/length s] [buffer->string ret]]
[buffer/set! ret i [uppercase/char [buffer/ref s i]]]]]
[defn lowercase [s]
"Lowercase a string S"
[def ret [buffer/allocate [buffer/length s]]]
[dotimes [i [buffer/length s] [buffer->string ret]]
[buffer/set! ret i [lowercase/char [buffer/ref s i]]]]]
[defn capitalize [s]
"Capitalize a string S"
[def ret [buffer/allocate [buffer/length s]]]
[def caps? #t]
[dotimes [i [buffer/length s] [buffer->string ret]]
[buffer/set! ret i [[if caps? uppercase/char lowercase/char] [buffer/ref s i]]]
[set! caps? [if [char/whitespace? [buffer/ref s i]] #t #f]]]]
