luxc/src/lux/analyser/env.clj


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

(ns lux.analyser.env
  (:require clojure.core.match
            clojure.core.match.array
            (lux [base :as & :refer [|do return return* |case |let]])
            [lux.analyser.base :as &&]))

;; [Exports]
(def next-local-idx
  (fn [state]
    (return* state (->> state (&/get$ &/$scopes) &/|head (&/get$ &/$locals) (&/get$ &/$counter)))))

(defn with-local [name type body]
  (fn [state]
    (let [old-mappings (->> state (&/get$ &/$scopes) &/|head (&/get$ &/$locals) (&/get$ &/$mappings))
          =return (body (&/update$ &/$scopes
                                   (fn [stack]
                                     (let [var-analysis (&&/|meta type &/empty-cursor (&&/$var (&/$Local (->> (&/|head stack) (&/get$ &/$locals) (&/get$ &/$counter)))))]
                                       (&/$Cons (&/update$ &/$locals #(->> %
                                                                           (&/update$ &/$counter inc)
                                                                           (&/update$ &/$mappings (fn [m] (&/|put name (&/T [type var-analysis]) m))))
                                                           (&/|head stack))
                                                (&/|tail stack))))
                                   state))]
      (|case =return
        (&/$Right ?state ?value)
        (return* (&/update$ &/$scopes (fn [stack*]
                                        (&/$Cons (&/update$ &/$locals #(->> %
                                                                            (&/update$ &/$counter dec)
                                                                            (&/set$ &/$mappings old-mappings))
                                                            (&/|head stack*))
                                                 (&/|tail stack*)))
                            ?state)
                 ?value)
        
        _
        =return))))

(defn with-alias [name var-analysis body]
  (fn [state]
    (let [old-mappings (->> state (&/get$ &/$scopes) &/|head (&/get$ &/$locals) (&/get$ &/$mappings))
          =return (body (&/update$ &/$scopes
                                   (fn [stack]
                                     (&/$Cons (&/update$ &/$locals #(->> %
                                                                         (&/update$ &/$mappings (fn [m] (&/|put name
                                                                                                               (&/T [(&&/expr-type* var-analysis)
                                                                                                                     var-analysis])
                                                                                                               m))))
                                                         (&/|head stack))
                                              (&/|tail stack)))
                                   state))]
      (|case =return
        (&/$Right ?state ?value)
        (return* (&/update$ &/$scopes (fn [stack*]
                                        (&/$Cons (&/update$ &/$locals #(->> %
                                                                            (&/set$ &/$mappings old-mappings))
                                                            (&/|head stack*))
                                                 (&/|tail stack*)))
                            ?state)
                 ?value)
        
        _
        =return))))

(def captured-vars
  (fn [state]
    (|case (&/get$ &/$scopes state)
      (&/$Nil)
      ((&/fail-with-loc "[Analyser Error] Cannot obtain captured vars without environments.")
       state)

      (&/$Cons env _)
      (return* state (->> env
                          (&/get$ &/$captured)
                          (&/get$ &/$mappings)
                          (&/|map (fn [mapping]
                                    (|let [[k v] mapping]
                                      (&/T [k (&/|second v)])))))))
    ))