(define-module (prelude/primitives)
               #: export (primitive-names
                           primitive-objs
                           lift-bool
                           lift-arithmetic
                           primitives
                           bool?
                           true?))

(define (convert-bool expr) (if expr 'true 'false))
(define (true? expr) (eq? expr 'true))
(define (false? expr) (eq? expr 'false))
(define (bool? expr)
  (or (true? expr)
      (false? expr)))

(define (and-special . items)
  (if (null? items)
      'false
      (let ([first (car items)])
        (cond
          [(true? first) (apply and-special (cdr items))]
          [(false? first) 'false]
          [else (error "AND: unable to evaluate non-boolean form" first)]))))

(define (or-special . items)
  (if (null? items)
      'false
      (let ([first (car items)])
        (cond
          [(true? first) 'true]
          [(false? first) (apply or-special (cdr items))]
          [else (error "OR: unable to evaluate non-boolean form" first)]))))

(define (not-fn x) (not (true? x)))

(define (lift-bool op)
  (lambda vals (convert-bool (apply op vals))))

(define primitives
  `((+ . ,+)
    (- . ,-)
    (* . ,*)
    (< . ,(lift-bool <))
    (> . ,(lift-bool >))
    (<= . ,(lift-bool <=))
    (>= . ,(lift-bool >=))
    (eq? . ,(lift-bool eq?))
    (&& . ,and-special)
    (|| . ,or-special)
    (/= . ,not-fn)
    (first . ,car)
    (rest . ,cdr)))

(define (primitive-names) (map car primitives))
(define (primitive-objs) (map cdr primitives))