From Newsgroup: comp.lang.scheme

Language: OCaml
Author: Jon Harrop
Length: 15 lines

let rec ( +: ) f g = match f, g with
| `Int n, `Int m -> `Int (n +/ m)
| `Int (Int 0), e | e, `Int (Int 0) -> e
| f, `Add(g, h) -> f +: g +: h
| f, g -> `Add(f, g)

let rec ( *: ) f g = match f, g with
| `Int n, `Int m -> `Int (n */ m)
| `Int (Int 0), e | e, `Int (Int 0) -> `Int (Int 0)
| `Int (Int 1), e | e, `Int (Int 1) -> e
| f, `Mul(g, h) -> f *: g *: h
| f, g -> `Mul(f, g)

let rec simplify = function
| `Int _ | `Var _ as f -> f
| `Add (f, g) -> simplify f +: simplify g
| `Mul (f, g) -> simplify f *: simplify g

Gauche Scheme

(use util.match)

(define (simp e)
(if (pair? e) (s (cons (car e) (map simp (cdr e)))) e))

(define s (match-lambda
[('+ (? number? a) (? number? b)) (+ a b)]
[('* (? number? a) (? number? b)) (* a b)]
[('+ 0 x) x]
[('+ x 0) x]
[('+ a ('+ b c)) ('+ ('+ a b) c)]
[('* 0 _) 0]
[('* _ 0) 0]
[('* 1 x) x]
[('* x 1) x]
[('* a ('* b c)) ('* ('* a b) c)]
[x x]))

(simp '(* (+ z (* 1 x)) (+ (+ (* (+ 2 -2) (+ (* z 0) 7))
(+ (+ 7 23) 8)) y)))

===>
(* (+ z x) (+ 38 y))

--- Synchronet 3.21a-Linux NewsLink 1.2