giles
4800246b23
Parser: jp-array-loop and jp-call-args-loop detect punct "..." and emit (js-spread inner). Transpile: when any element is spread, build array/args via js-array-spread-build with (list "js-value" v) and (list "js-spread" xs) tags. Runtime: js-array-spread-build walks items, appending values or splicing spreads via js-iterable-to-list (handles list/string/dict). Works in arrays, call args, variadic fns (Math.max(...arr)), and string spread ([...'abc']). 414/416 unit (+5), 148/148 slice unchanged.
1212 lines
35 KiB
Plaintext
1212 lines
35 KiB
Plaintext
;; 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
|
|
(begin
|
|
(cond
|
|
((jp-at? st "punct" "...")
|
|
(begin
|
|
(jp-advance! st)
|
|
(append!
|
|
elems
|
|
(list (quote js-spread) (jp-parse-assignment st)))))
|
|
(else (append! elems (jp-parse-assignment st))))
|
|
(cond
|
|
((jp-at? st "punct" ",")
|
|
(begin (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
|
|
(begin
|
|
(cond
|
|
((jp-at? st "punct" "...")
|
|
(begin
|
|
(jp-advance! st)
|
|
(append!
|
|
args
|
|
(list (quote js-spread) (jp-parse-assignment st)))))
|
|
(else (append! args (jp-parse-assignment st))))
|
|
(cond
|
|
((jp-at? st "punct" ",")
|
|
(begin (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))))))
|