blob: a8fd881aafec69198d1ad635b05b11225b5d16de (
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
|
(.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: infix^
(Parser Infix)
(<| <>.rec (function (_ infix^))
($_ <>.or
($_ <>.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))
(<code>.form (<>.many <code>.any))
(<code>.tuple (<>.and <code>.any infix^))
(<code>.tuple ($_ <>.either
(do <>.monad
[_ (<code>.this! (' #and))
init_subject infix^
init_op <code>.any
init_param infix^
steps (<>.some (<>.and <code>.any infix^))]
(wrap (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 infix^
init_op <code>.any
init_param infix^
steps (<>.some (<>.and <code>.any infix^))]
(wrap (list\fold (function (_ [op param] [_subject _op _param])
[(#Binary _subject _op _param) op param])
[init_subject init_op init_param]
steps)))
))
)))
(def: (to_prefix infix)
(-> Infix Code)
(case infix
(#Const value)
value
(#Call parts)
(code.form parts)
(#Unary op subject)
(` ((~ op) (~ (to_prefix subject))))
(#Binary left op right)
(` ((~ op) (~ (to_prefix right)) (~ (to_prefix left))))
))
(syntax: #export (infix {expr infix^})
{#.doc (doc "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.")}
(wrap (list (..to_prefix expr))))
|
