mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
Deftype generates 'update' functions that expect refs to functions too.
This commit is contained in:
parent
fe55144273
commit
1dc8b536fc
@ -102,7 +102,7 @@
|
||||
(doc put "Put a a value v into map m, using the key k.")
|
||||
(defn put [m k v]
|
||||
(let [idx (Int.mod (hash k) @(n-buckets &m))]
|
||||
(update-buckets m (fn [b]
|
||||
(update-buckets m &(fn [b]
|
||||
(let [n (Array.nth &b idx)]
|
||||
(Array.aset b idx (Bucket.grow n (Pair.init @k @v))))))))
|
||||
|
||||
@ -130,7 +130,7 @@
|
||||
(doc remove "Remove the value under the key k from the map m.")
|
||||
(defn remove [m k]
|
||||
(let [idx (Int.mod (hash k) @(n-buckets &m))]
|
||||
(update-buckets m (fn [b]
|
||||
(update-buckets m &(fn [b]
|
||||
(let [n (Array.nth &b idx)]
|
||||
(Array.aset b idx (Bucket.shrink n k)))))))
|
||||
|
||||
@ -217,7 +217,7 @@
|
||||
(doc put "Put a a key k into the set s.")
|
||||
(defn put [s k]
|
||||
(let [idx (Int.mod (hash k) @(n-buckets &s))]
|
||||
(update-buckets s (fn [b]
|
||||
(update-buckets s &(fn [b]
|
||||
(let [n (Array.nth &b idx)]
|
||||
(Array.aset b idx (SetBucket.grow n @k)))))))
|
||||
|
||||
@ -240,7 +240,7 @@
|
||||
(doc remove "Remove the key k from the set s.")
|
||||
(defn remove [s k]
|
||||
(let [idx (Int.mod (hash k) @(n-buckets &s))]
|
||||
(update-buckets s (fn [b]
|
||||
(update-buckets s &(fn [b]
|
||||
(let [n (Array.nth &b idx)]
|
||||
(Array.aset b idx (SetBucket.shrink n k)))))))
|
||||
|
||||
|
@ -8,7 +8,7 @@
|
||||
(if (op expected actual)
|
||||
(do
|
||||
(IO.colorize "green" &(str* @"Test '" @descr @"' passed\n"))
|
||||
(State.update-passed (State.copy state) Int.inc))
|
||||
(State.update-passed (State.copy state) &Int.inc))
|
||||
(do
|
||||
(IO.color "red")
|
||||
(IO.println &(str* @"Test '" @descr @"' failed:"))
|
||||
@ -16,7 +16,7 @@
|
||||
(IO.print &(str expected))
|
||||
(IO.println &(str* @"', actual value: '" (str actual) @"'"))
|
||||
(IO.color "reset")
|
||||
(State.update-failed (State.copy state) Int.inc))))
|
||||
(State.update-failed (State.copy state) &Int.inc))))
|
||||
|
||||
(doc assert-op "Assert that op returns true when given x and y.")
|
||||
(defn assert-op [state x y descr op]
|
||||
|
@ -581,7 +581,7 @@
|
||||
instantiate
|
||||
</div>
|
||||
<p class="sig">
|
||||
(λ [(Map a b), (λ [(Array (Bucket a b))] (Array (Bucket a b)))] (Map a b))
|
||||
(λ [(Map a b), (Ref (λ [(Array (Bucket a b))] (Array (Bucket a b))))] (Map a b))
|
||||
</p>
|
||||
<span>
|
||||
|
||||
@ -600,7 +600,7 @@
|
||||
instantiate
|
||||
</div>
|
||||
<p class="sig">
|
||||
(λ [(Map a b), (λ [Int] Int)] (Map a b))
|
||||
(λ [(Map a b), (Ref (λ [Int] Int))] (Map a b))
|
||||
</p>
|
||||
<span>
|
||||
|
||||
|
@ -305,7 +305,7 @@
|
||||
instantiate
|
||||
</div>
|
||||
<p class="sig">
|
||||
(λ [V2, (λ [Double] Double)] V2)
|
||||
(λ [V2, (Ref (λ [Double] Double))] V2)
|
||||
</p>
|
||||
<span>
|
||||
|
||||
@ -324,7 +324,7 @@
|
||||
instantiate
|
||||
</div>
|
||||
<p class="sig">
|
||||
(λ [V2, (λ [Double] Double)] V2)
|
||||
(λ [V2, (Ref (λ [Double] Double))] V2)
|
||||
</p>
|
||||
<span>
|
||||
|
||||
|
@ -343,7 +343,7 @@
|
||||
instantiate
|
||||
</div>
|
||||
<p class="sig">
|
||||
(λ [V3, (λ [Double] Double)] V3)
|
||||
(λ [V3, (Ref (λ [Double] Double))] V3)
|
||||
</p>
|
||||
<span>
|
||||
|
||||
@ -362,7 +362,7 @@
|
||||
instantiate
|
||||
</div>
|
||||
<p class="sig">
|
||||
(λ [V3, (λ [Double] Double)] V3)
|
||||
(λ [V3, (Ref (λ [Double] Double))] V3)
|
||||
</p>
|
||||
<span>
|
||||
|
||||
@ -381,7 +381,7 @@
|
||||
instantiate
|
||||
</div>
|
||||
<p class="sig">
|
||||
(λ [V3, (λ [Double] Double)] V3)
|
||||
(λ [V3, (Ref (λ [Double] Double))] V3)
|
||||
</p>
|
||||
<span>
|
||||
|
||||
|
@ -324,7 +324,7 @@
|
||||
instantiate
|
||||
</div>
|
||||
<p class="sig">
|
||||
(λ [VN, (λ [Int] Int)] VN)
|
||||
(λ [VN, (Ref (λ [Int] Int))] VN)
|
||||
</p>
|
||||
<span>
|
||||
|
||||
@ -343,7 +343,7 @@
|
||||
instantiate
|
||||
</div>
|
||||
<p class="sig">
|
||||
(λ [VN, (λ [(Array Double)] (Array Double))] VN)
|
||||
(λ [VN, (Ref (λ [(Array Double)] (Array Double)))] VN)
|
||||
</p>
|
||||
<span>
|
||||
|
||||
|
@ -91,7 +91,7 @@
|
||||
|
||||
(defn updating []
|
||||
(let [p1 (Peep.init 9999 (String.copy "jaha") (A.init (String.copy "mmm")))
|
||||
p2 (Peep.update-x p1 inc)]
|
||||
p2 (Peep.update-x p1 &inc)]
|
||||
(println (ref (str @(Peep.x (ref p2)))))))
|
||||
|
||||
(defn character []
|
||||
|
@ -15,7 +15,7 @@
|
||||
f (λ [SelfReferencer] SelfReferencer)])
|
||||
|
||||
(defn change-self [self]
|
||||
(SelfReferencer.update-hp self inc))
|
||||
(SelfReferencer.update-hp self &inc))
|
||||
|
||||
(deftype (GenericFuncMember a) [f (λ [a] a)])
|
||||
|
||||
|
@ -38,7 +38,7 @@
|
||||
(IO.println &(str &(Pair.init 10 @"hello")))
|
||||
(IO.println &(str &(Pair.init true 3.2)))
|
||||
(IO.println &(str &(Pair.init [1 2 3] [true false true false])))
|
||||
(IO.println &(str &(Pair.update-a (Pair.init 100 100) Int.inc)))
|
||||
(IO.println &(str &(Pair.update-a (Pair.init 100 100) &Int.inc)))
|
||||
(IO.println &(str &(Pair.set-b (Pair.init 100 100) 200)))
|
||||
(IO.println &(str @(Pair.a &(Pair.init 100 100))))
|
||||
(try-dictionary)
|
||||
|
@ -108,7 +108,7 @@
|
||||
(+ i 2))
|
||||
|
||||
(defn grow [snake]
|
||||
(let [new-snake (Snake.update-freeze snake inc2)
|
||||
(let [new-snake (Snake.update-freeze snake &inc2)
|
||||
b (Snake.body &new-snake)]
|
||||
(Snake.set-body new-snake (push-back @b (last b)))))
|
||||
|
||||
|
@ -13,8 +13,8 @@
|
||||
(defmodule Pos
|
||||
(defn move [pos]
|
||||
(=> pos
|
||||
(Pos.update-x incf)
|
||||
(Pos.update-y incf))))
|
||||
(Pos.update-x &incf)
|
||||
(Pos.update-y &incf))))
|
||||
|
||||
(deftype Monster
|
||||
[pos Pos
|
||||
@ -29,7 +29,7 @@
|
||||
100
|
||||
@name))
|
||||
(defn move [monster]
|
||||
(Monster.update-pos monster Pos.move)))
|
||||
(Monster.update-pos monster &Pos.move)))
|
||||
|
||||
(defn main []
|
||||
(do
|
||||
|
@ -86,7 +86,7 @@ templatesForSingleMember typeEnv env insidePath p@(StructTy typeName _) (nameXOb
|
||||
else instanceBinderWithDeps (SymPath insidePath ("set-" ++ memberName)) (FuncTy [p, t] p) (templateSetter typeEnv env (mangle memberName) t)
|
||||
,instanceBinderWithDeps (SymPath insidePath ("set-" ++ memberName ++ "!")) (FuncTy [RefTy (p), t] UnitTy) (templateMutatingSetter typeEnv env (mangle memberName) t)
|
||||
,instanceBinderWithDeps (SymPath insidePath ("update-" ++ memberName))
|
||||
(FuncTy [p, FuncTy [t] t] p)
|
||||
(FuncTy [p, RefTy (FuncTy [t] t)] p)
|
||||
(templateUpdater (mangle memberName))]
|
||||
|
||||
-- | The template for getters of a deftype.
|
||||
@ -159,13 +159,13 @@ templateMutatingSetter typeEnv env memberName memberTy =
|
||||
templateUpdater :: String -> Template
|
||||
templateUpdater member =
|
||||
Template
|
||||
(FuncTy [VarTy "p", FuncTy [VarTy "t"] (VarTy "t")] (VarTy "p"))
|
||||
(const (toTemplate "$p $NAME($p p, Lambda updater)")) -- "Lambda" used to be: $(Fn [t] t)
|
||||
(FuncTy [VarTy "p", RefTy (FuncTy [VarTy "t"] (VarTy "t"))] (VarTy "p"))
|
||||
(const (toTemplate "$p $NAME($p p, Lambda *updater)")) -- "Lambda" used to be: $(Fn [t] t)
|
||||
(const (toTemplate (unlines ["$DECL {"
|
||||
," p." ++ member ++ " = " ++ (templateCodeForCallingLambda "updater" (FuncTy [VarTy "t"] (VarTy "t")) ["p." ++ member]) ++ ";"
|
||||
," p." ++ member ++ " = " ++ (templateCodeForCallingLambda "(*updater)" (FuncTy [VarTy "t"] (VarTy "t")) ["p." ++ member]) ++ ";"
|
||||
," return p;"
|
||||
,"}\n"])))
|
||||
(\(FuncTy [_, t@(FuncTy fArgTys fRetTy)] _) ->
|
||||
(\(FuncTy [_, RefTy t@(FuncTy fArgTys fRetTy)] _) ->
|
||||
if isTypeGeneric fRetTy
|
||||
then []
|
||||
else [defineFunctionTypeAlias t, defineFunctionTypeAlias (FuncTy (lambdaEnvTy : fArgTys) fRetTy)])
|
||||
|
@ -84,7 +84,7 @@
|
||||
(defn struct-4 []
|
||||
(let [a (A.init @"")
|
||||
b (B.init a)
|
||||
c (B.update-a b h)]
|
||||
c (B.update-a b &h)]
|
||||
()))
|
||||
|
||||
(defn struct-5 []
|
||||
|
Loading…
Reference in New Issue
Block a user