aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/math/infix.lux
blob: 8a37aa0f77d5cae74215a0a8b5791d15e7b25fd8 (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
(.using
 [library
  [lux (.except)
   [abstract
    [monad (.only do)]]
   [control
    ["<>" parser (.open: "[1]#[0]" functor)
     ["<[0]>" code (.only Parser)]]]
   [data
    ["[0]" product]
    [collection
     ["[0]" list (.open: "[1]#[0]" mix)]]]
   [macro
    [syntax (.only 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)
  (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)
  (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))))