suzanne.soy/trivial
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

[regexp] follow return type spec a little better

Browse Source
This commit is contained in:
ben 2016-03-20 13:00:38 -04:00
parent cd4fb63945
commit 4faad17905
2 changed files with 36 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
test/regexp-pass.rkt
View File

@ -259,4 +259,10 @@
#rx"^\\\\draw\\[.*\\]? *\\(([0-9]+)\\)[^(]*\\(([0-9]+)\\);$"]) #rx"^\\\\draw\\[.*\\]? *\\(([0-9]+)\\)[^(]*\\(([0-9]+)\\);$"])
(regexp-match: EDGE_REGEXP "bye") (regexp-match: EDGE_REGEXP "bye")
(void)) (void))
;; -- check return type "inference"
(check-equal?
(regexp-match: #rx"hello" #"world")
;; Would be a type error if we annotated wrong
#f)
) )

34
trivial/private/regexp.rkt
View File

@ -2,6 +2,16 @@
;; Stronger types for regular expression matching. ;; Stronger types for regular expression matching.
;; Specification:
;; - Racket docs:
;; http://docs.racket-lang.org/reference/regexp.html
;;
;; - Pregexp docs:
;; http://ds26gte.github.io/pregexp/index.html
;;
;; - Racket source:
;; https://github.com/racket/racket/blob/master/racket/src/racket/src/regexp.c
(provide (provide
regexp: regexp:
pregexp: pregexp:
@ -85,8 +95,7 @@
(or (or
(eq? #\? (string-ref str (+ i 1))) (eq? #\? (string-ref str (+ i 1)))
(eq? #\* (string-ref str (+ i 1))))) (eq? #\* (string-ref str (+ i 1)))))
;; Group is starred, can't predict num. matches statically ;; TODO starred group = may be #f
;; or ?'d
#f] #f]
[(null? in-paren) [(null? in-paren)
(group-error str (format "')' at index ~a" i))] (group-error str (format "')' at index ~a" i))]
@ -129,6 +138,22 @@
(define-values (rx-key rx? rx-define rx-let) (define-values (rx-key rx? rx-define rx-let)
(make-value-property 'rx:groups parse-groups)) (make-value-property 'rx:groups parse-groups))
(define-syntax-class/predicate pattern/groups rx?) (define-syntax-class/predicate pattern/groups rx?)
)
;; -----------------------------------------------------------------------------
;; --- Other helpers
(begin-for-syntax
(define (infer-return-type pattern-sym arg-stx)
(if (and
(or (eq? pattern-sym 'String)
(eq? pattern-sym 'Regexp))
(or (syntax-parse arg-stx
((x:str) #t)
((x) #:when (bytes? (syntax-e #'x)) #f)
(_ #t))))
'String
'Bytes))
) )
;; ----------------------------------------------------------------------------- ;; -----------------------------------------------------------------------------
@ -159,12 +184,13 @@
#:with (num-groups . type-sym) (syntax/loc stx pat.evidence) #:with (num-groups . type-sym) (syntax/loc stx pat.evidence)
;; TODO keep source location in type-sym, stop using format-id ;; TODO keep source location in type-sym, stop using format-id
;; (Is it really that bad?) ;; (Is it really that bad?)
#:with type (format-id stx "~a" (syntax-e #'type-sym)) #:with return-type (format-id stx "~a" (infer-return-type (syntax-e #'type-sym)
#'(arg* ...)))
#:with (index* ...) (for/list ([i (in-range (syntax-e #'num-groups))]) i) #:with (index* ...) (for/list ([i (in-range (syntax-e #'num-groups))]) i)
(syntax/loc stx (syntax/loc stx
(let ([maybe-match (regexp-match pat.expanded arg* ...)]) (let ([maybe-match (regexp-match pat.expanded arg* ...)])
(if maybe-match (if maybe-match
(let ([m : (Listof (Option type)) maybe-match]) (let ([m : (Listof (Option return-type)) maybe-match])
(list (car maybe-match) (list (car maybe-match)
(begin (set! m (cdr m)) (begin (set! m (cdr m))
(or (car m) (error 'regexp-match: (format "Internal error at result index ~a, try using Racket's regexp-match" 'index*)))) (or (car m) (error 'regexp-match: (format "Internal error at result index ~a, try using Racket's regexp-match" 'index*))))