mirror of
https://github.com/carp-lang/Carp.git
synced 2024-10-26 13:51:50 +03:00
core: added a few more functions to stdlib
This commit is contained in:
parent
de40aef4d8
commit
d32fe4102f
@ -87,4 +87,24 @@
|
||||
(for [i 0 (count a)]
|
||||
(when (= e @(nth a i)) (set! &c (Int.inc c))))
|
||||
c))
|
||||
|
||||
(defn aupdate [a i f]
|
||||
(aset @a i (f (nth a i))))
|
||||
|
||||
(defn aupdate! [a i f]
|
||||
(aset! a i (f (nth a i))))
|
||||
|
||||
(defn swap [a i j]
|
||||
(let [x @(nth a i)
|
||||
y @(nth a j)]
|
||||
(aset (aset @a i y) j x)))
|
||||
|
||||
(defn swap! [a i j]
|
||||
(let-do [x @(nth a i)
|
||||
y @(nth a j)]
|
||||
(aset! a i y)
|
||||
(aset! a j x)))
|
||||
|
||||
;(defmacro push-back! [a e]
|
||||
; (list 'set! a (list 'Array.push-back (list 'copy a) e)))
|
||||
)
|
||||
|
@ -25,4 +25,7 @@
|
||||
(= @char-ref \8) 8
|
||||
(= @char-ref \9) 9
|
||||
-1))
|
||||
|
||||
(defn /= [a b]
|
||||
(not (= a b)))
|
||||
)
|
||||
|
@ -1,3 +1,32 @@
|
||||
(defdynamic caar [pair] (car (car pair)))
|
||||
(defdynamic cadr [pair] (car (cdr pair)))
|
||||
(defdynamic cdar [pair] (cdr (car pair)))
|
||||
(defdynamic cddr [pair] (cdr (cdr pair)))
|
||||
(defdynamic caaar [pair] (car (car (car pair))))
|
||||
(defdynamic caadr [pair] (car (car (cdr pair))))
|
||||
(defdynamic cadar [pair] (car (cdr (car pair))))
|
||||
(defdynamic cdaar [pair] (cdr (car (car pair))))
|
||||
(defdynamic caddr [pair] (car (cdr (cdr pair))))
|
||||
(defdynamic cdadr [pair] (cdr (car (cdr pair))))
|
||||
(defdynamic cddar [pair] (cdr (cdr (car pair))))
|
||||
(defdynamic cdddr [pair] (cdr (cdr (cdr pair))))
|
||||
(defdynamic caaaar [pair] (car (car (car (car pair)))))
|
||||
(defdynamic caaadr [pair] (car (car (car (cdr pair)))))
|
||||
(defdynamic caadar [pair] (car (car (cdr (car pair)))))
|
||||
(defdynamic caaddr [pair] (car (car (cdr (cdr pair)))))
|
||||
(defdynamic cadaar [pair] (car (cdr (car (car pair)))))
|
||||
(defdynamic cadadr [pair] (car (cdr (car (cdr pair)))))
|
||||
(defdynamic caddar [pair] (car (cdr (cdr (car pair)))))
|
||||
(defdynamic cadddr [pair] (car (cdr (cdr (cdr pair)))))
|
||||
(defdynamic cdaaar [pair] (cdr (car (car (car pair)))))
|
||||
(defdynamic cdaadr [pair] (cdr (car (car (cdr pair)))))
|
||||
(defdynamic cdadar [pair] (cdr (car (cdr (car pair)))))
|
||||
(defdynamic cdaddr [pair] (cdr (car (cdr (cdr pair)))))
|
||||
(defdynamic cddaar [pair] (cdr (cdr (car (car pair)))))
|
||||
(defdynamic cddadr [pair] (cdr (cdr (car (cdr pair)))))
|
||||
(defdynamic cdddar [pair] (cdr (cdr (cdr (car pair)))))
|
||||
(defdynamic cddddr [pair] (cdr (cdr (cdr (cdr pair)))))
|
||||
|
||||
(defdynamic cond-internal [xs]
|
||||
(if (= (count xs) 0)
|
||||
(list)
|
||||
@ -8,8 +37,8 @@
|
||||
(list
|
||||
'if
|
||||
(car xs)
|
||||
(car (cdr xs))
|
||||
(cond-internal (cdr (cdr xs))))))))
|
||||
(cadr xs)
|
||||
(cond-internal (cddr xs)))))))
|
||||
|
||||
(defmacro cond [:rest xs]
|
||||
(cond-internal xs))
|
||||
@ -17,10 +46,10 @@
|
||||
(defmacro for [settings body] ;; settings = variable, from, to, <step>
|
||||
(list
|
||||
'let
|
||||
(array (car settings) (car (cdr settings)))
|
||||
(array (car settings) (cadr settings))
|
||||
(list
|
||||
'while
|
||||
(list 'Int.< (car settings) (car (cdr (cdr settings))))
|
||||
(list 'Int.< (car settings) (caddr settings))
|
||||
(list 'do
|
||||
body
|
||||
(list
|
||||
@ -28,7 +57,7 @@
|
||||
(list 'Int.+
|
||||
(car settings)
|
||||
(if (= 4 (count settings)) ;; optional arg for step
|
||||
(car (cdr (cdr (cdr settings))))
|
||||
(cadddr settings)
|
||||
1)))))))
|
||||
|
||||
(defmacro refstr [x]
|
||||
@ -42,10 +71,10 @@
|
||||
(defdynamic thread-first-internal [xs]
|
||||
(if (= (count xs) 2)
|
||||
(if (list? (last xs))
|
||||
(cons (car (car (cdr xs)))
|
||||
(cons (caadr xs)
|
||||
(cons (car xs)
|
||||
(cdr (car (cdr xs)))))
|
||||
(list (car (cdr xs)) (car xs)))
|
||||
(cdadr xs)))
|
||||
(list (cadr xs) (car xs)))
|
||||
(if (list? (last xs))
|
||||
(append
|
||||
(list
|
||||
@ -58,7 +87,7 @@
|
||||
(if (= (count xs) 2)
|
||||
(if (list? (last xs))
|
||||
(cons-last (car xs) (last xs))
|
||||
(list (car (cdr xs)) (car xs)))
|
||||
(list (cadr xs) (car xs)))
|
||||
(if (list? (last xs))
|
||||
(cons-last (thread-last-internal (all-but-last xs)) (last xs))
|
||||
(list (last xs) (thread-last-internal (all-but-last xs))))))
|
||||
@ -72,6 +101,9 @@
|
||||
(defmacro swap! [x y]
|
||||
(list 'let (array 'tmp y) (list 'do (list 'set! &y x) (list 'set! &x 'tmp))))
|
||||
|
||||
(defmacro update! [x f]
|
||||
(list 'set! &x (list f x)))
|
||||
|
||||
(defmacro mac-only [:rest forms]
|
||||
(if (= "darwin" (os))
|
||||
(cons (quote do) forms)
|
||||
@ -125,8 +157,8 @@
|
||||
(car xs)
|
||||
(list 'if
|
||||
(list '= name (car xs))
|
||||
(car (cdr xs))
|
||||
(case-internal name (cdr (cdr xs))))))))
|
||||
(cadr xs)
|
||||
(case-internal name (cddr xs)))))))
|
||||
|
||||
(defmacro case [name :rest forms]
|
||||
(case-internal name forms))
|
||||
|
@ -79,6 +79,21 @@
|
||||
|
||||
(defn random-sized [n]
|
||||
(from-chars (Array.repeat n Char.random)))
|
||||
|
||||
(defn substring [s a b]
|
||||
(from-chars (Array.subarray &(chars s) a b)))
|
||||
|
||||
(defn prefix-string [s a]
|
||||
(from-chars (Array.prefix-array &(chars s) a)))
|
||||
|
||||
(defn suffix-string [s b]
|
||||
(from-chars (Array.suffix-array &(chars s) b)))
|
||||
|
||||
(defn starts-with? [s sub]
|
||||
(= sub &(prefix-string s (count sub))))
|
||||
|
||||
(defn ends-with? [s sub]
|
||||
(= sub &(suffix-string s (count sub))))
|
||||
)
|
||||
|
||||
(defmodule StringCopy
|
||||
|
@ -10,6 +10,8 @@
|
||||
|
||||
(defn excl [x] (String.append x @"!"))
|
||||
|
||||
(defn inc-ref [x] (+ @x 1))
|
||||
|
||||
(defn main []
|
||||
(let [a (range 0 9 1)
|
||||
b (Array.replicate 5 "Hi")]
|
||||
@ -84,4 +86,14 @@
|
||||
&(endo-map excl b)
|
||||
"endo-map works as expected"
|
||||
)
|
||||
(assert-equal test
|
||||
&[1 2]
|
||||
&(swap &[2 1] 0 1)
|
||||
"swap works as expected"
|
||||
)
|
||||
(assert-equal test
|
||||
&[1 3]
|
||||
&(aupdate &[1 2] 1 inc-ref)
|
||||
"aupdate works as expected"
|
||||
)
|
||||
(print-test-results test))))
|
||||
|
@ -55,5 +55,30 @@
|
||||
&(chars "erik")
|
||||
"chars works as expected"
|
||||
)
|
||||
(assert-equal test
|
||||
"edan"
|
||||
&(substring "svedang" 2 6)
|
||||
"substring works as expected"
|
||||
)
|
||||
(assert-equal test
|
||||
"sved"
|
||||
&(prefix-string "svedang" 4)
|
||||
"prefix-string works as expected"
|
||||
)
|
||||
(assert-equal test
|
||||
"dang"
|
||||
&(suffix-string "svedang" 3)
|
||||
"suffix-string works as expected"
|
||||
)
|
||||
(assert-equal test
|
||||
true
|
||||
(ends-with? "heller" "ler")
|
||||
"ends-with? works as expected"
|
||||
)
|
||||
(assert-equal test
|
||||
true
|
||||
(starts-with? "heller" "hell")
|
||||
"starts-with? works as expected"
|
||||
)
|
||||
(print-test-results test)
|
||||
))
|
||||
|
Loading…
Reference in New Issue
Block a user