aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/analysis/expression.lux
blob: b16499c01b8171f8af14ca80bb1ccd15d9c81bd1 (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
115
116
117
118
119
(;module:
  lux
  (lux (control [monad #+ do]
                ["ex" exception #+ exception:])
       (data ["e" error]
             [product]
             text/format)
       [macro]
       (lang [type]
             (type ["tc" check]))
       [host])
  (luxc ["&" lang]
        (lang ["&;" module]
              [";L" host]
              [";L" 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 [code]
       (do macro;Monad<Meta>
         [expectedT macro;expected-type]
         (let [[cursor code'] code]
           ## The cursor must be set in the compiler for the sake
           ## of having useful error messages.
           (&;with-cursor cursor
             (case code'
               (^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 macro;Monad<Meta>
                 [[funcT funcA] (commonA;with-unknown-type
                                  (analyse func))]
                 (case funcA
                   [_ (#;Symbol def-name)]
                   (do @
                     [?macro (&;with-error-tracking
                               (macro;find-macro def-name))]
                     (case ?macro
                       (#;Some macro)
                       (do @
                         [expansion (: (Meta (List Code))
                                       (function [compiler]
                                         (case (macroL;expand macro args compiler)
                                           (#e;Error error)
                                           ((&;throw Macro-Expansion-Failed error) compiler)

                                           output
                                           output)))]
                         (case expansion
                           (^ (list single))
                           (analyse single)

                           _
                           (&;throw Macro-Expression-Must-Have-Single-Expansion (%code code))))

                       _
                       (functionA;analyse-apply analyse funcT funcA args)))

                   _
                   (functionA;analyse-apply analyse funcT funcA args)))

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