feat(lexer): add token definitions and tokenizer
This commit is contained in:
dualfroz committed
1 parent
7c8ef00d77
commit
682fd8146b
1 file changed
+139
@@ -0,0 +1,139 @@
|
||||
module Fml.Core.Lexer
|
||||
|
||||
open System
|
||||
|
||||
type Token =
|
||||
| TkInt of int
|
||||
| TkBool of bool
|
||||
| TkStr of string
|
||||
| TkIdent of string
|
||||
| TkTyVar of string
|
||||
| TkLet | TkRec | TkIn | TkFun | TkIf | TkThen | TkElse | TkMatch | TkWith
|
||||
| TkType | TkOf | TkKwAnd | TkModule | TkStruct | TkEnd | TkOpen
|
||||
| TkArrow | TkEquals | TkNotEq | TkLt | TkLe | TkGt | TkGe
|
||||
| TkPlus | TkMinus | TkStar | TkSlash | TkMod | TkCaret
|
||||
| TkAnd | TkOr
|
||||
| TkLParen | TkRParen | TkLBracket | TkRBracket | TkLBrace | TkRBrace
|
||||
| TkComma | TkSemi | TkDoubleSemi | TkCons | TkBar | TkUnderscore
|
||||
| TkDot | TkColon
|
||||
| TkEOF
|
||||
|
||||
exception LexError of string
|
||||
|
||||
let tokenize (src: string) : Token list =
|
||||
let n = src.Length
|
||||
let tokens = ResizeArray<Token>()
|
||||
let mutable i = 0
|
||||
let peek k = if i + k < n then src.[i + k] else '\000'
|
||||
let isIdentStart c = Char.IsLetter c || c = '_'
|
||||
let isIdentCont c = Char.IsLetterOrDigit c || c = '_' || c = '\''
|
||||
while i < n do
|
||||
let c = src.[i]
|
||||
if c = ' ' || c = '\t' || c = '\r' || c = '\n' then
|
||||
i <- i + 1
|
||||
elif c = '(' && peek 1 = '*' then
|
||||
let mutable depth = 1
|
||||
i <- i + 2
|
||||
while i < n && depth > 0 do
|
||||
if i + 1 < n && src.[i] = '(' && src.[i + 1] = '*' then depth <- depth + 1; i <- i + 2
|
||||
elif i + 1 < n && src.[i] = '*' && src.[i + 1] = ')' then depth <- depth - 1; i <- i + 2
|
||||
else i <- i + 1
|
||||
if depth > 0 then raise (LexError "unterminated block comment")
|
||||
elif c = '"' then
|
||||
let sb = Text.StringBuilder()
|
||||
i <- i + 1
|
||||
let mutable closed = false
|
||||
while i < n && not closed do
|
||||
let ch = src.[i]
|
||||
if ch = '"' then
|
||||
closed <- true
|
||||
i <- i + 1
|
||||
elif ch = '\\' then
|
||||
let e = if i + 1 < n then src.[i + 1] else '\000'
|
||||
let r =
|
||||
match e with
|
||||
| 'n' -> '\n'
|
||||
| 't' -> '\t'
|
||||
| 'r' -> '\r'
|
||||
| '\\' -> '\\'
|
||||
| '"' -> '"'
|
||||
| _ -> raise (LexError (sprintf "invalid escape sequence in string"))
|
||||
sb.Append(r) |> ignore
|
||||
i <- i + 2
|
||||
else
|
||||
sb.Append(ch) |> ignore
|
||||
i <- i + 1
|
||||
if not closed then raise (LexError "unterminated string literal")
|
||||
tokens.Add(TkStr(sb.ToString()))
|
||||
elif c = '\'' && isIdentStart (peek 1) then
|
||||
i <- i + 1
|
||||
let start = i
|
||||
while i < n && isIdentCont src.[i] do i <- i + 1
|
||||
tokens.Add(TkTyVar(src.Substring(start, i - start)))
|
||||
elif Char.IsDigit c then
|
||||
let start = i
|
||||
while i < n && Char.IsDigit src.[i] do i <- i + 1
|
||||
tokens.Add(TkInt(Int32.Parse(src.Substring(start, i - start))))
|
||||
elif isIdentStart c then
|
||||
let start = i
|
||||
while i < n && isIdentCont src.[i] do i <- i + 1
|
||||
let word = src.Substring(start, i - start)
|
||||
let tok =
|
||||
match word with
|
||||
| "let" -> TkLet
|
||||
| "rec" -> TkRec
|
||||
| "in" -> TkIn
|
||||
| "fun" -> TkFun
|
||||
| "if" -> TkIf
|
||||
| "then" -> TkThen
|
||||
| "else" -> TkElse
|
||||
| "match" -> TkMatch
|
||||
| "with" -> TkWith
|
||||
| "type" -> TkType
|
||||
| "of" -> TkOf
|
||||
| "and" -> TkKwAnd
|
||||
| "module" -> TkModule
|
||||
| "struct" -> TkStruct
|
||||
| "end" -> TkEnd
|
||||
| "open" -> TkOpen
|
||||
| "mod" -> TkMod
|
||||
| "true" -> TkBool true
|
||||
| "false" -> TkBool false
|
||||
| "_" -> TkUnderscore
|
||||
| _ -> TkIdent word
|
||||
tokens.Add tok
|
||||
else
|
||||
let two = if i + 1 < n then src.Substring(i, 2) else ""
|
||||
match two with
|
||||
| "->" -> tokens.Add TkArrow; i <- i + 2
|
||||
| "<>" -> tokens.Add TkNotEq; i <- i + 2
|
||||
| "<=" -> tokens.Add TkLe; i <- i + 2
|
||||
| ">=" -> tokens.Add TkGe; i <- i + 2
|
||||
| "::" -> tokens.Add TkCons; i <- i + 2
|
||||
| "&&" -> tokens.Add TkAnd; i <- i + 2
|
||||
| "||" -> tokens.Add TkOr; i <- i + 2
|
||||
| ";;" -> tokens.Add TkDoubleSemi; i <- i + 2
|
||||
| _ ->
|
||||
match c with
|
||||
| '=' -> tokens.Add TkEquals; i <- i + 1
|
||||
| '<' -> tokens.Add TkLt; i <- i + 1
|
||||
| '>' -> tokens.Add TkGt; i <- i + 1
|
||||
| '+' -> tokens.Add TkPlus; i <- i + 1
|
||||
| '-' -> tokens.Add TkMinus; i <- i + 1
|
||||
| '*' -> tokens.Add TkStar; i <- i + 1
|
||||
| '/' -> tokens.Add TkSlash; i <- i + 1
|
||||
| '^' -> tokens.Add TkCaret; i <- i + 1
|
||||
| '(' -> tokens.Add TkLParen; i <- i + 1
|
||||
| ')' -> tokens.Add TkRParen; i <- i + 1
|
||||
| '[' -> tokens.Add TkLBracket; i <- i + 1
|
||||
| ']' -> tokens.Add TkRBracket; i <- i + 1
|
||||
| '{' -> tokens.Add TkLBrace; i <- i + 1
|
||||
| '}' -> tokens.Add TkRBrace; i <- i + 1
|
||||
| ',' -> tokens.Add TkComma; i <- i + 1
|
||||
| ';' -> tokens.Add TkSemi; i <- i + 1
|
||||
| '|' -> tokens.Add TkBar; i <- i + 1
|
||||
| '.' -> tokens.Add TkDot; i <- i + 1
|
||||
| ':' -> tokens.Add TkColon; i <- i + 1
|
||||
| _ -> raise (LexError (sprintf "unexpected character '%c'" c))
|
||||
tokens.Add TkEOF
|
||||
List.ofSeq tokens
|
||||
Reference in new issue
Block a user