aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/math/arithmetic/infix.lux
blob: e6f754c01351af65880250dc286f93832322c41f (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
... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/.

(.require
 [library
  [lux (.except)
   [abstract
    [monad (.only do)]]
   [control
    ["<>" parser (.use "[1]#[0]" functor)]]
   [data
    ["[0]" product]
    [collection
     ["[0]" list (.use "[1]#[0]" mix)]]]
   [math
    [number
     ["n" nat]
     ["i" int]]]
   [meta
    ["[0]" code (.only)
     ["<[1]>" \\parser (.only Parser)]]
    [macro
     [syntax (.only syntax)]]]]])

(type Infix
  (Rec Infix
    (Variant
     {#Const Code}
     {#Call (List Code)}
     {#Unary Code Infix}
     {#Binary Infix Code Infix})))

(def literal
  (Parser Code)
  (all <>.either
       (<>#each code.bit <code>.bit)
       (<>#each code.nat <code>.nat)
       (<>#each code.int <code>.int)
       (<>#each code.rev <code>.rev)
       (<>#each code.frac <code>.frac)
       (<>#each code.text <code>.text)
       (<>#each code.symbol <code>.symbol)))

(def expression
  (Parser Infix)
  (<| <>.rec (function (_ expression))
      (all <>.or
           ..literal
           (<code>.form (<>.many <code>.any))
           (<code>.tuple (<>.and <code>.any expression))
           (<code>.tuple (do <>.monad
                           [init_subject expression
                            init_op <code>.any
                            init_param expression
                            steps (<>.some (<>.and <code>.any expression))]
                           (in (list#mix (function (_ [op param] [_subject _op _param])
                                           [{#Binary _subject _op _param} op param])
                                         [init_subject init_op init_param]
                                         steps))))
           )))

(def (prefix infix)
  (-> Infix Code)
  (when infix
    {#Const value}
    value
    
    {#Call parts}
    (code.form parts)

    {#Unary op subject}
    (` ((, op) (, (prefix subject))))
    
    {#Binary left op right}
    (` ((, op) (, (prefix right)) (, (prefix left))))))

(def .public infix
  (syntax (_ [expr ..expression])
    (in (list (..prefix expr)))))