erlang: code:purge/1 + code:soft_purge/1 (+10 eval tests)
This commit is contained in:
@@ -1967,11 +1967,80 @@
|
||||
:else
|
||||
(er-mk-tuple (list (er-mk-atom "module") mod-arg))))))))))
|
||||
|
||||
(define er-procs-on-env
|
||||
(fn (target-env)
|
||||
(let ((all-keys (keys (er-sched-processes)))
|
||||
(matches (list)))
|
||||
(for-each
|
||||
(fn (i)
|
||||
(let ((proc (get (er-sched-processes) (nth all-keys i))))
|
||||
(let ((init-fun (get proc :initial-fun)))
|
||||
(when (and (not (= init-fun nil))
|
||||
(er-fun? init-fun)
|
||||
(= (get init-fun :env) target-env)
|
||||
(not (= (get proc :state) "dead")))
|
||||
(append! matches (get proc :pid))))))
|
||||
(range 0 (len all-keys)))
|
||||
matches)))
|
||||
|
||||
(define er-bif-code-purge
|
||||
(fn (vs)
|
||||
(let ((mod-arg (nth vs 0)))
|
||||
(cond
|
||||
(not (er-atom? mod-arg))
|
||||
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
||||
:else
|
||||
(let ((registry (er-modules-get)) (mod-name (get mod-arg :name)))
|
||||
(cond
|
||||
(not (dict-has? registry mod-name)) (er-mk-atom "false")
|
||||
:else
|
||||
(let ((slot (get registry mod-name)))
|
||||
(cond
|
||||
(= (er-module-old-env slot) nil) (er-mk-atom "false")
|
||||
:else
|
||||
(let ((procs (er-procs-on-env (er-module-old-env slot))))
|
||||
(for-each
|
||||
(fn (i) (er-cascade-exit! (nth procs i) (er-mk-atom "killed")))
|
||||
(range 0 (len procs)))
|
||||
(dict-set! registry mod-name
|
||||
(er-mk-module-slot (er-module-current-env slot) nil
|
||||
(er-module-version slot)))
|
||||
(er-mk-atom "true"))))))))))
|
||||
|
||||
(define er-bif-code-soft-purge
|
||||
(fn (vs)
|
||||
(let ((mod-arg (nth vs 0)))
|
||||
(cond
|
||||
(not (er-atom? mod-arg))
|
||||
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
||||
:else
|
||||
(let ((registry (er-modules-get)) (mod-name (get mod-arg :name)))
|
||||
(cond
|
||||
(not (dict-has? registry mod-name)) (er-mk-atom "true")
|
||||
:else
|
||||
(let ((slot (get registry mod-name)))
|
||||
(cond
|
||||
(= (er-module-old-env slot) nil) (er-mk-atom "true")
|
||||
:else
|
||||
(let ((procs (er-procs-on-env (er-module-old-env slot))))
|
||||
(cond
|
||||
(> (len procs) 0) (er-mk-atom "false")
|
||||
:else
|
||||
(do
|
||||
(dict-set! registry mod-name
|
||||
(er-mk-module-slot (er-module-current-env slot) nil
|
||||
(er-module-version slot)))
|
||||
(er-mk-atom "true"))))))))))))
|
||||
|
||||
(define er-apply-code-bif
|
||||
(fn (name vs)
|
||||
(cond
|
||||
(and (= name "load_binary") (= (len vs) 3))
|
||||
(er-bif-code-load-binary vs)
|
||||
(and (= name "purge") (= (len vs) 1))
|
||||
(er-bif-code-purge vs)
|
||||
(and (= name "soft_purge") (= (len vs) 1))
|
||||
(er-bif-code-soft-purge vs)
|
||||
:else (error
|
||||
(str "Erlang: undefined function 'code:" name "/" (len vs) "'")))))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user