-
Notifications
You must be signed in to change notification settings - Fork 1
/
Program.fs
99 lines (85 loc) · 4.66 KB
/
Program.fs
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
// Learn more about F# at http://fsharp.org
open Microsoft.FSharp.Text.Lexing
open AST
open System
let mutable stack: List<Map<string, Atomic>> = Map.empty :: List.empty
let read (id: string) =
List.tryPick (fun scope -> if Map.containsKey id scope then scope.[id] |> Some else None) stack
|> fun v -> if v.IsSome then v.Value else Exception <| "Variable not defined: " + id |> raise
let add (id: string) (v: Atomic) =
let scope = stack.Head |> fun scope -> scope.Add (id, v)
stack <- scope :: stack.Tail
()
let write (id: string) (v: Atomic) =
let scopeIndex = List.tryFindIndex (Map.containsKey id) stack
let scope = stack.[scopeIndex.Value] |> fun scope -> scope.Add (id, v)
stack <- List.mapi (fun i v -> if i = scopeIndex.Value then scope else v) stack
()
let rec evalExpr (expr: Expression) =
match expr with
| Equals (l, r) -> (evalExpr l, evalExpr r) ||> fun (l: Atomic) r -> l.IsEqual r |> Bool
| NotEquals (l, r) -> (evalExpr l, evalExpr r) ||> fun (l: Atomic) r -> l.IsNotEqual r |> Bool
| Bigger (l, r) -> (evalExpr l, evalExpr r) ||> fun (l: Atomic) r -> l.IsBigger r |> Bool
| Smaller (l, r) -> (evalExpr l, evalExpr r) ||> fun (l: Atomic) r -> l.IsSmaller r |> Bool
| Atomic a -> a
| Id id -> read id
| Not e -> evalExpr e |> fun r -> match r with
| Bool b -> not b |> Bool
| _ -> raise <| Exception "exepected Bool expr for '!'"
| Nested e -> evalExpr e
| And (l, r) -> (evalExpr l, evalExpr r) ||> fun l r -> Bool (l = Bool true && r = Bool true)
| Or (l, r) -> (evalExpr l, evalExpr r) ||> fun l r -> Bool (l = Bool true || r = Bool true)
| CollectionInit e -> List.map evalExpr e |> Collection
| CollectionGet (id, e) -> let c = read id
match c with
| Collection col -> match evalExpr e with
| Int i -> col.[i]
| _ -> Exception "Index not an int" |> raise
| _ -> Exception "Collection not found" |> raise
and evalCodeBlock (cb: CodeBlock) (scope: Map<string, Atomic>) =
stack <- scope :: stack
match cb with
| CodeBlock cb -> List.map evalStm cb |> ignore
stack <- stack.Tail
and evalForeach (id: string) (alias: string) (cb: CodeBlock) =
let col = read id
match col with
| Collection c -> List.map (fun item -> evalCodeBlock cb (Map.ofList [alias, item])) c
| _ -> Exception "foreach expected a collection" |> raise
|> ignore
and evalStm (stm: Statement) =
match stm with
| Declaration (name, expr) -> add name <| evalExpr expr
| Assigment (name, expr) -> write name <| evalExpr expr
| If (pred, _then, _else) -> evalExpr pred |> fun c -> if c = Bool true
then evalCodeBlock _then Map.empty |> ignore
elif _else.IsSome
then evalCodeBlock _else.Value Map.empty |> ignore
| Echo e -> evalExpr e |> printf "%A\n"
| Expression e -> evalExpr e |> ignore
| CollectionSet (id, i, e) -> let c = read id
let index = match evalExpr i with
| Int i -> i
| _ -> Exception "Index should be an int" |> raise
let newC = match c with
| Collection cc -> List.mapi (fun i a -> if i = index then evalExpr e else a) cc |> Collection
| _ -> Exception "Out of bouds" |> raise
write id newC
| ForEach (id, a, cb) -> evalForeach id a cb
| CollectionAdd (id, e) -> let v = evalExpr e
let c = match read id with
| Collection c -> c @ [v]
| _ -> Exception "@ expects a collection" |> raise
Collection c |> write id
[<EntryPoint>]
let main argv =
let test = """
let x = [1,2,3]
x @ 4
echo x
"""
let lexbuf = LexBuffer<char>.FromString test
let ast: Statement list = Parser.start Lexer.tokenstream lexbuf
printf "%A \n\n" ast
List.map evalStm ast |> ignore
0