private/frtime/demos/spreadsheet/preprocessor2.ss
(module preprocessor2 mzscheme
  
  (require (lib "string.ss")
           (lib "etc.ss")
           )
  
  (define (drop l n)
    (if (zero? n)
        l
        (drop (cdr l) (sub1 n))))
  
  (define (caddddr lst)
    (car (cdr (cdr (cdr (cdr lst))))))
  
  (define (first lst)
    (car lst))
  
  (define (take l n)
    (if (zero? n)
        '()
        (cons (car l)
              (take (cdr l)
                    (sub1 n)))))
  
  ;; ('a -> bool) * 'a list -> (#f or num)
  (define position-of-first-satisfied-in-list
    (lambda (pred l)
      (let loop ((i 0) (l l))
        (if (null? l) #f
            (if (pred (car l)) i
                (loop (+ i 1) (cdr l)))))))
  
  (define position-of-object-in-list
    (lambda (o l)
      (position-of-first-satisfied-in-list (lambda (x)
                                             (eqv? o x))
                                           l)))
  
  (define capitals
    '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))
  
  (define lower-case
    (let loop ([i 97])
      (if (<= i 122)
          (cons (integer->char i)
                (loop (add1 i)))
          '())))
  
  (define digits
    '(#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\0))
  
  (define (contains? i lst)
    (and (not (null? lst))
         (or (equal? i (car lst))
             (contains? i (cdr lst)))))
  
  (define (capital? char)
    (contains? char capitals))
  (define (lower-case? char)
    (contains? char lower-case))
  (define (digit? char)
    (contains? char digits))
  (define (letter? char)
    (or (capital? char)
        (lower-case? char)))
  
  (define-struct cell-reference (row1 ; num
                                 row2 ; num
                                 row-absolute? ; bool
                                 col1 ; num
                                 col2 ; num
                                 col-absolute? ; bool
                                 ))
  
  (define (capital->col-num char)
    (- (char->integer char)
       65))
  
  (define (lower-case->col-num char)
    (- (char->integer char)
       97))      
  
  #;(define (letter->col-num char)
      (if (capital? char)
          (capital->row-num char)
          (lower-case->row-num char)))
  
  (define (digit->row-num char)
    (- (char->integer char)
       48))
  
  #;(define (letter-list->col-num llst)
      (let loop ([num -1]
                 [lst llst])
        (cond [(null? lst)
               num]
              [(capital? (car lst))
               (loop (+ (* (add1 num) 26)
                        (capital->row-num (car lst)))
                     (cdr lst))]
              [(lower-case? (car lst))
               (loop (+ (* (add1 num) 26)
                        (lower-case->col-num (car lst)))
                     (cdr lst))])))
  
  (define (digit-list->row-num nlist)
    (let loop ([num 0]
               [lst nlist])
      (cond [(null? lst)
             num]
            [(digit? (car lst))
             (loop (+  (* num 10)
                       (digit->row-num (car lst)))
                   (cdr lst))])))
  
  (define NOT-A-CELL-REFERENCE #f)
  
  ;; char list -> cell-reference
  (define (parse-ref char-list)
    (let loop ([lst char-list]
               [reading-col-section #t]
               [row1 #f]
               [row2 #f]
               [row-absolute? #f]
               [col1 #f]
               [col2 #f]
               [col-absolute? #f])
      (cond [(null? lst)
             (if (and row1 row2 col1 col2 (not reading-col-section))
                 (make-cell-reference row1 row2 row-absolute? col1 col2 col-absolute?)
                 NOT-A-CELL-REFERENCE)]
            [reading-col-section
             (cond [(equal? (car lst)
                            #\$)
                    (if (or col1 col-absolute?) ;; then already hit first $, so this must refer to numbers
                        (loop lst #f row1 row2 row-absolute? col1 col2 col-absolute?)
                        (loop (cdr lst)
                              #t
                              row1 row2 row-absolute?
                              col1 col2
                              #t))]
                   [(letter? (car lst))
                    (let ([next (position-of-first-satisfied-in-list 
                                 (lambda (o)
                                   (or (equal? o #\$)
                                       (equal? o #\:)
                                       (digit? o)))
                                 lst)])
                      (if col1
                          (if next
                              (if (equal? 'invalid
                                          (letter-list->col-num (take lst
                                                                      next)))
                                  NOT-A-CELL-REFERENCE
                                  (loop (drop lst next)
                                        #t ; should get switched in next iteration
                                        row1 row2 row-absolute? 
                                        col1 
                                        (letter-list->col-num (take lst
                                                                    next)) 
                                        col-absolute?))
                              NOT-A-CELL-REFERENCE
                              )
                          (if next
                              (if (equal? 'invalid
                                          (letter-list->col-num (take lst
                                                                      next)))
                                  NOT-A-CELL-REFERENCE
                                  (loop (drop lst
                                              next)
                                        #t
                                        row1 row2 row-absolute?
                                        (letter-list->col-num (take lst
                                                                    next))
                                        (letter-list->col-num (take lst next))
                                        col-absolute?))
                              NOT-A-CELL-REFERENCE
                              )))]
                   [(equal? (car lst) #\:)
                    (if col1
                        (loop (cdr lst) #t row1 row2 row-absolute? col1 col2 col-absolute?)
                        NOT-A-CELL-REFERENCE)]
                   [(digit? (car lst))
                    (loop lst #f row1 row2 row-absolute? col1 col2 col-absolute?)]
                   [else NOT-A-CELL-REFERENCE])]
            [else ; reading NUMBER/ROW section section
             (cond [(equal? (car lst)
                            #\$)
                    (loop (cdr lst) #f row1 row2 #t col1 col2 col-absolute? ;!!
                          )]
                   [(digit? (car lst))
                    (let ([next (position-of-first-satisfied-in-list
                                 (lambda (o)
                                   (not (digit? o)))
                                 lst)])
                      (if row1
                          (if next
                              NOT-A-CELL-REFERENCE
                              (loop '()
                                    #f
                                    row1 
                                    (digit-list->row-num lst)
                                    row-absolute?
                                    col1 col2 col-absolute?))
                          (if next
                              (loop (drop lst next)
                                    #f
                                    (digit-list->row-num (take lst next))
                                    (digit-list->row-num (take lst next))
                                    row-absolute?
                                    col1 col2 col-absolute?)
                              (loop '()
                                    #f
                                    (digit-list->row-num lst)
                                    (digit-list->row-num lst)
                                    row-absolute?
                                    col1 col2 col-absolute?))))]
                   [(equal? (car lst)
                            #\:)
                    (loop (cdr lst) #t
                          row1 row2 row-absolute?
                          col1 col2 col-absolute?)]
                   [else
                    NOT-A-CELL-REFERENCE])])))
  
  ;
  ;(define pt1 '(#\a #\b #\1 #\2))
  ;(define pt1- (make-cell-reference 12 12 #f 27 27 #f))
  ;(define pt2 '(#\$ #\a #\b #\4))
  ;(define pt2- (make-cell-reference 4 4 #f 27 27 #t))
  ;(define pt3 '(#\a #\$ #\4))
  ;(define pt3- (make-cell-reference 4 4 #t 0 0 #f))
  ;(define pt4 '(#\a #\: #\e #\5))
  ;(define pt4- (make-cell-reference 5 5 #f 0 4 #f))
  ;(define pt5 '(#\z #\1 #\: #\8))
  ;(define pt5- (make-cell-reference 1 8 #f 25 25 #f))
  ;(define pt6 '(#\$ #\a #\: #\d #\1))
  ;(define pt6- (make-cell-reference 1 1 #f 0 3 #t))
  ;(define pt7 '(#\$ #\a #\$ #\0))
  ;(define pt7- (make-cell-reference 0 0 #t 0 0 #t))
  ;
  ;(define (equal-cell-refs? c1 c2)
  ;  (and (equal? (cell-reference-row1 c1)
  ;               (cell-reference-row1 c2))
  ;       (equal? (cell-reference-row2 c1)
  ;               (cell-reference-row2 c2))
  ;       (equal? (cell-reference-row-absolute? c1)
  ;               (cell-reference-row-absolute? c2))
  ;       (equal? (cell-reference-col1 c1)
  ;               (cell-reference-col1 c2))
  ;       (equal? (cell-reference-col2 c1)
  ;               (cell-reference-col2 c2))
  ;       (equal? (cell-reference-col-absolute? c1)
  ;               (cell-reference-col-absolute? c2))))
  ;
  ;(equal-cell-refs? (parse-ref pt1) pt1-)
  ;(equal-cell-refs? (parse-ref pt2) pt2-)
  ;(equal-cell-refs? (parse-ref pt3) pt3-)
  ;(equal-cell-refs? (parse-ref pt4) pt4-)
  ;(equal-cell-refs? (parse-ref pt5) pt5-)
  ;(equal-cell-refs? (parse-ref pt6) pt6-)
  ;(equal-cell-refs? (parse-ref pt7) pt7-)
  
  
  (define mapped-symbols
    '(+
      length
      =
      if
      quote
      *
      seconds
      add1
      map))  
  
  
  ;process: sexp symbol symbol symbol symbol num num -> sexp
  ;INPUT: An expression EXPR, the name of lookup procedures LOOKUP, LOOKUP-ROW, LOOKUP-COL, LOOKUP-MATRIX and the current row and column
  ; for the cell being processed, ROW and COL.
  ;OUTPUT: blah blah blah
  (define (process expr lookup lookup-row lookup-col lookup-matrix row col)
    (define (cell-ref->sexp cref c-row c-col)
      ;; cell-reference * num * num -> sexp
      (let ([ref-row1 (cell-reference-row1 cref)]
            [ref-col1 (cell-reference-col1 cref)]
            [ref-row2 (cell-reference-row2 cref)]
            [ref-col2 (cell-reference-col2 cref)]
            [row-ref-expr (lambda (n)
                            (if (cell-reference-row-absolute? cref)
                                n
                                (list '+ 'row (- n c-row))))]
            [col-ref-expr (lambda (n)
                            (if (cell-reference-col-absolute? cref)
                                n
                                (list '+ 'col (- n c-col))))])
        (if (not (= ref-row1 ref-row2))
            (if (not (= ref-col1 ref-col2))
                (list lookup-matrix 
                      (row-ref-expr ref-row1)
                      (row-ref-expr ref-row2)
                      (col-ref-expr ref-col1)
                      (col-ref-expr ref-col2))
                (list lookup-col 
                      (row-ref-expr ref-row1)
                      (row-ref-expr ref-row2)
                      (col-ref-expr ref-col1)))
            (if (not (= ref-col1 ref-col2))
                (list lookup-row
                      (row-ref-expr ref-row1)
                      (col-ref-expr ref-col1)
                      (col-ref-expr ref-col2))
                (list lookup
                      (row-ref-expr ref-row1)
                      (col-ref-expr ref-col1))))))
    ;; end of cell reference handling
    (cond [(symbol? expr)
           (let ([parsed (parse-ref (string->list (symbol->string expr)))])
             (cond [parsed (cell-ref->sexp parsed row col)]
                   [else ;; currently allowing all symbols.
                    expr]))]
          [(list? expr)
           (if (and (not (null? expr))
                    (equal? 'quote (car expr)))
               expr
               (map (lambda (sexp)
                      (process sexp lookup lookup-row lookup-col lookup-matrix row col))
                    expr))]
          [else expr]))
  
  
  
  
  ;(define t1 "a:zz$1")
  ;(define t2 "length")
  ;(define t3 "(+ 3 4)")
  ;(define t4 "(+ 2 a3)")
  ;(define t5 "(if (= 3 (length A1)) (a2 $A3) 'dont-see)")
  ;(define t6 "(ZD941 A:d3:40)")
  ;
  ;(define p (lambda (e)
  ;            (process (read (open-input-string e)) 'lookup 'lookup-row 'lookup-col 'lookup-matrix 1 1)))
  ;t1 (p t1)
  ;t2 (p t2)
  ;t3 (p t3)
  ;t4 (p t4)
  ;t5 (p t5)
  ;t6 (p t6)
  
  
  ;;  ISSUES:
  ;;     - When going from cell-references to symbols, be careful about LETTERS referring to COLUMNS
  ;;       and NUMBERS referring to ROWS.  Some procedures are still BROKEN because of this.
  ;;    
  ;;     - Now a lookup expression has more information about what sort of region it is looking up
  ;;       (singleton, row, column, matrix).  Use this when converting from lookup expressions to
  ;;       cell references.
  ;;
  ;;     - Now that lookup expressions contain all the information contained within cell references,
  ;;       the intermediate step between expressions and cell references is UNNECESSARY.  I should
  ;;       have procedure's LOOKUP-EXPR->SYMBOL that take care of everything for the UNPROCESSOR.
  ;;
  (define (letter-list->col-num llst)
    (let ([col-num (let loop ([num -1]
                              [lst llst])
                     (cond [(null? lst)
                            num]
                           [(capital? (car lst))
                            (loop (+ (* (add1 num) 26)
                                     (capital->col-num (car lst)))
                                  (cdr lst))]
                           [(lower-case? (car lst))
                            (loop (+ (* (add1 num) 26)
                                     (lower-case->col-num (car lst)))
                                  (cdr lst))]))])
      (if (>= col-num 702)
          'invalid
          col-num)))
  
  ; num -> char list
  (define (col-num->letter-list n)
    (let loop ([num n]
               [lst '()])
      (cond [(= -1 num)
             lst]
            [else (loop (sub1 (quotient num 26))
                        (cons (integer->char (+ 97 (remainder num 26)))
                              lst))])))
  
  ; num -> char list
  (define (row-num->digit-list n)
    (define help 
      (lambda (n)
        (let ([r (remainder n 10)]
              [q (quotient n 10)])
          (if (zero? q)
              (list (integer->char (+ 48 n)))
              (cons (integer->char (+ 48 r))
                    (help q))))))
    (reverse (help n)))
  
  
  
  (define (lookup-expr->symbol expr local-row local-col)
    (let* ([row-expr (cadr expr)]
           [col-expr (caddr expr)]
           [row-chars (cond [(number? row-expr)
                             (cons #\$
                                   (row-num->digit-list row-expr))]
                            [(list? row-expr)
                             (row-num->digit-list (+ local-row
                                                     (caddr row-expr)))])]
           [col-chars (cond [(number? col-expr)
                             (cons #\$
                                   (col-num->letter-list col-expr))]
                            [(list? col-expr)
                             (col-num->letter-list (+ local-col
                                                      (caddr col-expr)))])])
      
      (string->symbol (list->string (append col-chars
                                            row-chars)))))
  
  (define (lookup-row-expr->symbol expr local-row local-col)
    (let* ([row-expr (cadr expr)]
           [col1-expr (caddr expr)]
           [col2-expr (cadddr expr)]
           [row-chars (cond [(number? row-expr)
                             (cons #\$
                                   (row-num->digit-list row-expr))]
                            [(list? row-expr)
                             (row-num->digit-list (+ local-row
                                                     (caddr row-expr)))])]
           [col1-chars (cond [(number? col1-expr)
                              (cons #\$
                                    (col-num->letter-list col1-expr))]
                             [(list? col1-expr)
                              (col-num->letter-list (+ local-col
                                                       (caddr col1-expr)))])]
           [col2-chars (cons #\:
                             (cond [(number? col2-expr)
                                    (col-num->letter-list col2-expr)]
                                   [(list? col2-expr)
                                    (col-num->letter-list (+ local-col
                                                             (caddr col2-expr)))]))])
      (string->symbol (list->string (append col1-chars
                                            col2-chars
                                            row-chars)))))
  
  (define (lookup-col-expr->symbol expr local-row local-col)
    (let* ([row1-expr (cadr expr)]
           [row2-expr (caddr expr)]
           [col-expr (cadddr expr)]
           [row1-chars (cond [(number? row1-expr)
                              (cons #\$
                                    (row-num->digit-list row1-expr))]
                             [(list? row1-expr)
                              (row-num->digit-list (+ local-row
                                                      (caddr row1-expr)))])]
           [row2-chars (cons #\:
                             (cond [(number? row2-expr)
                                    (row-num->digit-list row2-expr)]
                                   [(list? row2-expr)
                                    (row-num->digit-list (+ local-row
                                                            (caddr row2-expr)))]))]
           [col-chars (cond [(number? col-expr)
                             (cons #\$
                                   (col-num->letter-list col-expr))]
                            [(list? col-expr)
                             (col-num->letter-list (+ local-col
                                                      (caddr col-expr)))])])
      
      (string->symbol (list->string (append col-chars
                                            row1-chars
                                            row2-chars)))))
  
  (define (lookup-matrix-expr->symbol expr local-row local-col)
    (let* ([row1-expr (cadr expr)]
           [row2-expr (caddr expr)]
           [col1-expr (cadddr expr)]
           [col2-expr (caddddr expr)]
           [row1-chars (cond [(number? row1-expr)
                              (cons #\$
                                    (row-num->digit-list row1-expr))]
                             [(list? row1-expr)
                              (row-num->digit-list (+ local-row
                                                      (caddr row1-expr)))])]
           [row2-chars (cons #\:
                             (cond [(number? row2-expr)
                                    (row-num->digit-list row2-expr)]
                                   [(list? row2-expr)
                                    (row-num->digit-list (+ local-row
                                                            (caddr row2-expr)))]))]
           [col1-chars (cond [(number? col1-expr)
                              (cons #\$
                                    (col-num->letter-list col1-expr))]
                             [(list? col1-expr)
                              (col-num->letter-list (+ local-col
                                                       (caddr col1-expr)))])]
           [col2-chars (cons #\:
                             (cond [(number? col2-expr)
                                    (col-num->letter-list col2-expr)]
                                   [(list? col2-expr)
                                    (col-num->letter-list (+ local-col
                                                             (caddr col2-expr)))]))])
      (string->symbol (list->string (append col1-chars
                                            col2-chars
                                            row1-chars
                                            row2-chars)))))
  
  
  
  ; sexp * symbol * symbol *symbol *symbol num * num -> sexp
  (define (unprocess expr lookup lookup-row lookup-col lookup-matrix local-row local-col)
    (cond [(list? expr)
           (cond [(null? expr)
                  '()]
                 [(equal? (first expr) lookup)
                  (lookup-expr->symbol expr local-row local-col)]
                 [(equal? (first expr) lookup-row)
                  (lookup-row-expr->symbol expr local-row local-col)]
                 [(equal? (first expr) lookup-col)
                  (lookup-col-expr->symbol expr local-row local-col)]
                 [(equal? (first expr) lookup-matrix)
                  (lookup-matrix-expr->symbol expr local-row local-col)]
                 [(equal? (first expr) 'quote)
                  expr]
                 [else
                  (map (lambda (e)
                         (unprocess e lookup lookup-row lookup-col
                                    lookup-matrix local-row local-col))
                       expr)])]
          [else
           expr]))
  ;              
  ;(define te1
  ;  '((lookup 3 4)
  ;    '(lookup 3 4)
  ;    (1 2 (lookup 0 0))
  ;    (lookup-matrix (+ row 0) (+ row 5) (+ col 2) (+ col 5))
  ;    (lookup-row 5 (+ col 1) (+ col 20))
  ;    (lookup-col 3  39 (+ col 0))))
  ;
  ;(unprocess te1
  ;           'lookup
  ;           'lookup-row
  ;           'lookup-col
  ;           'lookup-matrix
  ;           1
  ;           1)
  
  
  (provide process unprocess)
  
  )