-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathRuntime.fs
175 lines (159 loc) · 8.46 KB
/
Runtime.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
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
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
module Runtime
open System
open AST
open System.IO
open Microsoft.FSharp.Text.Lexing
open RuntimeFunctions
open TypeChecker
let rec evalExpression (mem: Memory<MemoryValue>) (expr: Expression) : Memory<MemoryValue> * MemoryValue =
match expr with
| Value v -> mem, v
| Read id -> mem, readMemory mem id
| Write (id, e, _rec, _) -> if Functions.ContainsKey id then Exception <| id + " is a reserved keyword" |> raise else
let m1, v1 = evalExpression mem e
let v2 = match (v1, _rec) with
| (LambdaExpr (s, e, p, r), true) -> LambdaExpr (s, e, p, Some id)
| _ -> v1
let m2 = writeMemory m1 id v2
m2, Unit ()
| Lambda (p, _, _, es) -> mem, LambdaExpr (mem, es, p, None)
| Apply (e, _, p) -> match e with
| Read i when Functions.ContainsKey i -> let (m1, p1) = evalExpression mem p
Functions.[i] mem p1
| _ -> let (m1, l) = evalExpression mem e
let (m2, p1) = evalExpression m1 p
let res = match l with
| LambdaExpr (s, es, p, r) -> applyLamda s es p1 p r
| _ -> Exception "can not apply" |> raise
m2, res
| Nested e -> evalExpression mem e
| Echo e -> let (_, v) = evalExpression mem e
prettyPrint v |> printfn "%s"
mem, Unit ()
| Equals (l,r) -> evalEquals mem l r
| NotEquals (l,r) -> evalNotEquals mem l r
| Plus (l, r) -> evalPlus mem l r
| Min (l, r) -> evalMin mem l r
| Times (l, r) -> evalTimes mem l r
| Divide (l, r) -> evalDivide mem l r
| And (l, r) -> evalAnd mem l r
| Or (l, r) -> evalOr mem l r
| Condition (c, i, e) -> let m1, will = evalExpression mem c
match will with
| Bool true -> evalExpression m1 i
| Bool false -> evalExpression m1 e
| _ -> Exception "Expected bool for if" |> raise
| ArrayInit (l, _) -> let list = List.map (evalExpression mem >> snd) l
(mem, Array.ofList list |> Array)
| ArrayGet (e, i) -> let m1, list = evalExpression mem e
let m2, index = evalExpression m1 i
match (list, index) with
| (Array l, Int i) -> m1, if i < l.Length then l.[i] else Unit ()
| (String s, Int i) -> m1, if i < s.Length then s.[i] |> string |> String else Unit ()
| _ -> Exception "can not index the value" |> raise
| ObjectInit r -> mem, Map.ofList r |> Map.map (fun k e -> evalExpression mem e |> snd) |> Object
| ObjectGet (o, k) -> let m1, obj = evalExpression mem o
match obj with
| Object r -> m1, r.[k]
| _ -> Exception "can not index the value" |> raise
| ObjectCopyWith (o, nv) -> let m1, obj = evalExpression mem o
let m2, v = evalExpression m1 (snd nv)
match obj with
| Object r -> m2, Map.add (fst nv) v r |> Object
| _ -> Exception "can not index the value" |> raise
| Open s -> loadModule mem s
| _ -> mem, Unit ()
and loadModule (mem: Memory<MemoryValue>) (name: string): Memory<MemoryValue> * MemoryValue =
let code = File.ReadAllText <| "./StandaardLib/" + name
let ast: Expression list = Parser.start Lexer.tokenstream <| LexBuffer<char>.FromString code
let mutable m1: Memory<MemoryValue> = mem
List.map (fun e -> (let m2, _ = evalExpression m1 e
m1 <- m2;)) ast |> ignore
m1, Unit ()
and evalAnd (mem: Memory<MemoryValue>) (left: Expression) (rigth: Expression) =
let m1, l1 = evalExpression mem left
match l1 with
| Bool false -> m1, Bool false
| Bool true -> let m2, r1 = evalExpression m1 rigth
match r1 with
| Bool _ -> m2, r1
| _ -> Exception "Type error with &&" |> raise
| _ -> Exception "Type error with &&" |> raise
and evalOr (mem: Memory<MemoryValue>) (left: Expression) (rigth: Expression) =
let m1, l1 = evalExpression mem left
let m2, r1 = evalExpression m1 rigth
match (l1, r1) with
| (Bool true, Bool _) -> m2, Bool true
| (Bool _, Bool true) -> m2, Bool true
| (Bool false, Bool false) -> m2, Bool false
| _ -> Exception "Type error with ||" |> raise
and evalEquals (mem: Memory<MemoryValue>) (left: Expression) (rigth: Expression) =
let m1, l1 = evalExpression mem left
let m2, r1 = evalExpression m1 rigth
match (l1, r1) with
| (Int i1, Int i2) -> m2, Bool (i1 = i2)
| (Bool b1, Bool b2 ) -> m2, Bool (b1 = b2)
| (Unit _, Unit _) -> m2, Bool true
| (String s1, String s2) -> m2, Bool (s1 = s2)
| _ -> m2, Bool false
and evalNotEquals (mem: Memory<MemoryValue>) (left: Expression) (rigth: Expression) =
let m1, l1 = evalExpression mem left
let m2, r1 = evalExpression m1 rigth
match (l1, r1) with
| (Int i1, Int i2) -> m2, Bool (i1 <> i2)
| (Bool b1, Bool b2 ) -> m2, Bool (b1 <> b2)
| (String s1, String s2) -> m2, Bool (s1 <> s2)
| (Unit _, Unit _) -> m2, Bool false
| _ -> Exception "Type error with !=" |> raise
and evalPlus (mem: Memory<MemoryValue>) (left: Expression) (rigth: Expression) =
let m1, l1 = evalExpression mem left
let m2, r1 = evalExpression m1 rigth
match (l1, r1) with
| (Int i1, Int i2) -> m2, Int (i1 + i2)
| (String s1, String s2) -> m2, String (s1 + s2)
| _ -> Exception "Type error with +" |> raise
and evalMin (mem: Memory<MemoryValue>) (left: Expression) (rigth: Expression) =
let m1, l1 = evalExpression mem left
let m2, r1 = evalExpression m1 rigth
match (l1, r1) with
| (Int i1, Int i2) -> m2, Int (i1 - i2)
| _ -> Exception "Type error with -" |> raise
and evalTimes (mem: Memory<MemoryValue>) (left: Expression) (rigth: Expression) =
let m1, l1 = evalExpression mem left
let m2, r1 = evalExpression m1 rigth
match (l1, r1) with
| (Int i1, Int i2) -> m2, Int (i1 * i2)
| _ -> Exception "Type error with *" |> raise
and evalDivide (mem: Memory<MemoryValue>) (left: Expression) (rigth: Expression) =
let m1, l1 = evalExpression mem left
let m2, r1 = evalExpression m1 rigth
match (l1, r1) with
| (Int i1, Int i2) -> m2, Int (i1 / i2)
| _ -> Exception "Type error with /" |> raise
and applyLamda (scope: Memory<MemoryValue>) (exprs: Expression list) (param: MemoryValue) (paramAlias: string ) (_rec: string option) =
let mutable res = Unit ()
let mutable mem = Map.empty :: scope
if _rec.IsSome then mem <- writeMemory mem _rec.Value <| LambdaExpr (scope, exprs, paramAlias, _rec)
mem <- writeMemory mem paramAlias param
List.map (fun e -> (let m1, v = evalExpression mem e
mem <- m1;
res <- v;)) exprs |> ignore
res
and prettyPrint (v: MemoryValue): string =
match v with
| Int i -> string i
| Bool b -> if b then "true" else "false"
| String s -> s
| Unit _ -> "()"
| Array a -> let mutable s = "[\n"
Array.map (fun v -> (s <- s + " " + (prettyPrint v) + ",\n")) a |> ignore
s + "]"
| Object p -> let mutable s = "{\n"
Map.map (fun id v -> (s <- s + " " + id + ": " + (prettyPrint v) + ",\n")) p |> ignore
s + "}"
| _ -> sprintf "%A" v
let evalExpressions (exprs: Expression list) =
typeCheckExpressions exprs
let mutable mem: Memory<MemoryValue> = [Map.empty]
List.map (fun e -> (let m1, _ = evalExpression mem e
mem <- m1;)) exprs |> ignore