-
Notifications
You must be signed in to change notification settings - Fork 1
/
realizer.cljc
104 lines (81 loc) · 2.96 KB
/
realizer.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
(ns fif.stdlib.realizer
(:require
[fif.stack-machine :as stack-machine]
[fif.stack-machine.processor :as processor]
[fif.stack-machine.stash :as stack-machine.stash]
[fif.stack-machine.words :refer [set-global-word-defn]]
[fif.stack-machine.exceptions :as exceptions]
[fif.stack-machine.mode :as mode]
[fif.utils.token :as utils.token]))
(def arg-realize-token '?)
(def arg-realize-start-token '?/start)
(def arg-realize-finish-token '?/finish)
(def realize-mode-flag :realize-mode)
(defn enter-realize-mode
[sm state]
(-> sm (mode/enter-mode realize-mode-flag state)))
(defn exit-realize-mode
[sm]
(-> sm (mode/exit-mode)))
(defmulti realize-mode mode/mode-dispatch-fn)
(defmethod realize-mode
{:op ::? :op-state ::init}
[sm]
(let [[collection] (-> sm stack-machine/get-stack)]
(-> sm
(stack-machine.stash/update-stash assoc ::collection-type (empty collection))
(mode/update-state assoc :op-state ::collect)
stack-machine/dequeue-code
stack-machine/pop-stack
(stack-machine/push-stack arg-realize-start-token)
(stack-machine/update-code #(concat %2 %3 %1) collection [arg-realize-finish-token]))))
(defmethod realize-mode
{:op ::? :op-state ::collect}
[sm]
(let [arg (-> sm stack-machine/get-code first)]
(cond
(= arg arg-realize-finish-token)
(-> sm
(mode/update-state assoc :op-state ::finish))
:else
(processor/process-arg sm))))
(defmethod realize-mode
{:op ::? :op-state ::finish}
[sm]
(let [coll-type (-> sm stack-machine.stash/peek-stash ::collection-type)
[realized-collection new-stack]
(-> sm
stack-machine/get-stack
(utils.token/split-at-token arg-realize-start-token))
realized-collection (->> realized-collection reverse (into coll-type))
realized-collection (if (seq? realized-collection)
(reverse realized-collection)
realized-collection)]
(-> sm
(stack-machine/set-stack new-stack)
(stack-machine/push-stack realized-collection)
(exit-realize-mode)
(stack-machine/dequeue-code))))
(defn realize-op
[sm]
(-> sm
(enter-realize-mode {:op ::? :op-state ::init})))
(defn import-stdlib-realize-mode
[sm]
(-> sm
(set-global-word-defn
arg-realize-token realize-op
:stdlib? true
:doc "<coll> ? -- Realizes the sequential collection."
:group :stdlib.realizer)
(set-global-word-defn
arg-realize-start-token exceptions/raise-unbounded-mode-argument
:stdlib? true
:doc "<coll> ? -- Realizes the sequential collection."
:group :stdlib.realizer)
(set-global-word-defn
arg-realize-finish-token exceptions/raise-unbounded-mode-argument
:stdlib? true
:doc "<coll> ? -- Realizes the sequential collection."
:group :stdlib.realizer)
(stack-machine/set-mode realize-mode-flag realize-mode)))