phi-lang/compile.phi
Simon From Jakobsen bdb3117e07 more compiler stuff
2025-09-19 15:20:30 +02:00

695 lines
20 KiB
Plaintext

(fn Emitter (ast filename) (do
(let output ())
(let (enter_scope leave_scope define_sym get_sym) (call Syms))
(fn generate () (do
(call emit "#!/usr/bin/env node\n")
(call emit "import { Runtime } from \"./runtime.js\"\n")
(call emit "const runtime = new Runtime(\"")
(call emit filename)
(call emit "\")\n")
(call discover_syms ast)
(call emit_exprs ast)
(return (call strings_join output))
))
(fn emit_exprs (exprs) (do
(for expr exprs (do
(call emit_expr expr)
(call emit ";\n")
))
))
(fn discover_syms (exprs) (do
(for expr exprs (do
(let (ty line) expr)
(if (!= ty "list") (return))
(let (_ _ s) expr)
(if (== (call len s) 0) (return))
(let ((_ _ id)) s)
(if (== id "fn") (do
(let (_ (_ _ name) (_ _ params) body) s)
(call define_sym name ("fn" name line))
))
))
))
(fn emit_expr (expr) (do
(let (ty line) expr)
(if (== ty "list") (do
(call emit_list expr)
) (if (== ty "int") (
(let (_ _ value) expr)
(call emit (call format "({ type: \"int\", value: % })" value))
) (if (== ty "string") (
(let (_ _ value) expr)
(call emit (call format "({ type: \"string\", value: \"%\" })" (call string_escape value)))
) (if (== ty "ident") (do
(let (_ _ value) expr)
(if (== value "null") (do
(call emit "({ type: \"null\" })")
(return)
) (if (== value "false") (do
(call emit "({ type: \"bool\", value: false })")
(return)
) (if (== value "true") (do
(call emit "({ type: \"bool\", value: true })")
(return)
))))
(let sym (call get_sym value))
(if (== sym null) (do
(call panic "undefined symbol '%' on line %" value line)
))
(let (sym_ty) sym)
(if (== sym_ty "builtin") (do
(let (_ id) sym)
(call emit (call format "((...args) => runtime.%(...args))" id))
) (if (== sym_ty "fn") (do
(call emit (call format "_%" value))
) (if (== sym_ty "param") (do
(call emit (call format "_%" value))
) (if (== sym_ty "let") (do
(call emit (call format "_%" value))
) (do
(call panic "not implemented '%'" sym_ty)
)))))
) (do
(call panic "unknown expr type '%' on line %" ty line)
)))))
))
(fn emit_list (expr) (do
(let (ty line s) expr)
(if (== (call len s) 0) (do
(call emit "({ type: \"list\", values: [] })")
(return)
))
(let ((id_ty _ id)) s)
(if (!= id_ty "ident") (do
(call emit "({ type: \"list\", values: [] })")
(return)
))
(if (== id "fn") (do
(let (_ (_ _ name) (_ _ params) body) s)
(call emit (call format "function _%(" name))
(call enter_scope)
(let first true)
(for (_ _ name) params (do
(if (not first) (do
(call emit ", ")
))
(= first false)
(call emit (call format "_%" name))
(call define_sym name ("param" name line))
))
(call emit (call format ") {\n" name))
(call emit (call format "runtime.pushCall(\"%\");\n" name))
(call emit_expr body)
(call emit ";\nruntime.popCall();\nreturn { type: \"null\" };\n}")
(call leave_scope)
) (if (== id "let") (do
(let (_ pat expr) s)
(call emit "let ")
(call emit_pat pat)
(call emit " = runtime.assignValue(")
(call emit_expr expr)
(call emit ")")
) (if (== id "do") (do
(call enter_scope)
(call discover_syms (call slice s 1))
(call emit_exprs (call slice s 1))
(call leave_scope)
) (if (== id "for") (do
(let (_ pat expr body) s)
(call enter_scope)
(call emit "for (let ")
(call emit_pat pat)
(call emit " of ")
(call emit_expr expr)
(call emit ") {\n")
(call emit_expr body)
(call emit "}")
(call leave_scope)
) (if (== id "loop") (do
(let (_ body) s)
(call emit "while (true) {\n")
(call emit_expr body)
(call emit "}")
) (if (== id "if") (do
(let (_ cond truthy falsy) s)
(call emit "if (")
(call emit_expr cond)
(call emit ") {\n")
(call emit_expr truthy)
(call emit "}")
(if (!= falsy null) (do
(call emit " else {\n")
(call emit_expr falsy)
(call emit "}")
))
) (if (== id "return") (do
(let (_ value) s)
(call emit "runtime.popCall();\n")
(call emit "return ")
(if (!= value null) (do
(call emit_expr value)
) (do
(call emit "{ type: \"null\" }")
))
) (if (== id "break") (do
(let (_ value) s)
(call emit "break")
(if (!= value null) (do
(call panic "not implemented")
))
) (if (== id "call") (do
(let (_ callee) s)
(let args (call slice s 2))
(call emit (call format "(runtime.setLine(%), " line))
(call emit_expr callee)
(call emit "(")
(let first true)
(for arg args (do
(if (not first) (do
(call emit ", ")
))
(= first false)
(call emit_expr arg)
))
(call emit "))")
) (if (== id "=") (do
(call emit_assign_expr s line "=")
) (if (== id "+=") (do
(call emit_assign_expr s line "+")
) (if (== id "-=") (do
(call emit_assign_expr s line "-")
) (if (== id "or") (do
(let (_ left right) s)
(call emit (call format "(runtime.setLine(%)" line))
(call emit ", { type: \"bool\", value: this.runtime.truthy(")
(call emit_expr left)
(call emit ") || this.runtime.falsy(")
(call emit_expr right)
(call emit ") })")
) (if (== id "and") (do
(let (_ left right) s)
(call emit (call format "(runtime.setLine(%)" line))
(call emit ", { type: \"bool\", value: this.runtime.truthy(")
(call emit_expr left)
(call emit ") && this.runtime.falsy(")
(call emit_expr right)
(call emit ") })")
) (if (== id "==") (do
(call emit_binary_op s "opEq")
) (if (== id "!=") (do
(call emit_binary_op s "opNe")
) (if (== id "<") (do
(call emit_binary_op s "opLt")
) (if (== id ">") (do
(call emit_binary_op s "opGt")
) (if (== id "<=") (do
(call emit_binary_op s "opLte")
) (if (== id ">=") (do
(call emit_binary_op s "opGte")
) (if (== id "+") (do
(call emit_binary_op s "opAdd")
) (if (== id "-") (do
(call emit_binary_op s "opSub")
) (if (== id "not") (do
(let (_ expr) s)
(call emit "runtime.opNot(")
(call emit_expr expr)
(call emit ")")
) (do
(call emit "({ type: \"list\", values: [")
(let first true)
(for e s (do
(if (not first) (do
(call emit ", ")
))
(= first false)
(call emit_expr e)
))
(call emit "] })")
))))))))))))))))))))))))
))
(fn emit_binary_op (s id) (do
(let (_ left right) s)
(call emit (call format "runtime.%(" id))
(call emit_expr left)
(call emit ", ")
(call emit_expr right)
(call emit ")")
))
(fn emit_assign_expr (s line id) (do
(let (_ (target_type) expr) s)
(if (!= target_type "ident") (do
) (do
(call panic "cannot assign to expression on line %" line)
))
(let (_ (_ _ ident)) s)
(let sym (call get_sym ident))
(if (== sym null) (do
(call panic "could not find symbol '%' on line %" ident line)
))
(let (sym_type sym_ident _) sym)
(if (== sym_type "let") (do
(call emit (call format "(_% = runtime.assignValue(" sym_ident))
(if (== id "=") (do
(call emit_expr expr)
) (if (== id "+") (do
(call emit (call format "runtime.opAdd(_%, " sym_ident))
(call emit_expr expr)
(call emit ")")
) (if (== id "-") (do
(call emit (call format "runtime.opSub(_%, " sym_ident))
(call emit_expr expr)
(call emit ")")
) (do
(call panic "not implemented")
))))
(call emit "))")
) (do
(call panic "cannot assign to symbol '%' on line %" sym_ident line)
))
))
(fn emit_pat (pat) (do
(let (ty) pat)
(if (== ty "ident") (do
(let (_ line name) pat)
(if (== name "_") (do
(return)
))
(call emit (call format "_%" name))
(call define_sym name ("let" name line))
) (if (== ty "list") (do
(let (_ _ pats) pat)
(call emit "[")
(let first true)
(for pat pats (do
(if (not first) (do
(call emit ", ")
))
(= first false)
(call emit_pat pat)
))
(call emit "]")
) (do
(call panic "cannot assign to '%'" pat)
)))
))
(fn emit (str) (do
(call push output str)
))
(return (generate))
))
(fn Syms () (do
(let syms (null (
("format" ("builtin" "builtinFormat"))
("print" ("builtin" "builtinPrint"))
("println" ("builtin" "builtinPrintln"))
("panic" ("builtin" "builtinPanic"))
("read_text_file" ("builtin" "builtinReadTextFile"))
("write_text_file" ("builtin" "builtinWriteTextFile"))
("push" ("builtin" "builtinPush"))
("at" ("builtin" "builtinAt"))
("set" ("builtin" "builtinSet"))
("len" ("builtin" "builtinLen"))
("string_to_int" ("builtin" "builtinStringToInt"))
("char_code" ("builtin" "builtinCharCode"))
("strings_join" ("builtin" "builtinStringsJoin"))
("get_args" ("builtin" "builtinGetArgs"))
)))
(fn enter_scope () (do
(= syms (syms ()))
))
(fn leave_scope () (do
(let (parent _) syms)
(= syms parent)
))
(fn define (ident sym) (do
(let (_ syms) syms)
(let i 0)
(loop (do
(if (>= i (call len syms)) (break))
(let (s_ident _) (call at syms i))
(if (== ident s_ident) (do
(call set syms i (ident sym))
(return)
))
(+= i 1)
))
(call push syms (ident sym))
))
(fn find_sym (syms ident) (do
(let (parent map) syms)
(let i 0)
(loop (do
(if (>= i (call len map)) (break))
(let (s_ident s_sym) (call at map i))
(if (== ident s_ident) (do
(return s_sym)
))
(+= i 1)
))
(if (!= parent null) (do
(return (call find_sym parent ident))
))
(return null)
))
(fn get (ident) (do
(return (call find_sym syms ident))
))
(return (
enter_scope
leave_scope
define
get
))
))
(fn string_escape (str) (do
(let str_len (call len str))
(let i 0)
(let result "")
(loop (do
(if (>= i str_len) (break))
(let ch (call at str i))
(if (== ch "\\") (do
(+= result "\\\\")
) (if (== ch "\"") (do
(+= result "\\\"")
) (if (== ch "\t") (do
(+= result "\\t")
) (if (== ch "\r") (do
(+= result "\\r")
) (if (== ch "\n") (do
(+= result "\\n")
) (if (== ch "\0") (do
(+= result "\\0")
) (do
(+= result ch)
)))))))
(+= i 1)
))
(return result)
))
(fn Parser (tokens) (do
(let i 0)
(let tok (call at tokens i))
(fn parse () (do
(let exprs ())
(loop (do
(if (call done) (break))
(call push exprs (call parse_expr))
))
(return exprs)
))
(fn parse_expr () (do
(let (ty line value) tok)
(if (call eat "(") (do
(let values ())
(loop (do
(if (call test ")") (break))
(call push values (call parse_expr))
))
(if (not (call eat ")")) (do
(call panic "expected ')' on line %" (call at tok 1))
))
(return ("list" line values))
) (if (call eat "string") (do
(return ("string" line value))
) (if (call eat "int") (do
(return ("int" line (call string_to_int value)))
) (if (call eat "ident") (do
(return ("ident" line value))
) (do
(call panic "expected expression, got '%' on line %" ty line)
)))))
))
(fn eat (pat) (do
(if (not (call test pat)) (return false))
(call step)
(return true)
))
(fn step () (do
(+= i 1)
(if (not (call done)) (do
(let new_tok (call at tokens i))
(= tok new_tok)
))
))
(fn test (pat) (do
(if (call done) (return false))
(let (ty) tok)
(return (== pat ty))
))
(fn done () (do
(return (>= i (call len tokens)))
))
(return (parse))
))
(fn tokenize (text) (do
(let text_len (call len text))
(let tokens ())
(let i 0)
(let line 1)
(let ident_chars (+ "abcdefghijklmnopqrstuvwxyz"
"ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890+-*/%&|=?!<>'_"))
(loop (do
(if (>= i text_len) (break))
(let ch (call at text i))
(if (call contains " \t\r\n" ch) (do
(if (== ch "\n") (do
(+= line 1)
))
(+= i 1)
) (if (call slice_eq text i "//") (do
(loop (do
(if (or (>= i text_len) (== (call at text i) "\n")) (do
(break)
))
(+= i 1)
))
) (if (call contains "()" ch) (do
(call push tokens (ch line))
(+= i 1)
) (if (== ch "\"") (do
(let value "")
(+= i 1)
(= ch (call at text i))
(loop (do
(if (or (>= i text_len) (== ch "\"")) (do
(break)
))
(if (== ch "\\") (do
(+= i 1)
(if (>= i text_len) (do
(break)
))
(= ch (call at text i))
(if (== ch "t") (do
(+= value "\t")
) (if (== ch "r") (do
(+= value "\r")
) (if (== ch "n") (do
(+= value "\n")
) (if (== ch "0") (do
(+= value "\n")
) (do
(+= value ch)
)))))
) (do
(+= value ch)
))
(+= i 1)
(= ch (call at text i))
))
(if (or (>= i text_len) (!= ch "\"")) (do
(call panic "expected '\"' on line %" line)
))
(+= i 1)
(call push tokens ("string" line value))
) (if (call contains "0123456789" ch) (do
(let value "")
(loop (do
(= ch (call at text i))
(if (or (>= i text_len) (not (call contains "0123456789" ch))) (do
(break)
))
(+= value ch)
(+= i 1)
))
(call push tokens ("int" line value))
) (if (call contains ident_chars ch) (do
(let value "")
(loop (do
(= ch (call at text i))
(if (or (>= i text_len) (not (call contains ident_chars ch))) (do
(break)
))
(+= value ch)
(+= i 1)
))
(call push tokens ("ident" line value))
) (do
(call println "illegal char '%'" ch)
(+= i 1)
)))))))
))
(return tokens)
))
(fn contains (text ch) (do
(let text_len (call len text))
(let i 0)
(loop (do
(if (>= i text_len) (break))
(if (== (call at text i) ch) (do
(return true)
))
(+= i 1)
))
(return false)
))
(fn slice_eq (str slice_idx substr) (do
(let str_len (call len str))
(let substr_len (call len substr))
(let i 0)
(loop (do
(if (>= i substr_len)
(return true))
(if (>= (+ slice_idx i) str_len)
(return false))
(if (!= (call at str (+ slice_idx i)) (call at substr i))
(return false))
(+= i 1)
))
(return true)
))
(fn print_expr (expr depth) (do
(let (ty line value) expr)
(if (== ty "list") (do
(call println "%(% %" (call indent depth) ty line)
(for e value (do
(call print_expr e (+ depth 1))
))
(call println "%)" (call indent depth))
) (do
(call println "%%" (call indent depth) expr)
))
))
(fn indent (depth) (do
(let space "")
(let i 0)
(loop (do
(if (>= i depth) (break))
(+= space " ")
(+= i 1)
))
(return space)
))
(fn slice (list idx) (do
(let list_len (call len list))
(let elems ())
(let i idx)
(loop (do
(if (>= i list_len) (break))
(call push elems (call at list i))
(+= i 1)
))
(return elems)
))
(let silent true)
(let (input_filename output_filename) (call get_args))
(if (not silent) (call println "reading file..."))
(let text (call read_text_file input_filename))
//(call println "=== text ===")
//(call println text)
(if (not silent) (call println "tokenizing..."))
(let tokens (call tokenize text))
// (call println "=== tokens ===")
// (for (tok line value) tokens (do
// (call println "%\t%\t%" line tok (if (!= value null) value ""))
// ))
(if (not silent) (call println "parsing..."))
(let parser (call Parser tokens))
(let (parse) parser)
(let ast (call parse))
// (call println "=== ast ===")
// (for expr ast (do
// (call print_expr expr 0)
// ))
(if (not silent) (call println "emitting..."))
(let emitter (call Emitter ast input_filename))
(let (emit) emitter)
(let js_code (call emit))
// (call println "=== js ===")
// (call println js_code)
(if (not silent) (call println "writing file..."))
(call write_text_file output_filename js_code)