aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/analyser.lux
blob: b220fb43392a874968b36de5dc2530c4d3c6efc6 (plain)
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
(;module:
  lux
  (lux (control monad)
       (data ["E" error]
             [text "T/" Eq<Text>]
             text/format
             [number]
             [product])
       [macro #+ Monad<Lux>]
       [type]
       (type ["TC" check]))
  (luxc ["&" base]
        (lang ["la" analysis])
        ["&;" module]
        ["&;" env])
  (. ["&&;" common]
     ["&&;" function]
     ["&&;" primitive]
     ["&&;" reference]
     ["&&;" type]
     ["&&;" struct]
     ["&&;" proc]))

(def: #export (analyser eval)
  (-> &;Eval &;Analyser)
  (: (-> Code (Lux la;Analysis))
     (function analyse [ast]
       (case ast
         (^template [<tag> <analyser>]
           [cursor (<tag> value)]
           (<analyser> value))
         ([#;Bool &&primitive;analyse-bool]
          [#;Nat  &&primitive;analyse-nat]
          [#;Int  &&primitive;analyse-int]
          [#;Deg  &&primitive;analyse-deg]
          [#;Real &&primitive;analyse-real]
          [#;Char &&primitive;analyse-char]
          [#;Text &&primitive;analyse-text])

         (^ [cursor (#;Tuple (list))])
         &&primitive;analyse-unit

         (^ [cursor (#;Tuple (list singleton))])
         (analyse singleton)

         (^ [cursor (#;Tuple elems)])
         (&&struct;analyse-tuple analyse elems)

         [cursor (#;Symbol reference)]
         (&&reference;analyse-reference reference)

         (^ [cursor (#;Form (list [_ (#;Symbol ["" "_lux_check"])]
                                  type
                                  value))])
         (&&type;analyse-check analyse eval type value)

         (^ [cursor (#;Form (list [_ (#;Symbol ["" "_lux_coerce"])]
                                  type
                                  value))])
         (&&type;analyse-coerce analyse eval type value)

         (^ [cursor (#;Form (list [_ (#;Symbol ["" "_lux_proc"])]
                                  [_ (#;Symbol proc)]
                                  [_ (#;Tuple args)]))])
         (&&proc;analyse-proc analyse proc args)

         (^ [cursor (#;Form (list [_ (#;Nat tag)]
                                  value))])
         (&&struct;analyse-variant analyse tag value)

         (^ [cursor (#;Form (list& func args))])
         (do Monad<Lux>
           [[funcT =func] (&&common;with-unknown-type
                            (analyse func))]
           (case =func
             (#la;Absolute def-name)
             (do @
               [[def-type def-anns def-value] (macro;find-def def-name)]
               (if (macro;macro? def-anns)
                 (do @
                   [## macro-expansion (function [compiler]
                    ##                   (case (macro-caller def-value args compiler)
                    ##                     (#E;Success [compiler' output])
                    ##                     (#E;Success [compiler' output])

                    ##                     (#E;Error error)
                    ##                     ((&;fail error) compiler)))
                    macro-expansion (: (Lux (List Code))
                                       (undefined))]
                   (case macro-expansion
                     (^ (list single-expansion))
                     (analyse single-expansion)

                     _
                     (&;fail (format "Macro expressions must expand to a single expression: " (%code ast)))))
                 (&&function;analyse-apply analyse funcT =func args)))

             _
             (&&function;analyse-apply analyse funcT =func args)))

         _
         (&;fail (format "Unrecognized syntax: " (%code ast)))
         ))))