aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/math/infix.lux
blob: 25a37563ac14dcb8a75ba4ecbc02d5a1036d4fd5 (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
(.module:
  [library
   [lux "*"
    [abstract
     [monad {"+" do}]]
    [control
     ["<>" parser ("[1]#[0]" functor)
      ["<[0]>" code {"+" Parser}]]]
    [data
     ["[0]" product]
     [collection
      ["[0]" list ("[1]#[0]" mix)]]]
    [macro
     [syntax {"+" syntax:}]
     ["[0]" code]]
    [math
     [number
      ["n" nat]
      ["i" int]]]]])

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

(def: literal
  (Parser Code)
  ($_ <>.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.identifier <code>.identifier)))

(def: expression
  (Parser Infix)
  (<| <>.rec (function (_ expression))
      ($_ <>.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)
  (case infix
    {#Const value}
    value
    
    {#Call parts}
    (code.form parts)

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

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