(module assignment mzscheme
  (require (lib "list.ss"))
  
  ;; Assignment macro; meant to act a bit like setf.
  (define-syntax (<- stx)
    (let ([build-assignment-stx
           (lambda (lhs-stx rhs-stx)
             (with-syntax ([rhs rhs-stx])
               (syntax-case lhs-stx (list-ref
                                     car first
                                     cdr rest
                                     vector-ref
                                     string-ref
                                     bytes-ref)
                 [id
                  (identifier? #'id)
                  (syntax/loc stx
                    (set! id rhs))]
                 
                 [(car a-pair)
                  (syntax/loc stx
                    (set-car! a-pair rhs))]
                 
                 [(first a-pair)
                  (syntax/loc stx
                    (set-car! a-pair rhs))]
                 
                 [(cdr a-pair)
                  (syntax/loc stx
                    (set-cdr! a-pair rhs))]
                 
                 [(rest a-pair)
                  (syntax/loc stx
                    (set-cdr! a-pair rhs))]
                 
                 [(list-ref l index)
                  (syntax/loc stx
                    (set-car! (list-tail l index) rhs))]
                 
                 [(vector-ref v index)
                  (syntax/loc stx
                    (vector-set! v index rhs))]
                 
                 [(string-ref s index)
                  (syntax/loc stx
                    (string-set! s index rhs))]
                 
                 [(bytes-ref b index)
                  (syntax/loc stx
                    (bytes-set! b index rhs))])))])
      
      (syntax-case stx ()
        [(_ lhs rhs)
         (cond
           [(and (identifier? #'lhs)
                 (set!-transformer? (syntax-local-value #'lhs)))
            (build-assignment-stx #'lhs #'rhs)]
           [else
            (build-assignment-stx (local-expand #'lhs
                                                'expression
                                                '(#%app
                                                  #%top
                                                  #%datum))
                                  #'rhs)])])))
  
  
  
  (provide <-))