haskell: operator sections + list comprehensions, Phase 1 parser complete (+22 tests, 211/211)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
This commit is contained in:
@@ -220,7 +220,44 @@
|
||||
((= (get t "type") "lbracket") (hk-parse-list-lit))
|
||||
(:else (hk-err "unexpected token in expression"))))))
|
||||
|
||||
;; ── Parens / tuple / unit ────────────────────────────────
|
||||
;; Returns {:name N :len L} if the current token begins an
|
||||
;; infix operator (varsym / consym / reservedop ":" / backtick),
|
||||
;; else nil. `len` is the number of tokens the operator occupies.
|
||||
(define
|
||||
hk-section-op-info
|
||||
(fn
|
||||
()
|
||||
(let ((t (hk-peek)))
|
||||
(cond
|
||||
((nil? t) nil)
|
||||
((= (get t "type") "varsym")
|
||||
{:name (get t "value") :len 1})
|
||||
((= (get t "type") "consym")
|
||||
{:name (get t "value") :len 1})
|
||||
((and
|
||||
(= (get t "type") "reservedop")
|
||||
(= (get t "value") ":"))
|
||||
{:name ":" :len 1})
|
||||
((= (get t "type") "backtick")
|
||||
(let ((varid-t (hk-peek-at 1)))
|
||||
(cond
|
||||
((and
|
||||
(not (nil? varid-t))
|
||||
(= (get varid-t "type") "varid"))
|
||||
{:name (get varid-t "value") :len 3})
|
||||
(:else nil))))
|
||||
(:else nil)))))
|
||||
|
||||
;; ── Parens / tuple / unit / operator sections ───────────
|
||||
;; Forms recognised inside parens:
|
||||
;; () → unit : (:con "()")
|
||||
;; (op) → operator reference : (:var OP)
|
||||
;; (op e) → right section : (:sect-right OP E) (op ≠ "-")
|
||||
;; (e) → plain parens : unwrapped E
|
||||
;; (e1, … , en) → tuple : (:tuple ITEMS)
|
||||
;; (e op) → left section : (:sect-left OP E)
|
||||
;; `-` is excluded from right sections because `-e` always means
|
||||
;; `negate e`; `(-)` is still a valid operator reference.
|
||||
(define
|
||||
hk-parse-parens
|
||||
(fn
|
||||
@@ -230,27 +267,197 @@
|
||||
((hk-match? "rparen" nil)
|
||||
(do (hk-advance!) (list :con "()")))
|
||||
(:else
|
||||
(let
|
||||
((first-e (hk-parse-expr-inner))
|
||||
(items (list))
|
||||
(is-tuple false))
|
||||
(append! items first-e)
|
||||
(define
|
||||
hk-tup-loop
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(hk-match? "comma" nil)
|
||||
(do
|
||||
(hk-advance!)
|
||||
(set! is-tuple true)
|
||||
(append! items (hk-parse-expr-inner))
|
||||
(hk-tup-loop)))))
|
||||
(hk-tup-loop)
|
||||
(hk-expect! "rparen" nil)
|
||||
(if is-tuple (list :tuple items) first-e))))))
|
||||
(let ((op-info (hk-section-op-info)))
|
||||
(cond
|
||||
;; Operator reference / right section
|
||||
((and
|
||||
(not (nil? op-info))
|
||||
(let
|
||||
((after
|
||||
(hk-peek-at (get op-info "len"))))
|
||||
(or
|
||||
(and
|
||||
(not (nil? after))
|
||||
(= (get after "type") "rparen"))
|
||||
(not (= (get op-info "name") "-")))))
|
||||
(let
|
||||
((op-name (get op-info "name"))
|
||||
(op-len (get op-info "len"))
|
||||
(after
|
||||
(hk-peek-at (get op-info "len"))))
|
||||
(hk-consume-op!)
|
||||
(cond
|
||||
((and
|
||||
(not (nil? after))
|
||||
(= (get after "type") "rparen"))
|
||||
(do (hk-advance!) (list :var op-name)))
|
||||
(:else
|
||||
(let ((expr-e (hk-parse-expr-inner)))
|
||||
(hk-expect! "rparen" nil)
|
||||
(list :sect-right op-name expr-e))))))
|
||||
(:else
|
||||
(let
|
||||
((first-e (hk-parse-expr-inner))
|
||||
(items (list))
|
||||
(is-tuple false))
|
||||
(append! items first-e)
|
||||
(define
|
||||
hk-tup-loop
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(hk-match? "comma" nil)
|
||||
(do
|
||||
(hk-advance!)
|
||||
(set! is-tuple true)
|
||||
(append! items (hk-parse-expr-inner))
|
||||
(hk-tup-loop)))))
|
||||
(hk-tup-loop)
|
||||
(cond
|
||||
((hk-match? "rparen" nil)
|
||||
(do
|
||||
(hk-advance!)
|
||||
(if
|
||||
is-tuple
|
||||
(list :tuple items)
|
||||
first-e)))
|
||||
(:else
|
||||
(let
|
||||
((op-info2 (hk-section-op-info)))
|
||||
(cond
|
||||
((and
|
||||
(not (nil? op-info2))
|
||||
(not is-tuple)
|
||||
(let
|
||||
((after2
|
||||
(hk-peek-at
|
||||
(get op-info2 "len"))))
|
||||
(and
|
||||
(not (nil? after2))
|
||||
(= (get after2 "type") "rparen"))))
|
||||
(let
|
||||
((op-name (get op-info2 "name")))
|
||||
(hk-consume-op!)
|
||||
(hk-advance!)
|
||||
(list :sect-left op-name first-e)))
|
||||
(:else
|
||||
(hk-err
|
||||
"expected ')' after expression"))))))))))))))
|
||||
|
||||
;; ── List literal / range ─────────────────────────────────
|
||||
;; ── List comprehension qualifiers ──────────────────────
|
||||
;; (:list-comp E QUALS) where each qualifier is one of:
|
||||
;; (:q-gen PAT E) — `pat <- expr`
|
||||
;; (:q-guard E) — bare boolean expression
|
||||
;; (:q-let DECLS) — `let decls`
|
||||
(define
|
||||
hk-comp-qual-is-gen?
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((j pos) (depth 0) (found false) (done false))
|
||||
(define
|
||||
hk-qsc-loop
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(and (not done) (< j n))
|
||||
(let
|
||||
((t (nth toks j)) (ty (get t "type")))
|
||||
(cond
|
||||
((and
|
||||
(= depth 0)
|
||||
(or
|
||||
(= ty "comma")
|
||||
(= ty "rbracket")))
|
||||
(set! done true))
|
||||
((and
|
||||
(= depth 0)
|
||||
(= ty "reservedop")
|
||||
(= (get t "value") "<-"))
|
||||
(do (set! found true) (set! done true)))
|
||||
((or
|
||||
(= ty "lparen")
|
||||
(= ty "lbracket")
|
||||
(= ty "lbrace")
|
||||
(= ty "vlbrace"))
|
||||
(set! depth (+ depth 1)))
|
||||
((or
|
||||
(= ty "rparen")
|
||||
(= ty "rbrace")
|
||||
(= ty "vrbrace"))
|
||||
(set! depth (- depth 1)))
|
||||
(:else nil))
|
||||
(set! j (+ j 1))
|
||||
(hk-qsc-loop)))))
|
||||
(hk-qsc-loop)
|
||||
found)))
|
||||
|
||||
(define
|
||||
hk-parse-comp-let
|
||||
(fn
|
||||
()
|
||||
(hk-expect! "reserved" "let")
|
||||
(let ((explicit (hk-match? "lbrace" nil)))
|
||||
(if
|
||||
explicit
|
||||
(hk-advance!)
|
||||
(hk-expect! "vlbrace" nil))
|
||||
(let
|
||||
((binds (list)))
|
||||
(when
|
||||
(not
|
||||
(if
|
||||
explicit
|
||||
(hk-match? "rbrace" nil)
|
||||
(hk-match? "vrbrace" nil)))
|
||||
(do
|
||||
(append! binds (hk-parse-bind))
|
||||
(define
|
||||
hk-cl-loop
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(or
|
||||
(hk-match? "semi" nil)
|
||||
(hk-match? "vsemi" nil))
|
||||
(do
|
||||
(hk-advance!)
|
||||
(when
|
||||
(not
|
||||
(if
|
||||
explicit
|
||||
(hk-match? "rbrace" nil)
|
||||
(hk-match? "vrbrace" nil)))
|
||||
(append! binds (hk-parse-bind)))
|
||||
(hk-cl-loop)))))
|
||||
(hk-cl-loop)))
|
||||
(cond
|
||||
(explicit (hk-expect! "rbrace" nil))
|
||||
((hk-match? "vrbrace" nil) (hk-advance!))
|
||||
;; In a single-line comprehension, `]` or `,`
|
||||
;; terminates the qualifier before layout's implicit
|
||||
;; vrbrace arrives — leave them for the outer parser.
|
||||
((or
|
||||
(hk-match? "rbracket" nil)
|
||||
(hk-match? "comma" nil))
|
||||
nil)
|
||||
(:else
|
||||
(hk-err "expected end of let block in comprehension")))
|
||||
(list :q-let binds)))))
|
||||
|
||||
(define
|
||||
hk-parse-qual
|
||||
(fn
|
||||
()
|
||||
(cond
|
||||
((hk-match? "reserved" "let") (hk-parse-comp-let))
|
||||
((hk-comp-qual-is-gen?)
|
||||
(let ((pat (hk-parse-pat)))
|
||||
(hk-expect! "reservedop" "<-")
|
||||
(list :q-gen pat (hk-parse-expr-inner))))
|
||||
(:else (list :q-guard (hk-parse-expr-inner))))))
|
||||
|
||||
;; ── List literal / range / comprehension ───────────────
|
||||
(define
|
||||
hk-parse-list-lit
|
||||
(fn
|
||||
@@ -270,6 +477,24 @@
|
||||
((end-e (hk-parse-expr-inner)))
|
||||
(hk-expect! "rbracket" nil)
|
||||
(list :range first-e end-e))))
|
||||
((hk-match? "reservedop" "|")
|
||||
(do
|
||||
(hk-advance!)
|
||||
(let ((quals (list)))
|
||||
(append! quals (hk-parse-qual))
|
||||
(define
|
||||
hk-lc-loop
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(hk-match? "comma" nil)
|
||||
(do
|
||||
(hk-advance!)
|
||||
(append! quals (hk-parse-qual))
|
||||
(hk-lc-loop)))))
|
||||
(hk-lc-loop)
|
||||
(hk-expect! "rbracket" nil)
|
||||
(list :list-comp first-e quals))))
|
||||
((hk-match? "comma" nil)
|
||||
(do
|
||||
(hk-advance!)
|
||||
@@ -1011,31 +1236,44 @@
|
||||
(let
|
||||
((op-tok (hk-peek)))
|
||||
(let
|
||||
((op-name
|
||||
((op-len
|
||||
(if
|
||||
(= (get op-tok "type") "backtick")
|
||||
3
|
||||
1))
|
||||
(op-name
|
||||
(if
|
||||
(= (get op-tok "type") "backtick")
|
||||
(get (hk-peek-at 1) "value")
|
||||
(get op-tok "value"))))
|
||||
(let
|
||||
((info (hk-op-info op-name)))
|
||||
(when
|
||||
(>= (get info "prec") min-prec)
|
||||
(do
|
||||
(hk-consume-op!)
|
||||
(let
|
||||
((next-min
|
||||
(cond
|
||||
((= (get info "assoc") "left")
|
||||
(+ (get info "prec") 1))
|
||||
((= (get info "assoc") "right")
|
||||
(get info "prec"))
|
||||
(:else (+ (get info "prec") 1)))))
|
||||
((after-op (hk-peek-at op-len))
|
||||
(info (hk-op-info op-name)))
|
||||
(cond
|
||||
;; Bail on `op )` — let the paren parser claim
|
||||
;; it as a left section (e op).
|
||||
((and
|
||||
(not (nil? after-op))
|
||||
(= (get after-op "type") "rparen"))
|
||||
nil)
|
||||
((>= (get info "prec") min-prec)
|
||||
(do
|
||||
(hk-consume-op!)
|
||||
(let
|
||||
((right (hk-parse-infix next-min)))
|
||||
(set!
|
||||
left
|
||||
(list :op op-name left right))
|
||||
(hk-inf-loop)))))))))))
|
||||
((next-min
|
||||
(cond
|
||||
((= (get info "assoc") "left")
|
||||
(+ (get info "prec") 1))
|
||||
((= (get info "assoc") "right")
|
||||
(get info "prec"))
|
||||
(:else (+ (get info "prec") 1)))))
|
||||
(let
|
||||
((right (hk-parse-infix next-min)))
|
||||
(set!
|
||||
left
|
||||
(list :op op-name left right))
|
||||
(hk-inf-loop)))))
|
||||
(:else nil))))))))
|
||||
(hk-inf-loop)
|
||||
left)))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user