aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/control/pipe.lux
blob: 2221505aff2512df83cdf9463eca820c9a5f512d (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
(.require
 [library
  [lux (.except let cond if exec when)
   [abstract
    ["[0]" monad]]
   [control
    ["<>" parser]
    ["[0]" try]]
   [data
    ["[0]" identity]
    [collection
     ["[0]" list (.use "[1]#[0]" monad)]]]
   [math
    [number
     ["n" nat]
     ["i" int]]]
   [meta
    ["[0]" code (.only)
     ["<[1]>" \\parser (.only Parser)]]
    [macro (.only with_symbols)
     [syntax (.only syntax)]]]]])

(def body
  (Parser (List Code))
  (<code>.tuple (<>.some <code>.any)))

(def .public new
  (syntax (_ [start <code>.any
              body ..body
              prev <code>.any])
    (in (list (` (|> (, start) (,* body)))))))

(def .public let
  (syntax (_ [binding <code>.any
              body <code>.any
              prev <code>.any])
    (in (list (` (.let [(, binding) (, prev)]
                   (, body)))))))

(def _reversed_
  (Parser Any)
  (function (_ tokens)
    {try.#Success [(list.reversed tokens) []]}))

(def .public cond
  (syntax (_ [_ _reversed_
              prev <code>.any
              else ..body
              _ _reversed_
              branches (<>.some (<>.and ..body ..body))])
    (with_symbols [g!temp]
      (in (list (` (.let [(, g!temp) (, prev)]
                     (.cond (,* (monad.do list.monad
                                  [[test then] branches]
                                  (list (` (|> (, g!temp) (,* test)))
                                        (` (|> (, g!temp) (,* then))))))
                            (|> (, g!temp) (,* else))))))))))

(def .public if
  (syntax (_ [test ..body
              then ..body
              else ..body
              prev <code>.any])
    (in (list (` (..cond [(,* test)] [(,* then)]
                         [(,* else)]
                         (, prev)))))))

(def .public while
  (syntax (_ [test ..body
              then ..body
              prev <code>.any])
    (with_symbols [g!temp g!again]
      (in (list (` (.loop ((, g!again) [(, g!temp) (, prev)])
                     (.if (|> (, g!temp) (,* test))
                       ((, g!again) (|> (, g!temp) (,* then)))
                       (, g!temp)))))))))

(def .public do
  (syntax (_ [monad <code>.any
              steps (<>.some ..body)
              prev <code>.any])
    (with_symbols [g!temp]
      (.when (list.reversed steps)
        (list.partial last_step prev_steps)
        (.let [step_bindings (monad.do list.monad
                               [step (list.reversed prev_steps)]
                               (list g!temp (` (|> (, g!temp) (,* step)))))]
          (in (list (` (monad.do (, monad)
                         [.let [(, g!temp) (, prev)]
                          (,* step_bindings)]
                         (|> (, g!temp) (,* last_step)))))))

        _
        (in (list prev))))))

(def .public exec
  (syntax (_ [body ..body
              prev <code>.any])
    (with_symbols [g!temp]
      (in (list (` (.let [(, g!temp) (, prev)]
                     (.exec (|> (, g!temp) (,* body))
                       (, g!temp)))))))))

(def .public tuple
  (syntax (_ [paths (<>.many ..body)
              prev <code>.any])
    (with_symbols [g!temp]
      (in (list (` (.let [(, g!temp) (, prev)]
                     [(,* (list#each (function (_ body) (` (|> (, g!temp) (,* body))))
                                     paths))])))))))

(def .public when
  (syntax (_ [branches (<>.many (<>.and <code>.any <code>.any))
              prev <code>.any])
    (in (list (` (.when (, prev)
                   (,* (|> branches
                           (list#each (function (_ [pattern body]) (list pattern body)))
                           list#conjoint))))))))