aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/abstract/monad/indexed.lux
blob: ad06165f347967fbad1337fe25113503aa878efa (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
(.module:
  [library
   [lux #*
    [control
     ["<>" parser
      ["<.>" code (#+ Parser)]]]
    [data
     [collection
      ["." list ("#\." functor mix)]]]
    ["." macro
     [syntax (#+ syntax:)]
     ["." code]]]]
  ["." //])

(interface: .public (IxMonad m)
  (: (All [p a]
       (-> a (m p p a)))
     in)

  (: (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 Name Code)
   (#Binding Binding)))

(def: global_identifier
  (Parser Name)
  (//.do <>.monad
    [[module short] <code>.identifier
     _ (<>.assertion "" (case module "" false _ true))]
    (in [module short])))

(def: context
  (Parser Context)
  (<>.or (<>.and ..global_identifier
                 <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>.record (<>.and (\ <>.monad each (|>> #.Some)
                                       <code>.local_identifier)
                                    <code>.any))
             (\ <>.monad each (|>> [#.None])
                <code>.any)))

(syntax: .public (do [[?name monad] ..named_monad
                      context (<code>.tuple (<>.some context))
                      expression <code>.any])
  (macro.with_identifiers [g!_ g!then]
    (let [body (list\mix (function (_ context next)
                           (case context
                             (#Macro macro parameter)
                             (` ((~ (code.identifier 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_identifier name)]
                    (` (let [(~ name) (~ monad)
                             {#..in (~' in)
                              #..then (~ g!then)} (~ name)]
                         (~ body))))

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