Arc Forumnew | comments | leaders | submitlogin
2 points by thaddeus 5584 days ago | link | parent

BTW I just got a chance to look at this tonight. I changed it a little so that $ would work with '!' and '.'

Again thanks for the help! T.

  (define (has-ssyntax-char? string i)
    (and (>= i 0)
         (or (let ((c (string-ref string i)))
               (or (eqv? c #\:) (eqv? c #\~) 
                   (eqv? c #\&)
                   (eqv? c #\$)                
                   ;(eqv? c #\_) 
                   (eqv? c #\.)  (eqv? c #\!)))
             (has-ssyntax-char? string (- i 1)))))


  (define (expand-ssyntax sym)
    ((cond ((or (insym? #\: sym) (insym? #\~ sym)) expand-compose)
           ((or (insym? #\. sym) (insym? #\! sym)(insym? #\$ sym)) expand-sexpr)
           ((insym? #\& sym) expand-and)
     ;     ((insym? #\_ sym) expand-curry)
           (#t (error "Unknown ssyntax" sym)))
     sym))

  (define (expand-sexpr sym)
    (build-sexpr (reverse (tokens (lambda (c) (or (eqv? c #\.) (eqv? c #\!)(eqv? c #\$)))
                                  (symbol->chars sym)
                                  '()
                                  '()
                                  #t))
                 sym))


  (define (build-sexpr toks orig)
    (cond ((null? toks)
           'get)
          ((null? (cdr toks))
           (chars->value (car toks)))
          (#t
           (list (build-sexpr (cddr toks) orig)
                 (cond ((eqv? (cadr toks) #\!)
                        (list 'quote (chars->value (car toks))))
                       ((eqv? (cadr toks) #\$)
                        (list 'sym (chars->value (car toks))))
                       ((or (eqv? (car toks) #\.) (eqv? (car toks) #\!)(car toks) #\$))
                         (err "Bad ssyntax" orig))
                       (#t (chars->value (car toks))))))))