struct-macro.fnl

;; fennel-ls: macro-file.
;; Title: struct-macro.fnl
;; Author: AlexJGriffith
;; Licence: GPL3+
;; Description: Compile time verification of feild values and named array indexing.

;;; Compile time Flags
(local def-asserts false)

;;; Example 
;; (import-macros {: def-struct : get! : set!} :struct-macro)
;;
;; (def-struct hitbox
;;   :x :number
;;   :y :number
;;   :h :number
;;   :w :number)
;;
;; (local hb (hitbox 10 10 30 30))
;;
;; (let [(x y w h) (get! hb hitbox :x :y :w :h)]
;;   (print x y w h))
;;
;; (set! hb hitbox :x 11 :y 12)
;;
;; (let [(x y w h) (get! hb hitbox :x :y :w :h)]
;;   (print x y w h))

(local _identity-table [])

(local offset 0)

(fn *def-struct [struct-name ...]
  "[:name :string :age :number]"
  (fn get-keys [t] (fcollect [i 1 (# t) 2] (sym (. t i))))
  (local struct (. _identity-table (tostring struct-name)))
  (when (not struct)
    (tset _identity-table (tostring struct-name) [...]))
  (local t (. _identity-table (tostring struct-name)))
  (local a (get-keys t))
  ;; (each [_ key (ipairs a)] (assert key "Struct key cannot be nil."))
  (local ap (get-keys t))
  (table.insert a (sym :ret?))
  (local ret `(fn ,struct-name ,a))
  (when def-asserts
    (for [i 1 (# t) 2]
      (let [expected-type (. t (+ i 1))
            value (sym (. t i))]
        (table.insert ret
                      `(assert (= ,expected-type (type ,value))
                               (string.format "Expected type %s for field %s in struct %s. Found type %s."
                                              ,expected-type ,(tostring value) ,(tostring struct-name) (type ,value)))))))
  (table.insert ret `(local ,(sym :ret) (or ret? [])))
  (each [i value (ipairs ap)]
    (table.insert ret `(tset ,(sym :ret) ,(+ offset i) ,value)))
  (table.insert ret (sym :ret))
  ret)

(fn get-field-index [t field]
  (var ret nil)
  (var j 1)
  (for [i 1 (# t) 2]
    (when (= (. t i) field) (set ret j))
    (set j (+ j 1)))
  ret)

(fn *get! [s struct-name ...]
  (local t (tostring struct-name))
  (assert (. _identity-table t)
          (string.format "Struct name _%s_ does not exist." t))
  (local fields [...])
  (if (= (# fields) 1)
      (let [field (. fields 1)
            i (get-field-index (. _identity-table t) field)]
        (assert i (string.format "Field _%s_ not defined in struct _%s_." field t))
        `(. ,s ,(+ offset i)))
      (let [ret `(values)]
           (each [_ field (ipairs fields)]
             (let [i (get-field-index (. _identity-table t) field)]
               (assert i (string.format "Field _%s_ not defined in struct _%s_." field t))
               (table.insert ret `(. ,s ,(+ offset i)))))
           ret)))

(fn *set! [s struct-name ...]
  (local t (tostring struct-name))
  (assert (. _identity-table t)
          (string.format "Struct name %s does not exist." t))
  (local fields [...])
  (if (= (# fields) 2)
      (let [field (. fields 1)
            value (. fields 2)
            i (get-field-index (. _identity-table t) field)]
        (assert i (string.format "Field _%s_ not defined in struct _%s_." field t))
        `(tset ,s ,(+ offset i) ,value))
      (let [ret `(do)]
        (for [i 1 (# fields) 2]
          (let [field (. fields i)
                value (. fields (+ i 1))
                i (get-field-index (. _identity-table t) field)]
            (assert i (string.format "Field _%s_ not defined in struct _%s_." field t))
            (table.insert ret `(tset ,s ,(+ offset i) ,value))))
        ret)))

{:def-struct *def-struct
 :get! *get!
 :set! *set!}