;; lib/js/parser.sx — tokens → JS AST (Pratt-style) ;; ;; Top-level parsing functions take a parser state dict ;; {:tokens tokens :idx 0} ;; and mutate :idx via set-key!. We use a boxed state so we can share it ;; across mutually-recursive parse fns without deep nesting. ;; ── Operator precedence table ──────────────────────────────────── (define js-op-prec (fn (op) (cond ((= op "||") 4) ((= op "??") 4) ((= op "&&") 5) ((= op "|") 6) ((= op "^") 7) ((= op "&") 8) ((= op "==") 9) ((= op "!=") 9) ((= op "===") 9) ((= op "!==") 9) ((= op "<") 10) ((= op ">") 10) ((= op "<=") 10) ((= op ">=") 10) ((= op "<<") 11) ((= op ">>") 11) ((= op ">>>") 11) ((= op "+") 12) ((= op "-") 12) ((= op "*") 13) ((= op "/") 13) ((= op "%") 13) ((= op "instanceof") 10) ((= op "in") 10) ((= op "**") 14) (else -1)))) (define js-op-right-assoc? (fn (op) (= op "**"))) (define js-assign-op? (fn (op) (or (= op "=") (= op "+=") (= op "-=") (= op "*=") (= op "/=") (= op "%=") (= op "**=") (= op "<<=") (= op ">>=") (= op ">>>=") (= op "&=") (= op "|=") (= op "^=") (= op "&&=") (= op "||=") (= op "??=")))) ;; ── State helpers ──────────────────────────────────────────────── (define jp-peek (fn (st) (let ((i (get st :idx)) (tokens (get st :tokens))) (if (< i (len tokens)) (nth tokens i) {:pos 0 :value nil :type "eof"})))) (define jp-peek-at (fn (st off) (let ((i (+ (get st :idx) off)) (tokens (get st :tokens))) (if (< i (len tokens)) (nth tokens i) {:pos 0 :value nil :type "eof"})))) (define jp-advance! (fn (st) (dict-set! st :idx (+ (get st :idx) 1)))) (define jp-at? (fn (st type value) (let ((t (jp-peek st))) (and (= (get t :type) type) (or (= value nil) (= (get t :value) value)))))) (define jp-expect! (fn (st type value) (let ((t (jp-peek st))) (if (jp-at? st type value) (do (jp-advance! st) t) (error (str "Expected " type " '" (if (= value nil) "" value) "' got " (get t :type) " '" (get t :value) "'")))))) ;; ── Primary ────────────────────────────────────────────────────── (define jp-parse-new-expr (fn (st) (let ((callee (jp-parse-new-callee st))) (if (jp-at? st "punct" "(") (do (jp-advance! st) (let ((args (list))) (do (jp-call-args-loop st args) (jp-expect! st "punct" ")") (list (quote js-new) callee args)))) (list (quote js-new) callee (list)))))) ;; ── Paren expression / arrow function ─────────────────────────── (define jp-parse-new-callee (fn (st) (let ((first (jp-parse-new-primary st))) (jp-parse-new-member-chain st first)))) (define jp-parse-new-primary (fn (st) (let ((t (jp-peek st))) (cond ((= (get t :type) "ident") (do (jp-advance! st) (list (quote js-ident) (get t :value)))) ((and (= (get t :type) "keyword") (= (get t :value) "this")) (do (jp-advance! st) (list (quote js-ident) "this"))) ((and (= (get t :type) "keyword") (= (get t :value) "new")) (do (jp-advance! st) (jp-parse-new-expr st))) ((and (= (get t :type) "punct") (= (get t :value) "(")) (jp-parse-paren-or-arrow st)) (else (error (str "Unexpected token after new: " (get t :type) " '" (get t :value) "'"))))))) ;; Helper: collect comma-separated idents into `params`. Sets ;; (:arrow-candidate true/false) on st to signal whether it still looks ;; like a potential arrow-fn param list. (define jp-parse-new-member-chain (fn (st obj) (let ((t (jp-peek st))) (cond ((and (= (get t :type) "punct") (= (get t :value) ".")) (do (jp-advance! st) (let ((name (get (jp-peek st) :value))) (do (jp-advance! st) (jp-parse-new-member-chain st (list (quote js-member) obj name)))))) ((and (= (get t :type) "punct") (= (get t :value) "[")) (do (jp-advance! st) (let ((idx (jp-parse-assignment st))) (do (jp-expect! st "punct" "]") (jp-parse-new-member-chain st (list (quote js-index) obj idx)))))) (else obj))))) (define jp-parse-async-tail (fn (st) (let ((t (jp-peek st))) (cond ((and (= (get t :type) "keyword") (= (get t :value) "function")) (do (jp-advance! st) (let ((nm (if (= (get (jp-peek st) :type) "ident") (let ((n (get (jp-peek st) :value))) (do (jp-advance! st) n)) nil))) (let ((params (jp-parse-param-list st))) (let ((body (jp-parse-block st))) (list (quote js-funcexpr-async) nm params body)))))) ((= (get t :type) "ident") (do (jp-advance! st) (jp-expect! st "op" "=>") (list (quote js-arrow-async) (list (get t :value)) (jp-parse-arrow-body st)))) ((= (get t :value) "(") (jp-parse-async-paren-arrow st)) (else (error (str "Unexpected token after `async`: '" (get t :value) "'"))))))) (define jp-parse-async-paren-arrow (fn (st) (do (jp-advance! st) (if (jp-at? st "punct" ")") (do (jp-advance! st) (jp-expect! st "op" "=>") (list (quote js-arrow-async) (list) (jp-parse-arrow-body st))) (let ((params (list))) (jp-parse-async-paren-arrow-loop st params) (jp-expect! st "punct" ")") (jp-expect! st "op" "=>") (list (quote js-arrow-async) params (jp-parse-arrow-body st))))))) (define jp-parse-async-paren-arrow-loop (fn (st params) (let ((t (jp-peek st))) (cond ((= (get t :type) "ident") (do (jp-advance! st) (append! params (get t :value)) (if (jp-at? st "punct" ",") (do (jp-advance! st) (jp-parse-async-paren-arrow-loop st params)) nil))) (else (error (str "Expected ident in async arrow params, got: '" (get t :value) "'"))))))) ;; ── Array literal ─────────────────────────────────────────────── (define jp-build-template-ast (fn (parts) (cons (quote js-tpl) (list (jp-map-template-parts parts))))) (define jp-map-template-parts (fn (parts) (if (empty? parts) (list) (cons (jp-template-part (first parts)) (jp-map-template-parts (rest parts)))))) ;; ── Object literal ────────────────────────────────────────────── (define jp-template-part (fn (p) (let ((kind (nth p 0)) (text (nth p 1))) (if (= kind "str") (list (quote js-str) text) (js-parse-expr text))))) (define jp-parse-primary (fn (st) (let ((t (jp-peek st))) (cond ((= (get t :type) "number") (do (jp-advance! st) (list (quote js-num) (get t :value)))) ((= (get t :type) "string") (do (jp-advance! st) (list (quote js-str) (get t :value)))) ((= (get t :type) "template") (do (jp-advance! st) (let ((val (get t :value))) (if (list? val) (jp-build-template-ast val) (list (quote js-str) val))))) ((= (get t :type) "regex") (do (jp-advance! st) (list (quote js-regex) (get (get t :value) :pattern) (get (get t :value) :flags)))) ((and (= (get t :type) "keyword") (= (get t :value) "true")) (do (jp-advance! st) (list (quote js-bool) true))) ((and (= (get t :type) "keyword") (= (get t :value) "false")) (do (jp-advance! st) (list (quote js-bool) false))) ((and (= (get t :type) "keyword") (= (get t :value) "null")) (do (jp-advance! st) (list (quote js-null)))) ((and (= (get t :type) "keyword") (= (get t :value) "undefined")) (do (jp-advance! st) (list (quote js-undef)))) ((and (= (get t :type) "keyword") (= (get t :value) "new")) (do (jp-advance! st) (jp-parse-new-expr st))) ((and (= (get t :type) "keyword") (= (get t :value) "this")) (do (jp-advance! st) (list (quote js-ident) "this"))) ((and (= (get t :type) "op") (or (= (get t :value) "++") (= (get t :value) "--"))) (do (jp-advance! st) (list (quote js-prefix) (get t :value) (jp-parse-unary st)))) ((and (= (get t :type) "op") (or (= (get t :value) "-") (= (get t :value) "+") (= (get t :value) "!") (= (get t :value) "~"))) (do (jp-advance! st) (list (quote js-unop) (get t :value) (jp-parse-unary st)))) ((and (= (get t :type) "keyword") (or (= (get t :value) "typeof") (= (get t :value) "void") (= (get t :value) "delete"))) (do (jp-advance! st) (list (quote js-unop) (get t :value) (jp-parse-unary st)))) ((and (= (get t :type) "punct") (= (get t :value) "(")) (jp-parse-paren-or-arrow st)) ((and (= (get t :type) "punct") (= (get t :value) "[")) (jp-parse-array st)) ((and (= (get t :type) "punct") (= (get t :value) "{")) (jp-parse-object st)) ((and (= (get t :type) "keyword") (= (get t :value) "await")) (do (jp-advance! st) (list (quote js-await) (jp-parse-unary st)))) ((and (= (get t :type) "keyword") (= (get t :value) "async")) (do (jp-advance! st) (jp-parse-async-tail st))) ((and (= (get t :type) "keyword") (= (get t :value) "function")) (do (jp-advance! st) (let ((nm (if (= (get (jp-peek st) :type) "ident") (let ((n (get (jp-peek st) :value))) (do (jp-advance! st) n)) nil))) (let ((params (jp-parse-param-list st))) (let ((body (jp-parse-block st))) (list (quote js-funcexpr) nm params body)))))) ((= (get t :type) "ident") (do (jp-advance! st) (if (jp-at? st "op" "=>") (do (jp-advance! st) (list (quote js-arrow) (list (get t :value)) (jp-parse-arrow-body st))) (list (quote js-ident) (get t :value))))) (else (error (str "Unexpected token: " (get t :type) " '" (get t :value) "'"))))))) (define jp-parse-paren-or-arrow (fn (st) (let ((saved (get st :idx))) (do (jp-advance! st) (if (jp-at? st "punct" ")") (do (jp-advance! st) (jp-expect! st "op" "=>") (list (quote js-arrow) (list) (jp-parse-arrow-body st))) (jp-try-arrow-or-paren st saved)))))) ;; ── Postfix chain: call, member, index ────────────────────────── (define jp-try-arrow-or-paren (fn (st saved) (let ((params (list)) (is-params true)) (do (jp-collect-params st params) (if (and (get-state-flag st) (jp-at? st "punct" ")")) (if (jp-looks-like-arrow? st) (do (jp-advance! st) (jp-advance! st) (list (quote js-arrow) params (jp-parse-arrow-body st))) (do (dict-set! st :idx saved) (jp-advance! st) (let ((e (jp-parse-assignment st))) (jp-expect! st "punct" ")") e))) (do (dict-set! st :idx saved) (jp-advance! st) (let ((e (jp-parse-assignment st))) (jp-expect! st "punct" ")") e))))))) (define jp-collect-params (fn (st params) (do (dict-set! st :arrow-candidate true) (jp-collect-params-loop st params)))) ;; ── Unary ─────────────────────────────────────────────────────── (define jp-collect-params-loop (fn (st params) (cond ((= (get (jp-peek st) :type) "ident") (do (append! params (get (jp-peek st) :value)) (jp-advance! st) (cond ((jp-at? st "punct" ",") (do (jp-advance! st) (jp-collect-params-loop st params))) ((jp-at? st "punct" ")") nil) (else (dict-set! st :arrow-candidate false))))) (else (dict-set! st :arrow-candidate false))))) ;; ── Binary (precedence climbing) ──────────────────────────────── (define get-state-flag (fn (st) (get st :arrow-candidate))) (define jp-looks-like-arrow? (fn (st) (let ((after (jp-peek-at st 1))) (and (= (get after :type) "op") (= (get after :value) "=>"))))) ;; ── Conditional (ternary) ─────────────────────────────────────── (define jp-parse-array (fn (st) (do (jp-advance! st) (let ((elems (list))) (jp-array-loop st elems) (jp-expect! st "punct" "]") (list (quote js-array) elems))))) ;; ── Assignment (right-associative) ────────────────────────────── (define jp-array-loop (fn (st elems) (cond ((jp-at? st "punct" "]") nil) (else (do (append! elems (jp-parse-assignment st)) (cond ((jp-at? st "punct" ",") (do (jp-advance! st) (jp-array-loop st elems))) (else nil))))))) ;; ── Entry point ───────────────────────────────────────────────── (define jp-parse-object (fn (st) (do (jp-advance! st) (let ((kvs (list))) (jp-object-loop st kvs) (jp-expect! st "punct" "}") (list (quote js-object) kvs))))) (define jp-object-loop (fn (st kvs) (cond ((jp-at? st "punct" "}") nil) (else (do (jp-parse-object-entry st kvs) (cond ((jp-at? st "punct" ",") (do (jp-advance! st) (jp-object-loop st kvs))) (else nil))))))) (define jp-parse-object-entry (fn (st kvs) (let ((t (jp-peek st))) (cond ((= (get t :type) "ident") (do (jp-advance! st) (let ((key (get t :value))) (cond ((jp-at? st "punct" ":") (do (jp-advance! st) (append! kvs {:value (jp-parse-assignment st) :key key}))) (else (append! kvs {:value (list (quote js-ident) key) :key key})))))) ((= (get t :type) "string") (do (jp-advance! st) (jp-expect! st "punct" ":") (append! kvs {:value (jp-parse-assignment st) :key (get t :value)}))) ((= (get t :type) "number") (do (jp-advance! st) (jp-expect! st "punct" ":") (append! kvs {:value (jp-parse-assignment st) :key (get t :value)}))) ((= (get t :type) "keyword") (do (jp-advance! st) (jp-expect! st "punct" ":") (append! kvs {:value (jp-parse-assignment st) :key (get t :value)}))) (else (error (str "Unexpected in object: " (get t :type)))))))) (define jp-parse-postfix (fn (st left) (cond ((jp-at? st "punct" ".") (do (jp-advance! st) (let ((t (jp-peek st))) (if (or (= (get t :type) "ident") (= (get t :type) "keyword")) (do (jp-advance! st) (jp-parse-postfix st (list (quote js-member) left (get t :value)))) (error "expected ident after ."))))) ((jp-at? st "punct" "[") (do (jp-advance! st) (let ((k (jp-parse-assignment st))) (jp-expect! st "punct" "]") (jp-parse-postfix st (list (quote js-index) left k))))) ((jp-at? st "punct" "(") (do (jp-advance! st) (let ((args (list))) (jp-call-args-loop st args) (jp-expect! st "punct" ")") (jp-parse-postfix st (list (quote js-call) left args))))) ((or (jp-at? st "op" "++") (jp-at? st "op" "--")) (let ((op (get (jp-peek st) :value))) (jp-advance! st) (list (quote js-postfix) op left))) (else left)))) (define jp-call-args-loop (fn (st args) (cond ((jp-at? st "punct" ")") nil) (else (do (append! args (jp-parse-assignment st)) (cond ((jp-at? st "punct" ",") (do (jp-advance! st) (jp-call-args-loop st args))) (else nil))))))) (define jp-parse-unary (fn (st) (jp-parse-postfix st (jp-parse-primary st)))) (define jp-parse-binary (fn (st min-prec) (let ((left (jp-parse-unary st))) (jp-binary-loop st min-prec left)))) (define jp-binary-loop (fn (st min-prec left) (let ((t (jp-peek st))) (cond ((not (or (= (get t :type) "op") (and (= (get t :type) "keyword") (or (= (get t :value) "instanceof") (= (get t :value) "in"))))) left) (else (let ((op (get t :value)) (prec (js-op-prec (get t :value)))) (cond ((< prec 0) left) ((< prec min-prec) left) (else (do (jp-advance! st) (let ((next-prec (if (js-op-right-assoc? op) prec (+ prec 1)))) (let ((right (jp-parse-binary st next-prec))) (jp-binary-loop st min-prec (list (quote js-binop) op left right))))))))))))) (define jp-parse-conditional (fn (st) (let ((c (jp-parse-binary st 0))) (cond ((jp-at? st "op" "?") (do (jp-advance! st) (let ((t (jp-parse-assignment st))) (jp-expect! st "punct" ":") (let ((e (jp-parse-assignment st))) (list (quote js-cond) c t e))))) (else c))))) (define jp-parse-assignment (fn (st) (let ((left (jp-parse-conditional st))) (let ((t (jp-peek st))) (cond ((and (= (get t :type) "op") (js-assign-op? (get t :value))) (do (jp-advance! st) (list (quote js-assign) (get t :value) left (jp-parse-assignment st)))) (else left)))))) (define jp-parse-param-list (fn (st) (let ((params (list))) (do (jp-expect! st "punct" "(") (if (jp-at? st "punct" ")") (do (jp-advance! st) params) (do (jp-parse-param-list-loop st params) (jp-expect! st "punct" ")") params)))))) (define jp-parse-param-list-loop (fn (st params) (cond ((jp-at? st "punct" "...") (do (jp-advance! st) (let ((nm (get (jp-peek st) :value))) (do (jp-advance! st) (append! params (list (quote js-rest) nm)))))) ((= (get (jp-peek st) :type) "ident") (do (let ((nm (get (jp-peek st) :value))) (do (jp-advance! st) (if (jp-at? st "op" "=") (do (jp-advance! st) (let ((dv (jp-parse-assignment st))) (append! params (list (quote js-param) nm dv)))) (append! params nm)))) (if (jp-at? st "punct" ",") (do (jp-advance! st) (jp-parse-param-list-loop st params)) nil))) (else (error (str "Expected parameter, got " (get (jp-peek st) :type) " '" (get (jp-peek st) :value) "'")))))) (define jp-parse-block (fn (st) (do (jp-expect! st "punct" "{") (let ((stmts (list))) (do (jp-parse-block-loop st stmts) (jp-expect! st "punct" "}") (list (quote js-block) stmts)))))) (define jp-parse-block-loop (fn (st stmts) (if (or (jp-at? st "punct" "}") (jp-at? st "eof" nil)) nil (do (append! stmts (jp-parse-stmt st)) (jp-parse-block-loop st stmts))))) (define jp-eat-semi (fn (st) (if (jp-at? st "punct" ";") (do (jp-advance! st) nil) nil))) (define jp-parse-vardecl (fn (st) (let ((nm (get (jp-peek st) :value))) (do (if (= (get (jp-peek st) :type) "ident") (jp-advance! st) (error (str "Expected ident in var decl, got " (get (jp-peek st) :type)))) (if (jp-at? st "op" "=") (do (jp-advance! st) (list (quote js-vardecl) nm (jp-parse-assignment st))) (list (quote js-vardecl) nm (list (quote js-undef)))))))) (define jp-parse-var-stmt (fn (st kind) (do (jp-advance! st) (let ((decls (list))) (do (append! decls (jp-parse-vardecl st)) (jp-parse-var-stmt-loop st decls) (jp-eat-semi st) (list (quote js-var) kind decls)))))) (define jp-parse-var-stmt-loop (fn (st decls) (if (jp-at? st "punct" ",") (do (jp-advance! st) (append! decls (jp-parse-vardecl st)) (jp-parse-var-stmt-loop st decls)) nil))) (define jp-parse-if-stmt (fn (st) (do (jp-advance! st) (jp-expect! st "punct" "(") (let ((c (jp-parse-assignment st))) (do (jp-expect! st "punct" ")") (let ((t (jp-parse-stmt st))) (if (jp-at? st "keyword" "else") (do (jp-advance! st) (list (quote js-if) c t (jp-parse-stmt st))) (list (quote js-if) c t nil)))))))) (define jp-parse-while-stmt (fn (st) (do (jp-advance! st) (jp-expect! st "punct" "(") (let ((c (jp-parse-assignment st))) (do (jp-expect! st "punct" ")") (let ((body (jp-parse-stmt st))) (list (quote js-while) c body))))))) (define jp-parse-do-while-stmt (fn (st) (do (jp-advance! st) (let ((body (jp-parse-stmt st))) (do (if (jp-at? st "keyword" "while") (jp-advance! st) (error "Expected 'while' after do-block")) (jp-expect! st "punct" "(") (let ((c (jp-parse-assignment st))) (do (jp-expect! st "punct" ")") (jp-eat-semi st) (list (quote js-do-while) body c)))))))) (define jp-parse-for-stmt (fn (st) (jp-advance! st) (jp-expect! st "punct" "(") (let ((has-decl false) (decl-kind nil)) (cond ((jp-at? st "keyword" "var") (begin (set! has-decl true) (set! decl-kind "var"))) ((jp-at? st "keyword" "let") (begin (set! has-decl true) (set! decl-kind "let"))) ((jp-at? st "keyword" "const") (begin (set! has-decl true) (set! decl-kind "const"))) (else nil)) (let ((ident-off (if has-decl 1 0))) (cond ((and (= (get (jp-peek-at st ident-off) :type) "ident") (or (and (= (get (jp-peek-at st (+ ident-off 1)) :type) "keyword") (= (get (jp-peek-at st (+ ident-off 1)) :value) "of")) (and (= (get (jp-peek-at st (+ ident-off 1)) :type) "keyword") (= (get (jp-peek-at st (+ ident-off 1)) :value) "in")))) (begin (when has-decl (jp-advance! st)) (let ((ident (get (jp-peek st) :value))) (jp-advance! st) (let ((iter-kind (get (jp-peek st) :value))) (jp-advance! st) (let ((iter (jp-parse-assignment st))) (jp-expect! st "punct" ")") (let ((body (jp-parse-stmt st))) (list (quote js-for-of-in) iter-kind ident iter body))))))) (else (let ((init (cond (has-decl (jp-parse-var-stmt st decl-kind)) ((jp-at? st "punct" ";") (begin (jp-advance! st) nil)) (else (let ((e (jp-parse-assignment st))) (jp-expect! st "punct" ";") (list (quote js-exprstmt) e)))))) (let ((cond-ast (if (jp-at? st "punct" ";") nil (jp-parse-assignment st)))) (jp-expect! st "punct" ";") (let ((step (if (jp-at? st "punct" ")") nil (jp-parse-assignment st)))) (jp-expect! st "punct" ")") (let ((body (jp-parse-stmt st))) (list (quote js-for) init cond-ast step body))))))))))) (define jp-parse-for-init (fn (st) (cond ((jp-at? st "punct" ";") (do (jp-advance! st) nil)) ((jp-at? st "keyword" "var") (jp-parse-var-stmt st "var")) ((jp-at? st "keyword" "let") (jp-parse-var-stmt st "let")) ((jp-at? st "keyword" "const") (jp-parse-var-stmt st "const")) (else (let ((e (jp-parse-assignment st))) (do (jp-expect! st "punct" ";") (list (quote js-exprstmt) e))))))) (define jp-parse-return-stmt (fn (st) (do (jp-advance! st) (if (or (jp-at? st "punct" ";") (jp-at? st "punct" "}") (jp-at? st "eof" nil)) (do (jp-eat-semi st) (list (quote js-return) nil)) (let ((e (jp-parse-assignment st))) (do (jp-eat-semi st) (list (quote js-return) e))))))) (define jp-parse-function-decl (fn (st) (do (jp-advance! st) (let ((nm (get (jp-peek st) :value))) (do (if (= (get (jp-peek st) :type) "ident") (jp-advance! st) (error "Expected function name")) (let ((params (jp-parse-param-list st))) (let ((body (jp-parse-block st))) (list (quote js-funcdecl) nm params body)))))))) (define jp-parse-async-function-decl (fn (st) (do (jp-advance! st) (let ((nm (get (jp-peek st) :value))) (do (if (= (get (jp-peek st) :type) "ident") (jp-advance! st) (error "Expected function name")) (let ((params (jp-parse-param-list st))) (let ((body (jp-parse-block st))) (list (quote js-funcdecl-async) nm params body)))))))) (define jp-parse-class-decl (fn (st) (do (jp-advance! st) (let ((name (get (jp-peek st) :value))) (do (jp-advance! st) (let ((parent (if (jp-at? st "keyword" "extends") (do (jp-advance! st) (let ((p-name (get (jp-peek st) :value))) (do (jp-advance! st) p-name))) nil))) (do (jp-expect! st "punct" "{") (let ((methods (jp-parse-class-body st (list)))) (do (jp-expect! st "punct" "}") (list (quote js-class) name parent methods)))))))))) (define jp-parse-class-body (fn (st acc) (cond ((jp-at? st "punct" "}") acc) ((jp-at? st "punct" ";") (do (jp-advance! st) (jp-parse-class-body st acc))) (else (do (append! acc (jp-parse-class-method st)) (jp-parse-class-body st acc)))))) (define jp-parse-class-method (fn (st) (let ((static? (if (jp-at? st "keyword" "static") (do (jp-advance! st) true) false))) (let ((name (get (jp-peek st) :value))) (do (jp-advance! st) (let ((params (jp-parse-param-list st))) (let ((body (jp-parse-block st))) (list (quote js-method) (if static? "static" "instance") name params body)))))))) (define jp-parse-throw-stmt (fn (st) (do (jp-advance! st) (let ((e (jp-parse-assignment st))) (do (jp-eat-semi st) (list (quote js-throw) e)))))) (define jp-parse-switch-stmt (fn (st) (jp-advance! st) (jp-expect! st "punct" "(") (let ((disc (jp-parse-assignment st))) (jp-expect! st "punct" ")") (jp-expect! st "punct" "{") (let ((cases (list))) (jp-parse-switch-cases st cases) (jp-expect! st "punct" "}") (list (quote js-switch) disc cases))))) (define jp-parse-switch-cases (fn (st cases) (cond ((jp-at? st "punct" "}") nil) ((jp-at? st "keyword" "case") (do (jp-advance! st) (let ((val (jp-parse-assignment st))) (jp-expect! st "punct" ":") (let ((body (list))) (jp-parse-switch-body st body) (append! cases (list "case" val body)) (jp-parse-switch-cases st cases))))) ((jp-at? st "keyword" "default") (do (jp-advance! st) (jp-expect! st "punct" ":") (let ((body (list))) (jp-parse-switch-body st body) (append! cases (list "default" nil body)) (jp-parse-switch-cases st cases)))) (else (error "switch: expected case or default"))))) (define jp-parse-switch-body (fn (st body) (cond ((jp-at? st "punct" "}") nil) ((jp-at? st "keyword" "case") nil) ((jp-at? st "keyword" "default") nil) (else (begin (append! body (jp-parse-stmt st)) (jp-parse-switch-body st body)))))) (define jp-parse-try-stmt (fn (st) (do (jp-advance! st) (let ((body (jp-parse-block st))) (let ((catch-part (if (jp-at? st "keyword" "catch") (do (jp-advance! st) (let ((has-param (jp-at? st "punct" "("))) (if has-param (do (jp-advance! st) (let ((pname (get (jp-peek st) :value))) (do (jp-advance! st) (jp-expect! st "punct" ")") (let ((cbody (jp-parse-block st))) (list pname cbody))))) (let ((cbody (jp-parse-block st))) (list nil cbody))))) nil))) (let ((finally-part (if (jp-at? st "keyword" "finally") (do (jp-advance! st) (jp-parse-block st)) nil))) (list (quote js-try) body catch-part finally-part))))))) (define jp-parse-stmt (fn (st) (cond ((jp-at? st "punct" "{") (jp-parse-block st)) ((jp-at? st "punct" ";") (do (jp-advance! st) (list (quote js-empty)))) ((jp-at? st "keyword" "var") (jp-parse-var-stmt st "var")) ((jp-at? st "keyword" "let") (jp-parse-var-stmt st "let")) ((jp-at? st "keyword" "const") (jp-parse-var-stmt st "const")) ((jp-at? st "keyword" "if") (jp-parse-if-stmt st)) ((jp-at? st "keyword" "while") (jp-parse-while-stmt st)) ((jp-at? st "keyword" "do") (jp-parse-do-while-stmt st)) ((jp-at? st "keyword" "for") (jp-parse-for-stmt st)) ((jp-at? st "keyword" "return") (jp-parse-return-stmt st)) ((jp-at? st "keyword" "break") (do (jp-advance! st) (jp-eat-semi st) (list (quote js-break)))) ((jp-at? st "keyword" "continue") (do (jp-advance! st) (jp-eat-semi st) (list (quote js-continue)))) ((jp-at? st "keyword" "class") (jp-parse-class-decl st)) ((jp-at? st "keyword" "throw") (jp-parse-throw-stmt st)) ((jp-at? st "keyword" "try") (jp-parse-try-stmt st)) ((and (jp-at? st "keyword" "async") (= (get (jp-peek-at st 1) :type) "keyword") (= (get (jp-peek-at st 1) :value) "function")) (do (jp-advance! st) (jp-parse-async-function-decl st))) ((jp-at? st "keyword" "function") (jp-parse-function-decl st)) ((jp-at? st "keyword" "switch") (jp-parse-switch-stmt st)) (else (let ((e (jp-parse-assignment st))) (do (jp-eat-semi st) (list (quote js-exprstmt) e))))))) (define jp-parse-program (fn (st) (let ((stmts (list))) (do (jp-parse-program-loop st stmts) (list (quote js-program) stmts))))) (define jp-parse-program-loop (fn (st stmts) (if (jp-at? st "eof" nil) nil (do (append! stmts (jp-parse-stmt st)) (jp-parse-program-loop st stmts))))) (define jp-parse-arrow-body (fn (st) (if (jp-at? st "punct" "{") (jp-parse-block st) (jp-parse-assignment st)))) (define js-parse (fn (tokens) (if (or (= (len tokens) 0) (and (= (len tokens) 1) (= (get (nth tokens 0) :type) "eof"))) (list (quote js-program) (list)) (let ((st {:idx 0 :tokens tokens :arrow-candidate true})) (jp-parse-program st))))) (define js-parse-expr (fn (src) (let ((tokens (js-tokenize src))) (if (or (= (len tokens) 0) (and (= (len tokens) 1) (= (get (nth tokens 0) :type) "eof"))) (list) (let ((st {:idx 0 :tokens tokens :arrow-candidate true})) (jp-parse-assignment st))))))