Use `'()` instead of `null`

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

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

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

@ -47,7 +47,7 @@
(get-string-token input-port))]
[(:: #\\ #\\) (cons #\\ (get-string-token input-port))]
[(:: #\\ #\") (cons #\" (get-string-token input-port))]
[#\" null]))
[#\" '()]))
(define-lex-abbrevs
@ -226,7 +226,7 @@
[(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)])
(sexp-list [() null]
(sexp-list [() '()]
[(sexp-list sexp) (cons $2 $1)]))))
(define (rs sn ip)

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

@ -117,7 +117,7 @@
(let loop ([res l]
;; chars : (union #f char-set)
[chars #f]
[no-chars null])
[no-chars '()])
(cond
[(null? res)
(if chars
@ -189,7 +189,7 @@
(let ([rs
(filter
(λ (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
[(null? rs) z]
[(null? (cdr rs)) (car rs)]
@ -201,7 +201,7 @@
;; build-and : (list-of re) cache -> re
(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
[(null? rs) (build-neg z cache)]
[(null? (cdr rs)) (car rs)]
@ -260,7 +260,7 @@
(ro4 (build-or `(,r1 ,r2 ,r3) c))
((orR-res ro) (list rc rr))
((orR-res ro4) (list r1 r2 r3))
((build-or null c) z)
((build-or '() c) z)
((build-or `(,r1 ,z) c) r1)
((build-repeat 0 +inf.0 rc c) rr)
((build-repeat 0 1 z c) e)
@ -280,7 +280,7 @@
(ra4 (build-and `(,r1 ,r2 ,r3) c))
((andR-res ra) (list rc rr))
((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) c) r1)
((build-neg r1 c) (build-neg r1 c))
@ -308,7 +308,7 @@
(r4 (build-or `(,r1 ,r2) c))
(r5 (->re `(union ,r3-5 #\7) 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 (is:make-range (char->integer #\1))))
((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))
(define (get-chars-for char-x? mapped-chars)
(cond
[(null? mapped-chars) null]
[(null? mapped-chars) '()]
[else
(define range (car mapped-chars))
(define low (car range))

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

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

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

@ -28,7 +28,7 @@
(define args
(let get-args ([i i][rhs rhs])
(cond
[(null? rhs) null]
[(null? rhs) '()]
[else
(define b (car rhs))
(define name (if (hash-ref empty-table (syntax->datum (car rhs)) #f)
@ -149,7 +149,7 @@
"Associativity must be left, right or nonassoc"
type))
(syntax->datum prec-decls)]))]
[#f null]
[#f '()]
[_ (raise-syntax-error
'parser-precedences
"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))
(append (if (and (> rhs-l 0) (eq? nt (vector-ref rhs (sub1 rhs-l))))
(list (item prod (sub1 rhs-l)))
null)
'())
(let loop ([i (sub1 rhs-l)])
(cond
[(and (> i 0)
@ -63,7 +63,7 @@
(cons (item prod (sub1 i))
(loop (sub1 i)))
(loop (sub1 i)))]
[else null]))))
[else '()]))))
;; 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
@ -74,7 +74,7 @@
;; comput-includes: lr0-automaton * grammar -> (trans-key -> trans-key list)
(define (compute-includes a g)
(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))])
(vector-set! items-for-input-nt (non-term-index 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 set-f (add-tk-map results))
(define stack null)
(define stack '())
(define (push x) (set! stack (cons x stack)))
(define (pop) (begin0
(car stack)

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

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

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

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

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

Loading…
Cancel
Save