-
Notifications
You must be signed in to change notification settings - Fork 1
/
tools.cljc
106 lines (84 loc) · 2.4 KB
/
tools.cljc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
(ns fif.stdlib.tools
"Includes stack functionality that can manipulate the entire stack
machine."
(:require
[clojure.string :as str]
[fif.stack-machine.stash :as stack-machine.stash]
[fif.stack-machine.scope :as stack-machine.scope]
[fif.stack-machine.words :refer [set-global-word-defn
set-global-meta]]
[fif.stack-machine.exceptions :as exceptions]
[fif.stack-machine :as stack]
[fif.def :as def
:refer [wrap-function-with-arity
wrap-procedure-with-arity]
:include-macros true]))
(defn reset-stack-op
"Resets the entire stack machine, similar to a soft-reset
- clears main stack
- clears the loop return stack
- resets the scope
- clears sub stash
- clears mode stash
- clears flags
- clears code queue
"
[sm]
(-> sm
stack/clear-stack
stack/clear-ret
stack/clear-temp-macro
stack/clear-scope
stack/clear-stash
stack/clear-mode-stash
stack/clear-flags
stack/clear-code))
(defn clear-stack-op
[sm]
(-> sm stack/clear-stack stack/dequeue-code))
(defn stack-empty?-op
[sm]
(let [bool (empty? (stack/get-stack sm))]
(-> sm
(stack/push-stack bool)
stack/dequeue-code)))
(defn reverse-stack-op
[sm]
(let [st (-> sm stack/get-stack reverse)]
(-> sm
(stack/set-stack (apply list st))
stack/dequeue-code)))
(defn get-stack-op
[sm]
(let [st (-> sm stack/get-stack)]
(-> sm
(stack/push-stack st)
stack/dequeue-code)))
(defn import-stdlib-stack-tools
[sm]
(-> sm
(set-global-word-defn
'$reset-stack-machine reset-stack-op
:stdlib? true
:group :stdlib.tools
:doc "soft-resets the stack machine.")
(set-global-word-defn
'$clear-stack clear-stack-op
:stdlib? true
:group :stdlib.tools
:doc "Clear the main stack.")
(set-global-word-defn
'$empty-stack? stack-empty?-op
:stdlib? true
:group :stdlib.tools
:doc "( -- b ) Returns true, if the main stack is empty.")
(set-global-word-defn
'$reverse-stack reverse-stack-op
:stdlib? true
:group :stdlib.tools
:doc "Reverse the main stack.")
(set-global-word-defn
'$get-stack get-stack-op
:stdlib? true
:group :stdlib.tools
:doc "( -- stack ) Push a copy of the main stack onto the main stack.")))