;;;;
;;;;
;;;; srfi-5.stk         -- Implementattion of SRFI-5
;;;;
;;;; Copyright © 2020-2022 Erick Gallesio - I3S-CNRS/Polytech Nice-Sophia <eg@unice.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;;           Author: Erick Gallesio [eg@unice.fr]
;;;;    Creation date:  8-Oct-2020 17:17
;;;;

;; SRFI-5 idenntifies the followings cases
;;
;;    1. Unnamed
;;       (let ((<parameter> <argument>)...) <body>...)
;;
;;    2. Named, non-signature-style, no rest argument
;;       (let <name> ((<parameter> <argument>)...) <body>...)
;;
;;    3. Named, signature-style, no rest argument
;;       (let (<name> (<parameter> <argument>)...) <body>...)
;;
;;    4. Named, non-signature-style, rest argument
;;       (let <name> ((<param> <arg>)...  . (<rest-param> <rest-arg>...)) <body>...)
;;
;;     5. Named, signature-style, rest argument
;;        (let (<name> (<param> <arg>)... . (<rest-param> <rest-arg>...)) <body>...)
;;



(define-module srfi/5
  (export let)
  (define-macro (let bindings . body)

    (define (find-names lst)
      (cond
       ((null? lst)       '())
       ((pair? (car lst)) (cons (caar lst) (find-names (cdr lst))))
       (else              (car lst))))

    (define (find-values lst)
      (cond
       ((null? lst)       '())
       ((pair? (car lst)) (append (cdar lst) (find-values (cdr lst))))
       (else              (cdr lst))))

    (cond
     ((and (pair? bindings) (symbol? (car bindings)))
      (let* ((name     (car bindings))
             (bindings (cdr bindings)))
        ;; ==== Named, signature-style, no rest argument
        ;; ==== Named, signature-style, rest argument
        `(letrec ((,name (lambda ,(find-names bindings) ,@body)))
           (,name ,@(find-values bindings)))))

     ((list?  bindings)
      ;; ==== Unamed
      `(%let ,bindings ,@body))

     (else
      (let* ((name     bindings)
             (bindings (car body))
             (body     (cdr body)))
        ;; === Named, non-signature-style, no rest argument
        ;; === Named, non-signature-style, rest argument
        `(letrec ((,name (lambda ,(find-names bindings) ,@body)))
           (,name ,@(find-values bindings)))))))

)

(provide "srfi/5")
