Path: ...!3.eu.feeder.erje.net!feeder.erje.net!news.in-chemnitz.de!news.swapon.de!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp
Subject: Re: Jon Harrop rewrite benchmark; Qi, Lisp and OCaml
Date: Thu, 8 Aug 2024 04:03:44 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 158
Message-ID: <v91g2f$3n2rs$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Thu, 08 Aug 2024 06:03:44 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="fd236d03c8b3925162f1d341b7e2d6de";
	logging-data="3902332"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX19s66LqHHRHqIU3Dnt1xX74"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:TrWN9/+hafUWVjDqMLjx83K8OTk=
Bytes: 4754

Mark Tarver wrote:

> The problem is to simplify symbolic expressions by applying the
> following rewrite rules from the leaves up:
> 
> rational n + rational m -> rational(n + m)
> rational n * rational m -> rational(n * m)
> symbol x -> symbol x
> 0+f -> f
> f+0 -> f
> 0*f -> 0
> f*0 -> 0
> 1*f -> f
> f*1 -> f
> a+(b+c) -> (a+b)+c
> a*(b*c) -> (a*b)*c


> 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


> Language: Lisp
> Author: Andre Thieme
> Length: 23 lines
> 
> (defun simplify (a)
>    (if (atom a)
>        a
>        (destructuring-bind (op x y) a
>         (let* ((f (simplify x))
>                (g (simplify y))
>                (nf (numberp f))
>                (ng (numberp g))
>                (+? (eq '+ op))
>                (*? (eq '* op)))
>           (cond
>             ((and +? nf ng)                   (+ f g))
>             ((and +? nf (zerop f))            g)
>             ((and +? ng (zerop g))            f)
>             ((and (listp g) (eq op (first g)))
>              (destructuring-bind (op2 u v) g
>                (simplify `(,op (,op ,f ,u) ,v))))
>             ((and *? nf ng)                   (* f g))
>             ((and *? (or (and nf (zerop f))
>                          (and ng (zerop g)))) 0)
>             ((and *? nf (= 1 f))              g)
>             ((and *? ng (= 1 g))              f)
>             (t                                `(,op ,f ,g)))))))


Testing:

(simplify '(+ x (+ y z)))

(+ (+ X Y) Z)


(simplify '(* x (+ (+ (* 12 0) (+ 23 8)) y)))

(* X (+ 31 Y))


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

(* (+ Z X) (+ 38 Y))


Language: Qi
Author: Mark Tarver

> (define simplify
>   [Op A B] -> (s [Op (simplify A) (simplify B)])
>   A -> A)
> 
> (define s
>   [+ M N] -> (+ M N)    where (and (number? M) (number? N))
>   [+ 0 F] -> F
>   [+ F 0] -> F
>   [+ A [+ B C]] -> [+ [+ A B] C]
>   [* M N] -> (* M N)    where (and (number? M) (number? N))
>   [* 0 F] -> 0
>   [* F 0] -> 0
>   [* F 1] -> F
>   [* 1 F] -> F
>   [* A [* B C]] -> [* [* A B] C]
>   A -> A)


newLISP

(define (ub pat xs) (if (unify pat xs) (bind $it) nil))

;; Without the evil "eval", it's one line longer.
(define (s x   ,  O A B C)
  (if (and (ub '(O A B) x) (int A) (int B)) (eval x)
      (ub '(+ 0 A) x)  A
      (ub '(+ A 0) x)  A
      (ub '(* 1 A) x)  A
      (ub '(* A 1) x)  A
      (ub '(* 0 A) x)  0
      (ub '(* A 0) x)  0
      (ub '(+ A (+ B C)) x) (list '+ (list '+ A B) C) 
      (ub '(* A (* B C)) x) (list '* (list '* A B) C) 
      x))

(define (simplify x   , Op A B)
  (if (ub '(Op A B) x) (s (list Op (simplify A) (simplify B)))
    x))
  

(simplify '(+ x (+ y z)))

(+ (+ x y) z)


(simplify '(* x (* y z)))

(* (* x y) z)


(simplify '(* x (+ (+ (* 12 0) (+ 23 8)) y)))

(* x (+ 31 y))


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

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


;; The evil "eval" enables it partially to handle "-" and "/".
(simplify '(* (+ z (* 1 x)) (+ (+ (* (- 2 2) (+ (* z 0) 7))
  (+ (/ 35 7) 8)) y)))

(* (+ z x) (+ 13 y))