Deftype generates 'update' functions that expect refs to functions too.

This commit is contained in:
Erik Svedäng 2018-11-14 14:21:12 +01:00
parent fe55144273
commit 1dc8b536fc
13 changed files with 28 additions and 28 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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