syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Adjust skeleton for extensible dataspace patterns

This commit is contained in:
Tony Garnock-Jones 2024-04-04 15:16:45 +02:00
parent b214835bcc
commit 6d1278fbb0
1 changed files with 24 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
syndicate/skeleton.rkt
View File

@ -154,13 +154,11 @@
(define (term-matches-ctor-spec? term ctor-spec)
(match ctor-spec
[(? number? arity)
(and (list? term) (= (length term) arity))]
[(cons label (? number? arity))
[(cons 'rec label)
(and (non-object-struct? term)
(let ((t (struct->struct-type term)))
(and (equal? (struct-type-name t) label)
(= (struct-type-constructor-arity t) arity))))]
(equal? (struct-type-name (struct->struct-type term)) label))]
['arr
(list? term)]
['dict
(hash? term)]))
@ -180,8 +178,8 @@
[(cons _selector table) table]))
(define ctor-spec
(match compound-pat
[(DCompound-rec label field-pats) (cons label (length field-pats))]
[(DCompound-arr item-pats) (length item-pats)]
[(DCompound-rec label field-pats) (cons 'rec label)]
[(DCompound-arr item-pats) 'arr]
[(DCompound-dict _entries) 'dict]))
(define (make-skeleton-node-with-cache)
(define unfiltered (skeleton-continuation-cache (skeleton-node-continuation sk)))
@ -250,16 +248,14 @@
(define popped-stack (drop term-stack pop-count))
(define old-top (car popped-stack))
(define new-top (step-term old-top key))
(define entry (hash-ref table
(cond [(non-object-struct? new-top)
(define t (struct->struct-type new-top))
(cons (struct-type-name t) (struct-type-constructor-arity t))]
[(list? new-top)
(length new-top)]
[(hash? new-top)
'dict]
[else #f])
#f))
(define entry
(hash-ref table
(cond [(non-object-struct? new-top) (cons 'rec (struct-type-name
(struct->struct-type new-top)))]
[(list? new-top) 'arr]
[(hash? new-top) 'dict]
[else #f])
#f))
(when entry (walk-node! entry (cons new-top popped-stack))))))
(define (add-term-to-skcont! skcont term)
@ -344,7 +340,13 @@
(step-term term key)))
(define (step-term term key)
(cond [(non-object-struct? term) (vector-ref (struct->vector term) (+ key 1))]
[(list? term) (list-ref term key)]
[(hash? term) (hash-ref term key (void))]
[else (error 'apply-projection "Term representation not supported: ~v" term)]))
(cond [(non-object-struct? term)
(define v (struct->vector term))
(define k (+ key 1)) ;; skip the label
(if (>= k (vector-length v)) (void) (vector-ref v k))]
[(list? term)
(if (>= key (length term)) (void) (list-ref term key))]
[(hash? term)
(hash-ref term key (void))]
[else
(error 'apply-projection "Term representation not supported: ~v" term)]))