Tries and patches to and from jsexpr
This commit is contained in:
parent
d033c69083
commit
839818f8e4
|
@ -37,7 +37,10 @@
|
||||||
patch-project/set/single
|
patch-project/set/single
|
||||||
|
|
||||||
pretty-print-patch
|
pretty-print-patch
|
||||||
patch->pretty-string)
|
patch->pretty-string
|
||||||
|
|
||||||
|
patch->jsexpr
|
||||||
|
jsexpr->patch)
|
||||||
|
|
||||||
(require racket/set)
|
(require racket/set)
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
|
@ -271,6 +274,21 @@
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(define (patch->jsexpr p success->jsexpr #:serialize-atom [serialize-atom values])
|
||||||
|
(match-define (patch in out) p)
|
||||||
|
(list (trie->jsexpr in success->jsexpr #:serialize-atom serialize-atom)
|
||||||
|
(trie->jsexpr out success->jsexpr #:serialize-atom serialize-atom)))
|
||||||
|
|
||||||
|
(define (jsexpr->patch pj
|
||||||
|
jsexpr->success
|
||||||
|
[lookup-struct-type (lambda (t) #f)]
|
||||||
|
#:deserialize-atom [deserialize-atom values])
|
||||||
|
(match-define (list ij oj) pj)
|
||||||
|
(patch (jsexpr->trie ij jsexpr->success lookup-struct-type #:deserialize-atom deserialize-atom)
|
||||||
|
(jsexpr->trie oj jsexpr->success lookup-struct-type #:deserialize-atom deserialize-atom)))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(define (set->trie label xs)
|
(define (set->trie label xs)
|
||||||
(for/fold [(acc trie-empty)] [(x (in-set xs))]
|
(for/fold [(acc trie-empty)] [(x (in-set xs))]
|
||||||
|
|
|
@ -66,7 +66,10 @@
|
||||||
trie->pretty-string
|
trie->pretty-string
|
||||||
trie->abstract-graph
|
trie->abstract-graph
|
||||||
abstract-graph->dot
|
abstract-graph->dot
|
||||||
trie->dot)
|
trie->dot
|
||||||
|
|
||||||
|
trie->jsexpr
|
||||||
|
jsexpr->trie)
|
||||||
|
|
||||||
(require racket/set)
|
(require racket/set)
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
|
@ -1016,6 +1019,67 @@
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;; ParenType -> String
|
||||||
|
(define (paren-type->string type)
|
||||||
|
(match type
|
||||||
|
['list "L"]
|
||||||
|
['vector "V"]
|
||||||
|
[(? struct-type?)
|
||||||
|
(string-append ":" (symbol->string (struct-type-name type)))]))
|
||||||
|
|
||||||
|
;; String (String -> (Option struct-type)) -> ParenType
|
||||||
|
(define (string->paren-type s lookup-struct-type)
|
||||||
|
(match s
|
||||||
|
["L" 'list]
|
||||||
|
["V" 'vector]
|
||||||
|
[_ (if (char=? (string-ref s 0) #\:)
|
||||||
|
(or (lookup-struct-type (substring s 1))
|
||||||
|
(error 'string->paren-type "Unexpected struct type name ~v" (substring s 1)))
|
||||||
|
(error 'string->paren-type "Invalid paren-type string representation ~v" s))]))
|
||||||
|
|
||||||
|
;; Trie (Any -> JSExpr) [#:serialize-atom (Any -> JSExpr)] -> JSExpr
|
||||||
|
(define (trie->jsexpr m success->jsexpr #:serialize-atom [serialize-atom values])
|
||||||
|
(let walk ((m m))
|
||||||
|
(match m
|
||||||
|
[(? trie-empty?) '()]
|
||||||
|
[(success v) (list (success->jsexpr v))]
|
||||||
|
[(branch opens wild sigmas)
|
||||||
|
(list (for/list [(kv (treap-to-alist opens))]
|
||||||
|
(match-define (cons (open-parenthesis arity type) v) kv)
|
||||||
|
(list arity
|
||||||
|
(paren-type->string type)
|
||||||
|
(walk v)))
|
||||||
|
(walk wild)
|
||||||
|
(for/list [(kv (treap-to-alist sigmas))]
|
||||||
|
(match-define (cons k v) kv)
|
||||||
|
(list (serialize-atom k)
|
||||||
|
(walk v))))])))
|
||||||
|
|
||||||
|
;; JSExpr (JSExpr -> Any) [String -> (Option struct-type)] [#:deserialize-atom (JSExpr -> Any)]
|
||||||
|
;; -> Trie
|
||||||
|
;; Deserializes a matcher from a JSON expression.
|
||||||
|
(define (jsexpr->trie j
|
||||||
|
jsexpr->success
|
||||||
|
[lookup-struct-type (lambda (t) #f)]
|
||||||
|
#:deserialize-atom [deserialize-atom values])
|
||||||
|
(let walk ((j j))
|
||||||
|
(match j
|
||||||
|
['() #f]
|
||||||
|
[(list vj) (rsuccess (jsexpr->success vj))]
|
||||||
|
[(list jopens jwild jsigmas)
|
||||||
|
(canonicalize
|
||||||
|
(collapse
|
||||||
|
(branch (for/fold [(acc empty-omap)] [(jopen (in-list jopens))]
|
||||||
|
(match-define (list arity type-str vj) jopen)
|
||||||
|
(define type (string->paren-type type-str lookup-struct-type))
|
||||||
|
(treap-insert acc (canonical-open-parenthesis arity type) (walk vj)))
|
||||||
|
(walk jwild)
|
||||||
|
(for/fold [(acc empty-smap)] [(jsigma (in-list jsigmas))]
|
||||||
|
(match-define (list atom vj) jsigma)
|
||||||
|
(treap-insert acc (deserialize-atom atom) (walk vj))))))])))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(struct test-foo (bar) #:transparent)
|
(struct test-foo (bar) #:transparent)
|
||||||
(struct test-bar (zot quux) #:transparent)
|
(struct test-bar (zot quux) #:transparent)
|
||||||
|
|
Loading…
Reference in New Issue