···
1
1
+
# Devenv
2
2
+
.devenv*
3
3
+
devenv.local.nix
4
4
+
devenv.local.yaml
5
5
+
6
6
+
# Lean build artifacts
7
7
+
.lake/
8
8
+
9
9
+
# direnv
10
10
+
.direnv
11
11
+
12
12
+
# pre-commit
13
13
+
.pre-commit-config.yaml
···
1
1
+
import Mlang
2
2
+
3
3
+
open Mlang
4
4
+
5
5
+
def checkAndEval (source : String) : Except String (Value × Judgment) := do
6
6
+
match parse source with
7
7
+
| .error err =>
8
8
+
throw s!"parse error: {reprStr err}"
9
9
+
| .ok expr =>
10
10
+
match inferType [] expr with
11
11
+
| .error err =>
12
12
+
throw s!"type error: {reprStr err}"
13
13
+
| .ok judgment =>
14
14
+
match eval [] expr with
15
15
+
| .ok value =>
16
16
+
pure (value, judgment)
17
17
+
| .error err =>
18
18
+
throw s!"runtime error: {reprStr err}"
19
19
+
20
20
+
def printResult (label : String) (source : String) : IO Unit := do
21
21
+
match checkAndEval source with
22
22
+
| .ok (value, judgment) =>
23
23
+
IO.println s!"{label}: {renderValue value} : {renderJudgment judgment}"
24
24
+
| .error msg =>
25
25
+
IO.println s!"{label}: {msg}"
26
26
+
27
27
+
def runFile (path : String) : IO UInt32 := do
28
28
+
let source ← IO.FS.readFile path
29
29
+
match checkAndEval source with
30
30
+
| .ok (value, judgment) =>
31
31
+
IO.println s!"{renderValue value} : {renderJudgment judgment}"
32
32
+
pure 0
33
33
+
| .error msg =>
34
34
+
IO.eprintln s!"{path}: {msg}"
35
35
+
pure 1
36
36
+
37
37
+
partial def repl : IO UInt32 := do
38
38
+
let stdin ← IO.getStdin
39
39
+
let line ← stdin.getLine
40
40
+
let input := (String.trimAscii line).toString
41
41
+
if input.isEmpty then
42
42
+
repl
43
43
+
else if input = ":quit" || input = ":q" then
44
44
+
pure 0
45
45
+
else do
46
46
+
match checkAndEval input with
47
47
+
| .ok (value, judgment) =>
48
48
+
IO.println s!"{renderValue value} : {renderJudgment judgment}"
49
49
+
| .error msg =>
50
50
+
IO.eprintln msg
51
51
+
repl
52
52
+
53
53
+
def printUsage : IO Unit := do
54
54
+
IO.println "usage:"
55
55
+
IO.println " mlang # start REPL"
56
56
+
IO.println " mlang <file> # run a source file"
57
57
+
IO.println " mlang --demo # run built-in examples"
58
58
+
IO.println " mlang :quit # not valid; use inside REPL"
59
59
+
60
60
+
def runDemo : IO UInt32 := do
61
61
+
printResult "sample" "let inc = fun (x : Int) => x + 1 in inc 41"
62
62
+
printResult "lexical-scope" "let x = 10 in let f = fun (y : Int) => x + y in let x = 100 in f 5"
63
63
+
printResult "conditional" "if 6 * 7 = 42 then 1 else 0"
64
64
+
printResult "effectful" "10 / 2"
65
65
+
printResult "handled" "try 10 / 0 with 99"
66
66
+
printResult "handled-nested" "1 + (try 10 / 0 with 4)"
67
67
+
printResult "runtime-error" "10 / 0"
68
68
+
printResult "type-error" "let inc = fun (x : Int) => x + 1 in inc true"
69
69
+
pure 0
70
70
+
71
71
+
def main (args : List String) : IO UInt32 := do
72
72
+
match args with
73
73
+
| [] =>
74
74
+
IO.println "mlang REPL. enter :quit to exit."
75
75
+
repl
76
76
+
| ["--demo"] =>
77
77
+
runDemo
78
78
+
| ["-h"] | ["--help"] =>
79
79
+
printUsage
80
80
+
pure 0
81
81
+
| [path] =>
82
82
+
runFile path
83
83
+
| _ =>
84
84
+
printUsage
85
85
+
pure 1
···
1
1
+
import Mlang.Interpreter
2
2
+
import Mlang.Parser
···
1
1
+
namespace Mlang
2
2
+
3
3
+
abbrev Name := String
4
4
+
5
5
+
inductive Effect where
6
6
+
| error : Effect
7
7
+
deriving Repr, Inhabited, BEq
8
8
+
9
9
+
abbrev Effects := List Effect
10
10
+
11
11
+
def Effects.contains (effects : Effects) (effect : Effect) : Bool :=
12
12
+
effects.any (· == effect)
13
13
+
14
14
+
def Effects.insert (effects : Effects) (effect : Effect) : Effects :=
15
15
+
if effects.contains effect then effects else effect :: effects
16
16
+
17
17
+
def Effects.union (lhs rhs : Effects) : Effects :=
18
18
+
rhs.foldl Effects.insert lhs
19
19
+
20
20
+
def Effects.erase (effects : Effects) (target : Effect) : Effects :=
21
21
+
effects.filter (· != target)
22
22
+
23
23
+
def Effects.render : Effects → String
24
24
+
| [] => "{}"
25
25
+
| effects =>
26
26
+
let names := effects.reverse.map (fun
27
27
+
| .error => "Error")
28
28
+
"{" ++ String.intercalate ", " names ++ "}"
29
29
+
30
30
+
inductive Ty where
31
31
+
| int : Ty
32
32
+
| bool : Ty
33
33
+
| funTy : Ty → Effects → Ty → Ty
34
34
+
deriving Repr, Inhabited, BEq
35
35
+
36
36
+
inductive Expr where
37
37
+
| int : Int → Expr
38
38
+
| bool : Bool → Expr
39
39
+
| var : Name → Expr
40
40
+
| add : Expr → Expr → Expr
41
41
+
| sub : Expr → Expr → Expr
42
42
+
| mul : Expr → Expr → Expr
43
43
+
| div : Expr → Expr → Expr
44
44
+
| eq : Expr → Expr → Expr
45
45
+
| letE : Name → Expr → Expr → Expr
46
46
+
| ifE : Expr → Expr → Expr → Expr
47
47
+
| tryE : Expr → Expr → Expr
48
48
+
| lam : Name → Ty → Expr → Expr
49
49
+
| app : Expr → Expr → Expr
50
50
+
deriving Repr, Inhabited
51
51
+
52
52
+
inductive Value where
53
53
+
| int : Int → Value
54
54
+
| bool : Bool → Value
55
55
+
| closure : Name → Expr → List (Name × Value) → Value
56
56
+
deriving Repr, Inhabited
57
57
+
58
58
+
abbrev Env := List (Name × Value)
59
59
+
60
60
+
inductive RuntimeError where
61
61
+
| unboundVariable : Name → RuntimeError
62
62
+
| typeError : String → RuntimeError
63
63
+
| divisionByZero : RuntimeError
64
64
+
deriving Repr, Inhabited
65
65
+
66
66
+
abbrev EvalM := Except RuntimeError
67
67
+
68
68
+
def Env.lookup (env : Env) (name : Name) : Option Value :=
69
69
+
match env with
70
70
+
| [] => none
71
71
+
| (n, v) :: rest => if n = name then some v else rest.lookup name
72
72
+
73
73
+
def expectInt : Value → EvalM Int
74
74
+
| .int n => .ok n
75
75
+
| _ => .error (.typeError "expected an integer")
76
76
+
77
77
+
def expectBool : Value → EvalM Bool
78
78
+
| .bool b => .ok b
79
79
+
| _ => .error (.typeError "expected a boolean")
80
80
+
81
81
+
partial def eval (env : Env) : Expr → EvalM Value
82
82
+
| .int n => .ok (.int n)
83
83
+
| .bool b => .ok (.bool b)
84
84
+
| .var name =>
85
85
+
match env.lookup name with
86
86
+
| some v => .ok v
87
87
+
| none => .error (.unboundVariable name)
88
88
+
| .add lhs rhs => do
89
89
+
let l ← expectInt (← eval env lhs)
90
90
+
let r ← expectInt (← eval env rhs)
91
91
+
pure (.int (l + r))
92
92
+
| .sub lhs rhs => do
93
93
+
let l ← expectInt (← eval env lhs)
94
94
+
let r ← expectInt (← eval env rhs)
95
95
+
pure (.int (l - r))
96
96
+
| .mul lhs rhs => do
97
97
+
let l ← expectInt (← eval env lhs)
98
98
+
let r ← expectInt (← eval env rhs)
99
99
+
pure (.int (l * r))
100
100
+
| .div lhs rhs => do
101
101
+
let l ← expectInt (← eval env lhs)
102
102
+
let r ← expectInt (← eval env rhs)
103
103
+
if r = 0 then
104
104
+
.error .divisionByZero
105
105
+
else
106
106
+
pure (.int (l / r))
107
107
+
| .eq lhs rhs => do
108
108
+
let l ← expectInt (← eval env lhs)
109
109
+
let r ← expectInt (← eval env rhs)
110
110
+
pure (.bool (l = r))
111
111
+
| .letE name value body => do
112
112
+
let value' ← eval env value
113
113
+
eval ((name, value') :: env) body
114
114
+
| .ifE cond thenBranch elseBranch => do
115
115
+
let c ← expectBool (← eval env cond)
116
116
+
if c then
117
117
+
eval env thenBranch
118
118
+
else
119
119
+
eval env elseBranch
120
120
+
| .tryE body handler =>
121
121
+
match eval env body with
122
122
+
| .ok value => .ok value
123
123
+
| .error _ => eval env handler
124
124
+
| .lam param _ body =>
125
125
+
pure (.closure param body env)
126
126
+
| .app fn arg => do
127
127
+
let fnVal ← eval env fn
128
128
+
let argVal ← eval env arg
129
129
+
match fnVal with
130
130
+
| .closure param body closureEnv =>
131
131
+
eval ((param, argVal) :: closureEnv) body
132
132
+
| _ =>
133
133
+
.error (.typeError "expected a function")
134
134
+
135
135
+
def renderValue : Value → String
136
136
+
| .int n => toString n
137
137
+
| .bool b => toString b
138
138
+
| .closure _ _ _ => "<closure>"
139
139
+
140
140
+
abbrev TyEnv := List (Name × Ty)
141
141
+
142
142
+
structure Judgment where
143
143
+
ty : Ty
144
144
+
effects : Effects
145
145
+
deriving Repr, Inhabited
146
146
+
147
147
+
inductive TypeError where
148
148
+
| unboundVariable : Name → TypeError
149
149
+
| mismatch : Ty → Ty → TypeError
150
150
+
| expectedFunction : Ty → TypeError
151
151
+
deriving Repr, Inhabited
152
152
+
153
153
+
abbrev CheckM := Except TypeError
154
154
+
155
155
+
def TyEnv.lookup (env : TyEnv) (name : Name) : Option Ty :=
156
156
+
match env with
157
157
+
| [] => none
158
158
+
| (n, ty) :: rest => if n = name then some ty else rest.lookup name
159
159
+
160
160
+
def ensureType (expected actual : Ty) : CheckM Unit :=
161
161
+
if expected == actual then
162
162
+
pure ()
163
163
+
else
164
164
+
throw (.mismatch expected actual)
165
165
+
166
166
+
def pureJudgment (ty : Ty) : Judgment :=
167
167
+
{ ty := ty, effects := [] }
168
168
+
169
169
+
partial def inferType (env : TyEnv) : Expr → CheckM Judgment
170
170
+
| .int _ => pure (pureJudgment .int)
171
171
+
| .bool _ => pure (pureJudgment .bool)
172
172
+
| .var name =>
173
173
+
match env.lookup name with
174
174
+
| some ty => pure (pureJudgment ty)
175
175
+
| none => throw (.unboundVariable name)
176
176
+
| .add lhs rhs
177
177
+
| .sub lhs rhs
178
178
+
| .mul lhs rhs => do
179
179
+
let lhsJ ← inferType env lhs
180
180
+
let rhsJ ← inferType env rhs
181
181
+
ensureType .int lhsJ.ty
182
182
+
ensureType .int rhsJ.ty
183
183
+
pure { ty := .int, effects := lhsJ.effects.union rhsJ.effects }
184
184
+
| .div lhs rhs => do
185
185
+
let lhsJ ← inferType env lhs
186
186
+
let rhsJ ← inferType env rhs
187
187
+
ensureType .int lhsJ.ty
188
188
+
ensureType .int rhsJ.ty
189
189
+
pure {
190
190
+
ty := .int
191
191
+
effects := (lhsJ.effects.union rhsJ.effects).insert .error
192
192
+
}
193
193
+
| .eq lhs rhs => do
194
194
+
let lhsJ ← inferType env lhs
195
195
+
let rhsJ ← inferType env rhs
196
196
+
ensureType .int lhsJ.ty
197
197
+
ensureType .int rhsJ.ty
198
198
+
pure { ty := .bool, effects := lhsJ.effects.union rhsJ.effects }
199
199
+
| .letE name value body => do
200
200
+
let valueJ ← inferType env value
201
201
+
let bodyJ ← inferType ((name, valueJ.ty) :: env) body
202
202
+
pure {
203
203
+
ty := bodyJ.ty
204
204
+
effects := valueJ.effects.union bodyJ.effects
205
205
+
}
206
206
+
| .ifE cond thenBranch elseBranch => do
207
207
+
let condJ ← inferType env cond
208
208
+
ensureType .bool condJ.ty
209
209
+
let thenJ ← inferType env thenBranch
210
210
+
let elseJ ← inferType env elseBranch
211
211
+
ensureType thenJ.ty elseJ.ty
212
212
+
pure {
213
213
+
ty := thenJ.ty
214
214
+
effects := condJ.effects.union (thenJ.effects.union elseJ.effects)
215
215
+
}
216
216
+
| .tryE body handler => do
217
217
+
let bodyJ ← inferType env body
218
218
+
let handlerJ ← inferType env handler
219
219
+
ensureType bodyJ.ty handlerJ.ty
220
220
+
pure {
221
221
+
ty := bodyJ.ty
222
222
+
effects := (bodyJ.effects.erase .error).union handlerJ.effects
223
223
+
}
224
224
+
| .lam param paramTy body => do
225
225
+
let bodyJ ← inferType ((param, paramTy) :: env) body
226
226
+
pure (pureJudgment (.funTy paramTy bodyJ.effects bodyJ.ty))
227
227
+
| .app fn arg => do
228
228
+
let fnJ ← inferType env fn
229
229
+
let argJ ← inferType env arg
230
230
+
match fnJ.ty with
231
231
+
| .funTy paramTy latentEffects resultTy =>
232
232
+
ensureType paramTy argJ.ty
233
233
+
pure {
234
234
+
ty := resultTy
235
235
+
effects := fnJ.effects.union (argJ.effects.union latentEffects)
236
236
+
}
237
237
+
| _ =>
238
238
+
throw (.expectedFunction fnJ.ty)
239
239
+
240
240
+
def renderType : Ty → String
241
241
+
| .int => "Int"
242
242
+
| .bool => "Bool"
243
243
+
| .funTy lhs effects rhs => s!"({renderType lhs} -> {renderType rhs} ! {effects.render})"
244
244
+
245
245
+
def renderJudgment (judgment : Judgment) : String :=
246
246
+
s!"{renderType judgment.ty} ! {judgment.effects.render}"
247
247
+
248
248
+
def sampleProgram : Expr :=
249
249
+
.letE "inc" (.lam "x" .int (.add (.var "x") (.int 1)))
250
250
+
(.app (.var "inc") (.int 41))
251
251
+
252
252
+
def lexicalScopeProgram : Expr :=
253
253
+
.letE "x" (.int 10)
254
254
+
(.letE "f" (.lam "y" .int (.add (.var "x") (.var "y")))
255
255
+
(.letE "x" (.int 100)
256
256
+
(.app (.var "f") (.int 5))))
257
257
+
258
258
+
def conditionalProgram : Expr :=
259
259
+
.ifE (.eq (.mul (.int 6) (.int 7)) (.int 42))
260
260
+
(.int 1)
261
261
+
(.int 0)
262
262
+
263
263
+
end Mlang
···
1
1
+
import Mlang.Interpreter
2
2
+
3
3
+
namespace Mlang
4
4
+
5
5
+
inductive Token where
6
6
+
| int : Int → Token
7
7
+
| bool : Bool → Token
8
8
+
| ident : String → Token
9
9
+
| lparen : Token
10
10
+
| rparen : Token
11
11
+
| colon : Token
12
12
+
| plus : Token
13
13
+
| minus : Token
14
14
+
| star : Token
15
15
+
| slash : Token
16
16
+
| eq : Token
17
17
+
| thinArrow : Token
18
18
+
| fatArrow : Token
19
19
+
| kwLet : Token
20
20
+
| kwIn : Token
21
21
+
| kwIf : Token
22
22
+
| kwThen : Token
23
23
+
| kwElse : Token
24
24
+
| kwFun : Token
25
25
+
| kwTry : Token
26
26
+
| kwWith : Token
27
27
+
deriving Repr, BEq, Inhabited
28
28
+
29
29
+
inductive ParseError where
30
30
+
| lexError : String → ParseError
31
31
+
| unexpectedEof : String → ParseError
32
32
+
| unexpectedToken : String → ParseError
33
33
+
| trailingTokens : List Token → ParseError
34
34
+
deriving Repr, Inhabited
35
35
+
36
36
+
abbrev ParseM := Except ParseError
37
37
+
38
38
+
def isDigit (c : Char) : Bool :=
39
39
+
'0' <= c && c <= '9'
40
40
+
41
41
+
def isIdentStart (c : Char) : Bool :=
42
42
+
c.isAlpha || c = '_'
43
43
+
44
44
+
def isIdentContinue (c : Char) : Bool :=
45
45
+
isIdentStart c || isDigit c
46
46
+
47
47
+
def isAtomStart : Token → Bool
48
48
+
| .int _ | .bool _ | .ident _ | .lparen => true
49
49
+
| _ => false
50
50
+
51
51
+
partial def spanChars (p : Char → Bool) : List Char → List Char × List Char
52
52
+
| [] => ([], [])
53
53
+
| c :: cs =>
54
54
+
if p c then
55
55
+
let (taken, rest) := spanChars p cs
56
56
+
(c :: taken, rest)
57
57
+
else
58
58
+
([], c :: cs)
59
59
+
60
60
+
def charsToString (chars : List Char) : String :=
61
61
+
String.ofList chars
62
62
+
63
63
+
def lexIdent (chars : List Char) : Token × List Char :=
64
64
+
let (nameChars, rest) := spanChars isIdentContinue chars
65
65
+
let name := charsToString nameChars
66
66
+
let token :=
67
67
+
match name with
68
68
+
| "let" => .kwLet
69
69
+
| "in" => .kwIn
70
70
+
| "if" => .kwIf
71
71
+
| "then" => .kwThen
72
72
+
| "else" => .kwElse
73
73
+
| "fun" => .kwFun
74
74
+
| "try" => .kwTry
75
75
+
| "with" => .kwWith
76
76
+
| "true" => .bool true
77
77
+
| "false" => .bool false
78
78
+
| _ => .ident name
79
79
+
(token, rest)
80
80
+
81
81
+
def lexNumber (chars : List Char) : ParseM (Token × List Char) := do
82
82
+
let (digits, rest) := spanChars isDigit chars
83
83
+
match String.toInt? (charsToString digits) with
84
84
+
| some n => pure (.int n, rest)
85
85
+
| none => throw (.lexError "invalid integer literal")
86
86
+
87
87
+
partial def lexChars : List Char → ParseM (List Token)
88
88
+
| [] => pure []
89
89
+
| c :: cs =>
90
90
+
if c.isWhitespace then
91
91
+
lexChars cs
92
92
+
else if isDigit c then do
93
93
+
let (tok, rest) ← lexNumber (c :: cs)
94
94
+
let toks ← lexChars rest
95
95
+
pure (tok :: toks)
96
96
+
else if isIdentStart c then do
97
97
+
let (tok, rest) := lexIdent (c :: cs)
98
98
+
let toks ← lexChars rest
99
99
+
pure (tok :: toks)
100
100
+
else
101
101
+
match c, cs with
102
102
+
| '(', _ => do pure (.lparen :: (← lexChars cs))
103
103
+
| ')', _ => do pure (.rparen :: (← lexChars cs))
104
104
+
| ':', _ => do pure (.colon :: (← lexChars cs))
105
105
+
| '+', _ => do pure (.plus :: (← lexChars cs))
106
106
+
| '-', '>' :: rest => do pure (.thinArrow :: (← lexChars rest))
107
107
+
| '-', _ => do pure (.minus :: (← lexChars cs))
108
108
+
| '*', _ => do pure (.star :: (← lexChars cs))
109
109
+
| '/', _ => do pure (.slash :: (← lexChars cs))
110
110
+
| '=', '>' :: rest => do pure (.fatArrow :: (← lexChars rest))
111
111
+
| '=', _ => do pure (.eq :: (← lexChars cs))
112
112
+
| _, _ => throw (.lexError s!"unexpected character '{c}'")
113
113
+
114
114
+
def lex (input : String) : ParseM (List Token) :=
115
115
+
lexChars input.toList
116
116
+
117
117
+
abbrev ParserState := List Token
118
118
+
119
119
+
def expectToken (expected : Token) : ParserState → ParseM ParserState
120
120
+
| tok :: rest =>
121
121
+
if tok == expected then
122
122
+
pure rest
123
123
+
else
124
124
+
throw (.unexpectedToken s!"expected {reprStr expected}, got {reprStr tok}")
125
125
+
| [] => throw (.unexpectedEof s!"expected {reprStr expected}")
126
126
+
127
127
+
mutual
128
128
+
partial def parseTy (tokens : ParserState) : ParseM (Ty × ParserState) := do
129
129
+
let (lhs, rest) ← parseTyAtom tokens
130
130
+
match rest with
131
131
+
| .thinArrow :: rest =>
132
132
+
let (rhs, rest) ← parseTy rest
133
133
+
pure (.funTy lhs [] rhs, rest)
134
134
+
| _ => pure (lhs, rest)
135
135
+
136
136
+
partial def parseTyAtom : ParserState → ParseM (Ty × ParserState)
137
137
+
| .ident "Int" :: rest => pure (.int, rest)
138
138
+
| .ident "Bool" :: rest => pure (.bool, rest)
139
139
+
| .lparen :: rest => do
140
140
+
let (ty, rest) ← parseTy rest
141
141
+
let rest ← expectToken .rparen rest
142
142
+
pure (ty, rest)
143
143
+
| tok :: _ => throw (.unexpectedToken s!"expected type, got {reprStr tok}")
144
144
+
| [] => throw (.unexpectedEof "expected type")
145
145
+
end
146
146
+
147
147
+
mutual
148
148
+
partial def parseExpr (tokens : ParserState) : ParseM (Expr × ParserState) := do
149
149
+
match tokens with
150
150
+
| .kwLet :: .ident name :: .eq :: rest => do
151
151
+
let (value, rest) ← parseExpr rest
152
152
+
let rest ← expectToken .kwIn rest
153
153
+
let (body, rest) ← parseExpr rest
154
154
+
pure (.letE name value body, rest)
155
155
+
| .kwIf :: rest => do
156
156
+
let (cond, rest) ← parseExpr rest
157
157
+
let rest ← expectToken .kwThen rest
158
158
+
let (thenBranch, rest) ← parseExpr rest
159
159
+
let rest ← expectToken .kwElse rest
160
160
+
let (elseBranch, rest) ← parseExpr rest
161
161
+
pure (.ifE cond thenBranch elseBranch, rest)
162
162
+
| .kwTry :: rest => do
163
163
+
let (body, rest) ← parseExpr rest
164
164
+
let rest ← expectToken .kwWith rest
165
165
+
let (handler, rest) ← parseExpr rest
166
166
+
pure (.tryE body handler, rest)
167
167
+
| .kwFun :: .lparen :: .ident name :: .colon :: rest => do
168
168
+
let (paramTy, rest) ← parseTy rest
169
169
+
let rest ← expectToken .rparen rest
170
170
+
let rest ← expectToken .fatArrow rest
171
171
+
let (body, rest) ← parseExpr rest
172
172
+
pure (.lam name paramTy body, rest)
173
173
+
| _ =>
174
174
+
parseEq tokens
175
175
+
176
176
+
partial def parseEq (tokens : ParserState) : ParseM (Expr × ParserState) := do
177
177
+
let (lhs, rest) ← parseAddSub tokens
178
178
+
match rest with
179
179
+
| .eq :: rest =>
180
180
+
let (rhs, rest) ← parseEq rest
181
181
+
pure (Expr.eq lhs rhs, rest)
182
182
+
| _ => pure (lhs, rest)
183
183
+
184
184
+
partial def parseAddSub (tokens : ParserState) : ParseM (Expr × ParserState) := do
185
185
+
let (first, rest) ← parseMul tokens
186
186
+
parseAddSubTail first rest
187
187
+
188
188
+
partial def parseAddSubTail (lhs : Expr) (tokens : ParserState) : ParseM (Expr × ParserState) := do
189
189
+
match tokens with
190
190
+
| .plus :: rest => do
191
191
+
let (rhs, rest) ← parseMul rest
192
192
+
parseAddSubTail (.add lhs rhs) rest
193
193
+
| .minus :: rest => do
194
194
+
let (rhs, rest) ← parseMul rest
195
195
+
parseAddSubTail (.sub lhs rhs) rest
196
196
+
| _ => pure (lhs, tokens)
197
197
+
198
198
+
partial def parseMul (tokens : ParserState) : ParseM (Expr × ParserState) := do
199
199
+
let (first, rest) ← parseApp tokens
200
200
+
parseMulTail first rest
201
201
+
202
202
+
partial def parseMulTail (lhs : Expr) (tokens : ParserState) : ParseM (Expr × ParserState) := do
203
203
+
match tokens with
204
204
+
| .star :: rest => do
205
205
+
let (rhs, rest) ← parseApp rest
206
206
+
parseMulTail (.mul lhs rhs) rest
207
207
+
| .slash :: rest => do
208
208
+
let (rhs, rest) ← parseApp rest
209
209
+
parseMulTail (.div lhs rhs) rest
210
210
+
| _ => pure (lhs, tokens)
211
211
+
212
212
+
partial def parseApp (tokens : ParserState) : ParseM (Expr × ParserState) := do
213
213
+
let (fn, rest) ← parseAtom tokens
214
214
+
parseAppTail fn rest
215
215
+
216
216
+
partial def parseAppTail (fn : Expr) (tokens : ParserState) : ParseM (Expr × ParserState) := do
217
217
+
match tokens with
218
218
+
| tok :: _ =>
219
219
+
if isAtomStart tok then do
220
220
+
let (arg, rest) ← parseAtom tokens
221
221
+
parseAppTail (.app fn arg) rest
222
222
+
else
223
223
+
pure (fn, tokens)
224
224
+
| [] => pure (fn, [])
225
225
+
226
226
+
partial def parseAtom : ParserState → ParseM (Expr × ParserState)
227
227
+
| .int n :: rest => pure (.int n, rest)
228
228
+
| .bool b :: rest => pure (.bool b, rest)
229
229
+
| .ident name :: rest => pure (.var name, rest)
230
230
+
| .lparen :: rest => do
231
231
+
let (expr, rest) ← parseExpr rest
232
232
+
let rest ← expectToken .rparen rest
233
233
+
pure (expr, rest)
234
234
+
| tok :: _ => throw (.unexpectedToken s!"expected expression, got {reprStr tok}")
235
235
+
| [] => throw (.unexpectedEof "expected expression")
236
236
+
end
237
237
+
238
238
+
def parse (input : String) : ParseM Expr := do
239
239
+
let tokens ← lex input
240
240
+
let (expr, rest) ← parseExpr tokens
241
241
+
match rest with
242
242
+
| [] => pure expr
243
243
+
| _ => throw (.trailingTokens rest)
244
244
+
245
245
+
end Mlang
···
1
1
+
# mlang
2
2
+
3
3
+
A small functional language prototype written in Lean 4.
4
4
+
5
5
+
Current scope:
6
6
+
7
7
+
- integer and boolean literals
8
8
+
- variables
9
9
+
- `let`
10
10
+
- `if`
11
11
+
- typed lambdas
12
12
+
- function application
13
13
+
- integer arithmetic
14
14
+
- integer division
15
15
+
- lexical closures
16
16
+
- hand-written lexer and parser
17
17
+
- static type checker
18
18
+
- implicit effect tracking
19
19
+
20
20
+
The interpreter lives in [Mlang/Interpreter.lean](/home/nandi/code/mlang/Mlang/Interpreter.lean:1).
21
21
+
The parser lives in [Mlang/Parser.lean](/home/nandi/code/mlang/Mlang/Parser.lean:1).
22
22
+
23
23
+
## Run
24
24
+
25
25
+
With `devenv` installed:
26
26
+
27
27
+
```bash
28
28
+
devenv shell
29
29
+
build
30
30
+
run
31
31
+
```
32
32
+
33
33
+
You can also run commands directly without entering the shell:
34
34
+
35
35
+
```bash
36
36
+
devenv test
37
37
+
devenv shell -- build
38
38
+
devenv shell -- run
39
39
+
```
40
40
+
41
41
+
The executable supports a REPL and file execution:
42
42
+
43
43
+
```bash
44
44
+
devenv shell -- lake exe mlang
45
45
+
devenv shell -- lake exe mlang examples/samples.mlg
46
46
+
devenv shell -- lake exe mlang --demo
47
47
+
```
48
48
+
49
49
+
Current syntax:
50
50
+
51
51
+
```text
52
52
+
expr ::= let name = expr in expr
53
53
+
| if expr then expr else expr
54
54
+
| try expr with expr
55
55
+
| fun (name : type) => expr
56
56
+
| expr = expr
57
57
+
| expr + expr
58
58
+
| expr - expr
59
59
+
| expr * expr
60
60
+
| expr expr
61
61
+
| (expr)
62
62
+
| true | false | 123 | name
63
63
+
64
64
+
type ::= Int | Bool | type -> type | (type)
65
65
+
```
66
66
+
67
67
+
Expressions are checked as `Type ! Effects`. Pure expressions get `{}`; division carries `{Error}` implicitly. `try ... with ...` handles `Error` and removes it from the resulting effect set when recovered locally.
68
68
+
69
69
+
The REPL parses, typechecks, and evaluates one expression per line. Use `:quit` to exit.
70
70
+
71
71
+
## Next steps
72
72
+
73
73
+
- persist top-level bindings across REPL entries
74
74
+
- add recursive functions
75
75
+
- add algebraic data types and pattern matching
76
76
+
- compile to a bytecode VM or another backend
···
1
1
+
{
2
2
+
"nodes": {
3
3
+
"devenv": {
4
4
+
"locked": {
5
5
+
"dir": "src/modules",
6
6
+
"lastModified": 1780091591,
7
7
+
"narHash": "sha256-07KVQbmtDbtTU9DlbOQiIXXS+UA+t+/aQ65iY311bSc=",
8
8
+
"owner": "cachix",
9
9
+
"repo": "devenv",
10
10
+
"rev": "21d68a204558895af93ad82014f8fa83f9c9a51e",
11
11
+
"type": "github"
12
12
+
},
13
13
+
"original": {
14
14
+
"dir": "src/modules",
15
15
+
"owner": "cachix",
16
16
+
"repo": "devenv",
17
17
+
"type": "github"
18
18
+
}
19
19
+
},
20
20
+
"nixpkgs": {
21
21
+
"inputs": {
22
22
+
"nixpkgs-src": "nixpkgs-src"
23
23
+
},
24
24
+
"locked": {
25
25
+
"lastModified": 1778507786,
26
26
+
"narHash": "sha256-HzSQCKMsMr8r55LwM1JuzIOB+8bzk0FEv6sItKvsfoY=",
27
27
+
"owner": "cachix",
28
28
+
"repo": "devenv-nixpkgs",
29
29
+
"rev": "8f24a228a782e24576b155d1e39f0d914b380691",
30
30
+
"type": "github"
31
31
+
},
32
32
+
"original": {
33
33
+
"owner": "cachix",
34
34
+
"ref": "rolling",
35
35
+
"repo": "devenv-nixpkgs",
36
36
+
"type": "github"
37
37
+
}
38
38
+
},
39
39
+
"nixpkgs-src": {
40
40
+
"flake": false,
41
41
+
"locked": {
42
42
+
"lastModified": 1778274207,
43
43
+
"narHash": "sha256-I4puXmX1iovcCHZlRmztO3vW0mAbbRvq4F8wgIMQ1MM=",
44
44
+
"owner": "NixOS",
45
45
+
"repo": "nixpkgs",
46
46
+
"rev": "b3da656039dc7a6240f27b2ef8cc6a3ef3bccae7",
47
47
+
"type": "github"
48
48
+
},
49
49
+
"original": {
50
50
+
"owner": "NixOS",
51
51
+
"ref": "nixpkgs-unstable",
52
52
+
"repo": "nixpkgs",
53
53
+
"type": "github"
54
54
+
}
55
55
+
},
56
56
+
"root": {
57
57
+
"inputs": {
58
58
+
"devenv": "devenv",
59
59
+
"nixpkgs": "nixpkgs"
60
60
+
}
61
61
+
}
62
62
+
},
63
63
+
"root": "root",
64
64
+
"version": 7
65
65
+
}
···
1
1
+
{ pkgs, lib, config, inputs, ... }:
2
2
+
3
3
+
{
4
4
+
packages = with pkgs; [
5
5
+
git
6
6
+
lean4
7
7
+
];
8
8
+
9
9
+
scripts.build.exec = ''
10
10
+
lake build
11
11
+
'';
12
12
+
13
13
+
scripts.run.exec = ''
14
14
+
lake exe mlang
15
15
+
'';
16
16
+
17
17
+
enterShell = ''
18
18
+
echo "mlang devenv ready"
19
19
+
lean --version
20
20
+
lake --version
21
21
+
'';
22
22
+
23
23
+
enterTest = ''
24
24
+
lean --version
25
25
+
lake --version
26
26
+
'';
27
27
+
}
···
1
1
+
# yaml-language-server: $schema=https://devenv.sh/devenv.schema.json
2
2
+
inputs:
3
3
+
nixpkgs:
4
4
+
url: github:cachix/devenv-nixpkgs/rolling
5
5
+
6
6
+
# If you're using non-OSS software, you can set allow_unfree to true.
7
7
+
# allow_unfree: true
8
8
+
9
9
+
# If you're not willing to allow unsupported packages:
10
10
+
# allow_unsupported_system: false
11
11
+
12
12
+
# If you're willing to use a package that's vulnerable
13
13
+
# permitted_insecure_packages:
14
14
+
# - "openssl-1.1.1w"
15
15
+
16
16
+
# If you have more than one devenv you can merge them
17
17
+
#imports:
18
18
+
# - ./backend
···
1
1
+
try 10 / 0 with 42
···
1
1
+
{"version": "1.1.0",
2
2
+
"packagesDir": ".lake/packages",
3
3
+
"packages": [],
4
4
+
"name": "mlang",
5
5
+
"lakeDir": ".lake"}
···
1
1
+
import Lake
2
2
+
open Lake DSL
3
3
+
4
4
+
package «mlang» where
5
5
+
version := v!"0.1.0"
6
6
+
7
7
+
lean_lib «Mlang» where
8
8
+
9
9
+
@[default_target]
10
10
+
lean_exe «mlang» where
11
11
+
root := `Main
···
1
1
+
leanprover/lean4:stable