例如：
(* (* (* 1 2) 3) (* 4 5)) = (* 1 (* 2 (* 3 (* 4 5))))
我现在坐着试图弄清楚如何写这个程序几个小时，但我似乎无法让它工作。
由此产生的程序（但它没有按预期工作）：
(define interpret-arithmetic-expression_Magritte_bizarre
(lambda (e)
(cond
[(is-literal? e)
(make-literal (literal-1 e))]
[(is-plus? e)
(if (is-plus? (plus-1 e))
(make-plus (interpret-arithmetic-expression_Magritte_bizarre (plus-1 (plus-1 e)))
(make-plus (interpret-arithmetic-expression_Magritte_bizarre (plus-2 (plus-1 e)))
(interpret-arithmetic-expression_Magritte_bizarre (plus-2 e))))
(make-plus (interpret-arithmetic-expression_Magritte_bizarre (plus-1 e))
(interpret-arithmetic-expression_Magritte_bizarre (plus-2 e))))]
[(is-times? e)
(if (is-times? (times-1 e))
(make-times (interpret-arithmetic-expression_Magritte_bizarre (times-1 (times-1 e)))
(make-times (interpret-arithmetic-expression_Magritte_bizarre (times-2 (times-1 e)))
(interpret-arithmetic-expression_Magritte_bizarre (times-2 e))))
(make-times (interpret-arithmetic-expression_Magritte_bizarre (times-1 e))
(interpret-arithmetic-expression_Magritte_bizarre (times-2 e))))]
[else
(errorf 'interpret-arithmetic-expression_Magritte
"unrecognized expression: ~s"
e)])))
答案 0 :(得分：3)
这不完全是答案：
但是下面的代码会使各种表达变得扁平化：
> (flatten-expression '(+ (+ (* 2 a (* 1 b)) 1 3 (+ 3))))
'(+ (* 2 a 1 b) 1 3 3)
如果使用预先放大器，它也可以更好地完成它：
> (flatten-expression '(- 1 (+ 2 4) 5))
'(- 1 (+ 2 4) 5)
> (flatten-expression (presimplify-expression '(- 1 (+ 2 4) 5)))
'(- 1 (+ 2 4 5))
还有一个基本的评估员。
#lang racket
;;;; Flattening expressions
;;;
;;; Expressions are either (op ...), numbers or symbols. Operators are
;;; symbols.
;;;
;;; These tests only look at the top-level of a compound expression
;;;
;;; There is a lot more that could be done than this of course:
;;; partially-evaluating things, for instance.
;;;
(define (compound-expression? e)
(and (list? e)
(symbol? (first e))))
(define (atomic-expression? e)
(or (number? e)
(symbol? e)))
(define (valid-expression? e)
(or (atomic-expression? e)
(compound-expression? e)))
;;; Pulling apart and assembling compound expressions
;;;
(define (ce-op e)
(first e))
(define (ce-args e)
(rest e))
(define (make-ce op args)
(cons op args))
;;; A full checker
;;;
(define (valid-expression*? e)
(cond
[(atomic-expression? e)
#t]
[(compound-expression? e)
(andmap valid-expression*? (ce-args e))]
[else #f]))
;;; Flattening.
;;; This is overcomplicated: really it could just know what operators can
;;; be flattened.
;;;
(define flattenable-operators '(* +))
(define (flatten-expression e (fops flattenable-operators))
(define (flatten-fop op argtail accum agenda)
(if (null? argtail)
(if (null? agenda)
(make-ce op (reverse accum))
(flatten-fop op (first agenda) accum (rest agenda)))
(let ([arg (first argtail)]
[tail (rest argtail)])
(cond
[(atomic-expression? arg)
(flatten-fop op tail (cons arg accum) agenda)]
[(compound-expression? arg)
(if (eqv? (ce-op arg) op)
(flatten-fop op (ce-args arg) accum (cons tail agenda))
(flatten-fop op tail
(cons (flatten-expression arg fops)
accum)
agenda))]
[else (error "not an expression:" arg)]))))
(cond
[(atomic-expression? e)
e]
[(compound-expression? e)
(let ([op (ce-op e)]
[args (ce-args e)])
(if (memv op fops)
(flatten-fop op args '() '())
(make-ce op (map (λ (a) (flatten-expression a fops)) args))))]
[else (error "not an expression:" e)]))
;;; A simplifier to make the flattener's life more productive
;;;
(define (presimplify-expression e)
;; This has built-in knowledge of some arithmetic operators,
;; and uses the usual Lisp/Scheme semantics for / and -: (/ a b c) is
;; (/ a (* b c)) & so on.
(cond
[(atomic-expression? e)
e]
[(compound-expression? e)
(let ([op (ce-op e)]
[args (ce-args e)])
(case (length args)
[(0)
(case op
[(+ *) 0]
[(/ -) (error "no args for" op)]
[else e])]
[(1)
(case op
[(+ * /) (presimplify-expression (first args))]
[else (make-ce op (map presimplify-expression args))])]
[else
(case op
[(-) (make-ce op
(list (presimplify-expression (first args))
(make-ce '+ (map presimplify-expression
(rest args)))))]
[(/) (make-ce op
(list (presimplify-expression (first args))
(make-ce '* (map presimplify-expression
(rest args)))))]
[else (make-ce op (map presimplify-expression args))])]))]
[else
(error "not an expression:" e)]))
(define (simplify-expression e (fops flattenable-operators))
(flatten-expression (presimplify-expression e) fops))
;;; An evaluator
;;;
(define builtin-bindings
`((+ . ,+)
(- . ,-)
(* . ,*)
(/ . ,/)))
(define (evaluate-expression e (bindings '()))
(for ([b bindings])
(unless (and (cons? b) (symbol? (car b)))
(error "bad binding form" b))
(when (assv (car b) builtin-bindings)
(error "trying to rebind a builtin " (car b))))
(define (symbol-binding s)
(let ([binding (or (assv s builtin-bindings)
(assv s bindings))])
(unless binding
(error "unbound variable" s))
(cdr binding)))
(define (eval-exp e)
(cond
[(atomic-expression? e)
(cond
[(number? e) e]
[(symbol? e) (symbol-binding e)]
[else (error "mutant horror" e)])]
[(compound-expression? e)
(let ([op (ce-op e)]
[args (ce-args e)])
(apply (symbol-binding op)
(map eval-exp args)))]))
(eval-exp e))