helper.scm

(def var-counter 0)
(defn generate-var ()
      (set! var-counter (add1 var-counter))
      (string-append "%tmp"
                     (fixnum->string var-counter)))

(def label-count 0)
(defn unique-label (name)
      (set! label-count (add1 label-count))
      (format "L~A_~A"(list label-count name)))

(defn arg-str (arity)
      (cond
        ((eq? arity 0) "")
        ((eq? arity 1) "i64")
        (else
          (~>> arity sub1 arg-str (string-append "i64, ")))))

(defn var-str (vars)
      (~>> vars
           (map (fn (a) (string-append "i64 " a)))
           (join ", ")))

(defn escape-char (char) char
      (cond
        ((eq? char #\+) "_plus_")
        ((eq? char #\>) "_greater_")
        ((eq? char #\<) "_less_")
        ((eq? char #\=) "_equal_")
        ((eq? char #\*) "_times_")
        ((eq? char #\/) "_slash_")
        ((eq? char #\?) "_questionmark_")
        (else (char->string char))))

(defn escape (str)
      (~>> str any->string string->list
           (map escape-char)
           (cons "prim_")
           (join "")))

(defn tagged-list? (expr tag)
      (and (pair? expr) (eq? (fst expr) tag)))

(defn map-with-index (f lst) (map-with-index_ f 0 lst))
(defn map-with-index_ (f start lst)
      (if (null? lst)
        lst
        (cons
          (f (fst lst) start)
          (map-with-index_ f (add1 start) (rst lst)))))

(defn empty-set () '())
(defn singleton-set (expr) (list expr))

(defn set-subtract (a b)
      (filter (fn (e) (not (member? e b)))
              a))

(defn set-union (a b)
      (cond
        ((null? a) b)
        ((null? b) a)
        ((member? (fst b) a)
         (set-union a (rst b)))
        (else
          (set-union (cons (fst b) a) (rst b)))))

(defn set-union* (sets)
      (cond
        ((null? sets) sets)
        ((null? (rst sets)) (fst sets))
        (else (set-union*
                (cons (set-union (fst sets) (frst sets))
                      (rrst sets))))))

(def empty-env '())

(defn extend-env (var val env)
      (alist-cons var val env))

(defn extend-env* (vars vals env)
      (if (null? vars)
        env
        (extend-env* (rst vars) (rst vals)
                     (extend-env (fst vars) (fst vals) env))))

(defn lookup (var env)
      (let ((res (assoc var env)))
        (if res
          (rst res)
          (error "Trying to lookup unbound variable: " var))))

(defn lookup-or (var alt env)
      (let ((res (assoc var env)))
        (if res (rst res) alt)))