Builtin case construct evaluation before macro expansion issue pasted by patham9 on Mon Oct 2 17:40:32 2023

(define-syntax CaseMettaHelper
  (syntax-rules (else)
    ((_ else bi) (list else bi))
    ((_ ai bi) (list (list ai) bi))))

(define-syntax CaseMettaClean
  (syntax-rules (else)
    ((_ var ((a1 else)))
     (case var (else b1)))
    ((_ var ((a1 b1)))
     (case var ((a1) b1)))
    ((_ var ((ai bi) ...))
     (list var (CaseMettaHelper ai bi) ...))))
     ;^^^^
     ;expected would have been to be able to use directly
     ;case instead of list here, but case is so greedy that
     ;CaseMettaHelper won't be evaluated before it complains about it.

(define-syntax CaseMetta
  (syntax-rules (else)
    ((_ var cases)
     (eval (let ((x (CaseMettaClean var cases))) (append (list 'case) x))))))
     ;forces to have the CaseMettaClean evaluated before filling in "case".

(display (CaseMetta 3 ((1 2) (3 4))))
;4
[ permalink | raw ]

Fixed version pasted by wasamasa on Mon Oct 2 18:04:04 2023

(import (chicken base))

(define-syntax CaseMetta
  (syntax-rules (else)
    ((_ var ((pat body ...) ...))
     (case var ((pat) body ...) ...))))

(let ((x 1))
  (print
   (case x
     ((1) 2)
     ((3) 4)))

  (print
   (CaseMetta x
     ((1 2)
      (3 4)))))
[ permalink | raw ]

Not the solution unfortunately pasted by patham9 on Mon Oct 2 18:26:07 2023

Your macro does not consider the else case.
My initial one also did not:

(define-syntax CaseMetta
  (syntax-rules ()
    ((_ var ((a1 b1)))
     (case var ((a1) b1)))
    ((_ var ((a1 b1) ...))
     (case var ((a1) b1) ...))))

The complexity growth came from me trying to address the else case! :)
[ permalink | raw ]

Error comes when else is tried to be considered pasted by patham9 on Mon Oct 2 18:40:40 2023

(define-syntax CaseMettaHelper
  (syntax-rules (else)
    ((_ else bi) (list else bi))
    ((_ ai bi) (list (list ai) bi))))

(define-syntax CaseMetta
  (syntax-rules (else)
    ((_ var ((pat body ...) ...))
     (case var (CaseMettaHelper pat body ...) ...))))


(display (CaseMetta 3 ((1 2) (else 4))))
;bad argument type - not a list: CaseMettaHelper356
[ permalink | raw ]

With support for else, cribbed from R7RS-small pasted by wasamasa on Mon Oct 2 18:54:13 2023

(import (chicken base))

(define-syntax CaseMetta
  (syntax-rules (else)
    ((_ key
        ((else result1 result2 ...)))
     (begin result1 result2 ...))
    ((_ key
        ((atom result1 result2 ...)))
     (if (eqv? key atom)
         (begin result1 result2 ...)))
    ((_ key
        ((atom result1 result2 ...)
         clause clauses ...))
     (if (eqv? key atom)
         (begin result1 result2 ...)
         (CaseMetta key (clause clauses ...))))))

(let ((x 1)
      (y 5))
  (print
   (case x
     ((1) 2)
     ((3) 4)
     (else 999)))
  (print
   (case y
     ((1) 2)
     ((3) 4)
     (else 999)))

  (print
   (CaseMetta x
     ((1 2)
      (3 4)
      (else 999))))
  (print
   (CaseMetta y
     ((1 2)
      (3 4)
      (else 999)))))
[ permalink | raw ]

Also my solution for completeness added by patham9 on Mon Oct 2 19:13:28 2023

(define-syntax CaseMettaMatch
  (syntax-rules (else)
    ((_ var ((pat body) ...))
     (case var ((pat) body) ...))))
     
(define-syntax CaseMettaNoMatch
  (syntax-rules ()
    ((_ var ((p body1) ... (elsemaybe elsebody)))
     (if (eq? 'elsemaybe 'else)
         'elsebody))))

(define-syntax CaseMetta
  (syntax-rules ()
    ((_ var cases)
      (let ((z (CaseMettaMatch var cases)))
           (if (eq? (if #f 1) z)
               (CaseMettaNoMatch var cases) z)))))

(display (CaseMetta 343 ((1 2) (3 4) (5 6) (else 42) )))
;42

(display (CaseMetta 343 ((1 2) (3 4) (5 6) (asdasd 42) )))
;unspecified

(display (CaseMetta 3 ((1 2) (3 4) (5 6) (asdasd 42) )))
;4
[ permalink | raw ]