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