application/octet-stream
•
7.04 KB
•
188 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 [α]
"Return string α as a keyword"
[symbol->keyword [str->sym α]]]
[defn string->byte-array [a]
"Turn a string into an UTF-8 encoded byte array"
[def ret [array/allocate [string/length a]]]
[for [i 0 [string/length a]]
[array/set! ret i [char-at a i]]]
ret]
[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"
[print [cat str "\r\n"]]]
[defn display [value]
"Display VALUE"
[print value]]
[defn newline []
"Print a single line feed character"
[display "\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] [string/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 int->string/binary [α]
"Turn α into a its **binary** string representation"
[def ret ""]
[when-not α [def α 0]]
[when [zero? α] [set! ret "0"]]
[while [not-zero? α]
[set! ret [cat [from-char-code [+ #\0 [logand α #b1]]] ret]]
[set! α [ash α -1]]]
ret]
[defn int->string/octal [α]
"Turn α into a its **octal** string representation"
[def ret ""]
[when-not α [def α 0]]
[when [zero? α] [set! ret "0"]]
[while [not-zero? α]
[set! ret [cat [from-char-code [+ #\0 [logand α #b111]]] ret]]
[set! α [ash α -3]]]
ret]
[def int->string/hex/conversion-arr #["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"]]
[defn int->string/HEX [α]
"Turn α into a its **hexadecimal** string representation"
[def ret ""]
[when-not α [def α 0]]
[when [zero? α] [set! ret "0"]]
[when [< α 0] [throw [list :type-error "Can't print negative numbers in hex for now" α [current-lambda]]]]
[while [not-zero? α]
[set! ret [cat [array/ref int->string/hex/conversion-arr [logand α #b1111]] ret]]
[set! α [ash α -4]]]
ret]
[defn int->string/hex [α]
"Turn α into a its **hexadecimal** string representation"
[lowercase [int->string/HEX α]]]
[defn int->string/decimal [α]
"Turn α into a its **decimal** string representation"
[string α]]
[def int->string int->string/decimal]
[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 [< [string/length text] goal-length]
[set! text [cat char text]]]
[if [> [string/length text] goal-length]
[string/cut text [- [string/length text] goal-length] [string/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 [< [string/length text] goal-length]
[set! text [cat text char]]]
[if [> [string/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 [< [string/length text] goal-length]
[set! text [cat char text char]]]
[if [> [string/length text] goal-length]
[let [[end-overflow [/ [- [string/length text] goal-length] 2]]
[start-overflow [- [- [string/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 [string/length str]]
[def start 0]
[def ret #nil]
[while [< start slen]
[set! ret [cons [string/cut str start [+ 1 start]] ret]]
[++ 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 [string/length separator]]]]
[cons [string/cut str start [string/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 [string/length separator]
[0 [split/empty str]]
[otherwise [split/string str separator 0]]]]
[defn read/single [text]
[typecheck/only text :string]
[car [read text]]]
[defn string/length?! [chars]
[fn [a] [== chars [string/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]]]]]
