aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/analysis/expression.lux
blob: afc347248ddab09175e53808eb50702020d96418 (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
112
113
114
(;module:
  lux
  (lux (control [monad #+ do]
                ["ex" exception #+ exception:])
       (data ["e" error]
             [product]
             text/format)
       [meta]
       (meta [type]
             (type ["tc" check]))
       [host])
  (luxc ["&" lang]
        (lang ["&;" module]
              [";L" host]
              (host [";H" macro])
              ["la" analysis]
              (translation [";T" common])))
  (.. [";A" common]
      [";A" function]
      [";A" primitive]
      [";A" reference]
      [";A" structure]
      [";A" procedure]))

(exception: #export Macro-Expression-Must-Have-Single-Expansion)
(exception: #export Unrecognized-Syntax)
(exception: #export Macro-Expansion-Failed)

(def: #export (analyser eval)
  (-> &;Eval &;Analyser)
  (: (-> Code (Meta la;Analysis))
     (function analyse [ast]
       (do meta;Monad<Meta>
         [expectedT meta;expected-type]
         (let [[cursor ast'] ast]
           ## The cursor must be set in the compiler for the sake
           ## of having useful error messages.
           (&;with-cursor cursor
             (case ast'
               (^template [<tag> <analyser>]
                 (<tag> value)
                 (<analyser> value))
               ([#;Bool primitiveA;analyse-bool]
                [#;Nat  primitiveA;analyse-nat]
                [#;Int  primitiveA;analyse-int]
                [#;Deg  primitiveA;analyse-deg]
                [#;Frac primitiveA;analyse-frac]
                [#;Text primitiveA;analyse-text])

               (^ (#;Tuple (list)))
               primitiveA;analyse-unit

               ## Singleton tuples are equivalent to the element they contain.
               (^ (#;Tuple (list singleton)))
               (analyse singleton)

               (^ (#;Tuple elems))
               (structureA;analyse-product analyse elems)

               (^ (#;Record pairs))
               (structureA;analyse-record analyse pairs)

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

               (^ (#;Form (list& [_ (#;Text proc-name)] proc-args)))
               (procedureA;analyse-procedure analyse eval proc-name proc-args)

               (^template [<tag> <analyser>]
                 (^ (#;Form (list& [_ (<tag> tag)]
                                   values)))
                 (case values
                   (#;Cons value #;Nil)
                   (<analyser> analyse tag value)

                   _
                   (<analyser> analyse tag (` [(~@ values)]))))
               ([#;Nat structureA;analyse-sum]
                [#;Tag structureA;analyse-tagged-sum])

               (#;Tag tag)
               (structureA;analyse-tagged-sum analyse tag (' []))
               
               (^ (#;Form (list& func args)))
               (do meta;Monad<Meta>
                 [[funcT =func] (commonA;with-unknown-type
                                  (analyse func))]
                 (case =func
                   [_ (#;Symbol def-name)]
                   (do @
                     [[def-type def-anns def-value] (meta;find-def def-name)]
                     (if (meta;macro? def-anns)
                       (do @
                         [expansion (function [compiler]
                                      (case (macroH;expand (:! Macro def-value) args compiler)
                                        (#e;Success [compiler' output])
                                        (#e;Success [compiler' output])

                                        (#e;Error error)
                                        ((&;throw Macro-Expansion-Failed error) compiler)))]
                         (case expansion
                           (^ (list single))
                           (analyse single)

                           _
                           (&;throw Macro-Expression-Must-Have-Single-Expansion (%code ast))))
                       (functionA;analyse-apply analyse funcT =func args)))

                   _
                   (functionA;analyse-apply analyse funcT =func args)))

               _
               (&;throw Unrecognized-Syntax (%code ast))
               )))))))