diff --git a/graph-lib/graph/_experiment_queues_without_list.rkt b/graph-lib/graph/_experiment_queues_without_list.rkt deleted file mode 100644 index d0931f9..0000000 --- a/graph-lib/graph/_experiment_queues_without_list.rkt +++ /dev/null @@ -1,18 +0,0 @@ -#lang typed/racket - -#| -(let ([res-zero '()] - [res-one '()] - [res-two '()] -|# - -(define (process-zero v res-zero) - (cons v res-zero)) - -(define (enqueue [v : Integer]) - (let ([name : (U 'zero 'one 'two) (cond [(= (modulo v 3) 0) 'zero] - [(= (modulo v 3) 1) 'one] - [else 'two])]) - (cond [(eq? name 'zero) ] - [(eq? name 'one) ] - [(eq? name 'two) ]))) \ No newline at end of file diff --git a/graph-lib/lib/low/logn-id.rkt b/graph-lib/lib/low/logn-id.rkt new file mode 100644 index 0000000..42fab0b --- /dev/null +++ b/graph-lib/lib/low/logn-id.rkt @@ -0,0 +1,65 @@ +#lang typed/racket + +(require (for-syntax syntax/parse + racket/syntax + racket/function + racket/match + syntax/stx)) + +(begin-for-syntax + (define (insert make-node v ts) + (match ts + [`() `((,v))] + [`(() . ,b) `((,v) . ,b)] + [`((,a) . ,b) `(() . ,(insert make-node (make-node v a) b))])) + + (define (merge-trees make-node ts) + (match ts + [`{[,a]} a] + [`{[,a] [] . ,rest} (merge-trees make-node `{[,a] . ,rest})] + [`{[] . ,rest} (merge-trees make-node rest)] + [`{[,a] [,b] . ,rest} (merge-trees make-node + `{[,(make-node a b)] . ,rest})])) + + (define (make-binary-tree l make-node make-leaf) + (merge-trees make-node + (foldl (curry insert make-node) + '() + (map make-leaf l))))) + +(define-syntax (define-logn-ids stx) + (syntax-parse stx + [(_ matcher:id [id:id ty:id] ...) + (define/with-syntax (tmp ...) (generate-temporaries #'(id ...))) + (define bt + (make-binary-tree (syntax->list #'([ty id . tmp] ...)) + (λ (x y) `(node ,(generate-temporary) ,x ,y)) + (λ (x) `(leaf ,(stx-car x) + ,(generate-temporary (stx-car x)) + ,(stx-car (stx-cdr x)) + ,(stx-cdr (stx-cdr x)))))) + (define (make-structs bt parent) + (match bt + [`(node ,s ,a ,b) #`(begin (struct #,s #,@parent ()) + #,(make-structs a (list s)) + #,(make-structs b (list s)))] + [`(leaf ,t ,s ,a ,_) #`(begin (struct #,s #,@parent () #:type-name #,t) + (define #,a (#,s)))])) + (define (make-btd bt) + (match bt + [`(node ,s ,(and a `(,_ ,sa . ,_)) ,b) + #`(if ((make-predicate #,sa) v-cache) + #,(make-btd a) + #,(make-btd b))] + [`(leaf ,s ,a ,t ,tmp) + tmp])) + #`(begin #,(make-structs bt #'()) + (define-syntax (matcher stx) + (syntax-parse stx + [(_ v:expr [(~literal id) tmp] ...) + #'(let ([v-cache v]) + #,(make-btd bt))])))])) + +(define-logn-ids match-x [a A] [b B] [c C] [d D] [e E]) + +(match-x b [a 1] [b 2] [c 3] [d 4] [e 5]) \ No newline at end of file