Use `'()` instead of `null`

remotes/jackfirth/master
Jack Firth 2 years ago
parent 0d423ff56e
commit e9bb15e9d5

@ -35,7 +35,7 @@
(define translated-patterns (define translated-patterns
(let loop ([primitive-patterns (syntax->list a-clause)]) (let loop ([primitive-patterns (syntax->list a-clause)])
(cond (cond
[(empty? primitive-patterns) null] [(empty? primitive-patterns) '()]
[else [else
(cons (syntax-case (first primitive-patterns) (id lit token inferred-id) (cons (syntax-case (first primitive-patterns) (id lit token inferred-id)
[(id val) [(id val)
@ -104,7 +104,7 @@
;; of explicit token types, though the user is not allow to express it themselves. ;; of explicit token types, though the user is not allow to express it themselves.
(define (rules-collect-token-types rules) (define (rules-collect-token-types rules)
(define-values (implicit explicit) (define-values (implicit explicit)
(for/fold ([implicit null] (for/fold ([implicit '()]
[explicit (list (datum->syntax (first rules) 'EOF))]) [explicit (list (datum->syntax (first rules) 'EOF))])
([a-rule (in-list rules)]) ([a-rule (in-list rules)])
(syntax-case a-rule (rule) (syntax-case a-rule (rule)
@ -187,7 +187,7 @@
(define (rule-collect-used-ids a-rule) (define (rule-collect-used-ids a-rule)
(syntax-case a-rule (rule) (syntax-case a-rule (rule)
[(rule id a-pattern) [(rule id a-pattern)
(pattern-collect-used-ids #'a-pattern null)])) (pattern-collect-used-ids #'a-pattern '())]))
;; pattern-collect-used-ids: pattern-stx (listof identifier) -> (listof identifier) ;; pattern-collect-used-ids: pattern-stx (listof identifier) -> (listof identifier)
;; Returns a flat list of rule identifiers referenced in the pattern. ;; Returns a flat list of rule identifiers referenced in the pattern.
@ -228,7 +228,7 @@
(make-free-id-table (for/list ([a-rule (in-list rules)]) (make-free-id-table (for/list ([a-rule (in-list rules)])
(cons (rule-id a-rule) (sat:make-and))))) (cons (rule-id a-rule) (sat:make-and)))))
(define leaves null) (define leaves '())
(define (make-leaf) (define (make-leaf)
(define a-leaf (sat:make-and)) (define a-leaf (sat:make-and))

@ -138,7 +138,7 @@
(report-answer answer-key (report-answer answer-key
max-depth max-depth
tasks tasks
null)) '()))
(let* ([tasks (queue-task tasks (λ (max-depth tasks) (let* ([tasks (queue-task tasks (λ (max-depth tasks)
(parse-a gota-k faila-k max-depth tasks)))] (parse-a gota-k faila-k max-depth tasks)))]
[tasks (queue-task tasks (λ (max-depth tasks) [tasks (queue-task tasks (λ (max-depth tasks)
@ -217,7 +217,7 @@
;; Reports an answer to multiple waiting threads: ;; Reports an answer to multiple waiting threads:
(define (report-answer-all answer-key max-depth ts val k) (define (report-answer-all answer-key max-depth ts val k)
(define v (hash-ref (tasks-multi-waits ts) answer-key (λ () null))) (define v (hash-ref (tasks-multi-waits ts) answer-key (λ () '())))
(hash-remove! (tasks-multi-waits ts) answer-key) (hash-remove! (tasks-multi-waits ts) answer-key)
(let ([ts (tasks (append (map (λ (a) (a val)) v) (let ([ts (tasks (append (map (λ (a) (a val)) v)
(tasks-active ts)) (tasks-active ts))
@ -243,7 +243,7 @@
(if multi? (if multi?
(hash-set! (tasks-multi-waits ts) answer-key (hash-set! (tasks-multi-waits ts) answer-key
(cons wait (hash-ref (tasks-multi-waits ts) answer-key (cons wait (hash-ref (tasks-multi-waits ts) answer-key
(λ () null)))) (λ () '()))))
(hash-set! (tasks-waits ts) answer-key wait)) (hash-set! (tasks-waits ts) answer-key wait))
(let ([ts (tasks (tasks-active ts) (let ([ts (tasks (tasks-active ts)
(tasks-active-back ts) (tasks-active-back ts)
@ -260,7 +260,7 @@
(if (tasks-progress? ts) (if (tasks-progress? ts)
(swap-task max-depth (swap-task max-depth
(tasks (reverse (tasks-active-back ts)) (tasks (reverse (tasks-active-back ts))
null '()
(tasks-waits ts) (tasks-waits ts)
(tasks-multi-waits ts) (tasks-multi-waits ts)
(tasks-cache ts) (tasks-cache ts)
@ -332,7 +332,7 @@
[#,id-end-pos (at-tok-pos #'tok-end #'last-consumed-token)] [#,id-end-pos (at-tok-pos #'tok-end #'last-consumed-token)]
#,@(if n-end-pos #,@(if n-end-pos
#`([#,n-end-pos (at-tok-pos #'tok-end #'last-consumed-token)]) #`([#,n-end-pos (at-tok-pos #'tok-end #'last-consumed-token)])
null)) '()))
#,(loop (cdr pat) (add1 pos))))) #,(loop (cdr pat) (add1 pos)))))
stream last-consumed-token depth stream last-consumed-token depth
#,(let ([cnt (for/sum ([item (in-list (cdr pat))]) #,(let ([cnt (for/sum ([item (in-list (cdr pat))])
@ -357,7 +357,7 @@
[#,id-end-pos (at-tok-pos #'tok-end #'stream-a)] [#,id-end-pos (at-tok-pos #'tok-end #'stream-a)]
#,@(if n-end-pos #,@(if n-end-pos
#`([#,n-end-pos (at-tok-pos #'tok-end #'stream-a)]) #`([#,n-end-pos (at-tok-pos #'tok-end #'stream-a)])
null)) '()))
#,(loop (cdr pat) (add1 pos))))) #,(loop (cdr pat) (add1 pos)))))
(fail-k max-depth tasks)))]))))) (fail-k max-depth tasks)))])))))
@ -444,7 +444,7 @@
(report-answer-all answer-key (report-answer-all answer-key
max-depth max-depth
tasks tasks
null '()
(λ (max-depth tasks) (λ (max-depth tasks)
(fail-k max-depth tasks)))) (fail-k max-depth tasks))))
(k end max-depth tasks new-got-k new-fail-k))])))) (k end max-depth tasks new-got-k new-fail-k))]))))
@ -476,21 +476,21 @@
[(e-terminals-def? v) [(e-terminals-def? v)
(for/list ([v (in-list (syntax->list (e-terminals-def-t v)))]) (for/list ([v (in-list (syntax->list (e-terminals-def-t v)))])
(cons v #t))] (cons v #t))]
[else null])))] [else '()])))]
[_else null])))] [_else '()])))]
[all-end-toks (apply [all-end-toks (apply
append append
(for/list ([clause (in-list clauses)]) (for/list ([clause (in-list clauses)])
(syntax-case clause (end) (syntax-case clause (end)
[(end T ...) [(end T ...)
(syntax->list #'(T ...))] (syntax->list #'(T ...))]
[_else null])))]) [_else '()])))])
(let loop ([clauses clauses] (let loop ([clauses clauses]
[cfg-start #f] [cfg-start #f]
[cfg-grammar #f] [cfg-grammar #f]
[cfg-error #f] [cfg-error #f]
[src-pos? #f] [src-pos? #f]
[parser-clauses null]) [parser-clauses '()])
(if (null? clauses) (if (null? clauses)
(values cfg-start (values cfg-start
cfg-grammar cfg-grammar
@ -554,7 +554,7 @@
(if (zero? (car l)) (if (zero? (car l))
(append (cdr l) (loop (cdr pat))) (append (cdr l) (loop (cdr pat)))
(cdr l))) (cdr l)))
null))))) '())))))
(define new (define new
(filter (λ (id) (filter (λ (id)
(andmap (λ (id2) (andmap (λ (id2)

@ -47,7 +47,7 @@
(get-string-token input-port))] (get-string-token input-port))]
[(:: #\\ #\\) (cons #\\ (get-string-token input-port))] [(:: #\\ #\\) (cons #\\ (get-string-token input-port))]
[(:: #\\ #\") (cons #\" (get-string-token input-port))] [(:: #\\ #\") (cons #\" (get-string-token input-port))]
[#\" null])) [#\" '()]))
(define-lex-abbrevs (define-lex-abbrevs
@ -226,7 +226,7 @@
[(UNQUOTE-SPLICING sexp) (build-so (list 'unquote-splicing $2) 1 2)] [(UNQUOTE-SPLICING sexp) (build-so (list 'unquote-splicing $2) 1 2)]
[(OP sexp-list DOT sexp CP) (build-so (append (reverse $2) $4) 1 5)]) [(OP sexp-list DOT sexp CP) (build-so (append (reverse $2) $4) 1 5)])
(sexp-list [() null] (sexp-list [() '()]
[(sexp-list sexp) (cons $2 $1)])))) [(sexp-list sexp) (cons $2 $1)]))))
(define (rs sn ip) (define (rs sn ip)

@ -17,7 +17,7 @@
;; taking the derivative of r. ;; taking the derivative of r.
(define (get-char-groups r found-negation) (define (get-char-groups r found-negation)
(cond (cond
[(or (eq? r e) (eq? r z)) null] [(or (eq? r e) (eq? r z)) '()]
[(char-setR? r) (list r)] [(char-setR? r) (list r)]
[(concatR? r) [(concatR? r)
(if (re-nullable? (concatR-re1 r)) (if (re-nullable? (concatR-re1 r))
@ -38,8 +38,8 @@
(test-block ((c (make-cache)) (test-block ((c (make-cache))
(r1 (->re #\1 c)) (r1 (->re #\1 c))
(r2 (->re #\2 c))) (r2 (->re #\2 c)))
((get-char-groups e #f) null) ((get-char-groups e #f) '())
((get-char-groups z #f) null) ((get-char-groups z #f) '())
((get-char-groups r1 #f) (list r1)) ((get-char-groups r1 #f) (list r1))
((get-char-groups (->re `(concatenation ,r1 ,r2) c) #f) ((get-char-groups (->re `(concatenation ,r1 ,r2) c) #f)
(list r1)) (list r1))
@ -142,7 +142,7 @@
(test-block ((c (make-cache)) (test-block ((c (make-cache))
(r1 (->re #\1 c)) (r1 (->re #\1 c))
(r2 (->re #\2 c))) (r2 (->re #\2 c)))
((derive null (char->integer #\1) c) #f) ((derive '() (char->integer #\1) c) #f)
((derive (list (cons r1 1) (cons r2 2)) (char->integer #\1) c) ((derive (list (cons r1 1) (cons r2 2)) (char->integer #\1) c)
(list (cons e 1) (cons z 2))) (list (cons e 1) (cons z 2)))
((derive (list (cons r1 1) (cons r2 2)) (char->integer #\3) c) #f)) ((derive (list (cons r1 1) (cons r2 2)) (char->integer #\3) c) #f))
@ -163,7 +163,7 @@
(r2 (->re #\b c)) (r2 (->re #\b c))
(b (list (cons z 1) (cons z 2) (cons z 3) (cons e 4) (cons z 5))) (b (list (cons z 1) (cons z 2) (cons z 3) (cons e 4) (cons z 5)))
(a (list (cons r1 1) (cons r2 2)))) (a (list (cons r1 1) (cons r2 2))))
((derive null (c->i #\a) c) #f) ((derive '() (c->i #\a) c) #f)
((derive a (c->i #\a) c) (list (cons e 1) (cons z 2))) ((derive a (c->i #\a) c) (list (cons e 1) (cons z 2)))
((derive a (c->i #\b) c) (list (cons z 1) (cons e 2))) ((derive a (c->i #\b) c) (list (cons z 1) (cons e 2)))
((derive a (c->i #\c) c) #f) ((derive a (c->i #\c) c) #f)
@ -194,7 +194,7 @@
;; derivative of the car of st. Only one derivative per set need to be taken. ;; derivative of the car of st. Only one derivative per set need to be taken.
(define (compute-chars st) (define (compute-chars st)
(cond (cond
[(null? st) null] [(null? st) '()]
[else [else
(loc:partition (map char-setR-chars (loc:partition (map char-setR-chars
(apply append (map (λ (x) (get-char-groups (car x) #f)) (apply append (map (λ (x) (get-char-groups (car x) #f))
@ -204,8 +204,8 @@
(c->i char->integer) (c->i char->integer)
(r1 (->re `(char-range #\1 #\4) c)) (r1 (->re `(char-range #\1 #\4) c))
(r2 (->re `(char-range #\2 #\3) c))) (r2 (->re `(char-range #\2 #\3) c)))
((compute-chars null) null) ((compute-chars '()) '())
((compute-chars (list (state null 1))) null) ((compute-chars (list (state '() 1))) '())
((map is:integer-set-contents ((map is:integer-set-contents
(compute-chars (list (state (list (cons r1 1) (cons r2 2)) 2)))) (compute-chars (list (state (list (cons r1 1) (cons r2 2)) 2))))
(list (is:integer-set-contents (is:make-range (c->i #\2) (c->i #\3))) (list (is:integer-set-contents (is:make-range (c->i #\2) (c->i #\3)))
@ -229,7 +229,7 @@
[start (state rs (get-state-number))]) [start (state rs (get-state-number))])
(cache (cons 'state (get-key rs)) (λ () start)) (cache (cons 'state (get-key rs)) (λ () start))
(let loop ([old-states (list start)] (let loop ([old-states (list start)]
[new-states null] [new-states '()]
[all-states (list start)] [all-states (list start)]
[cs (compute-chars (list start))]) [cs (compute-chars (list start))])
(cond (cond
@ -248,7 +248,7 @@
(state-index (cdr t))))))) (state-index (cdr t)))))))
< #:key car))] < #:key car))]
[(null? old-states) [(null? old-states)
(loop new-states null all-states (compute-chars new-states))] (loop new-states '() all-states (compute-chars new-states))]
[(null? cs) [(null? cs)
(loop (cdr old-states) new-states all-states (compute-chars (cdr old-states)))] (loop (cdr old-states) new-states all-states (compute-chars (cdr old-states)))]
[else [else
@ -267,7 +267,7 @@
s s
(cons (cons c new-state) (cons (cons c new-state)
(hash-ref transitions s (hash-ref transitions s
(λ () null)))) (λ () '()))))
(cond (cond
[new-state? [new-state?
(loop old-states (cons new-state new-states) new-all-states (cdr cs))] (loop old-states (cons new-state new-states) new-all-states (cdr cs))]

@ -117,7 +117,7 @@
(let loop ([res l] (let loop ([res l]
;; chars : (union #f char-set) ;; chars : (union #f char-set)
[chars #f] [chars #f]
[no-chars null]) [no-chars '()])
(cond (cond
[(null? res) [(null? res)
(if chars (if chars
@ -189,7 +189,7 @@
(let ([rs (let ([rs
(filter (filter
(λ (x) (not (eq? x z))) (λ (x) (not (eq? x z)))
(do-simple-equiv (replace rs orR? orR-res null) re-index))]) (do-simple-equiv (replace rs orR? orR-res '()) re-index))])
(cond (cond
[(null? rs) z] [(null? rs) z]
[(null? (cdr rs)) (car rs)] [(null? (cdr rs)) (car rs)]
@ -201,7 +201,7 @@
;; build-and : (list-of re) cache -> re ;; build-and : (list-of re) cache -> re
(define (build-and rs cache) (define (build-and rs cache)
(let ([rs (do-simple-equiv (replace rs andR? andR-res null) re-index)]) (let ([rs (do-simple-equiv (replace rs andR? andR-res '()) re-index)])
(cond (cond
[(null? rs) (build-neg z cache)] [(null? rs) (build-neg z cache)]
[(null? (cdr rs)) (car rs)] [(null? (cdr rs)) (car rs)]
@ -260,7 +260,7 @@
(ro4 (build-or `(,r1 ,r2 ,r3) c)) (ro4 (build-or `(,r1 ,r2 ,r3) c))
((orR-res ro) (list rc rr)) ((orR-res ro) (list rc rr))
((orR-res ro4) (list r1 r2 r3)) ((orR-res ro4) (list r1 r2 r3))
((build-or null c) z) ((build-or '() c) z)
((build-or `(,r1 ,z) c) r1) ((build-or `(,r1 ,z) c) r1)
((build-repeat 0 +inf.0 rc c) rr) ((build-repeat 0 +inf.0 rc c) rr)
((build-repeat 0 1 z c) e) ((build-repeat 0 1 z c) e)
@ -280,7 +280,7 @@
(ra4 (build-and `(,r1 ,r2 ,r3) c)) (ra4 (build-and `(,r1 ,r2 ,r3) c))
((andR-res ra) (list rc rr)) ((andR-res ra) (list rc rr))
((andR-res ra4) (list r1 r2 r3)) ((andR-res ra4) (list r1 r2 r3))
((build-and null c) (build-neg z c)) ((build-and '() c) (build-neg z c))
((build-and `(,r1 ,z) c) z) ((build-and `(,r1 ,z) c) z)
((build-and `(,r1) c) r1) ((build-and `(,r1) c) r1)
((build-neg r1 c) (build-neg r1 c)) ((build-neg r1 c) (build-neg r1 c))
@ -308,7 +308,7 @@
(r4 (build-or `(,r1 ,r2) c)) (r4 (build-or `(,r1 ,r2) c))
(r5 (->re `(union ,r3-5 #\7) c)) (r5 (->re `(union ,r3-5 #\7) c))
(r6 (->re #\6 c))) (r6 (->re #\6 c)))
((flatten-res null orR? orR-res is:union c) null) ((flatten-res '() orR? orR-res is:union c) '())
((isc (char-setR-chars (car (flatten-res `(,r1) orR? orR-res is:union c)))) ((isc (char-setR-chars (car (flatten-res `(,r1) orR? orR-res is:union c))))
(isc (is:make-range (char->integer #\1)))) (isc (is:make-range (char->integer #\1))))
((isc (char-setR-chars (car (flatten-res `(,r4) orR? orR-res is:union c)))) ((isc (char-setR-chars (car (flatten-res `(,r4) orR? orR-res is:union c))))

@ -9,7 +9,7 @@
;; get-chars-for-x : (nat -> bool) (listof (list nat nat bool)) -> (listof (cons nat nat)) ;; get-chars-for-x : (nat -> bool) (listof (list nat nat bool)) -> (listof (cons nat nat))
(define (get-chars-for char-x? mapped-chars) (define (get-chars-for char-x? mapped-chars)
(cond (cond
[(null? mapped-chars) null] [(null? mapped-chars) '()]
[else [else
(define range (car mapped-chars)) (define range (car mapped-chars))
(define low (car range)) (define low (car range))

@ -83,23 +83,23 @@
(module+ test (module+ test
(check-equal? (remove-dups '((1 2) (2 2) (1 3) (1 4) (check-equal? (remove-dups '((1 2) (2 2) (1 3) (1 4)
(100 4) (0 5)) cadr null) (100 4) (0 5)) cadr '())
'((1 2) (1 3) (1 4) (0 5))) '((1 2) (1 3) (1 4) (0 5)))
(check-equal? (remove-dups null error null) null)) (check-equal? (remove-dups '() error '()) '()))
;; do-simple-equiv : (list-of X) (X -> nat) -> (list-of X) ;; do-simple-equiv : (list-of X) (X -> nat) -> (list-of X)
;; Sorts l according to index and removes the entries with duplicate ;; Sorts l according to index and removes the entries with duplicate
;; indexes. ;; indexes.
(define (do-simple-equiv l index) (define (do-simple-equiv l index)
(define ordered (sort l < #:key index)) (define ordered (sort l < #:key index))
(remove-dups ordered index null)) (remove-dups ordered index '()))
(module+ test (module+ test
(check-equal? (do-simple-equiv '((2 2) (1 4) (1 2) (check-equal? (do-simple-equiv '((2 2) (1 4) (1 2)
(100 4) (1 3) (0 5)) (100 4) (1 3) (0 5))
cadr) cadr)
'((2 2) (1 3) (1 4) (0 5))) '((2 2) (1 3) (1 4) (0 5)))
(check-equal? (do-simple-equiv null error) null)) (check-equal? (do-simple-equiv '() error) '()))
;; replace : (list-of X) (X -> bool) (X -> (list-of X)) (list-of X) -> ;; replace : (list-of X) (X -> bool) (X -> (list-of X)) (list-of X) ->
;; (list-of X) ;; (list-of X)
@ -113,11 +113,11 @@
(module+ test (module+ test
(check-equal? (replace null void (λ () (list 1)) null) null) (check-equal? (replace '() void (λ () (list 1)) '()) '())
(check-equal? (replace '(1 2 3 4 3 5) (check-equal? (replace '(1 2 3 4 3 5)
(λ (x) (= x 3)) (λ (x) (= x 3))
(λ (x) (list 1 2 3)) (λ (x) (list 1 2 3))
null) '())
'(5 1 2 3 4 1 2 3 2 1))) '(5 1 2 3 4 1 2 3 2 1)))

@ -234,7 +234,7 @@
;; of productions that we don't know about yet. ;; of productions that we don't know about yet.
(define (set-nullables prods) (define (set-nullables prods)
(cond (cond
[(null? prods) null] [(null? prods) '()]
[(vector-ref nullable (gram-sym-index (prod-lhs (car prods)))) [(vector-ref nullable (gram-sym-index (prod-lhs (car prods))))
(set-nullables (cdr prods))] (set-nullables (cdr prods))]
[(vector-andmap (λ (nt) (vector-ref nullable (gram-sym-index nt))) (prod-rhs (car prods))) [(vector-andmap (λ (nt) (vector-ref nullable (gram-sym-index nt))) (prod-rhs (car prods)))

@ -18,7 +18,7 @@
(define N (make-hasheq)) (define N (make-hasheq))
(define (get-N x) (hash-ref N x zero-thunk)) (define (get-N x) (hash-ref N x zero-thunk))
(define (set-N x d) (hash-set! N x d)) (define (set-N x d) (hash-set! N x d))
(define stack null) (define stack '())
(define (push x) (set! stack (cons x stack))) (define (push x) (set! stack (cons x stack)))
(define (pop) (begin0 (define (pop) (begin0
(car stack) (car stack)

@ -28,7 +28,7 @@
(define args (define args
(let get-args ([i i][rhs rhs]) (let get-args ([i i][rhs rhs])
(cond (cond
[(null? rhs) null] [(null? rhs) '()]
[else [else
(define b (car rhs)) (define b (car rhs))
(define name (if (hash-ref empty-table (syntax->datum (car rhs)) #f) (define name (if (hash-ref empty-table (syntax->datum (car rhs)) #f)
@ -149,7 +149,7 @@
"Associativity must be left, right or nonassoc" "Associativity must be left, right or nonassoc"
type)) type))
(syntax->datum prec-decls)]))] (syntax->datum prec-decls)]))]
[#f null] [#f '()]
[_ (raise-syntax-error [_ (raise-syntax-error
'parser-precedences 'parser-precedences
"Precedence declaration must be of the form (precs (assoc term ...) ...) where assoc is left, right or nonassoc" "Precedence declaration must be of the form (precs (assoc term ...) ...) where assoc is left, right or nonassoc"

@ -53,7 +53,7 @@
(define rhs-l (vector-length rhs)) (define rhs-l (vector-length rhs))
(append (if (and (> rhs-l 0) (eq? nt (vector-ref rhs (sub1 rhs-l)))) (append (if (and (> rhs-l 0) (eq? nt (vector-ref rhs (sub1 rhs-l))))
(list (item prod (sub1 rhs-l))) (list (item prod (sub1 rhs-l)))
null) '())
(let loop ([i (sub1 rhs-l)]) (let loop ([i (sub1 rhs-l)])
(cond (cond
[(and (> i 0) [(and (> i 0)
@ -63,7 +63,7 @@
(cons (item prod (sub1 i)) (cons (item prod (sub1 i))
(loop (sub1 i))) (loop (sub1 i)))
(loop (sub1 i)))] (loop (sub1 i)))]
[else null])))) [else '()]))))
;; prod-list->items-for-include: grammar * prod list * non-term -> lr0-item list ;; prod-list->items-for-include: grammar * prod list * non-term -> lr0-item list
;; return the list of all (B -> beta . nt gamma) such that (B -> beta nt gamma) in prod-list ;; return the list of all (B -> beta . nt gamma) such that (B -> beta nt gamma) in prod-list
@ -74,7 +74,7 @@
;; comput-includes: lr0-automaton * grammar -> (trans-key -> trans-key list) ;; comput-includes: lr0-automaton * grammar -> (trans-key -> trans-key list)
(define (compute-includes a g) (define (compute-includes a g)
(define num-states (send a get-num-states)) (define num-states (send a get-num-states))
(define items-for-input-nt (make-vector (grammar-num-non-terms g) null)) (define items-for-input-nt (make-vector (grammar-num-non-terms g) '()))
(for ([input-nt (in-list (grammar-non-terms g))]) (for ([input-nt (in-list (grammar-non-terms g))])
(vector-set! items-for-input-nt (non-term-index input-nt) (vector-set! items-for-input-nt (non-term-index input-nt)
(prod-list->items-for-include g (grammar-all-prods g) input-nt))) (prod-list->items-for-include g (grammar-all-prods g) input-nt)))
@ -213,7 +213,7 @@
(define get-f (lookup-tk-map results)) (define get-f (lookup-tk-map results))
(define set-f (add-tk-map results)) (define set-f (add-tk-map results))
(define stack null) (define stack '())
(define (push x) (set! stack (cons x stack))) (define (push x) (set! stack (cons x stack)))
(define (pop) (begin0 (define (pop) (begin0
(car stack) (car stack)

@ -28,7 +28,7 @@
(define (trans-key-list-remove-dups tkl) (define (trans-key-list-remove-dups tkl)
(let loop ([sorted (sort tkl trans-key<?)]) (let loop ([sorted (sort tkl trans-key<?)])
(cond (cond
[(null? sorted) null] [(null? sorted) '()]
[(null? (cdr sorted)) sorted] [(null? (cdr sorted)) sorted]
[(and (= (non-term-index (trans-key-gs (car sorted))) [(and (= (non-term-index (trans-key-gs (car sorted)))
(non-term-index (trans-key-gs (cadr sorted)))) (non-term-index (trans-key-gs (cadr sorted))))
@ -59,7 +59,7 @@
(define (reverse-assoc assoc) (define (reverse-assoc assoc)
(define reverse-hash (make-hash)) (define reverse-hash (make-hash))
(define (hash-table-add! ht k v) (define (hash-table-add! ht k v)
(hash-set! ht k (cons v (hash-ref ht k (λ () null))))) (hash-set! ht k (cons v (hash-ref ht k (λ () '())))))
(for ([trans-key/kernel (in-list assoc)]) (for ([trans-key/kernel (in-list assoc)])
(define tk (car trans-key/kernel)) (define tk (car trans-key/kernel))
(hash-table-add! reverse-hash (hash-table-add! reverse-hash
@ -126,7 +126,7 @@
(for*/list ([k (in-list k)] (for*/list ([k (in-list k)]
[val (in-list (hash-ref (vector-ref reverse-transitions (kernel-index k)) [val (in-list (hash-ref (vector-ref reverse-transitions (kernel-index k))
(gram-sym-symbol s) (gram-sym-symbol s)
(λ () null)))]) (λ () '())))])
val)))) val))))
(define ((union comp<?) l1 l2) (define ((union comp<?) l1 l2)
@ -171,14 +171,14 @@
(grammar-prods-for-non-term grammar nt)))) (grammar-prods-for-non-term grammar nt))))
(λ (nt) (list nt)) (λ (nt) (list nt))
(union non-term<?) (union non-term<?)
(λ () null))) (λ () '())))
;; closure: LR1-item list -> LR1-item list ;; closure: LR1-item list -> LR1-item list
;; Creates a set of items containing i s.t. if A -> n.Xm is in it, ;; Creates a set of items containing i s.t. if A -> n.Xm is in it,
;; X -> .o is in it too. ;; X -> .o is in it too.
(define (LR0-closure i) (define (LR0-closure i)
(cond (cond
[(null? i) null] [(null? i) '()]
[else [else
(define next-gsym (sym-at-dot (car i))) (define next-gsym (sym-at-dot (car i)))
(cond (cond
@ -192,8 +192,8 @@
[else (cons (car i) (LR0-closure (cdr i)))])])) [else (cons (car i) (LR0-closure (cdr i)))])]))
;; maps trans-keys to kernels ;; maps trans-keys to kernels
(define automaton-term null) (define automaton-term '())
(define automaton-non-term null) (define automaton-non-term '())
;; keeps the kernels we have seen, so we can have a unique ;; keeps the kernels we have seen, so we can have a unique
;; list for each kernel ;; list for each kernel
@ -216,11 +216,11 @@
(define (add-item! table i) (define (add-item! table i)
(define gs (sym-at-dot i)) (define gs (sym-at-dot i))
(cond (cond
[gs (define already (hash-ref table (gram-sym-symbol gs) (λ () null))) [gs (define already (hash-ref table (gram-sym-symbol gs) (λ () '())))
(unless (member i already) (unless (member i already)
(hash-set! table (gram-sym-symbol gs) (cons i already)))] (hash-set! table (gram-sym-symbol gs) (cons i already)))]
((zero? (vector-length (prod-rhs (item-prod i)))) ((zero? (vector-length (prod-rhs (item-prod i))))
(define current (hash-ref epsilons ker (λ () null))) (define current (hash-ref epsilons ker (λ () '())))
(hash-set! epsilons ker (cons i current))))) (hash-set! epsilons ker (cons i current)))))
;; Group the items of the LR0 closure of the kernel ;; Group the items of the LR0 closure of the kernel
@ -235,9 +235,9 @@
(define is (define is
(let loop ([gsyms grammar-symbols]) (let loop ([gsyms grammar-symbols])
(cond (cond
[(null? gsyms) null] [(null? gsyms) '()]
[else [else
(define items (hash-ref table (gram-sym-symbol (car gsyms)) (λ () null))) (define items (hash-ref table (gram-sym-symbol (car gsyms)) (λ () '())))
(cond (cond
[(null? items) (loop (cdr gsyms))] [(null? items) (loop (cdr gsyms))]
[else (cons (list (car gsyms) items) [else (cons (list (car gsyms) items)
@ -278,7 +278,7 @@
k)) k))
(define new-kernels (make-queue)) (define new-kernels (make-queue))
(let loop ([old-kernels startk] (let loop ([old-kernels startk]
[seen-kernels null]) [seen-kernels '()])
(cond (cond
[(and (empty-queue? new-kernels) (null? old-kernels)) [(and (empty-queue? new-kernels) (null? old-kernels))
(make-object lr0% automaton-term automaton-non-term (make-object lr0% automaton-term automaton-non-term
@ -290,16 +290,16 @@
(struct q (f l) #:mutable) (struct q (f l) #:mutable)
(define (empty-queue? q) (null? (q-f q))) (define (empty-queue? q) (null? (q-f q)))
(define (make-queue) (q null null)) (define (make-queue) (q '() '()))
(define (enq! q i) (define (enq! q i)
(cond (cond
[(empty-queue? q) [(empty-queue? q)
(let ([i (mcons i null)]) (let ([i (mcons i '())])
(set-q-l! q i) (set-q-l! q i)
(set-q-f! q i))] (set-q-f! q i))]
[else [else
(set-mcdr! (q-l q) (mcons i null)) (set-mcdr! (q-l q) (mcons i '()))
(set-q-l! q (mcdr (q-l q)))])) (set-q-l! q (mcdr (q-l q)))]))

@ -57,7 +57,7 @@
(syntax-case assocs () (syntax-case assocs ()
(((__ TERM ...) ...) (((__ TERM ...) ...)
(syntax->list #'(TERM ... ...))))) (syntax->list #'(TERM ... ...)))))
null)]) '())])
#`(when #f #`(when #f
(let ((BIND void) ... (TMP void) ...) (let ((BIND void) ... (TMP void) ...)
(void BOUND ... ... TERM-GROUP ... START ... END ... PREC ...))))) (void BOUND ... ... TERM-GROUP ... START ... END ... PREC ...)))))

@ -18,7 +18,7 @@
;; make-parse-table : int -> parse-table ;; make-parse-table : int -> parse-table
(define (make-parse-table num-states) (define (make-parse-table num-states)
(make-vector num-states null)) (make-vector num-states '()))
;; table-add!: parse-table nat symbol action -> ;; table-add!: parse-table nat symbol action ->
(define (table-add! table state-index symbol val) (define (table-add! table state-index symbol val)
@ -30,7 +30,7 @@
(for/vector ([state-entry (in-list (vector->list table))]) (for/vector ([state-entry (in-list (vector->list table))])
(define ht (make-hasheq)) (define ht (make-hasheq))
(for* ([gs/actions (in-list state-entry)] (for* ([gs/actions (in-list state-entry)]
[group (in-value (hash-ref ht (car gs/actions) (λ () null)))] [group (in-value (hash-ref ht (car gs/actions) (λ () '())))]
#:unless (member (cdr gs/actions) group)) #:unless (member (cdr gs/actions) group))
(hash-set! ht (car gs/actions) (cons (cdr gs/actions) group))) (hash-set! ht (car gs/actions) (cons (cdr gs/actions) group)))
(hash-map ht cons))) (hash-map ht cons)))
@ -185,7 +185,7 @@
(list reduce)] (list reduce)]
[(eq? 'right (prec-assoc shift-prec)) [(eq? 'right (prec-assoc shift-prec))
(list shift)] (list shift)]
[else null])] [else '()])]
[else actions])) [else actions]))
@ -226,7 +226,7 @@
(kernel-index to-state)))))) (kernel-index to-state))))))
(send a for-each-state (send a for-each-state
(λ (state) (λ (state)
(for ([item (in-list (append (hash-ref (send a get-epsilon-trans) state (λ () null)) (for ([item (in-list (append (hash-ref (send a get-epsilon-trans) state (λ () '()))
(filter (λ (item) (filter (λ (item)
(not (move-dot-right item))) (not (move-dot-right item)))
(kernel-items state))))]) (kernel-items state))))])

@ -272,7 +272,7 @@
(let-values ([(new-stack args) (let-values ([(new-stack args)
(reduce-stack stack (reduce-stack stack
(runtime-reduce-rhs-length action) (runtime-reduce-rhs-length action)
null '()
src-pos)]) src-pos)])
(define goto (define goto
(runtime-goto-state (runtime-goto-state

@ -95,7 +95,7 @@
(define p (if (string? port-or-string) (define p (if (string? port-or-string)
(open-input-string port-or-string) (open-input-string port-or-string)
port-or-string)) port-or-string))
(let loop ([acc null]) (let loop ([acc '()])
(define-values (lex cat shape start end) (colorer p)) (define-values (lex cat shape start end) (colorer p))
(if (or (eq? 'eof cat) (eof-object? lex)) (if (or (eq? 'eof cat) (eof-object? lex))
(reverse acc) (reverse acc)

Loading…
Cancel
Save