From 1dc8b536fc8dd6c60f644d99b7841b075463261f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Erik=20Sved=C3=A4ng?= Date: Wed, 14 Nov 2018 14:21:12 +0100 Subject: [PATCH] Deftype generates 'update' functions that expect refs to functions too. --- core/Map.carp | 8 ++++---- core/Test.carp | 4 ++-- docs/core/Map.html | 4 ++-- docs/core/V2.html | 4 ++-- docs/core/V3.html | 6 +++--- docs/core/VN.html | 4 ++-- examples/basics.carp | 2 +- examples/function_members.carp | 2 +- examples/generic_structs.carp | 2 +- examples/reptile.carp | 2 +- examples/updating.carp | 6 +++--- src/Deftype.hs | 10 +++++----- test/memory.carp | 2 +- 13 files changed, 28 insertions(+), 28 deletions(-) diff --git a/core/Map.carp b/core/Map.carp index 743ef7d7..59e1b443 100644 --- a/core/Map.carp +++ b/core/Map.carp @@ -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))))))) diff --git a/core/Test.carp b/core/Test.carp index e6cd313c..1e2c6da2 100644 --- a/core/Test.carp +++ b/core/Test.carp @@ -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] diff --git a/docs/core/Map.html b/docs/core/Map.html index de09e429..c0a26cae 100644 --- a/docs/core/Map.html +++ b/docs/core/Map.html @@ -581,7 +581,7 @@ instantiate

- (λ [(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))

@@ -600,7 +600,7 @@ instantiate

- (λ [(Map a b), (λ [Int] Int)] (Map a b)) + (λ [(Map a b), (Ref (λ [Int] Int))] (Map a b))

diff --git a/docs/core/V2.html b/docs/core/V2.html index a2e2bfa7..09d57bb6 100644 --- a/docs/core/V2.html +++ b/docs/core/V2.html @@ -305,7 +305,7 @@ instantiate

- (λ [V2, (λ [Double] Double)] V2) + (λ [V2, (Ref (λ [Double] Double))] V2)

@@ -324,7 +324,7 @@ instantiate

- (λ [V2, (λ [Double] Double)] V2) + (λ [V2, (Ref (λ [Double] Double))] V2)

diff --git a/docs/core/V3.html b/docs/core/V3.html index 6405c9fc..ff6ea9a4 100644 --- a/docs/core/V3.html +++ b/docs/core/V3.html @@ -343,7 +343,7 @@ instantiate

- (λ [V3, (λ [Double] Double)] V3) + (λ [V3, (Ref (λ [Double] Double))] V3)

@@ -362,7 +362,7 @@ instantiate

- (λ [V3, (λ [Double] Double)] V3) + (λ [V3, (Ref (λ [Double] Double))] V3)

@@ -381,7 +381,7 @@ instantiate

- (λ [V3, (λ [Double] Double)] V3) + (λ [V3, (Ref (λ [Double] Double))] V3)

diff --git a/docs/core/VN.html b/docs/core/VN.html index 2b6d15a0..eb17a079 100644 --- a/docs/core/VN.html +++ b/docs/core/VN.html @@ -324,7 +324,7 @@ instantiate

- (λ [VN, (λ [Int] Int)] VN) + (λ [VN, (Ref (λ [Int] Int))] VN)

@@ -343,7 +343,7 @@ instantiate

- (λ [VN, (λ [(Array Double)] (Array Double))] VN) + (λ [VN, (Ref (λ [(Array Double)] (Array Double)))] VN)

diff --git a/examples/basics.carp b/examples/basics.carp index 0ebdce37..d7cbcae0 100644 --- a/examples/basics.carp +++ b/examples/basics.carp @@ -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 [] diff --git a/examples/function_members.carp b/examples/function_members.carp index a427dfcd..b4fb9296 100644 --- a/examples/function_members.carp +++ b/examples/function_members.carp @@ -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)]) diff --git a/examples/generic_structs.carp b/examples/generic_structs.carp index 55729a28..92866663 100644 --- a/examples/generic_structs.carp +++ b/examples/generic_structs.carp @@ -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) diff --git a/examples/reptile.carp b/examples/reptile.carp index 7a70b390..48c21671 100644 --- a/examples/reptile.carp +++ b/examples/reptile.carp @@ -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))))) diff --git a/examples/updating.carp b/examples/updating.carp index 66fc2f6e..618ff3da 100644 --- a/examples/updating.carp +++ b/examples/updating.carp @@ -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 diff --git a/src/Deftype.hs b/src/Deftype.hs index 79c60541..5f85258e 100644 --- a/src/Deftype.hs +++ b/src/Deftype.hs @@ -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)]) diff --git a/test/memory.carp b/test/memory.carp index 25703480..b22ea7ca 100644 --- a/test/memory.carp +++ b/test/memory.carp @@ -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 []