aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/analyser.lux
blob: eba8ae62a40c8a94727c87fa782cb93d38f0c650 (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
104
105
106
107
108
109
110
111
(;module:
  lux
  (lux (control monad)
       (data ["R" result]
             [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]
     ## ["&&;" case]
     ["&&;" proc]))

(def: #export (analyser eval)
  (-> &;Eval &;Analyser)
  (: (-> Code (Lux la;Analysis))
     (function analyse [ast]
       (let [[cursor ast'] ast]
         (&;with-cursor cursor
           (case ast'
             (^template [<tag> <analyser>]
               (<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])

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

             (^ (#;Tuple (list singleton)))
             (analyse singleton)

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

             (#;Symbol reference)
             (&&reference;analyse-reference reference)

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

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

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

             ## (^ (#;Form (list& [_ (#;Symbol ["" "_lux_case"])]
             ##                   input
             ##                   branches)))
             ## (&&case;analyse-case analyse proc branches)

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

             (^ (#;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)
                        ##                     (#R;Success [compiler' output])
                        ##                     (#R;Success [compiler' output])

                        ##                     (#R;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)))
             ))))))