Functional Programming
11. Program Transformation



11.1 Processing Scheme with Scheme

The syntax for Scheme naturally lends itself to processing by Scheme programs, sicne a Scheme program is a list.

We are now going to look at how to manipulate Scheme programs as data. We begin with the taks of simply walking over the list that represents the parse tree of a Scheme program. code/StateScheme/WalkOverExpression.rkt

    #lang racket
     
    ; (walk-over-expression expr)
     
    ; recursor, walk over and accumulate results, in this case just reconstruct
    ; the expression
    (define walk-over-r
      (lambda (accum expr)
        (cond  
          ( (not (list? expr)) 
            ; handle simple atomic term here
            expr
           )
          (  (null? expr)
             ; handle empty list here
             accum
             )
          (#t 
           ; handle list here
           (map (lambda (e) (walk-over-r '() e)) expr)
           )
          )
        
        ))
     
    (define walk-over
      (lambda (expr)
        (walk-over-r '() expr)
        ))
     
    (walk-over '())
    (walk-over 'a)
    (walk-over '(a b c))
    (walk-over '(lambda () x))
    (walk-over '(lambda (x) x))
    (walk-over '(lambda (x y) x))
    (walk-over '(lambda (x) (lambda (y) x y)))
    (walk-over '(lambda (x) (lambda (y) x y (lambda (z) (lambda (y) x y)))))


11.2 Threading State Through a Traversal

Now we walk over the expression tree but pass state in and out of the recursion so that we can maintain a global piece of state. This global piece is the sequence number of the next token. code/StateScheme/ThreadedWalkOverExpression.rkt

    #lang racket
     
    ; Example of threading state through a recursively decomposed problem.
     
    ; Problem: go through a list (utimately an expression to be transformed)
    ; and sequentially number each token encountered in the left to right
    ; depth-first traversal of the list.
    ; 
    ; For example:
    ; (walk-over '( (a b ( c d ) e ) f ( g h (i ( j k ( l m ) ) ) ) n ) )
    ; geneates this result:
    ; ((a-0 b-1 (c-2 d-3) e-4) f-5 (g-6 h-7 (i-8 (j-9 k-10 (l-11 m-12)))) n-13)
     
    ; The recursor takes state-in (a list) and an expression and returns
    ; a list (state-out result)
    ; 
    ; (walk-over-expression-r state-in expr) -> (state-out result)
     
    ; The state is very simple, consisting of a 1-element list, where the 
    ; element is the sequence number for the next symbol.
     
    (define walk-over-r
      (lambda (state-in expr)
        (cond  
          ( (not (list? expr)) 
            ; handle simple atomic term here, use new symbol number and update
            ; the next symbol number
            (list (list (+ 1 (first state-in)))
                  (string->symbol (string-append  (symbol->string expr) "-" 
                           (number->string (first state-in)) ) ))
           )
          (#t 
           ; handle list here, use fold to thread previous results 
            (foldl 
             ; e is the current element to be processed
             ; fold-state is a list (state-in current-fold-results)
             
             (lambda (e fold-state) 
               (let ( [ e-result (walk-over-r (first fold-state) e) ] )
                 ; now construct new fold state to pass along consisting of
                 ; updated state and appending modified expression to the 
                 ; current-fold-results
                 (list (first e-result) 
                       (append (second fold-state) (list (second e-result)))
                  )
               )
               )
             
             (list state-in '()) ; initial state and result
             expr
            )
           )
          )
        )
        )
     
    (define walk-over
      (lambda (expr)
        (second (walk-over-r '(0) expr))
        
        ; To see what the final state is, use this variant
        ; (walk-over-r '(0) expr)
        ))
     
     
     
    (walk-over '())
    (walk-over 'a)
    (walk-over '(a b c))
    (walk-over '(lambda () x))
    (walk-over '(lambda (x) x))
    (walk-over '(lambda (x y) x))
    (walk-over '(lambda (x) (lambda (y) x y)))
    (walk-over '(lambda (x) (lambda (y) x y (lambda (z) (lambda (y) x y)))))
    (walk-over '( (a b ( c d ) e ) f ( g h (i ( j k ( l m ) ) ) ) n ) )


11.3 A Simple Calculator Example

This example shows how to build up the evaluation of a calculator that has variables that can be assigned values and used later (in depth-first order) in the expression. code/StateScheme/CalculatorV1.rkt

    #lang racket
     
    ; First cut at evaluator for simple arithmetic expression trees.  In this
    ; version we do not need any global state.  But in the next version with 
    ; variables we will.
     
    (define evaluate-expression-r
      (lambda (state-in expr)
        (cond  
          ( (not (list? expr)) 
            ; handle simple atomic term here, use new symbol number and update
            ; the next symbol number
            (list state-in expr)
           )
          (#t 
            ; handle list here, use fold to thread previous results
            ; fold-state is a list of threaded state (unused) and a list 
            ; containing the value of the expressions that are the subtrees 
            ; of the current expression.   There should be two values on the 
            ; latter list when the recursion encounters an operation
          
            (foldl 
            (lambda (e fold-state) 
               (let ( [ e-result (evaluate-expression-r (first fold-state) e) ] )
                 ; now pass on state and augmented result
                 (list (first e-result) ; state-out
                       (if (equal? e 'PLUS)
                           ; if at a plus, the first 2 items on the previous 
                           ; results list are the values to be added.  
                           (+ (first (second fold-state)) 
                              (second (second fold-state)))
                           
                           ; If not a plus, we have an expression evaluation 
                           ; result to save.
                           (append (second fold-state) (list (second e-result)))
                           )
                  )
               )
               )
             
             (list state-in '()) ; initial state and result
             expr
            )
           )
          )
        )
        )
     
    (define evaluate-expression
      (lambda (expr)
        (second (evaluate-expression-r '() expr))
        ))
     
     
     
    (evaluate-expression 1)
    (evaluate-expression '( (42 10 PLUS) (1 3 PLUS) PLUS))
    (evaluate-expression 
        '( ((42 10 PLUS) (1 3 PLUS) PLUS) ((2 4 PLUS) (8 16 PLUS) PLUS) PLUS))
     
And here it is with extensions for variables. code/StateScheme/CalculatorV2.rkt

    #lang racket
     
    ; Evaluator for simple arithmetic expression trees.  In this
    ; version we use global state containing a hash to keep track 
    ; of current variable values.
     
    ; the global state is a list consisting of one element: an immutable hash
     
    (define evaluate-expression-r
      (lambda (state-in expr)
        (cond  
          ( (not (list? expr)) 
            ; handle simple atomic term here, use new symbol number and update
            ; the next symbol number
            (list state-in (lookup-value state-in expr))
           )
          (#t 
            ; handle list here, use fold to thread previous results
            ; fold-state is a list of state followed by a list containing 
            ; the value of the expressions that are the subtrees of the 
            ; current expression.   There should be two values on the latter 
            ; list when the recursion encounters an operation
          
            (foldl 
            (lambda (e fold-state) 
               (let ( [ e-result (evaluate-expression-r (first fold-state) e) ] )
                 ; now pass on state and augmented result
                       (cond
                           ( (equal? e 'PLUS)
                           ; if at a plus, the first 2 items on the previous 
                           ; results list are the values to be added. 
                             (list (first e-result)
                                   (+ (first (second fold-state)) 
                                      (second (second fold-state)))
                                   )
                             )
                           
                           ( (equal? e 'ASSIGN)
                             ; if at an assignment, the first element is 
                             ; assigned to be the value of the 
                             ; variable in the second list element.
                             (list (list (dict-set (first (first e-result))
                                           (second (second fold-state)) 
                                           (first (second fold-state))) )
                                   (first (second fold-state)) )
                             )
                           
                           (#t 
                             ; If not a plus or assignment, we have an 
                             ; expression evaluation result to save.
                             (list (first e-result)
                                   (append (second fold-state) 
                                           (list (second e-result)))
                             )
                           )
                           )
                  
               )
               )
             
             (list state-in '()) ; initial state and result
             expr
            )
           )
          )
        )
        )
     
    (define evaluate-expression
      (lambda (expr)
        (second (evaluate-expression-r (list (make-immutable-hash '()) ) expr))
        ))
     
    ; look up value of identifier exp in the hash contained in the state, 
    ; if not present return the identifier
    (define lookup-value
      (lambda (state-in exp)
        (hash-ref (first state-in) exp exp)
        )
      )
     
     
    (evaluate-expression 1)
    (evaluate-expression '( (42 10 PLUS) (1 3 PLUS) PLUS))
    (evaluate-expression 
        '( ((42 10 PLUS) (1 3 PLUS) PLUS) ((2 4 PLUS) (8 16 PLUS) PLUS) PLUS))
    (evaluate-expression '( (2 A ASSIGN) (A A PLUS) PLUS ) )
    (evaluate-expression 
        '( ( 100 ( (((40 2 PLUS) A ASSIGN) A PLUS) B ASSIGN) PLUS ) (B A PLUS) PLUS) )
     
    ; and this surprising one
    (evaluate-expression '( (2 1 ASSIGN) 1 PLUS ) )
     
    ;(define h (make-immutable-hash '()))
    ;(define h1 (dict-set h 'a 21))
    ;(define h2 (dict-set h1 'b 42))
    ;(hash-ref h1 'a 99)
    ;(hash-ref h1 'b 99)
    ;(hash-ref h2 'b 99)
11. Program Transformation
Notes on Functional Programming / Version 2.08 2014-02-10