-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathAlgebrizer.hs
94 lines (79 loc) · 3.88 KB
/
Algebrizer.hs
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
module Algebrizer (semiAlgebrize) where
import Expression
unheight = Height {heights = 0, difference = 0}
unit = Expression {
rawvalue = 1,
onStack = [],
offStack = [],
sstack = [],
lheight = (unheight,unheight),
rheight = (unheight,unheight)
}
singleHeight :: Integer -> Integer -> Bool -> Expression
singleHeight diff val False = Expression {
rawvalue = val,
onStack = [],
offStack = [],
sstack = [],
lheight = (Height {heights = 1, difference = diff},unheight),
rheight = (unheight,unheight)
}
singleHeight diff val True = Expression {
rawvalue = val,
onStack = [],
offStack = [],
sstack = [],
lheight = (unheight,unheight),
rheight = (Height {heights = 1, difference = diff},unheight)
}
empty = Expression {
rawvalue = 0,
onStack = [],
offStack = [],
sstack = [],
lheight = (unheight,unheight),
rheight = (unheight,unheight)
}
newScope sdepth = Expression {
rawvalue = 0,
onStack = [],
offStack = [],
sstack = ([1..sdepth]>>[0])++[1],
lheight = (unheight,unheight),
rheight = (unheight,unheight)
}
semiAlgebrize :: String -> ([Expression], [Expression], [Expression]) -> (Integer, Integer, Integer) -> Bool -> (([Expression], [Expression], [Expression]), (Integer, Integer, Integer), Bool)
semiAlgebrize [] a b s = (a, b, s)
semiAlgebrize x@('{':'}':_) ([], offStack, sstack) (onDepth, offDepth, sdepth) True = semiAlgebrize x ([Expression {
rawvalue = 0,
onStack = ([1..onDepth]>>[0])++[1],
offStack = [],
sstack = [],
lheight = (unheight,unheight),
rheight = (unheight,unheight)
}], offStack, sstack) (onDepth+1, offDepth, sdepth) True
semiAlgebrize x@('{':'}':_) ([], offStack, sstack) (onDepth, offDepth, sdepth) False = semiAlgebrize x ([Expression {
rawvalue = 0,
onStack = [],
offStack = ([1..onDepth]>>[0])++[1],
sstack = [],
lheight = (unheight,unheight),
rheight = (unheight,unheight)
}], offStack, sstack) (onDepth+1, offDepth, sdepth) False
semiAlgebrize x@(a:b:_) (onStack, offStack, []) (onDepth, offDepth, sdepth) s
| elem (a:b:[]) ["()","[]","{}"] || a == '>' = semiAlgebrize x (onStack, offStack, [newScope sdepth]) (onDepth, offDepth, sdepth + 1) s
semiAlgebrize x@(a:_) (onStack, offStack, []) (onDepth, offDepth, sdepth) s
| elem a ")]" = semiAlgebrize x (onStack, offStack, [newScope sdepth, newScope sdepth]) (onDepth, offDepth, sdepth + 2) s
semiAlgebrize x@(a:_) (onStack, offStack, [top]) (onDepth, offDepth, sdepth) s
| elem a ")]" = semiAlgebrize x (onStack, offStack, [top, newScope sdepth]) (onDepth, offDepth, sdepth + 1) s
semiAlgebrize ('(':')':x) (onStack, offStack, (top:rest)) depths s = semiAlgebrize x (onStack, offStack, (plus unit top:rest)) depths s
semiAlgebrize ('[':']':x) (onStack, offStack, (top:rest)) depths@(onDepth, _, _) s = semiAlgebrize x (onStack, offStack, (plus (singleHeight onDepth (toInteger $ length onStack) s) top:rest)) depths s
semiAlgebrize ('{':'}':x) ((poppand:onStack), offStack, (top:rest)) depths s = semiAlgebrize x (onStack, offStack, (plus poppand top):rest) depths s
semiAlgebrize ('<':'>':x) (onStack, offStack, sstack) (ldepth, rdepth, sdepth) s = semiAlgebrize x (offStack, onStack, sstack) (rdepth, ldepth, sdepth) (not s)
semiAlgebrize ('(':x) (onStack, offStack, scope) depths s = semiAlgebrize x (onStack, offStack, empty:scope) depths s
semiAlgebrize ('[':x) (onStack, offStack, scope) depths s = semiAlgebrize x (onStack, offStack, empty:scope) depths s
semiAlgebrize ('<':x) (onStack, offStack, scope) depths s = semiAlgebrize x (onStack, offStack, empty:scope) depths s
semiAlgebrize (')':x) (onStack, offStack, (top:next:scope)) depths s = semiAlgebrize x (top:onStack, offStack, (plus top next):scope) depths s
semiAlgebrize ('>':x) (onStack, offStack, (top:scope)) depths s = semiAlgebrize x (onStack, offStack, scope) depths s
semiAlgebrize (']':x) (onStack, offStack, (top:next:scope)) depths s = semiAlgebrize x (onStack, offStack, (plus (neg top) next):scope) depths s
semiAlgebrize x a b c = error$ show(x, a, b, c)