aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/control/function/mutual.lux
blob: d0b03aa0811ec8e7c3145a590a16e434b1e4c58c (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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
(.using
 [library
  [lux (.except Definition let def macro)
   ["[0]" meta]
   [abstract
    ["[0]" monad (.only do)]]
   [control
    ["[0]" try (.only Try)]
    ["[0]" exception (.only exception:)]
    ["<>" parser (.open: "[1]#[0]" monad)
     ["<[0]>" code (.only Parser)]]]
   [data
    ["[0]" product]
    [text
     ["%" \\format (.only format)]]
    [collection
     ["[0]" list (.open: "[1]#[0]" functor)]
     [dictionary
      ["[0]" plist (.only PList)]]]]
   ["[0]" macro (.only)
    ["[0]" local]
    ["[0]" code]
    [syntax (.only syntax)
     ["[0]" declaration (.only Declaration)]]]]]
 ["[0]" //])

(type: Mutual
  (Record
   [#declaration Declaration
    #type Code
    #body Code]))

(.def mutual
  (Parser [Declaration Code Code])
  (all <>.and
       declaration.parser
       <code>.any
       <code>.any
       ))

(.def (mutual_definition context g!context [g!name mutual])
  (-> (List Code) Code [Code Mutual] Code)
  (` (function ((~ g!name) (~ g!context))
       (.let [[(~+ context)] (~ g!context)]
         (function (~ (declaration.format (the #declaration mutual)))
           (~ (the #body mutual)))))))

(.def (macro g!context g!self)
  (-> Code Code Macro)
  (<| (as Macro)
      (is Macro')
      (function (_ parameters)
        (at meta.monad in (list (` (((~ g!self) (~ g!context)) (~+ parameters))))))))

(.def .public let
  (syntax (_ [functions (<code>.tuple (<>.some ..mutual))
              body <code>.any])
    (case functions
      {.#End}
      (in (list body))
      
      {.#Item mutual {.#End}}
      (.let [g!name (|> mutual (the [#declaration declaration.#name]) code.local)]
        (in (list (` (.let [(~ g!name) (is (~ (the #type mutual))
                                           (function (~ (declaration.format (the #declaration mutual)))
                                             (~ (the #body mutual))))]
                       (~ body))))))
      
      _
      (macro.with_symbols [g!context g!output]
        (do [! meta.monad]
          [here_name meta.current_module_name
           hidden_names (monad.each ! (//.constant (macro.symbol "mutual_function#"))
                                    functions)
           .let [definitions (list#each (..mutual_definition hidden_names g!context)
                                        (list.zipped_2 hidden_names
                                                       functions))
                 context_types (list#each (function (_ mutual)
                                            (` (-> (~ g!context) (~ (the #type mutual)))))
                                          functions)
                 user_names (list#each (|>> (the [#declaration declaration.#name]) code.local)
                                       functions)]
           g!pop (local.push (list#each (function (_ [g!name mutual])
                                          [[here_name (the [#declaration declaration.#name] mutual)]
                                           (..macro g!context g!name)])
                                        (list.zipped_2 hidden_names
                                                       functions)))]
          (in (list (` (.let [(~ g!context) (is (Rec (~ g!context)
                                                  [(~+ context_types)])
                                                [(~+ definitions)])
                              [(~+ user_names)] (.let [[(~+ user_names)] (~ g!context)]
                                                  [(~+ (list#each (function (_ g!name)
                                                                    (` ((~ g!name) (~ g!context))))
                                                                  user_names))])
                              (~ g!output) (~ body)]
                         (exec (~ g!pop)
                           (~ g!output)))))))))))

(type: Definition
  (Record
   [#export_policy Code
    #mutual Mutual]))

(.def definition
  (Parser Definition)
  (<code>.tuple (<>.either (<>.and <code>.any ..mutual)
                           (<>.and (<>#in (` .private)) ..mutual))))

(.def .public def
  (syntax (_ [functions (<>.many ..definition)])
    (case functions
      {.#End}
      (in (list))
      
      {.#Item definition {.#End}}
      (.let [(open "_[0]") definition
             (open "_[0]") _#mutual]
        (in (list (` (.def (~ _#export_policy) (~ (declaration.format _#declaration))
                       (~ _#type)
                       (~ _#body))))))
      
      _
      (macro.with_symbols [g!context g!output]
        (do [! meta.monad]
          [here_name meta.current_module_name
           hidden_names (monad.each ! (//.constant (macro.symbol "mutual_function#"))
                                    functions)
           .let [definitions (list#each (..mutual_definition hidden_names g!context)
                                        (list.zipped_2 hidden_names
                                                       (list#each (the #mutual) functions)))
                 context_types (list#each (function (_ mutual)
                                            (` (-> (~ g!context) (~ (the [#mutual #type] mutual)))))
                                          functions)
                 user_names (list#each (|>> (the [#mutual #declaration declaration.#name]) code.local)
                                       functions)]
           g!pop (local.push (list#each (function (_ [g!name mutual])
                                          [[here_name (the [#mutual #declaration declaration.#name] mutual)]
                                           (..macro g!context g!name)])
                                        (list.zipped_2 hidden_names
                                                       functions)))]
          (in (list.partial (` (.def (~ g!context)
                                 [(~+ (list#each (the [#mutual #type]) functions))]
                                 (.let [(~ g!context) (is (Rec (~ g!context)
                                                            [(~+ context_types)])
                                                          [(~+ definitions)])
                                        [(~+ user_names)] (~ g!context)]
                                   [(~+ (list#each (function (_ g!name)
                                                     (` ((~ g!name) (~ g!context))))
                                                   user_names))])))
                            g!pop
                            (list#each (function (_ mutual)
                                         (.let [g!name (|> mutual (the [#mutual #declaration declaration.#name]) code.local)]
                                           (` (.def
                                                (~ (the #export_policy mutual))
                                                (~ g!name)
                                                (~ (the [#mutual #type] mutual))
                                                (.let [[(~+ user_names)] (~ g!context)]
                                                  (~ g!name))))))
                                       functions))))))))