application/octet-stream
•
3.06 KB
•
152 lines
;; Contains various little pieces that were implemented in nujel instead of
;; C because of various reasons
[def default [λ [arg default-value]
"Returns ARG or DEFAULT-VALUE if ARG is #nil"
[if arg arg default-value]
]]
[def caar [λ [p]
"[car [car p]]"
[car [car p]]
]]
[def cadr [λ [p]
"[car [cdr p]]"
[car [cdr p]]
]]
[def cdar [λ [p]
"[cdr [car p]]"
[cdr [car p]]
]]
[def cddr [λ [p]
"[cdr [cdr p]]"
[cdr [cdr p]]
]]
[def caddr [λ [p]
"[car [cdr [cdr p]]]"
[car [cdr [cdr p]]]
]]
[def cdddr [λ [p]
"[cdr [cdr [cdr p]]]"
[cdr [cdr [cdr p]]]
]]
[def cadddr [λ [p]
"[car [cdr [cdr [cdr p]]]]"
[car [cdr [cdr [cdr p]]]]
]]
[def ++ [λ [i]
"[+ I 1]"
[+ i 1]
]]
[def -- [λ [i]
"[- I 1]"
[- i 1]
]]
[def >> [λ [val amount]
"Shifts VAL by AMOUNT bits to the right"
[ash val [- amount]]
]]
[def length [λ [a]
"Returns the length of a"
[cond [[string? a] [str/length a]]
[[pair? a] [list-length a]]
[#t 0]
]
]]
[def describe [λ [a] "Returns the DocString to its argument, if available"
[cond [[not [string? a]] "Please quote the symbol in question, like [describe \"help\"]"]
[#t [let [[ds [car [cl-text [resolve [str->sym a]]]]]
[args [arg-list [resolve [str->sym a]]]]
[fn [cat a]]]
["[" fn args "] - " [if [string? ds] ds "No DocString found"]]]]
]
]]
[def display [λ [value]
"Display VALUE"
[print value]
]]
[def newline [λ []
"Print a single line feed character"
[display "\n"]
]]
[def list [λ [...arguments]
"Return ARGUMENTS as a list"
...arguments
]]
[def arr-fill! [λ [a v i]
"Fills array a with value v"
[cond [[>= [int i] [arr-length a]] a]
[#t [arr-set! a [int i] v] [arr-fill! a v [++ i]]]
]
]]
[def min [let []
[def iter [λ [a l]
[cond [[nil? l] a]
[[< a [car l]] [iter a [cdr l]]]
[#t [iter [car l] [cdr l]]]
]
]]
[λ [...l]
"Returns the minimum value of its arguments"
[cond [[nil? ...l] 0]
[[nil? [cdr ...l]] [car ...l]]
[#t [iter [car ...l] [cdr ...l]]]
]
]
]]
[def max [let []
[def iter [λ [a l]
[cond [[nil? l] a]
[[> a [car l]] [iter a [cdr l]]]
[#t [iter [car l] [cdr l]]]
]
]]
[λ [...l]
"Returns the maximum value of its arguments"
[cond [[nil? ...l] 0]
[[nil? [cdr ...l]] [car ...l]]
[#t [iter [car ...l] [cdr ...l]]]
]
]
]]
[def lognand [λ [...l]
"Returns the Nand of its arguments"
[lognot [apply logand ...l]]
]]
[def mem [λ [] "Return some pretty printed memory usage information"
[let [[info [memory-info]]] [cat
[ansi-white "Memory Info"] "\n"
[ansi-green "Values: "] [getf info :value] "\n"
[ansi-blue "Closures: "] [getf info :closure] "\n"
[ansi-red "Arrays: "] [getf info :array] "\n"
[ansi-yellow "STrings: "] [getf info :string] "\n"
[ansi-cyan "NFunc: "] [getf info :native-function] "\n"
[ansi-purple "Vectors: "] [getf info :vector] "\n"
[ansi-pink "Symbols: "] [getf info :symbol] "\n" [ansi-reset]
]]
]]
[def wrap-value [λ [val min max] "Constrains VAL to be within MIN and MAX, wrapping it around"
[+ min [% [- val min] [- max min]]]
]]