diff --git a/remix/stx0.rkt b/remix/stx0.rkt index da740ce..6d7de4f 100644 --- a/remix/stx0.rkt +++ b/remix/stx0.rkt @@ -179,88 +179,17 @@ (syntax/loc stx (remix-cut (#%dot bodies ...)))]))]) -;; xxx actually implement cut with _ or $ as the var accessor -(define-syntax-parameter remix-cut-box - #f) - -(begin-for-syntax - (struct remix-cut-box-st ([round-two? #:mutable] arg-n->id)) - (define (argmax* f l) - (if (empty? l) - #f - (argmax f l))) - (define (remix-cut-box-st->args this-box the-stx-base) - (match-define (remix-cut-box-st _ arg-n->id) this-box) - (define max-arg-n - (argmax* (λ (x) x) (hash-keys arg-n->id))) - (printf "cut box -> args ~v\n" arg-n->id) - (cond - [max-arg-n - (for/list ([i (in-range (add1 max-arg-n))]) - (printf "arg ~v is...\n" i) - (define nr (format-id the-stx-base "cut-arg~a" i)) - (hash-set! arg-n->id i nr) - nr)] - [else - #'()])) - - (define (remix-cut-index->stx index-stx) - (match-define (remix-cut-box-st round-two? arg-n->id) - (syntax-parameter-value #'remix-cut-box)) - (syntax-parse index-stx - ;; xxx support keywords, rest, etc - [n:nat - (let () - (define nv (syntax->datum #'n)) - (define nr - (hash-ref! arg-n->id nv - (λ () - (printf "cut arg needed for index ~v\n" nv) - #t))) - (cond - [round-two? - (printf "really using it ~v\n" nr) - nr] - [else - (printf "not using it ~v\n" nr) - #'(error 'cut)]))]))) - -(define-syntax remix-cut-$ - (singleton-struct - #:property prop:procedure - (λ (_ stx) - (syntax-parse stx - [$:id - (syntax/loc stx - (#%dot $ 0))])) - #:methods gen:dot-transformer - [(define (dot-transform _ stx) - (syntax-parse stx - [(#%dot $:id index:expr) - (quasisyntax/loc stx - #,(remix-cut-index->stx #'index))] - ;; xxx test this - [(#%dot $:id index:expr more:expr ...) - (quasisyntax/loc stx - (#%dot #,(remix-cut-index->stx #'index) more ...))]))])) - -(require (for-syntax (for-syntax racket/base))) +;; xxx make this more powerful, like super-cut +(define-syntax-parameter remix-cut-$ + (λ (stx) + (raise-syntax-error '$ "illegal outside cut" stx))) (define-syntax (remix-cut stx) (syntax-parse stx [(_ body:expr) - (let () - (define this-box (remix-cut-box-st #f (make-hasheq))) - (define cut-body-stx - (quasisyntax/loc stx - (syntax-parameterize ([remix-cut-box #,this-box]) - body))) - (local-expand cut-body-stx 'expression '()) - (set-remix-cut-box-st-round-two?! this-box #t) - (define the-stx-base #'body) - (define cut-args (remix-cut-box-st->args this-box the-stx-base)) - (printf "args are ~v\n" cut-args) - (quasisyntax/loc stx - (remix-λ #,cut-args #,cut-body-stx)))])) + (syntax/loc stx + (remix-λ (x) + (syntax-parameterize ([remix-cut-$ (make-rename-transformer #'x)]) + body)))])) (define-syntax (remix-cond stx) (syntax-parse stx @@ -292,6 +221,7 @@ #%dot #%app #%datum + quote unquote module module* diff --git a/remix/tests/simple.rkt b/remix/tests/simple.rkt index 084b337..c451c1a 100644 --- a/remix/tests/simple.rkt +++ b/remix/tests/simple.rkt @@ -119,12 +119,12 @@ (def f11 λ.(+ 10 1)) (def v11 - (f11)) + (f11 'ignored)) (module+ test v11) (def v11b - (λ.(+ 10 1))) + (λ.(+ 10 1) 'ignored)) (module+ test v11b)