aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/extension.lux
blob: ae9745baa6942a95cd57e234822931fabe53e0af (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
(.module:
  [library
   [lux #*
    [abstract
     ["." monad]]
    [control
     ["<>" parser ("#\." monad)
      ["<c>" code (#+ Parser)]
      ["<a>" analysis]
      ["<s>" synthesis]]]
    [data
     ["." product]
     [collection
      ["." list ("#\." functor)]]]
    [macro (#+ with_gensyms)
     ["." code]
     [syntax (#+ syntax:)]]
    [tool
     [compiler
      ["." phase]]]]])

(type: Input
  {#variable Text
   #parser Code})

(def: (simple default)
  (-> Code (Parser Input))
  ($_ <>.and
      <c>.local_identifier
      (<>\in default)))

(def: complex
  (Parser Input)
  (<c>.record ($_ <>.and
                  <c>.local_identifier
                  <c>.any)))

(def: (input default)
  (-> Code (Parser Input))
  (<>.either (..simple default)
             ..complex))

(type: Declaration
  {#name Code
   #label Text
   #phase Text
   #archive Text
   #inputs (List Input)})

(def: (declaration default)
  (-> Code (Parser Declaration))
  (<c>.form ($_ <>.and
                <c>.any
                <c>.local_identifier
                <c>.local_identifier
                <c>.local_identifier
                (<>.some (..input default)))))

(template [<any> <end> <and> <run> <extension> <name>]
  [(syntax: .public (<name>
                     {[name extension phase archive inputs] (..declaration (` <any>))}
                     body)
     (let [g!parser (case (list\map product.right inputs)
                      #.End
                      (` <end>)
                      
                      parsers
                      (` (.$_ <and> (~+ parsers))))
           g!name (code.local_identifier extension)
           g!phase (code.local_identifier phase)
           g!archive (code.local_identifier archive)]
       (with_gensyms [g!handler g!inputs g!error]
         (in (list (` (<extension> (~ name)
                                   (.function ((~ g!handler) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs))
                                     (.case ((~! <run>) (~ g!parser) (~ g!inputs))
                                       (#.Right [(~+ (list\map (|>> product.left
                                                                    code.local_identifier)
                                                               inputs))])
                                       (~ body)

                                       (#.Left (~ g!error))
                                       ((~! phase.failure) (~ g!error)))
                                     ))))))))]

  [<c>.any <c>.end! <c>.and <c>.run "lux def analysis" analysis:]
  [<a>.any <a>.end! <a>.and <a>.run "lux def synthesis" synthesis:]
  [<s>.any <s>.end! <s>.and <s>.run "lux def generation" generation:]
  [<c>.any <c>.end! <c>.and <c>.run "lux def directive" directive:]
  )