carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-10-26 05:45:37 +03:00
Code Issues Projects Releases Wiki Activity

core: added a few more functions to stdlib

Browse Source
This commit is contained in:
hellerve 2018-01-02 18:13:52 +01:00
parent de40aef4d8
commit d32fe4102f
6 changed files with 118 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
core/Array.carp
View File

@ -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)))
)

3
core/Char.carp
View File

@ -25,4 +25,7 @@
(= @char-ref \8) 8
(= @char-ref \9) 9
-1))
(defn /= [a b]
(not (= a b)))
)

54
core/Macros.carp
View File

@ -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))

15
core/String.carp
View File

@ -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

12
test/array.carp
View File

@ -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))))

25
test/string.carp
View File

@ -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)
))