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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
/// This module should parse tokens into an expression
module Expression
open MarkalcShared
open Types
open Logger
(* SUPPORTED OPERATIONS:
BinaryExpressions (in order of precedence):
% - Modulo
^ - To the power
* - Multiply
/ - Divide
+ - Add
- - Subtract
*)
// HELPER FUNCTIONS
let makeFloat i d =
sprintf "%A.%A" i d |> float
let makeInt (i:string) =
i |> int
let makeCellReference (row:string,col:string) =
RowCol(row|>uint32,col|>uint32)
// [row=3,col=2]
// ]2=col,3=row[
// [row=3,col=2] [3,42]
/// EXPRESSION PARSER
let parseExp toks =
let rec (|Expression|_|) (toks:Token list) =
let (|NumberPat|_|) = function
| NUMBER(i) :: DOT :: NUMBER(d) :: after -> (makeFloat i d, after) |> Some
| NUMBER(i) :: after -> (makeInt i |> float, after) |> Some
| _ -> None
let rec (|CellRefPat|_|) = function
| RSBRA :: NUMBER(col) :: COMMA :: NUMBER(row) :: LSBRA :: after
-> ((row,col) |> makeCellReference,after) |> Some
| RSBRA :: NUMBER(row) :: EQUAL :: LITERAL("row") :: COMMA :: NUMBER(col) :: EQUAL :: LITERAL("col") :: LSBRA :: after
-> sprintf "Row:%A, Col:%A" row col |> globLog.Debug None
((row,col) |> makeCellReference,after) |> Some
| RSBRA :: NUMBER(col) :: EQUAL :: LITERAL("col") :: COMMA :: NUMBER(row) :: EQUAL :: LITERAL("row") :: LSBRA :: after
-> sprintf "Row:%A, Col:%A" row col |> globLog.Debug None
((row,col) |> makeCellReference,after) |> Some
| _ -> None
let rec (|ExpressionList|_|) = function
| Expression(exp,COMMA::ExpressionList(exps,after)) -> (exp::exps,after) |> Some
| CellRefPat(x,COLON::CellRefPat(y,after)) -> cellRange (x,y) |> function
| Some lst -> (List.map (CellRef >> Op) lst,after) |> Some
| _ -> None
| Expression(exp,after) -> ([exp],after) |> Some
| _ -> None
// DEFINE FUNCTIONS
let funcConstruct funcname = function
| RCBRA :: ExpressionList (lst,LCBRA::LITERAL(funcname)::after) ->
(CommaFunction(funcname,lst),after) |> Some
| _ -> None
let (|Sum|_|) = funcConstruct "SUM"
let (|Avg|_|) = funcConstruct "AVG"
let (|Min|_|) = funcConstruct "MIN"
let (|Max|_|) = funcConstruct "MAX"
let (|FunctionPat|_|) = function
| Sum (x,after) -> (x,after) |> Some
| Avg (x,after) -> (x,after) |> Some
| Min (x,after) -> (x,after) |> Some
| Max (x,after) -> (x,after) |> Some
| _ -> None
let (|BasePat|_|) = function
| NumberPat (x,after) -> (x |> Float |> Op,after) |> Some
| FunctionPat (x,after) -> (x,after) |> Some
// Parsing in reverse so right and left brackets swapped
| CellRefPat (x,after) -> (x |> CellRef |> Op,after) |> Some
| RBRA :: Expression (x,LBRA::after) -> (x,after) |> Some
| _ -> None
// Active pattern to construct precedence-aware active patterns; descends recursively until highest precedence match.
// Quirk: Returns right-associative results, so parsing in reverse to get left-associativity.
let rec (|HOFPat|_|) (|PrevPat|_|) op (t:Token) = function
| PrevPat (exp1, after) ->
match after with
| x :: (HOFPat (|PrevPat|_|) op t (exp2, after')) when x = t ->
(BinExp (op, exp2, exp1), after') |> Some // exp1 and exp2 swapped because parsing in reverse
| _ -> (exp1, after) |> Some
| _ -> None
// Build precendence and normal binary operators
let patPrecedence = [(%),PERCENT;( **),CARET;(*),ASTERISK;(/),SLASH;(-),MINUS;( + ),PLUS]
let constructPatterns s x = ((|HOFPat|_|) (List.head s) (fst x) (snd x))::s
let patterns = List.fold constructPatterns [(|BasePat|_|)] patPrecedence
let (|FirstPat|_|) = List.head patterns
// Unary operators, only negative number so far. Doesn't work.
// let (|UnaryOperators|_|) = function
// | FirstPat (exp1, after) ->
// match after with
// // Negative Numbers
// | NumberPat(x,MINUS::after') -> (-x |> Float |> Op,after') |> Some
// // ... Could have more patterns here.
// | _ -> (exp1,after) |> Some
// | _ -> None
match toks with
| FirstPat x -> Some x
| _ -> None
// Add other options to cells
//let (|Option|_|) toks =
// match toks with
// | NUMBER(i)::COMMA::after -> // Number of decimal places
// | NUMBER(i)::EQUAL::LITERAL("dp")::COMMA::after -> // Number of decimal places
match List.rev toks with
| NUMBER(i)::COMMA::rest -> match rest with
| Expression (exp,[]) -> (exp,i|>int) |> DPExp |> Ok
| _ -> sprintf "Not valid expression %A" toks |> Error
| Expression (exp,[]) -> (exp,-1) |> DPExp |> Ok
| _ -> sprintf "Not valid expression %A" toks |> Error
let parseExpression toks =
match toks with
| EQUAL :: tail ->
whitespaceFilter tail |> parseExp |> function
| Error(e) -> Error toks
| Ok(x) -> Ok x
| toks -> Error toks
// ################## TEST FUNCTIONS ####################
// Recursively evaluate expression AST. CellRef will need access to whole table, this is used to test everything else
let evalExpTest (e:TExpr) =
let rec evalExpTest' (e:Expr) =
match e with
| BinExp(f,x,y) -> f (evalExpTest'(x)) (evalExpTest'(y))
| Op (Float(x)) -> x
| _ -> 13.0
match e with
| DPExp(exp,dp) when dp < 0 -> evalExpTest' exp
| DPExp(exp,dp) -> evalExpTest' exp |> round dp
// Test evaluation without table
let parseExpTest (toks:Token list) =
whitespaceFilter toks // Remove whitespace
|> parseExp
|> function
| Error(e) -> printfn "Error parsing expression: %A" e
Error toks
| Ok(x) -> evalExpTest x |> Ok
|
