Clean up preprocess-lang
This commit is contained in:
parent
21807d3790
commit
1e6786eedf
|
@ -1,5 +1,6 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require (for-syntax racket/base)
|
(require (for-syntax racket/base
|
||||||
|
racket/math)
|
||||||
racket/bool
|
racket/bool
|
||||||
racket/contract
|
racket/contract
|
||||||
racket/list
|
racket/list
|
||||||
|
@ -23,13 +24,10 @@
|
||||||
;; sorts rhs's so that recursive ones go last
|
;; sorts rhs's so that recursive ones go last
|
||||||
(define (sep-lang lang)
|
(define (sep-lang lang)
|
||||||
(define (filter-edges edges lang)
|
(define (filter-edges edges lang)
|
||||||
(foldl
|
(for/fold ([ht (hash)])
|
||||||
(λ (nt m)
|
([nt (in-list lang)])
|
||||||
(let ([name (nt-name nt)])
|
(define name (nt-name nt))
|
||||||
(hash-set m name
|
(hash-set ht name (hash-ref edges name))))
|
||||||
(hash-ref edges name))))
|
|
||||||
(hash)
|
|
||||||
lang))
|
|
||||||
(define edges (find-edges lang))
|
(define edges (find-edges lang))
|
||||||
(define cyclic-nts (find-cycles edges))
|
(define cyclic-nts (find-cycles edges))
|
||||||
(define-values (cyclic non-cyclic)
|
(define-values (cyclic non-cyclic)
|
||||||
|
@ -296,11 +294,18 @@
|
||||||
|
|
||||||
;; fold-map/set : (a -> setof b) (listof a) -> (setof b)
|
;; fold-map/set : (a -> setof b) (listof a) -> (setof b)
|
||||||
(define (fold-map/set f l)
|
(define (fold-map/set f l)
|
||||||
(foldl
|
(for/fold ([acc (set)])
|
||||||
(λ (x s)
|
([x (in-list l)])
|
||||||
(set-union (f x) s))
|
(set-union (f x) acc)))
|
||||||
(set)
|
|
||||||
l))
|
(define (pos-inf? n)
|
||||||
|
(and (infinite? n)
|
||||||
|
(positive? n)))
|
||||||
|
|
||||||
|
(define (my-max default new)
|
||||||
|
(if (> new default)
|
||||||
|
new
|
||||||
|
default))
|
||||||
|
|
||||||
;; Short circuits for +inf
|
;; Short circuits for +inf
|
||||||
(define-syntax (for/max stx)
|
(define-syntax (for/max stx)
|
||||||
|
@ -310,11 +315,7 @@
|
||||||
#'(for/fold/derived original
|
#'(for/fold/derived original
|
||||||
([current-max -inf.0])
|
([current-max -inf.0])
|
||||||
clauses
|
clauses
|
||||||
#:break (and (infinite? current-max)
|
#:break (pos-inf? current-max)
|
||||||
(positive? current-max))
|
(my-max current-max
|
||||||
(define maybe-new-max
|
(let () . defs+exprs))))]))
|
||||||
(let () . defs+exprs))
|
|
||||||
(if (> maybe-new-max current-max)
|
|
||||||
maybe-new-max
|
|
||||||
current-max)))]))
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user