mirror of
https://github.com/carp-lang/Carp.git
synced 2024-10-11 20:49:05 +03:00
Added setter-ref set.. to DefType. Increases performance
This commit is contained in:
parent
5042415109
commit
b9cd06f6cb
@ -52,15 +52,15 @@
|
|||||||
(defn reduce-pz [t b] (+ @t (* (Planet.vz b) (Planet.mass b))))
|
(defn reduce-pz [t b] (+ @t (* (Planet.vz b) (Planet.mass b))))
|
||||||
|
|
||||||
(defn offset_momentum [bodies]
|
(defn offset_momentum [bodies]
|
||||||
(let [b (first bodies)
|
(let [b (nth bodies 0)
|
||||||
px (reduce reduce-px 0.0 bodies)
|
px (reduce reduce-px 0.0 bodies)
|
||||||
py (reduce reduce-py 0.0 bodies)
|
py (reduce reduce-py 0.0 bodies)
|
||||||
pz (reduce reduce-pz 0.0 bodies)]
|
pz (reduce reduce-pz 0.0 bodies)]
|
||||||
(aset! bodies 0
|
(do
|
||||||
(=> b
|
(Planet.set!-vx b (/ (neg px) (solar_mass)))
|
||||||
(Planet.set-vx (/ (neg px) (solar_mass)))
|
(Planet.set!-vy b (/ (neg py) (solar_mass)))
|
||||||
(Planet.set-vy (/ (neg py) (solar_mass)))
|
(Planet.set!-vz b (/ (neg pz) (solar_mass))))))
|
||||||
(Planet.set-vz (/ (neg pz) (solar_mass)))))))
|
|
||||||
|
|
||||||
|
|
||||||
(defn energy [bodies]
|
(defn energy [bodies]
|
||||||
@ -84,35 +84,30 @@
|
|||||||
|
|
||||||
(defn update-planet [i bodies dt]
|
(defn update-planet [i bodies dt]
|
||||||
(let [b (nth bodies i)]
|
(let [b (nth bodies i)]
|
||||||
(aset! bodies i
|
(do
|
||||||
(=> @b
|
(Planet.set!-x b (+ (Planet.x b) (* dt (Planet.vx b))))
|
||||||
(Planet.set-x (+ (Planet.x b) (* dt (Planet.vx b))))
|
(Planet.set!-y b (+ (Planet.y b) (* dt (Planet.vy b))))
|
||||||
(Planet.set-y (+ (Planet.y b) (* dt (Planet.vy b))))
|
(Planet.set!-z b (+ (Planet.z b) (* dt (Planet.vz b)))))))
|
||||||
(Planet.set-z (+ (Planet.z b) (* dt (Planet.vz b))))))))
|
|
||||||
|
|
||||||
(defn advance [bodies dt]
|
(defn advance [bodies dt]
|
||||||
(do
|
(do
|
||||||
(for [i 0 (count bodies)]
|
(for [i 0 (count bodies)]
|
||||||
(let [b (nth bodies i)]
|
(let [b (nth bodies i)]
|
||||||
(for [j (+ i 1) (count bodies)]
|
(for [j (+ i 1) (count bodies)]
|
||||||
(let-do [b2 (nth bodies j)
|
(let [b2 (nth bodies j)
|
||||||
dx (- (Planet.x b) (Planet.x b2))
|
dx (- (Planet.x b) (Planet.x b2))
|
||||||
dy (- (Planet.y b) (Planet.y b2))
|
dy (- (Planet.y b) (Planet.y b2))
|
||||||
dz (- (Planet.z b) (Planet.z b2))
|
dz (- (Planet.z b) (Planet.z b2))
|
||||||
dist (sqrt (+ (ipow dx 2) (+ (ipow dy 2) (ipow dz 2))))
|
dist (sqrt (+ (ipow dx 2) (+ (ipow dy 2) (ipow dz 2))))
|
||||||
mag (/ dt (ipow dist 3))]
|
mag (/ dt (ipow dist 3))]
|
||||||
|
(do
|
||||||
|
(Planet.set!-vx b (- (Planet.vx b) (* dx (* (Planet.mass b2) mag))))
|
||||||
(aset! bodies i
|
(Planet.set!-vy b (- (Planet.vy b) (* dy (* (Planet.mass b2) mag))))
|
||||||
(=> @b
|
(Planet.set!-vz b (- (Planet.vz b) (* dz (* (Planet.mass b2) mag))))
|
||||||
(Planet.set-vx (- (Planet.vx b) (* dx (* (Planet.mass b2) mag))))
|
|
||||||
(Planet.set-vy (- (Planet.vy b) (* dy (* (Planet.mass b2) mag))))
|
(Planet.set!-vx b2 (+ (Planet.vx b2) (* dx (* (Planet.mass b) mag))))
|
||||||
(Planet.set-vz (- (Planet.vz b) (* dz (* (Planet.mass b2) mag))))))
|
(Planet.set!-vy b2 (+ (Planet.vy b2) (* dy (* (Planet.mass b) mag))))
|
||||||
(aset! bodies j
|
(Planet.set!-vz b2 (+ (Planet.vz b2) (* dz (* (Planet.mass b) mag)))))))))
|
||||||
(=> @b2
|
|
||||||
(Planet.set-vx (+ (Planet.vx b2) (* dx (* (Planet.mass b) mag))))
|
|
||||||
(Planet.set-vy (+ (Planet.vy b2) (* dy (* (Planet.mass b) mag))))
|
|
||||||
(Planet.set-vz (+ (Planet.vz b2) (* dz (* (Planet.mass b) mag))))))))))
|
|
||||||
|
|
||||||
(for [i 0 (count bodies)]
|
(for [i 0 (count bodies)]
|
||||||
(update-planet i bodies dt))))
|
(update-planet i bodies dt))))
|
||||||
|
@ -154,6 +154,7 @@ templatesForSingleMember typeEnv env insidePath structTy@(StructTy typeName _) (
|
|||||||
fixedMemberTy = if isManaged typeEnv t then RefTy t else t
|
fixedMemberTy = if isManaged typeEnv t then RefTy t else t
|
||||||
in [instanceBinderWithDeps (SymPath insidePath memberName) (FuncTy [RefTy p] fixedMemberTy) (templateGetter (mangle memberName) fixedMemberTy)
|
in [instanceBinderWithDeps (SymPath insidePath memberName) (FuncTy [RefTy p] fixedMemberTy) (templateGetter (mangle memberName) fixedMemberTy)
|
||||||
,instanceBinderWithDeps (SymPath insidePath ("set-" ++ memberName)) (FuncTy [p, t] p) (templateSetter typeEnv env (mangle memberName) t)
|
,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) (templateSetterRef typeEnv env (mangle memberName) t)
|
||||||
,instanceBinderWithDeps (SymPath insidePath ("update-" ++ memberName))
|
,instanceBinderWithDeps (SymPath insidePath ("update-" ++ memberName))
|
||||||
(FuncTy [p, FuncTy [t] t] p)
|
(FuncTy [p, FuncTy [t] t] p)
|
||||||
(templateUpdater (mangle memberName))]
|
(templateUpdater (mangle memberName))]
|
||||||
@ -306,6 +307,20 @@ templateSetter typeEnv env memberName memberTy =
|
|||||||
then depsOfPolymorphicFunction typeEnv env [] "delete" (typesDeleterFunctionType memberTy)
|
then depsOfPolymorphicFunction typeEnv env [] "delete" (typesDeleterFunctionType memberTy)
|
||||||
else [])
|
else [])
|
||||||
|
|
||||||
|
-- | The template for setters of a deftype.
|
||||||
|
templateSetterRef :: TypeEnv -> Env -> String -> Ty -> Template
|
||||||
|
templateSetterRef typeEnv env memberName memberTy =
|
||||||
|
Template
|
||||||
|
(FuncTy [RefTy (VarTy "p"), VarTy "t"] UnitTy)
|
||||||
|
(const (toTemplate "void $NAME($p* pRef, $t newValue)"))
|
||||||
|
(const (toTemplate (unlines ["$DECL {"
|
||||||
|
," pRef->" ++ memberName ++ " = newValue;"
|
||||||
|
,"}\n"])))
|
||||||
|
(\_ -> if isManaged typeEnv memberTy
|
||||||
|
then depsOfPolymorphicFunction typeEnv env [] "delete" (typesDeleterFunctionType memberTy)
|
||||||
|
else [])
|
||||||
|
|
||||||
|
|
||||||
-- | The template for updater functions of a deftype
|
-- | The template for updater functions of a deftype
|
||||||
-- | (allows changing a variable by passing an transformation function).
|
-- | (allows changing a variable by passing an transformation function).
|
||||||
templateUpdater :: String -> Template
|
templateUpdater :: String -> Template
|
||||||
|
Loading…
Reference in New Issue
Block a user