aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/math/infix.lux
blob: 616c6270921be0042aeb1ccaa0bccf6439795ec0 (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
(.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)
      (<>\each code.tag <code>.tag)))

(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))))