aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/abstract/monad/indexed.lux
blob: 0894b4021ea289caa1659c5a2af0fa12fe796f68 (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
(.using
 [library
  [lux (.except global)
   [control
    ["<>" parser (.only)
     ["<[0]>" code (.only Parser)]]]
   [data
    [collection
     ["[0]" list (.open: "[1]#[0]" functor mix)]]]
   ["[0]" macro (.only)
    [syntax (.only syntax:)]
    ["[0]" code]]]]
 ["[0]" //])

(type: .public (IxMonad m)
  (Interface
   (is (All (_ p a)
         (-> a (m p p a)))
       in)

   (is (All (_ ii it io vi vo)
         (-> (-> vi (m it io vo))
             (m ii it vi)
             (m ii io vo)))
       then)))

(type: Binding
  [Code Code])

(def: binding
  (Parser Binding)
  (<>.and <code>.any <code>.any))

(type: Context
  (Variant
   {#Macro Symbol Code}
   {#Binding Binding}))

(def: global
  (Parser Symbol)
  (//.do <>.monad
    [[module short] <code>.symbol
     _ (<>.assertion "" (case module "" false _ true))]
    (in [module short])))

(def: context
  (Parser Context)
  (<>.or (<>.and ..global
                 <code>.any)
         binding))

(def: (pair_list [binding value])
  (All (_ a) (-> [a a] (List a)))
  (list binding value))

(def: named_monad
  (Parser [(Maybe Text) Code])
  (<>.either (<code>.tuple (<>.and (# <>.monad each (|>> {.#Some})
                                      <code>.local)
                                   <code>.any))
             (# <>.monad each (|>> [{.#None}])
                <code>.any)))

(syntax: .public (do [[?name monad] ..named_monad
                      context (<code>.tuple (<>.some context))
                      expression <code>.any])
  (macro.with_symbols [g!_ g!then]
    (let [body (list#mix (function (_ context next)
                           (case context
                             {#Macro macro parameter}
                             (` ((~ (code.symbol macro))
                                 (~ parameter)
                                 (~ next)))
                             
                             {#Binding [binding value]}
                             (` ((~ g!then)
                                 (.function ((~ g!_) (~ binding))
                                   (~ next))
                                 (~ value)))))
                         expression
                         (list.reversed context))]
      (in (list (case ?name
                  {.#Some name}
                  (let [name (code.local name)]
                    (` (let [(~ name) (~ monad)
                             [..in (~' in)
                              ..then (~ g!then)] (~ name)]
                         (~ body))))

                  {.#None}
                  (` (let [[..in (~' in)
                            ..then (~ g!then)] (~ monad)]
                       (~ body)))))))))