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

[function] really working

Browse Source
This commit is contained in:
ben 2016-03-19 23:44:00 -04:00
parent 23d776fd7c
commit d82c256cf7
1 changed files with 2 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
trivial/private/function.rkt
View File

@ -38,14 +38,12 @@
(define (formal->type x) (define (formal->type x)
(or (syntax-property x TYPE-KEY) (or (syntax-property x TYPE-KEY)
;(syntax/loc x Any)))
(format-id x "Any"))) ;; Could just use TR's Any from here (format-id x "Any"))) ;; Could just use TR's Any from here
(define (parse-procedure-arity stx) (define (parse-procedure-arity stx)
(syntax-parse stx #:literals (: #%plain-lambda lambda) (syntax-parse stx #:literals (: #%plain-lambda lambda)
[(#%plain-lambda (x*:id ...) e* ...) [(#%plain-lambda (x*:id ...) e* ...)
(map formal->type (syntax-e #'(x* ...)))] (map formal->type (syntax-e #'(x* ...)))]
;(syntax/loc stx (x* ...))]
;; TODO polydots, keywords, optional args ;; TODO polydots, keywords, optional args
;; TODO standard library functions ;; TODO standard library functions
[_ #f])) [_ #f]))
@ -62,11 +60,11 @@
(syntax-parse stx (syntax-parse stx
[(_ p:procedure/arity) [(_ p:procedure/arity)
#:with x* (for/list ([_t (in-list (syntax-e #'p.evidence))]) (gensym)) #:with x* (for/list ([_t (in-list (syntax-e #'p.evidence))]) (gensym))
#:with p+ (for/fold ([e (quasisyntax/loc stx (p.expanded #,#'x*))]) #:with p+ (for/fold ([e (quasisyntax/loc stx (p.expanded #,@#'x*))])
([x (in-list (reverse (syntax-e #'x*)))] ([x (in-list (reverse (syntax-e #'x*)))]
[t (in-list (syntax-e #'p.evidence))]) [t (in-list (syntax-e #'p.evidence))])
(quasisyntax/loc stx (quasisyntax/loc stx
(lambda (#,x) #,e))) (lambda ([#,x : #,t]) #,e)))
(syntax/loc stx p+)] (syntax/loc stx p+)]
[_ [_
(raise-user-error 'curry "Fail at: ~a" (syntax->datum stx))])) (raise-user-error 'curry "Fail at: ~a" (syntax->datum stx))]))