carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-09-11 05:25:28 +03:00
Code Issues Projects Releases Wiki Activity

Changed type signature of (set! ...) form.

Browse Source
This commit is contained in:
Erik Svedäng 2018-02-02 07:19:10 +01:00
parent ccf1afaf84
commit 26887f3716
25 changed files with 124 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
README.md
View File

@ -48,7 +48,7 @@ The Carp REPL has built-in documentation, run ```(help)``` to access it!
(if (= &guess "q\n")
(do
(println "Good bye...")
(set! &play false))
(set! play false))
(do
(cond (< num answer) (println "Too low.")
(> num answer) (println "Too high.")

22
core/Array.carp
View File

@ -4,7 +4,7 @@
(let [total x]
(do
(for [i 0 (count xs)]
(set! &total (f &total (nth xs i))))
(set! total (f &total (nth xs i))))
total)))
(defn first [a]
@ -20,7 +20,7 @@
(for [i 0 (count a)]
(when (/= @(nth a i) @(nth b i))
(do
(set! &eq false)
(set! eq false)
(break))))
eq)))
@ -31,7 +31,7 @@
(for [i 1 n]
(let [x @(nth xs i)]
(if (< result x)
(set! &result x)
(set! result x)
())))
result)))
@ -42,7 +42,7 @@
(for [i 1 n]
(let [x @(nth xs i)]
(if (> result x)
(set! &result x)
(set! result x)
())))
result)))
@ -53,7 +53,7 @@
(let [result []]
(do
(for [i start-index end-index]
(set! &result (push-back @&result @(nth xs i))))
(set! result (push-back @&result @(nth xs i))))
result)))
(defn prefix-array [xs end-index]
@ -68,9 +68,9 @@
(while (Int.< i j)
(let-do [tmp @(nth &a i)]
(aset! &a i @(nth &a j))
(set! &i (Int.inc i))
(set! i (Int.inc i))
(aset! &a j tmp)
(set! &j (Int.dec j))))
(set! j (Int.dec j))))
a))
(defn index-of [a e]
@ -78,14 +78,14 @@
(for [i 0 (count a)]
(when (= @(nth a i) e)
(do
(set! &idx i)
(set! idx i)
(break))))
idx))
(defn element-count [a e]
(let-do [c 0]
(for [i 0 (count a)]
(when (= e @(nth a i)) (set! &c (Int.inc c))))
(when (= e @(nth a i)) (set! c (Int.inc c))))
c))
(defn aupdate [a i f]
@ -114,8 +114,8 @@
(while (op e end)
(do
(aset! &x i e)
(set! &i (Int.inc i))
(set! &e (+ e step))))
(set! i (Int.inc i))
(set! e (+ e step))))
x))
(defn sort [a]

14
core/Bench.carp
View File

@ -9,7 +9,7 @@
(defn set-min-runs! [n]
; / 2 because we run it twice per benchmarking run,
; but this is an implementation detail
(set! &min-runs (/ n 2)))
(set! min-runs (/ n 2)))
(defn get-unit [n]
(cond
@ -72,15 +72,15 @@
@(Statistics.Summary.median &summ5))
@(Statistics.Summary.median-abs-dev &summ5))))
(do
(set! &total (Double.+ total loop-run))
(set! &done true)
(set! &res &summ5))
(set! total (Double.+ total loop-run))
(set! done true)
(set! res &summ5))
(do
(set! &total (Double.+ total loop-run))
(set! total (Double.+ total loop-run))
(if (< (Double.* n 10.0) n)
; abort on overflow
(set! &total (Double.+ total 3000000000.0))
(set! &n (Double.* n 2.0)))))))
(set! total (Double.+ total 3000000000.0))
(set! n (Double.* n 2.0)))))))
(if done
(print-bench-results res total)
(IO.println "Could not stabilize benchmark after more than 3 seconds!")))))

6
core/Int.carp
View File

@ -51,9 +51,9 @@
(while (/= y 0)
(do
(when (/= (bit-and y 1) 0)
(set! &r (* r x)))
(set! &y (/ y 2))
(set! &x (* x x))))
(set! r (* r x)))
(set! y (/ y 2))
(set! x (* x x))))
r))
)

8
core/Macros.carp
View File

@ -44,7 +44,7 @@
(cond-internal xs))
(defmacro for [settings :rest body] ;; settings = variable, from, to, <step>
(if (> (count body) 1)
(if (> (count body) 1)
(macro-error "Warning: the body of the 'for' loop can only contain one expression")
(list
'let
@ -59,7 +59,7 @@
(car body)
body))
(list
'set! (list 'ref (car settings))
'set! (car settings)
(list 'Int.+
(car settings)
(if (= 4 (count settings)) ;; optional arg for step
@ -105,10 +105,10 @@
(thread-last-internal forms))
(defmacro swap! [x y]
(list 'let (array 'tmp y) (list 'do (list 'set! &y x) (list 'set! &x 'tmp))))
(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)))
(list 'set! x (list f x)))
(defmacro mac-only [:rest forms]
(if (= "darwin" (os))

6
core/Statistics.carp
View File

@ -23,7 +23,7 @@
(let [total @(Array.nth data 0)]
(do
(for [i 1 (Array.count data)]
(set! &total (+ total @(Array.nth data i))))
(set! total (+ total @(Array.nth data i))))
total))))
(defn mean [data]
@ -34,14 +34,14 @@
(do
(for [i 0 (Array.count a)]
(let [tmp (Double.- (Double.copy (Array.nth a i)) mean)]
(set! &sum (Double.* tmp tmp))))
(set! sum (Double.* tmp tmp))))
sum)))
(defn _xx [a mean]
(let [sum 0.0]
(do
(for [i 0 (Array.count a)]
(set! &sum (Double.- (Double.copy (Array.nth a i)) mean)))
(set! sum (Double.- (Double.copy (Array.nth a i)) mean)))
sum)))
(defn _ss [data]

14
core/String.carp
View File

@ -24,7 +24,7 @@
(let [str @""]
(do
(for [i 0 n]
(set! &str (append str @inpt)))
(set! str (append str @inpt)))
str)))
;; A temporary version of this function, until we have some nicer way to write it
@ -40,14 +40,14 @@
(if (Int.< 0 (Array.element-count &(the (Array Char) @&separators) @c))
(if (= 0 (String.count &word))
() ;; no word
(do (set! &result (Array.push-back @&result @&word))
(set! &word @"")))
(set! &word (append @&word (from-chars [@c])))))))
(do (set! result (Array.push-back @&result @&word))
(set! word @"")))
(set! word (append @&word (from-chars [@c])))))))
;; Some sweet code duplication for the final word:
(if (= 0 (String.count &word))
()
(do (set! &result (Array.push-back @&result @&word))
(set! &word @"")))
(do (set! result (Array.push-back @&result @&word))
(set! word @"")))
result)))
(defn words [s]
@ -68,7 +68,7 @@
(let-do [n 0]
(for [i 0 (count s)]
(when (= c (char-at s i))
(set! &n (Int.inc n))))
(set! n (Int.inc n))))
n))
(defn reverse [s]

6
core/Test.carp
View File

@ -31,7 +31,7 @@
(do
(for [i 0 len-color-table]
(if (String.= cname (Array.nth (Array.nth &(color-table) i) 0))
(set! &res @(Array.nth (Array.nth &(color-table) i) 1))
(set! res @(Array.nth (Array.nth &(color-table) i) 1))
()))
(String.append @"\x1b[" (String.append res @"m")))))
@ -104,8 +104,8 @@
(defdynamic with-test-internal [name forms]
(if (= (count forms) 1)
(list (list 'set! (list 'ref name) (list 'ref (car forms))))
(cons (list 'set! (list 'ref name) (list 'ref (car forms)))
(list (list 'set! name (list 'ref (car forms))))
(cons (list 'set! name (list 'ref (car forms)))
(with-test-internal name (cdr forms)))))

2
core/Vector.carp
View File

@ -217,7 +217,7 @@
(let [total []]
(do
(for [i 0 (Array.count a)]
(set! &total (Array.push-back @&total (f @(Array.nth a i) @(Array.nth b i)))))
(set! total (Array.push-back @&total (f @(Array.nth a i) @(Array.nth b i)))))
(VN.init (Array.count a) total))))
(defn zip [f a b]

4
examples/ant.carp
View File

@ -102,7 +102,7 @@
(do
(handle-events &app rend)
(draw rend &state)
(set! &state (tick state))
(set! state (tick state))
(SDL_Delay 2)))))
;; Just the model
@ -112,7 +112,7 @@
;; (let [state (create-state)]
;; (for [i 0 10000]
;; (do
;; (set! &state (tick state))
;; (set! state (tick state))
;; (IO.println &(str (State.dir &state)))
;; (IO.println &(str (Debug.memory-balance)))
;; (System.sleep-micros 1000)

8
examples/basics.carp
View File

@ -186,6 +186,13 @@
c2 (count &b)]
(println* &(str (+ c1 c2)))))
(defn changing-target-of-ref []
(let [s1 @"hello"
s2 @"goodbye"
r &s1]
(do (set! r &s2)
(IO.println r))))
(defn main []
(do (Things.call)
(use-doubles)
@ -219,4 +226,5 @@
(threading)
(multiple-stringification-of-arrays)
(two-counts-in-same-func)
(changing-target-of-ref)
))

44
examples/benchmark_mandelbrot.carp
View File

@ -1,4 +1,4 @@
;;; Taken from
;;; Taken from
;;; http://benchmarksgame.alioth.debian.org/u64q/program.php?test=mandelbrot&lang=gcc&id=2
(add-cflag "-Wall -pipe -O3 -fomit-frame-pointer -march=native")
@ -17,7 +17,7 @@
(register putc (Fn [Int FILE] ()))
(defn main []
(do
(do
(print &(string-join @"P4\n" (str w) @" " (str h) @"\n"))
(let [iter 50
limit 2.0
@ -25,43 +25,43 @@
bit_num 0]
(for [y 0 (to-int h)]
(for [x 0 (to-int w)]
(let [Zr 0.0
(let [Zr 0.0
Zi 0.0
Tr 0.0
Ti 0.0
Cr (- (/ (* 2.0 (from-int x)) w) 1.5)
Cr (- (/ (* 2.0 (from-int x)) w) 1.5)
Ci (- (/ (* 2.0 (from-int y)) w) 1.0)]
(do
(let [i 0]
(while (and (< i iter)
(<= (+ Tr Ti) (* limit limit)))
(do
(set! &Zi (+ (* 2.0 (* Zr Zi)) Ci))
(set! &Zr (+ (- Tr Ti) Cr))
(set! &Tr (* Zr Zr))
(set! &Ti (* Zi Zi))
(set! &i (inc i)))))
(set! Zi (+ (* 2.0 (* Zr Zi)) Ci))
(set! Zr (+ (- Tr Ti) Cr))
(set! Tr (* Zr Zr))
(set! Ti (* Zi Zi))
(set! i (inc i)))))
(set! byte_acc (* 2 byte_acc))
(set! &byte_acc (* 2 byte_acc))
(when (<= (+ Tr Ti) (* limit limit))
(set! &byte_acc (bit-or byte_acc 1)))
(set! &bit_num (inc bit_num))
(set! byte_acc (bit-or byte_acc 1)))
(set! bit_num (inc bit_num))
(if (= bit_num 8)
(do
(do
(putc byte_acc stdout)
(set! &byte_acc 0)
(set! &bit_num 0))
(set! byte_acc 0)
(set! bit_num 0))
(if (= x (- (to-int w) 1))
(do
(set! &byte_acc
(set! byte_acc
(bit-shift-left byte_acc (- 8 (mod (to-int w) 8))))
(putc byte_acc stdout)
(set! &byte_acc 0)
(set! &bit_num 0))
(set! byte_acc 0)
(set! bit_num 0))
())))))))))
;;; (build)
;;; (build)

10
examples/benchmark_n-body.carp
View File

@ -24,9 +24,9 @@
(while (/= y 0)
(do
(when (/= (bit-and y 1) 0)
(set! &r (* r x)))
(set! &y (/ y 2))
(set! &x (* x x))))
(set! r (* r x)))
(set! y (/ y 2))
(set! x (* x x))))
r))
(def n 50000000)
@ -67,7 +67,7 @@
(let-do [e 0.0]
(for [i 0 (count bodies)]
(let-do [b (nth bodies i)]
(set! &e (+ e (* 0.5 (* (Planet.mass b)
(set! e (+ e (* 0.5 (* (Planet.mass b)
(+ (ipow (Planet.vx b) 2)
(+ (ipow (Planet.vy b) 2)
(ipow (Planet.vz b) 2)))))))
@ -78,7 +78,7 @@
dy (- (Planet.y b) (Planet.y b2))
dz (- (Planet.z b) (Planet.z b2))
dist (sqrt (+ (ipow dx 2) (+ (ipow dy 2) (ipow dz 2))))]
(set! &e (- e (/ (* (Planet.mass b) (Planet.mass b2)) dist)))))))
(set! e (- e (/ (* (Planet.mass b) (Planet.mass b2)) dist)))))))
e))

2
examples/bugs.carp
View File

@ -9,7 +9,7 @@
;; (let [str ""]
;; (do
;; (for [i 0 n]
;; (set! &str &(append @str @inpt)))
;; (set! str &(append @str @inpt)))
;; @str)))
;; (defn main []
;; (let [strings (faulty-repeat 20 "x")]

2
examples/generic_structs.carp
View File

@ -17,7 +17,7 @@
(for [i 0 (count pairs)]
(let [pair (nth pairs i)]
(when (= (Entry.key pair) &lookup-key)
(set! &result @(Entry.value pair)))))
(set! result @(Entry.value pair)))))
result))
(defn try-dictionary []

2
examples/globals.carp
View File

@ -17,7 +17,7 @@
(do
;;(IO.println s)
(IO.println &(A.str &a))
;;(set! &a (A.init 123))
;;(set! a (A.init 123))
;;(IO.println &(A.str &a))
(IO.println &(str &q))
(IO.println &(str &stuff))

6
examples/guessing.carp
View File

@ -11,14 +11,14 @@
(do (println "~ The Number Guessing Game ~")
(println "(Enter q to quit.)\n")
(set! &guessing true)
(set! &answer (random-between 1 100))
(set! guessing true)
(set! answer (random-between 1 100))
(print "Please enter a number between 1 - 99: ")))
(defn exit! []
(do (println "Good bye...")
(set! &guessing false)))
(set! guessing false)))
(defn play-again? [user-input]
(if (= user-input "y\n") true false))

14
examples/reptile.carp
View File

@ -71,8 +71,8 @@
(or (= key SDLK_RIGHT)
(or (= key SDLK_UP)
(or (= key SDLK_LEFT) (= key SDLK_DOWN))))
(set! &input-dir key)
(= key SDLK_RETURN) (set! &reset true)
(set! input-dir key)
(= key SDLK_RETURN) (set! reset true)
(= key SDLK_ESCAPE) (quit app)
()))
()
@ -92,7 +92,7 @@
(while (> i -1)
(do
(aset! body (inc i) @(nth body i))
(set! &i (dec i)))))
(set! i (dec i)))))
@body))
(defn create-human []
@ -172,12 +172,12 @@
(while (not (World.dead &world))
(if reset
(do
(set! &input-dir SDLK_RIGHT)
(set! &world (create-world))
(set! &reset false))
(set! input-dir SDLK_RIGHT)
(set! world (create-world))
(set! reset false))
(do
(let [new-world (tick &world)]
(set! &world new-world))
(set! world new-world))
(handle-events &app rend &world)
(draw rend &world)
(SDL_Delay 50))))

13
examples/temp.carp
View File

@ -8,3 +8,16 @@
;; (Bucket.init 0 []))
;; (defn f []
;; (the (Bucket Float Bool) (empty))) ;; run checks in the concretizer to fix this
(defn changing-target-of-ref []
(let [s1 @"hello"
s2 @"goodbye"
r &s1]
(do (set! r &s2)
(IO.println r))))
(defn )
(defn main []
)

2
src/GenerateConstraints.hs
View File

@ -103,7 +103,7 @@ genConstraints root = fmap sort (gen root)
do insideValueConstraints <- gen value
variableType <- toEither (ty variable) (ExpressionMissingType variable)
valueType <- toEither (ty value) (ExpressionMissingType value)
let sameTypeConstraint = Constraint variableType (RefTy valueType) variable value OrdSetBang
let sameTypeConstraint = Constraint variableType valueType variable value OrdSetBang
return (sameTypeConstraint : insideValueConstraints)
-- The

12
test/control_flow.carp
View File

@ -9,35 +9,35 @@
(while (< x 10)
(if (> x 4)
(break)
(set! &x (inc x))))
(set! x (inc x))))
x)))
(defn when-test-true []
(let [x 0]
(do
(when true
(set! &x 5))
(set! x 5))
x)))
(defn when-test-false []
(let [x 0]
(do
(when false
(set! &x 5))
(set! x 5))
x)))
(defn unless-test-true []
(let [x 0]
(do
(unless true
(set! &x 5))
(set! x 5))
x)))
(defn unless-test-false []
(let [x 0]
(do
(unless false
(set! &x 5))
(set! x 5))
x)))
(defn all-eq [a b]
@ -47,7 +47,7 @@
(do
(for [i 0 (Array.count a)]
(if (/= @(Array.nth a i) @(Array.nth b i))
(set! &eq false)
(set! eq false)
()))
eq))))

4
test/macros.carp
View File

@ -3,12 +3,12 @@
(defn test-do-let []
(let-do [x 1]
(set! &x (+ x 1))
(set! x (+ x 1))
(= x 2)))
(defn test-comment []
(let-do [x 1]
(comment (set! &x (+ x 1)))
(comment (set! x (+ x 1)))
(= x 1)))
(defn test-case-dflt []

13
test/memory.carp
View File

@ -96,22 +96,24 @@
(defn setting-1 []
(let [s @""]
(do (set! &s @"")
(do (set! s @"")
())))
(defn setting-2 []
(let [s @""]
(do (set! &s s)
(do (set! s s)
())))
(defn setting-3 []
(let [s @""]
(do (set! &s @&s)
(do (set! s @&s)
())))
(defn setting-4 []
(let [s ""]
(do ;;(set! s @s) ;; Here the variable itself is a ref!
(let [s @""
t @""
r &s]
(do (set! r &t) ;; Here the set variable is a ref.
())))
(defn branching [b s]
@ -145,6 +147,7 @@
(assert-no-leak test setting-1 "setting-1 does not leak")
(assert-no-leak test setting-2 "setting-2 does not leak")
(assert-no-leak test setting-3 "setting-3 does not leak")
(assert-no-leak test setting-4 "setting-4 does not leak")
(assert-no-leak test if-1 "if-1 does not leak")
(assert-no-leak test if-2 "if-2 does not leak")
(print-test-results test))))

4
test/safe_artihmetic.carp
View File

@ -9,14 +9,14 @@
(let [c 0
_ false]
(do
(set! &_ (f a b &c))
(set! _ (f a b &c))
c)))
(defn return-res-long [f a b]
(let [c 0l
_ false]
(do
(set! &_ (f a b &c))
(set! _ (f a b &c))
c)))
(defn main []

4
test/statistics.carp
View File

@ -10,7 +10,7 @@
(do
(for [i 0 (Array.count a)]
(if (not (Double.= @(Array.nth a i) @(Array.nth b i)))
(set! &res false)
(set! res false)
()))
res))))
@ -21,7 +21,7 @@
(do
(for [i 0 (Array.count a)]
(if (not (Double.approx @(Array.nth a i) @(Array.nth b i)))
(set! &res false)
(set! res false)
()))
res))))