blob: a04cf8944071918945fe258c370934ae011eaf8d (
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
|
(.module:
{#.doc "Common mathematical constants and functions."}
[library
[lux #*
[abstract
[monad (#+ do)]]
[control
["<>" parser ("#\." functor)
["<.>" code (#+ Parser)]]]
[data
["." product]
[collection
["." list ("#\." fold)]]]
[macro
[syntax (#+ syntax:)]
["." code]]
[math
[number
["n" nat]
["i" int]]]]])
(type: #rec Infix
(#Const Code)
(#Call (List Code))
(#Unary Code Infix)
(#Binary Infix Code Infix))
(def: literal
(Parser Code)
($_ <>.either
(<>\map code.bit <code>.bit)
(<>\map code.nat <code>.nat)
(<>\map code.int <code>.int)
(<>\map code.rev <code>.rev)
(<>\map code.frac <code>.frac)
(<>\map code.text <code>.text)
(<>\map code.identifier <code>.identifier)
(<>\map 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 ($_ <>.either
(do <>.monad
[_ (<code>.this! (' #and))
init_subject expression
init_op <code>.any
init_param expression
steps (<>.some (<>.and <code>.any expression))]
(in (product.right (list\fold (function (_ [op param] [subject [_subject _op _param]])
[param [(#Binary _subject _op _param)
(` and)
(#Binary subject op param)]])
[init_param [init_subject init_op init_param]]
steps))))
(do <>.monad
[init_subject expression
init_op <code>.any
init_param expression
steps (<>.some (<>.and <code>.any expression))]
(in (list\fold (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})
{#.doc (example "Infix math syntax."
(infix [x i.* +10])
(infix [[x i.+ y] i.* [x i.- y]])
(infix [sin [x i.+ y]])
(infix [[x n.< y] and [y n.< z]])
(infix [#and x n.< y n.< z])
(infix [(n.* 3 9) gcd 450])
"The rules for infix syntax are simple."
"If you want your binary function to work well with it."
"Then take the argument to the right (y) as your first argument,"
"and take the argument to the left (x) as your second argument.")}
(in (list (..prefix expr))))
|
