table.lisp 4.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161
  1. (import core/base (defmacro defun let* when if list unless gensym slice progn get-idx
  2. set-idx! error = /= mod - + n or for for-pairs with not apply else))
  3. (import lua/basic (next len#) :export)
  4. (import core/demand (assert-type!))
  5. (import core/list ())
  6. (import core/type (key?))
  7. (defun struct->list (tbl)
  8. "Converts a structure TBL that is a list by having its keys be indices
  9. to a regular list.
  10. ### Example
  11. ```cl
  12. > (struct->list { 1 \"foo\" 2 \"bar\" })
  13. out = (\"foo\" \"bar\")
  14. ```"
  15. (update-struct tbl :tag "list"
  16. :n (len# tbl)))
  17. (defun struct->list! (tbl)
  18. "Converts a structure TBL that is a list by having its keys be indices
  19. to a regular list. This differs from `struct->list` in that it mutates
  20. its argument.
  21. ### Example
  22. ```cl
  23. > (struct->list! { 1 \"foo\" 2 \"bar\" })
  24. out = (\"foo\" \"bar\")
  25. ```"
  26. (.<! tbl :tag "list")
  27. (.<! tbl :n (len# tbl))
  28. tbl)
  29. (defun list->struct (list)
  30. "Converts a LIST to a structure, mapping an index to the element in the
  31. list. Note that `nil` elements may not be mapped correctly.
  32. ### Example
  33. ```cl
  34. > (list->struct '(\"foo\"))
  35. out = {1 \"foo\"}
  36. ```"
  37. (assert-type! list list)
  38. (with (out {})
  39. (for i 1 (n list) 1
  40. (set-idx! out i (nth list i)))
  41. out))
  42. ;; Chain a series of index accesses together
  43. (defmacro .> (x &keys)
  44. "Index the structure X with the sequence of accesses given by KEYS."
  45. (with (res x)
  46. (for-each key keys (set! res `(get-idx ,res ,key)))
  47. res))
  48. (defmacro .<! (x &keys value)
  49. "Set the value at KEYS in the structure X to VALUE."
  50. (with (res x)
  51. (for i 1 (- (n keys) 1) 1
  52. (with (key (get-idx keys i))
  53. (set! res `(get-idx ,res ,key))))
  54. `(set-idx! ,res ,(get-idx keys (n keys)) ,value)))
  55. (defun struct (&entries)
  56. "Return the structure given by the list of pairs ENTRIES. Note that, in
  57. contrast to variations of [[let*]], the pairs are given \"unpacked\":
  58. Instead of invoking
  59. ```cl :no-test
  60. (struct [(:foo bar)])
  61. ```
  62. or
  63. ```cl :no-test
  64. (struct {:foo bar})
  65. ```
  66. you must instead invoke it like
  67. ```cl
  68. > (struct :foo \"bar\")
  69. out = {\"foo\" \"bar\"}
  70. ```"
  71. (when (= (mod (n entries) 2) 1)
  72. (error "Expected an even number of arguments to struct" 2))
  73. (with (out {})
  74. (for i 1 (n entries) 2
  75. (let* [(key (get-idx entries i))
  76. (val (get-idx entries (+ 1 i)))]
  77. (set-idx! out (if (key? key) (get-idx key "value") key) val)))
  78. out))
  79. (defun fast-struct (&entries)
  80. "A variation of [[struct]], which will not perform any coercing of the
  81. KEYS in entries.
  82. Note, if you know your values at compile time, it is more performant
  83. to use a struct literal."
  84. (when (= (mod (n entries) 2) 1)
  85. (error "Expected an even number of arguments to struct" 2))
  86. (with (out {})
  87. (for i 1 (n entries) 2
  88. (set-idx! out (get-idx entries i) (get-idx entries (+ i 1))))
  89. out))
  90. (defun empty-struct? (xs)
  91. "Check that XS is the empty struct.
  92. ### Example
  93. ```cl
  94. > (empty-struct? {})
  95. out = true
  96. > (empty-struct? { :a 1 })
  97. out = false
  98. ```"
  99. (not (next xs)))
  100. (defun nkeys (st)
  101. "Return the number of keys in the structure ST."
  102. (with (cnt 0)
  103. (for-pairs () st (set! cnt (+ cnt 1)))
  104. cnt))
  105. (defun iter-pairs (table func)
  106. "Iterate over TABLE with a function FUNC of the form `(lambda (key val) ...)`"
  107. (for-pairs (k v) table (func k v)))
  108. (defun copy-of (struct)
  109. "Create a shallow copy of STRUCT."
  110. (with (out {})
  111. (for-pairs (k v) struct (.<! out k v))
  112. out))
  113. (defun merge (&structs)
  114. "Merge all tables in STRUCTS together into a new table."
  115. (with (out {})
  116. (for-each st structs
  117. (for-pairs (k v) st
  118. (.<! out k v)))
  119. out))
  120. (defun keys (st)
  121. "Return the keys in the structure ST."
  122. (with (out '())
  123. (for-pairs (k _) st (push! out k))
  124. out))
  125. (defun values (st)
  126. "Return the values in the structure ST."
  127. (with (out '())
  128. (for-pairs (_ v) st (push! out v))
  129. out))
  130. (defun update-struct (st &keys)
  131. "Create a new structure based of ST, setting the values given by the
  132. pairs in KEYS."
  133. (merge st (apply struct keys)))
  134. (defun create-lookup (values)
  135. "Convert VALUES into a lookup table, with each value being converted to
  136. a key whose corresponding value is the value's index."
  137. (with (res {})
  138. (for i 1 (n values) 1 (.<! res (nth values i) i))
  139. res))