Skip to content

Commit

Permalink
slightly improve propagation of multiple-value static infos
Browse files Browse the repository at this point in the history
This is by no means a complete solution to #439, but it tries a little
bit harder to normalize the multiple-value static infos (and also
assumes harder the `((#%values (<infos> ...)))` shape).

Also fix a curious bug in `def`/`let` that fails to propagate
single-value static infos wrapped in `#%values`.
  • Loading branch information
usaoc committed Jan 1, 2024
1 parent cd27aea commit 5a0765f
Show file tree
Hide file tree
Showing 6 changed files with 93 additions and 54 deletions.
31 changes: 12 additions & 19 deletions rhombus/private/class-method-result.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -117,30 +117,23 @@
(annotation-string-and annot-str all-annot-str))))]
;; no annotation in the inheritance chain
[else (values #f #f)]))
(define (extract-static-infoss infos)
(syntax-parse infos
#:literals (#%values)
[((#%values (si ...))) (syntax->list #'(si ...))]
[_ (list infos)]))
(define static-infoss (extract-static-infoss static-infos))
(define static-infoss-count (length static-infoss))
;; Like `Super_1 && ... && Super_n && This`, in reverse of
;; the actual checks (checks happen "bottom-up"); or in
;; other words, a variant of `&&` that prioritizes the
;; left-hand side static infos.
(define all-static-infos
(for/foldr ([all-static-infoss (for/list ([_ (in-range static-infoss-count)])
'())]
#:result (if (eqv? static-infoss-count 1)
(car all-static-infoss)
#`((#%values #,all-static-infoss))))
([infos (in-list (cons static-infos
(map method-result-static-infos super-results)))]
#:do [(define infoss (extract-static-infoss infos))]
#:when (eqv? (length infoss) static-infoss-count))
(for/list ([infos (in-list infoss)]
[all-static-infos (in-list all-static-infoss)])
(static-infos-union infos all-static-infos))))]
(if all-count
(for/foldr ([all-static-infoss (for/list ([_ (in-range all-count)])
'())]
#:result (if (eqv? all-count 1)
#`#,(car all-static-infoss)
#`((#%values #,all-static-infoss))))
([infos (in-list (cons static-infos
(map method-result-static-infos super-results)))])
(for/list ([infos (in-list (normalize-static-infos/values all-count infos))]
[all-static-infos (in-list all-static-infoss)])
(static-infos-union infos all-static-infos)))
#'()))]
#:attr handler handler-stx
#:attr handler-id (and handler-stx
(not (identifier? handler-stx))
Expand Down
7 changes: 3 additions & 4 deletions rhombus/private/composite.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -110,10 +110,9 @@
(define (static-info-lookup/pair infos key)
(define maybe-infos (static-info-lookup infos key))
(and maybe-infos
(syntax-parse maybe-infos
#:literals (#%values)
[((#%values (car-infos cdr-infos))) #'((car car-infos) (cdr cdr-infos))]
[_ #f])))
(syntax-parse (normalize-static-infos/values 2 maybe-infos)
[(() ()) #f]
[(car-infos cdr-infos) #'((car car-infos) (cdr cdr-infos))])))
(or (and (syntax-e #'index-result-info?)
(static-info-lookup/pair #'static-infos #'#%index-result))
(and (syntax-e #'sequence-element-info?)
Expand Down
17 changes: 4 additions & 13 deletions rhombus/private/def+let.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,6 @@
"definition.rkt"
"binding.rkt"
"parse.rkt"
"values-key.rkt"
"static-info.rkt"
"forwarding-sequence.rkt"
(only-in "values.rkt"
Expand Down Expand Up @@ -94,7 +93,7 @@
[lhs::binding
#:with lhs-e::binding-form #'lhs.parsed
#:with rhs (rhombus-local-expand (enforest-expression-block rhs-stx))
#:with static-infos (single-valued-static-info (extract-static-infos #'rhs))
#:with static-infos (normalize-static-infos (extract-static-infos #'rhs))
#:with lhs-impl::binding-impl #'(lhs-e.infoer-id static-infos lhs-e.data)
#:with lhs-i::binding-info #'lhs-impl.info
(for ([id (in-list (syntax->list #'(lhs-i.bind-id ...)))]
Expand Down Expand Up @@ -123,14 +122,9 @@
[(lhs::binding ...)
#:with (lhs-e::binding-form ...) #'(lhs.parsed ...)
#:with rhs (rhombus-local-expand (enforest-expression-block rhs-stx))
#:with (static-infos ...) (let ([si (extract-static-infos #'rhs)])
(define lhss (syntax->list #'(lhs ...)))
(syntax-parse (static-info-lookup si #'#%values)
[(si ...)
#:when (= (length (syntax->list #'(si ...)))
(length lhss))
(map single-valued-static-info (syntax->list #'(si ...)))]
[_ (for/list ([lhs (in-list lhss)]) #'())]))
#:with (static-infos ...) (normalize-static-infos/values
(length (syntax->list gs-stx))
(extract-static-infos #'rhs))
#:with (lhs-impl::binding-impl ...) #'((lhs-e.infoer-id static-infos lhs-e.data) ...)
#:with (lhs-i::binding-info ...) #'(lhs-impl.info ...)
#:with (tmp-id ...) (generate-temporaries #'(lhs-i.name-id ...))
Expand Down Expand Up @@ -198,6 +192,3 @@
(if pos
(list "position" (unquoted-printing-string (n->th pos)))
'())))

(define-for-syntax (single-valued-static-info si)
(static-infos-remove si #'#%values))
22 changes: 5 additions & 17 deletions rhombus/private/for.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,6 @@
"index-result-key.rkt"
"sequence-constructor-key.rkt"
"sequence-element-key.rkt"
"values-key.rkt"
"parse.rkt"
"parens.rkt"
(rename-in "values.rkt"
Expand Down Expand Up @@ -280,22 +279,11 @@
(syntax-parse lhs-parsed-stxes
[(lhs-e::binding-form ...)
#:with rhs (rhombus-local-expand (enforest-expression-block rhs-blk-stx))
#:with (static-infos ...) (cond
[(or (syntax-local-static-info #'rhs #'#%sequence-element)
(syntax-local-static-info #'rhs #'#%index-result))
=> (lambda (infos)
(define number-of-vals (length (syntax->list #'(lhs-e ...))))
(define infoss
(syntax-parse infos
#:literals (#%values)
[((#%values (si ...))) (syntax->list #'(si ...))]
[_ (list infos)]))
(if (= (length infoss) number-of-vals)
infoss
(for/list ([idx (in-range number-of-vals)])
#'())))]
[else (for/list ([lhs-e (in-list (syntax->list #'(lhs-e ...)))])
#'())])
#:with (static-infos ...) (normalize-static-infos/values
(length lhs-parsed-stxes)
(or (syntax-local-static-info #'rhs #'#%sequence-element)
(syntax-local-static-info #'rhs #'#%index-result)
#'()))
#:with (lhs-impl::binding-impl ...) #'((lhs-e.infoer-id static-infos lhs-e.data)...)
#:with (lhs-i::binding-info ...) #'(lhs-impl.info ...)
#:with (form-id . _) orig-stx
Expand Down
25 changes: 24 additions & 1 deletion rhombus/private/static-info.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,8 @@
"introducer.rkt"
"srcloc.rkt")
"expression.rkt"
"indirect-static-info-key.rkt")
"indirect-static-info-key.rkt"
"values-key.rkt")

;; Represent static information in either of two ways:
;;
Expand All @@ -27,6 +28,8 @@
:static-info
syntax-local-static-info
extract-static-infos
normalize-static-infos
normalize-static-infos/values
unwrap-static-infos
discard-static-infos
relocate-wrapped
Expand Down Expand Up @@ -106,6 +109,26 @@
(cons #'form (loop #'e #t))]
[_ null])))

(define (normalize-static-infos infos)
(car (normalize-static-infos/values 1 infos)))

(define (normalize-static-infos/values num infos)
(define infoss
(syntax-parse infos
#:literals (#%values)
[((#%values (si ...))) (syntax->list #'(si ...))]
[_ (list infos)]))
(if (eqv? (length infoss) num)
(for/list ([infos (in-list infoss)])
(let loop ([infos infos])
(syntax-parse infos
#:literals (#%values)
[((#%values (only-infos))) (loop #'only-infos)]
[((#%values _)) #'()]
[_ infos])))
(for/list ([_ (in-range num)])
#'())))

(define (unwrap-static-infos e)
(syntax-parse e
#:literals (begin quote-syntax)
Expand Down
45 changes: 45 additions & 0 deletions rhombus/tests/def.rhm
Original file line number Diff line number Diff line change
Expand Up @@ -54,3 +54,48 @@ check:
"1st",
"matching(1)",
)

check:
use_static
def str = (fun () :: String: "a string")()
str.length()
~is 8

check:
use_static
def str = (fun () :: (String): "a string")()
str.length()
~is 8

check:
use_static
def (str) = (fun () :: String: "a string")()
str.length()
~is 8

check:
use_static
def (str) = (fun () :: (String): "a string")()
str.length()
~is 8

check:
~eval
use_static
def str = (fun () :~ (String, String): "a string")()
str.length()
~throws "no such field or method (based on static information)"

check:
~eval
use_static
def (str) = (fun () :~ (String, String): "a string")()
str.length()
~throws "no such field or method (based on static information)"

check:
~eval
use_static
def (str, _) = (fun () :~ String: values("a string", "another"))()
str.length()
~throws "no such field or method (based on static information)"

0 comments on commit 5a0765f

Please sign in to comment.