giles
a11f3c33b6
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 55s
ref is a builtin boxing its arg in a one-element list. Prefix ! parses to (:deref ...) and reads via (nth cell 0). := joins the binop precedence table at level 1 right-assoc and mutates via set-nth!. Closures share the underlying cell.
761 lines
26 KiB
Plaintext
761 lines
26 KiB
Plaintext
;; lib/ocaml/parser.sx — OCaml expression parser.
|
|
;;
|
|
;; Input: token list from (ocaml-tokenize src).
|
|
;; Output: an OCaml AST. Nodes are plain lists tagged by a keyword head;
|
|
;; keywords serialize to their string name so `(list :var "x")` is the
|
|
;; same value as `(list "var" "x")` at runtime.
|
|
;;
|
|
;; Expression scope:
|
|
;; atoms int/float/string/char/bool, unit (), var, con, list literal
|
|
;; application left-associative, f x y z
|
|
;; prefix -E unary minus, not E
|
|
;; infix 29 ops via lib/guest/pratt.sx
|
|
;; tuple a, b, c (lower than infix, higher than let/if)
|
|
;; parens (e)
|
|
;; if if c then t else e (else optional → unit)
|
|
;; fun fun x y -> body
|
|
;; let let x = e in body (no rec, function shorthand)
|
|
;; let rec f x = e in body
|
|
;; match match e with [|] p -> body | p -> body | ...
|
|
;; sequence e1 ; e2 → (:seq e1 e2 …) (lowest-precedence binary)
|
|
;;
|
|
;; Pattern scope:
|
|
;; _ (wildcard), int/string/char/bool literals, ident (var binding),
|
|
;; ctor (no args), ctor pat, (), parens, tuple (pat,pat,…),
|
|
;; list literal [pat;pat;…], cons p1 :: p2.
|
|
;;
|
|
;; AST shapes:
|
|
;; (:int N) (:float N) (:string S) (:char C) (:bool B) (:unit)
|
|
;; (:var NAME) (:con NAME)
|
|
;; (:app FN ARG)
|
|
;; (:op OP LHS RHS)
|
|
;; (:neg E) (:not E)
|
|
;; (:tuple ITEMS) (:list ITEMS)
|
|
;; (:seq EXPRS)
|
|
;; (:if C T E)
|
|
;; (:fun PARAMS BODY)
|
|
;; (:let NAME PARAMS EXPR BODY) (:let-rec NAME PARAMS EXPR BODY)
|
|
;; (:match SCRUTINEE CLAUSES) CLAUSES = ((:case PAT BODY) ...)
|
|
;;
|
|
;; (:pwild) (:pvar N) (:plit LIT)
|
|
;; (:pcon NAME ARG-PATS) — ARG-PATS empty for nullary
|
|
;; (:ptuple PATS) (:plist PATS) (:pcons HEAD TAIL)
|
|
|
|
(define ocaml-tok-type (fn (t) (if (= t nil) "eof" (get t :type))))
|
|
|
|
(define ocaml-tok-value (fn (t) (if (= t nil) nil (get t :value))))
|
|
|
|
(define
|
|
ocaml-op-table
|
|
(list
|
|
(list ":=" 1 :right)
|
|
(list "||" 2 :right)
|
|
(list "or" 2 :right)
|
|
(list "&&" 3 :right)
|
|
(list "&" 3 :right)
|
|
(list "=" 4 :left)
|
|
(list "<" 4 :left)
|
|
(list ">" 4 :left)
|
|
(list "<=" 4 :left)
|
|
(list ">=" 4 :left)
|
|
(list "<>" 4 :left)
|
|
(list "==" 4 :left)
|
|
(list "!=" 4 :left)
|
|
(list "|>" 4 :left)
|
|
(list "@" 5 :right)
|
|
(list "^" 5 :right)
|
|
(list "::" 6 :right)
|
|
(list "+" 7 :left)
|
|
(list "-" 7 :left)
|
|
(list "*" 8 :left)
|
|
(list "/" 8 :left)
|
|
(list "%" 8 :left)
|
|
(list "mod" 8 :left)
|
|
(list "land" 8 :left)
|
|
(list "lor" 8 :left)
|
|
(list "lxor" 8 :left)
|
|
(list "**" 9 :right)
|
|
(list "lsl" 9 :right)
|
|
(list "lsr" 9 :right)
|
|
(list "asr" 9 :right)))
|
|
|
|
(define
|
|
ocaml-binop-prec
|
|
(fn
|
|
(op)
|
|
(let
|
|
((entry (pratt-op-lookup ocaml-op-table op)))
|
|
(if (= entry nil) 0 (pratt-op-prec entry)))))
|
|
|
|
(define
|
|
ocaml-binop-right?
|
|
(fn
|
|
(op)
|
|
(let
|
|
((entry (pratt-op-lookup ocaml-op-table op)))
|
|
(and (not (= entry nil)) (= (pratt-op-assoc entry) :right)))))
|
|
|
|
(define
|
|
ocaml-tok-is-binop?
|
|
(fn
|
|
(tok)
|
|
(let
|
|
((tt (ocaml-tok-type tok)) (tv (ocaml-tok-value tok)))
|
|
(cond
|
|
((= tt "op") (not (= (ocaml-binop-prec tv) 0)))
|
|
((= tt "keyword") (not (= (ocaml-binop-prec tv) 0)))
|
|
(else false)))))
|
|
|
|
(define
|
|
ocaml-parse
|
|
(fn
|
|
(src)
|
|
(let
|
|
((tokens (ocaml-tokenize src)) (idx 0) (tok-len 0))
|
|
(begin
|
|
(set! tok-len (len tokens))
|
|
(define peek-tok (fn () (nth tokens idx)))
|
|
(define advance-tok! (fn () (set! idx (+ idx 1))))
|
|
(define
|
|
check-tok?
|
|
(fn
|
|
(type value)
|
|
(let
|
|
((t (peek-tok)))
|
|
(and
|
|
(= (ocaml-tok-type t) type)
|
|
(or (= value nil) (= (ocaml-tok-value t) value))))))
|
|
(define
|
|
consume!
|
|
(fn
|
|
(type value)
|
|
(if
|
|
(check-tok? type value)
|
|
(let ((t (peek-tok))) (begin (advance-tok!) t))
|
|
(error
|
|
(str
|
|
"ocaml-parse: expected "
|
|
type
|
|
" "
|
|
value
|
|
" got "
|
|
(ocaml-tok-type (peek-tok))
|
|
" "
|
|
(ocaml-tok-value (peek-tok)))))))
|
|
(define at-kw? (fn (kw) (check-tok? "keyword" kw)))
|
|
(define at-op? (fn (op) (check-tok? "op" op)))
|
|
(define parse-pattern (fn () nil))
|
|
(define parse-pattern-cons (fn () nil))
|
|
(define parse-pattern-app (fn () nil))
|
|
(define parse-pattern-atom (fn () nil))
|
|
(define
|
|
at-pattern-atom?
|
|
(fn
|
|
()
|
|
(let
|
|
((tt (ocaml-tok-type (peek-tok)))
|
|
(tv (ocaml-tok-value (peek-tok))))
|
|
(cond
|
|
((= tt "number") true)
|
|
((= tt "string") true)
|
|
((= tt "char") true)
|
|
((= tt "ident") true)
|
|
((= tt "ctor") true)
|
|
((and (= tt "keyword") (or (= tv "true") (= tv "false")))
|
|
true)
|
|
((and (= tt "op") (or (= tv "(") (= tv "["))) true)
|
|
(else false)))))
|
|
(set!
|
|
parse-pattern-atom
|
|
(fn
|
|
()
|
|
(let
|
|
((tt (ocaml-tok-type (peek-tok)))
|
|
(tv (ocaml-tok-value (peek-tok))))
|
|
(cond
|
|
((= tt "number")
|
|
(begin
|
|
(advance-tok!)
|
|
(if
|
|
(= (round tv) tv)
|
|
(list :plit (list :int tv))
|
|
(list :plit (list :float tv)))))
|
|
((= tt "string")
|
|
(begin (advance-tok!) (list :plit (list :string tv))))
|
|
((= tt "char")
|
|
(begin (advance-tok!) (list :plit (list :char tv))))
|
|
((and (= tt "keyword") (= tv "true"))
|
|
(begin (advance-tok!) (list :plit (list :bool true))))
|
|
((and (= tt "keyword") (= tv "false"))
|
|
(begin (advance-tok!) (list :plit (list :bool false))))
|
|
((and (= tt "ident") (= tv "_"))
|
|
(begin (advance-tok!) (list :pwild)))
|
|
((= tt "ident") (begin (advance-tok!) (list :pvar tv)))
|
|
((= tt "ctor") (begin (advance-tok!) (list :pcon tv)))
|
|
((and (= tt "op") (= tv "("))
|
|
(begin
|
|
(advance-tok!)
|
|
(cond
|
|
((at-op? ")")
|
|
(begin (advance-tok!) (list :plit (list :unit))))
|
|
(else
|
|
(let
|
|
((first (parse-pattern)))
|
|
(cond
|
|
((at-op? ",")
|
|
(let
|
|
((items (list first)))
|
|
(begin
|
|
(define
|
|
loop
|
|
(fn
|
|
()
|
|
(when
|
|
(at-op? ",")
|
|
(begin
|
|
(advance-tok!)
|
|
(append! items (parse-pattern))
|
|
(loop)))))
|
|
(loop)
|
|
(consume! "op" ")")
|
|
(cons :ptuple items))))
|
|
(else (begin (consume! "op" ")") first))))))))
|
|
((and (= tt "op") (= tv "["))
|
|
(begin
|
|
(advance-tok!)
|
|
(cond
|
|
((at-op? "]") (begin (advance-tok!) (list :plist)))
|
|
(else
|
|
(let
|
|
((items (list)))
|
|
(begin
|
|
(append! items (parse-pattern))
|
|
(define
|
|
loop
|
|
(fn
|
|
()
|
|
(when
|
|
(at-op? ";")
|
|
(begin
|
|
(advance-tok!)
|
|
(when
|
|
(not (at-op? "]"))
|
|
(begin
|
|
(append! items (parse-pattern))
|
|
(loop)))))))
|
|
(loop)
|
|
(consume! "op" "]")
|
|
(cons :plist items)))))))
|
|
(else
|
|
(error
|
|
(str
|
|
"ocaml-parse: unexpected pattern token "
|
|
tt
|
|
" "
|
|
tv
|
|
" at idx "
|
|
idx)))))))
|
|
(set!
|
|
parse-pattern-app
|
|
(fn
|
|
()
|
|
(let
|
|
((head (parse-pattern-atom)))
|
|
(cond
|
|
((and (= (nth head 0) :pcon) (at-pattern-atom?))
|
|
(let
|
|
((arg (parse-pattern-atom)))
|
|
(let
|
|
((args (cond ((= (nth arg 0) :ptuple) (rest arg)) (else (list arg)))))
|
|
(concat (list :pcon (nth head 1)) args))))
|
|
(else head)))))
|
|
(set!
|
|
parse-pattern-cons
|
|
(fn
|
|
()
|
|
(let
|
|
((lhs (parse-pattern-app)))
|
|
(cond
|
|
((at-op? "::")
|
|
(begin
|
|
(advance-tok!)
|
|
(list :pcons lhs (parse-pattern-cons))))
|
|
(else lhs)))))
|
|
(set! parse-pattern (fn () (parse-pattern-cons)))
|
|
(define parse-expr (fn () nil))
|
|
(define parse-expr-no-seq (fn () nil))
|
|
(define parse-tuple (fn () nil))
|
|
(define parse-binop-rhs (fn (lhs min-prec) lhs))
|
|
(define parse-prefix (fn () nil))
|
|
(define parse-app (fn () nil))
|
|
(define parse-atom (fn () nil))
|
|
(set!
|
|
parse-atom
|
|
(fn
|
|
()
|
|
(let
|
|
((t (peek-tok))
|
|
(tt (ocaml-tok-type (peek-tok)))
|
|
(tv (ocaml-tok-value (peek-tok))))
|
|
(cond
|
|
((= tt "number")
|
|
(begin
|
|
(advance-tok!)
|
|
(if (= (round tv) tv) (list :int tv) (list :float tv))))
|
|
((= tt "string") (begin (advance-tok!) (list :string tv)))
|
|
((= tt "char") (begin (advance-tok!) (list :char tv)))
|
|
((and (= tt "keyword") (= tv "true"))
|
|
(begin (advance-tok!) (list :bool true)))
|
|
((and (= tt "keyword") (= tv "false"))
|
|
(begin (advance-tok!) (list :bool false)))
|
|
((= tt "ident") (begin (advance-tok!) (list :var tv)))
|
|
((= tt "ctor") (begin (advance-tok!) (list :con tv)))
|
|
((and (= tt "op") (= tv "("))
|
|
(begin
|
|
(advance-tok!)
|
|
(cond
|
|
((at-op? ")") (begin (advance-tok!) (list :unit)))
|
|
(else
|
|
(let
|
|
((e (parse-expr)))
|
|
(begin (consume! "op" ")") e))))))
|
|
((and (= tt "op") (= tv "["))
|
|
(begin
|
|
(advance-tok!)
|
|
(cond
|
|
((at-op? "]") (begin (advance-tok!) (list :list)))
|
|
(else
|
|
(let
|
|
((items (list)))
|
|
(begin
|
|
(append! items (parse-expr-no-seq))
|
|
(define
|
|
loop
|
|
(fn
|
|
()
|
|
(when
|
|
(at-op? ";")
|
|
(begin
|
|
(advance-tok!)
|
|
(when
|
|
(not (at-op? "]"))
|
|
(begin
|
|
(append! items (parse-expr-no-seq))
|
|
(loop)))))))
|
|
(loop)
|
|
(consume! "op" "]")
|
|
(cons :list items)))))))
|
|
((at-kw? "begin")
|
|
(begin
|
|
(advance-tok!)
|
|
(let
|
|
((e (parse-expr)))
|
|
(begin (consume! "keyword" "end") e))))
|
|
(else
|
|
(error
|
|
(str
|
|
"ocaml-parse: unexpected token "
|
|
tt
|
|
" "
|
|
tv
|
|
" at idx "
|
|
idx)))))))
|
|
(define
|
|
at-app-start?
|
|
(fn
|
|
()
|
|
(let
|
|
((tt (ocaml-tok-type (peek-tok)))
|
|
(tv (ocaml-tok-value (peek-tok))))
|
|
(cond
|
|
((= tt "number") true)
|
|
((= tt "string") true)
|
|
((= tt "char") true)
|
|
((= tt "ident") true)
|
|
((= tt "ctor") true)
|
|
((and (= tt "keyword") (or (= tv "true") (= tv "false") (= tv "begin")))
|
|
true)
|
|
((and (= tt "op") (or (= tv "(") (= tv "["))) true)
|
|
(else false)))))
|
|
(set!
|
|
parse-app
|
|
(fn
|
|
()
|
|
(let
|
|
((head (parse-atom)))
|
|
(begin
|
|
(define
|
|
loop
|
|
(fn
|
|
()
|
|
(when
|
|
(at-app-start?)
|
|
(let
|
|
((arg (parse-atom)))
|
|
(begin (set! head (list :app head arg)) (loop))))))
|
|
(loop)
|
|
head))))
|
|
(set!
|
|
parse-prefix
|
|
(fn
|
|
()
|
|
(cond
|
|
((at-op? "-")
|
|
(begin (advance-tok!) (list :neg (parse-prefix))))
|
|
((at-op? "!")
|
|
(begin (advance-tok!) (list :deref (parse-prefix))))
|
|
((at-kw? "not")
|
|
(begin (advance-tok!) (list :not (parse-prefix))))
|
|
(else (parse-app)))))
|
|
(set!
|
|
parse-binop-rhs
|
|
(fn
|
|
(lhs min-prec)
|
|
(let
|
|
((tok (peek-tok)))
|
|
(cond
|
|
((not (ocaml-tok-is-binop? tok)) lhs)
|
|
(else
|
|
(let
|
|
((op (ocaml-tok-value tok))
|
|
(prec (ocaml-binop-prec (ocaml-tok-value tok))))
|
|
(cond
|
|
((< prec min-prec) lhs)
|
|
(else
|
|
(begin
|
|
(advance-tok!)
|
|
(let
|
|
((rhs (parse-prefix))
|
|
(next-min
|
|
(if
|
|
(ocaml-binop-right? op)
|
|
prec
|
|
(+ prec 1))))
|
|
(begin
|
|
(set! rhs (parse-binop-rhs rhs next-min))
|
|
(parse-binop-rhs (list :op op lhs rhs) min-prec))))))))))))
|
|
(define
|
|
parse-binary
|
|
(fn
|
|
()
|
|
(let ((lhs (parse-prefix))) (parse-binop-rhs lhs 1))))
|
|
(set!
|
|
parse-tuple
|
|
(fn
|
|
()
|
|
(let
|
|
((first (parse-binary)))
|
|
(cond
|
|
((at-op? ",")
|
|
(let
|
|
((items (list first)))
|
|
(begin
|
|
(define
|
|
loop
|
|
(fn
|
|
()
|
|
(when
|
|
(at-op? ",")
|
|
(begin
|
|
(advance-tok!)
|
|
(append! items (parse-binary))
|
|
(loop)))))
|
|
(loop)
|
|
(cons :tuple items))))
|
|
(else first)))))
|
|
(define
|
|
parse-fun
|
|
(fn
|
|
()
|
|
(let
|
|
((params (list)))
|
|
(begin
|
|
(define
|
|
collect-params
|
|
(fn
|
|
()
|
|
(when
|
|
(check-tok? "ident" nil)
|
|
(begin
|
|
(append! params (ocaml-tok-value (peek-tok)))
|
|
(advance-tok!)
|
|
(collect-params)))))
|
|
(collect-params)
|
|
(when
|
|
(= (len params) 0)
|
|
(error "ocaml-parse: fun expects at least one parameter"))
|
|
(consume! "op" "->")
|
|
(let ((body (parse-expr))) (list :fun params body))))))
|
|
(define
|
|
parse-let
|
|
(fn
|
|
()
|
|
(let
|
|
((reccy false))
|
|
(begin
|
|
(when
|
|
(at-kw? "rec")
|
|
(begin (advance-tok!) (set! reccy true)))
|
|
(let
|
|
((name (ocaml-tok-value (consume! "ident" nil)))
|
|
(params (list)))
|
|
(begin
|
|
(define
|
|
collect-params
|
|
(fn
|
|
()
|
|
(when
|
|
(check-tok? "ident" nil)
|
|
(begin
|
|
(append! params (ocaml-tok-value (peek-tok)))
|
|
(advance-tok!)
|
|
(collect-params)))))
|
|
(collect-params)
|
|
(consume! "op" "=")
|
|
(let
|
|
((rhs (parse-expr)))
|
|
(begin
|
|
(consume! "keyword" "in")
|
|
(let
|
|
((body (parse-expr)))
|
|
(if
|
|
reccy
|
|
(list :let-rec name params rhs body)
|
|
(list :let name params rhs body)))))))))))
|
|
(define
|
|
parse-if
|
|
(fn
|
|
()
|
|
(let
|
|
((cond-expr (parse-expr-no-seq)))
|
|
(begin
|
|
(consume! "keyword" "then")
|
|
(let
|
|
((then-expr (parse-expr-no-seq)))
|
|
(cond
|
|
((at-kw? "else")
|
|
(begin
|
|
(advance-tok!)
|
|
(let
|
|
((else-expr (parse-expr-no-seq)))
|
|
(list :if cond-expr then-expr else-expr))))
|
|
(else (list :if cond-expr then-expr (list :unit)))))))))
|
|
(define
|
|
parse-match
|
|
(fn
|
|
()
|
|
(let
|
|
((scrut (parse-expr-no-seq)))
|
|
(begin
|
|
(consume! "keyword" "with")
|
|
(when (at-op? "|") (advance-tok!))
|
|
(let
|
|
((cases (list)))
|
|
(begin
|
|
(define
|
|
one
|
|
(fn
|
|
()
|
|
(let
|
|
((p (parse-pattern)))
|
|
(begin
|
|
(consume! "op" "->")
|
|
(let
|
|
((body (parse-expr)))
|
|
(append! cases (list :case p body)))))))
|
|
(one)
|
|
(define
|
|
loop
|
|
(fn
|
|
()
|
|
(when
|
|
(at-op? "|")
|
|
(begin (advance-tok!) (one) (loop)))))
|
|
(loop)
|
|
(cons :match (cons scrut (list cases)))))))))
|
|
(set!
|
|
parse-expr-no-seq
|
|
(fn
|
|
()
|
|
(cond
|
|
((at-kw? "fun") (begin (advance-tok!) (parse-fun)))
|
|
((at-kw? "let") (begin (advance-tok!) (parse-let)))
|
|
((at-kw? "if") (begin (advance-tok!) (parse-if)))
|
|
((at-kw? "match") (begin (advance-tok!) (parse-match)))
|
|
(else (parse-tuple)))))
|
|
(set!
|
|
parse-expr
|
|
(fn
|
|
()
|
|
(let
|
|
((lhs (parse-expr-no-seq)))
|
|
(cond
|
|
((at-op? ";")
|
|
(let
|
|
((items (list lhs)))
|
|
(begin
|
|
(define
|
|
loop
|
|
(fn
|
|
()
|
|
(when
|
|
(at-op? ";")
|
|
(begin
|
|
(advance-tok!)
|
|
(cond
|
|
((at-kw? "end") nil)
|
|
((at-op? ")") nil)
|
|
((at-op? "|") nil)
|
|
((at-kw? "in") nil)
|
|
((at-kw? "then") nil)
|
|
((at-kw? "else") nil)
|
|
((= (ocaml-tok-type (peek-tok)) "eof") nil)
|
|
(else
|
|
(begin
|
|
(append! items (parse-expr-no-seq))
|
|
(loop))))))))
|
|
(loop)
|
|
(cons :seq items))))
|
|
(else lhs)))))
|
|
(let
|
|
((result (parse-expr)))
|
|
(begin
|
|
(when
|
|
(not (= (ocaml-tok-type (peek-tok)) "eof"))
|
|
(error
|
|
(str
|
|
"ocaml-parse: trailing tokens at idx "
|
|
idx
|
|
" — got "
|
|
(ocaml-tok-type (peek-tok))
|
|
" "
|
|
(ocaml-tok-value (peek-tok)))))
|
|
result))))))
|
|
|
|
(define
|
|
ocaml-parse-program
|
|
(fn
|
|
(src)
|
|
(let
|
|
((tokens (ocaml-tokenize src))
|
|
(idx 0)
|
|
(tok-len 0)
|
|
(decls (list)))
|
|
(begin
|
|
(set! tok-len (len tokens))
|
|
(define peek-tok (fn () (nth tokens idx)))
|
|
(define advance-tok! (fn () (set! idx (+ idx 1))))
|
|
(define
|
|
check-tok?
|
|
(fn
|
|
(type value)
|
|
(let
|
|
((t (peek-tok)))
|
|
(and
|
|
(= (ocaml-tok-type t) type)
|
|
(or (= value nil) (= (ocaml-tok-value t) value))))))
|
|
(define
|
|
consume!
|
|
(fn
|
|
(type value)
|
|
(if
|
|
(check-tok? type value)
|
|
(let ((t (peek-tok))) (begin (advance-tok!) t))
|
|
(error
|
|
(str
|
|
"ocaml-parse-program: expected "
|
|
type
|
|
" "
|
|
value
|
|
" got "
|
|
(ocaml-tok-type (peek-tok))
|
|
" "
|
|
(ocaml-tok-value (peek-tok)))))))
|
|
(define at-kw? (fn (kw) (check-tok? "keyword" kw)))
|
|
(define at-op? (fn (op) (check-tok? "op" op)))
|
|
(define
|
|
skip-double-semi!
|
|
(fn
|
|
()
|
|
(when (at-op? ";;") (begin (advance-tok!) (skip-double-semi!)))))
|
|
(define
|
|
cur-pos
|
|
(fn
|
|
()
|
|
(let ((t (peek-tok))) (if (= t nil) (len src) (get t :pos)))))
|
|
(define
|
|
skip-to-boundary!
|
|
(fn
|
|
()
|
|
(cond
|
|
((>= idx tok-len) nil)
|
|
((= (ocaml-tok-type (peek-tok)) "eof") nil)
|
|
((at-op? ";;") nil)
|
|
((at-kw? "let") nil)
|
|
(else (begin (advance-tok!) (skip-to-boundary!))))))
|
|
(define
|
|
parse-decl-let
|
|
(fn
|
|
()
|
|
(advance-tok!)
|
|
(let
|
|
((reccy false))
|
|
(begin
|
|
(when
|
|
(at-kw? "rec")
|
|
(begin (advance-tok!) (set! reccy true)))
|
|
(let
|
|
((name (ocaml-tok-value (consume! "ident" nil)))
|
|
(params (list)))
|
|
(begin
|
|
(define
|
|
collect-params
|
|
(fn
|
|
()
|
|
(when
|
|
(check-tok? "ident" nil)
|
|
(begin
|
|
(append! params (ocaml-tok-value (peek-tok)))
|
|
(advance-tok!)
|
|
(collect-params)))))
|
|
(collect-params)
|
|
(consume! "op" "=")
|
|
(let
|
|
((expr-start (cur-pos)))
|
|
(begin
|
|
(skip-to-boundary!)
|
|
(let
|
|
((expr-src (slice src expr-start (cur-pos))))
|
|
(let
|
|
((expr (ocaml-parse expr-src)))
|
|
(if
|
|
reccy
|
|
(list :def-rec name params expr)
|
|
(list :def name params expr))))))))))))
|
|
(define
|
|
parse-decl-expr
|
|
(fn
|
|
()
|
|
(let
|
|
((expr-start (cur-pos)))
|
|
(begin
|
|
(skip-to-boundary!)
|
|
(let
|
|
((expr-src (slice src expr-start (cur-pos))))
|
|
(let ((expr (ocaml-parse expr-src))) (list :expr expr)))))))
|
|
(define
|
|
loop
|
|
(fn
|
|
()
|
|
(begin
|
|
(skip-double-semi!)
|
|
(when
|
|
(< idx tok-len)
|
|
(cond
|
|
((= (ocaml-tok-type (peek-tok)) "eof") nil)
|
|
((at-kw? "let")
|
|
(begin (append! decls (parse-decl-let)) (loop)))
|
|
(else (begin (append! decls (parse-decl-expr)) (loop))))))))
|
|
(loop)
|
|
(cons :program decls)))))
|