1. Forum
  2. USENET
  3. comp.lang.scheme

  • Re: Jon Harrop rewrite benchmark; Qi, Lisp and OCaml

    From B. Pym@Nobody447095@here-nor-there.org to comp.lang.lisp,comp.lang.scheme on Fri Aug 1 21:11:55 2025
    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