#| Copyright 2024 Peter McGoron
 |
 | Licensed under the Apache License, Version 2.0 (the "License");
 |
 | you may not use this file except in compliance with the License.
 | You may obtain a copy of the License at
 |
 |     http://www.apache.org/licenses/LICENSE-2.0
 |
 | Unless required by applicable law or agreed to in writing, software
 | distributed under the License is distributed on an "AS IS" BASIS,
 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 | See the License for the specific language governing permissions and
 | limitations under the License.
 |#

(cond-expand
 (chicken (import test r7rs))
 (else (import (srfi 64))))

(load "../mcgoron.cond-thunk.srfi.210.compat.sld")
(load "../mcgoron.cond-thunk.sld")
(load "../mcgoron.cond-thunk.values.sld")
(import (mcgoron cond-thunk) (mcgoron cond-thunk values) (srfi 1))

(define function=> pair=>)

(define (mult=> form)
  (cond-values
    (after ((let (function=> form) => (head tail))
        (when (eq? head '*)))
      tail)))

(define (add=> form)
  (cond-values
    (after ((let (function=> form) => (head tail))
        (when (eq? head '+)))
      tail)))

(define (add? form)
  (cond-thunk
    (after ((let (add=> form) => (_)))
      #t)
    (else #f)))

(define (distribute form)
  (cond-thunk
    (after ((let (mult=> form) => (arguments)))
      (let-values (((add others) (partition add? arguments)))
        ;; ADD is a list of addition clauses.
        (let ((added-values (concatenate (map cdr add))))
          (cons '+
                (map (lambda (added-value)
                       (cons* '*
                              (distribute added-value)
                              others))
                     added-values)))))
    (after ((let (function=> form) => (head arguments)))
      (cons head (map distribute arguments)))
    (else form)))

(test
 "distribute1"
 '(+ (* y x) (* z x))
 (distribute '(* x (+ y z))))