Skip to content

Commit 8b7eba5

Browse files
chrisrink10chrisrink10
authored
Support destructuring (#289)
* Support destructuring in function args and let bindings * Small changes * Update map destructure defs * Test core functions * Clean up map-binding code * Fixed associative destructuring * Fixed individual destructure bindings * Add a partition function * Fix range and partition * Destructuring in let bindings * Let binding associative destructuring tests * Nested destructuring first pass * Fix sequential destructuring * Reoganize some tests * More test reorganizing * Sequential destructuring tests w/ short seqs * Support namespaced keys bindings * Namespaced keys bindings tests for let * Or destructuring with let bindings * More tests * Support keyword rest arguments
1 parent 53d32ae commit 8b7eba5

File tree

3 files changed

+728
-1
lines changed

3 files changed

+728
-1
lines changed

‎src/basilisp/core/__init__.lpy

Lines changed: 298 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1800,3 +1800,301 @@
18001800
new-map))
18011801
{}
18021802
ks))
1803+
1804+
;;;;;;;;;;;;;;;;;;;;;;;;;;;
1805+
;; Destructuring Support ;;
1806+
;;;;;;;;;;;;;;;;;;;;;;;;;;;
1807+
1808+
(defn gensym
1809+
"Generate a unique symbol name of the form prefix_#. If no prefix is
1810+
given, then v_ will be used."
1811+
([]
1812+
(gensym "v_"))
1813+
([prefix]
1814+
(symbol (basilisp.lang.util/genname prefix))))
1815+
1816+
(defmulti ^:private destructure-def
1817+
(fn [arg]
1818+
(cond
1819+
(symbol? arg) :symbol
1820+
(vector? arg) :vector
1821+
(map? arg) :map
1822+
:else :default)))
1823+
1824+
(defmethod destructure-def :map
1825+
[arg]
1826+
(let [alias (or (:as arg) (gensym "map_arg_"))
1827+
1828+
;; :or bindings allow users to specify default values for certain
1829+
;; associative keys.
1830+
or-bindings (:or arg)
1831+
1832+
;; Namespaced keywords can destructure into non-namespaced
1833+
;; local names by specifying the namespace and with the name
1834+
;; "keys", just as the non-namespaced name "keys" will access
1835+
;; non-namespaced keywords.
1836+
;;
1837+
;; (let [{:movie/keys [title actors]} {:movie/title "Die Hard"
1838+
;; :movie/actors ["Bruce Willis"]}]
1839+
;; ...)
1840+
;;
1841+
kw-keys (->> (keys arg)
1842+
(filter keyword?)
1843+
(filter #(= "keys" (name %))))
1844+
1845+
;; Keyword, string, and symbol keys may all be destructured from
1846+
;; associative types.
1847+
kws (mapcat (fn [kw]
1848+
(let [kw-ns (namespace kw)
1849+
syms (get arg kw)]
1850+
(cond->> syms
1851+
kw-ns (map #(symbol kw-ns (name %))))))
1852+
kw-keys)
1853+
strs (:strs arg)
1854+
syms (:syms arg)
1855+
1856+
;; Fetch all the remaining keys in the map which do not
1857+
;; correspond to special functionality.
1858+
remaining (->> [:as :or :strs :syms]
1859+
(concat kw-keys)
1860+
(apply dissoc arg))
1861+
1862+
;; Destructuring forms may be nested arbitrarily, so generate the
1863+
;; definitions for any nested destructured forms as well.
1864+
children (map #(vector % (destructure-def %)) (keys remaining))]
1865+
{:name alias
1866+
:type :map
1867+
:keys kws
1868+
:strs strs
1869+
:syms syms
1870+
1871+
:or-bindings or-bindings
1872+
:remaining (->> children
1873+
(filter #(not= :symbol (:type (second %))))
1874+
(map first)
1875+
(apply dissoc remaining))
1876+
1877+
:children (map second children)}))
1878+
1879+
(defmethod destructure-def :symbol
1880+
[arg]
1881+
{:name arg
1882+
:type :symbol})
1883+
1884+
(defmethod destructure-def :vector
1885+
[arg]
1886+
(let [;; Fetch the name bound to this argument with any trailing
1887+
;; :as key.
1888+
alias-args (drop-while (partial not= :as) arg)
1889+
alias (->> alias-args (apply hash-map) :as)
1890+
1891+
;; Split the remaining arguments into sequential arguments
1892+
;; and the rest arg (if one at all).
1893+
args (->> arg
1894+
(drop-last (count alias-args))
1895+
(split-with (partial not= '&)))
1896+
1897+
sequential-args (first args)
1898+
rest-arg (second args)]
1899+
{:name (or alias (gensym "vec_arg_"))
1900+
:type :vector
1901+
:rest (when (seq rest-arg)
1902+
{:starts (count sequential-args)
1903+
:name (second rest-arg)})
1904+
:children (map destructure-def sequential-args)}))
1905+
1906+
(defmethod destructure-def :default
1907+
[arg]
1908+
(throw
1909+
(ex-info "Invalid destructuring argument type"
1910+
{:type (builtins/type arg)})))
1911+
1912+
(defmulti ^:private destructure-binding
1913+
(fn [ddef]
1914+
(:type ddef)))
1915+
1916+
(defmethod destructure-binding :vector
1917+
[ddef]
1918+
(let [fn-arg (:name ddef)
1919+
sequential-args (->> (:children ddef)
1920+
(map-indexed (fn [idx child]
1921+
(let [alias (:name child)]
1922+
(concat
1923+
[alias `(nth ~fn-arg ~idx nil)]
1924+
(when-not (= :symbol (:type child))
1925+
(destructure-binding child))))))
1926+
(apply concat))
1927+
rest-def (:rest ddef)
1928+
rest-arg (when rest-def
1929+
[(:name rest-def) `(nthnext ~fn-arg ~(:starts rest-def))])]
1930+
(concat
1931+
sequential-args
1932+
rest-arg
1933+
(->> (:children ddef)
1934+
(filter #(not= :symbol (:type %)))
1935+
(mapcat destructure-binding)))))
1936+
1937+
(defmethod destructure-binding :map
1938+
[ddef]
1939+
(let [fn-arg (:name ddef)
1940+
ors (:or-bindings ddef)
1941+
1942+
kw-binding (fn [arg]
1943+
(let [kw-ns (namespace arg)
1944+
kw-name (name arg)
1945+
sym (symbol kw-name)
1946+
kw (if kw-ns
1947+
(keyword kw-ns kw-name)
1948+
(keyword kw-name))
1949+
or-binding (get ors sym)]
1950+
(if or-binding
1951+
[sym `(or (get ~fn-arg ~kw) ~or-binding)]
1952+
[sym `(get ~fn-arg ~kw)])))
1953+
1954+
map-binding (fn [f arg]
1955+
(let [k (f arg)
1956+
or-binding (get ors arg)]
1957+
(if or-binding
1958+
[arg `(or (get ~fn-arg ~k) ~or-binding)]
1959+
[arg `(get ~fn-arg ~k)])))
1960+
1961+
sym-binding (fn [arg]
1962+
(let [k (symbol (name arg))
1963+
or-binding (get ors arg)]
1964+
(if or-binding
1965+
[arg `(or (get ~fn-arg (quote ~k)) ~or-binding)]
1966+
[arg `(get ~fn-arg (quote ~k))])))
1967+
1968+
rem-binding (fn [arg]
1969+
(let [binding (key arg)
1970+
key (val arg)
1971+
or-binding (get ors binding)]
1972+
(if or-binding
1973+
[binding `(or (get ~fn-arg (quote ~key)) ~or-binding)]
1974+
[binding `(get ~fn-arg ~key)])))
1975+
1976+
child-binding (fn [child]
1977+
(let [alias (name (:name child))
1978+
arg (symbol alias)
1979+
k (keyword alias)]
1980+
[arg `(get ~fn-arg ~k)]))
1981+
1982+
non-sym-children (filter #(not= :symbol (:type %)) (:children ddef))]
1983+
(concat
1984+
(mapcat kw-binding (:keys ddef))
1985+
(mapcat (partial map-binding name) (:strs ddef))
1986+
(mapcat sym-binding (:syms ddef))
1987+
(mapcat rem-binding (:remaining ddef))
1988+
(mapcat child-binding non-sym-children)
1989+
(mapcat destructure-binding non-sym-children))))
1990+
1991+
(defmethod destructure-binding :default
1992+
[ddef]
1993+
(throw
1994+
(ex-info "Invalid destructuring argument type"
1995+
{:type (:type ddef)})))
1996+
1997+
(defn ^:private fn-arity-with-destructuring
1998+
"Take a function arity definition (an argument vector and 0 or more body
1999+
expressions) whose argument vector may or may not require destructuring
2000+
and return a function arity definition which uses only bare symbols and
2001+
wraps the original definition in a let binding which performs the
2002+
destructuring steps.
2003+
2004+
As an example, for sequential destructuring like:
2005+
2006+
(fn [[f & r]]
2007+
{:first f
2008+
:rest r})
2009+
2010+
This function would emit a list of:
2011+
2012+
[vec_arg_3432]
2013+
(let* [f (get vec_arg_3432 0)
2014+
r (nthnext vec_arg_3432 1)]
2015+
{:first f
2016+
:rest r})"
2017+
[body]
2018+
(let [args (first body)
2019+
body (rest body)
2020+
2021+
arg-groups (split-with (partial not= '&) args)
2022+
args (first arg-groups)
2023+
rest-args (second arg-groups)
2024+
rest-defs (map destructure-def rest-args)
2025+
2026+
rest-binding (concat
2027+
(let [rest-arg (second rest-defs)]
2028+
(when (= :map (:type rest-arg))
2029+
`[~(:name rest-arg) (apply hash-map ~(:name rest-arg))]))
2030+
(->> rest-defs
2031+
(filter #(not= :symbol (:type %)))
2032+
(mapcat destructure-binding)))
2033+
2034+
defs (map destructure-def args)
2035+
arg-vec (vec (concat
2036+
(map :name defs)
2037+
(map :name rest-defs)))
2038+
bindings (->> defs
2039+
(filter #(not= :symbol (:type %)))
2040+
(mapcat destructure-binding)
2041+
(concat rest-binding))
2042+
new-body (if (seq bindings)
2043+
[`(let* [~@bindings]
2044+
~@body)]
2045+
body)]
2046+
(apply list arg-vec new-body)))
2047+
2048+
(defmacro ^:no-warn-on-redef fn
2049+
"Return an anonymous (but possibly named) function.
2050+
2051+
Function argument vectors support sequential and associative destructuring."
2052+
[& body]
2053+
(let [name (when (symbol? (first body))
2054+
(first body))
2055+
body (cond-> body name rest)
2056+
arities (cond
2057+
(vector? (first body))
2058+
(fn-arity-with-destructuring body)
2059+
2060+
(seq? (first body))
2061+
(map fn-arity-with-destructuring body)
2062+
2063+
:else
2064+
body)]
2065+
(if name
2066+
`(fn* ~name
2067+
~@arities)
2068+
`(fn* ~@arities))))
2069+
2070+
(defn destructure
2071+
"Take a [binding expr] pair (as from a let block) and produce all of the
2072+
replacement bindings for the binding which perform destructuring on the
2073+
initial expression.
2074+
2075+
As an example, for sequential destructuring like:
2076+
2077+
[f & r :as v] [1 2 3 4]
2078+
2079+
This function would emit a list of bindings which can be inserted directly
2080+
into a let* binding to perform destructuring:
2081+
2082+
(v [1 2 3 4]
2083+
f (nth v 0)
2084+
r (nthnext v 1))"
2085+
[[binding expr]]
2086+
(let [ddef (destructure-def binding)
2087+
orig-name (:name ddef)
2088+
bindings (if (= :symbol (:type ddef))
2089+
[]
2090+
(destructure-binding ddef))]
2091+
(apply list orig-name expr bindings)))
2092+
2093+
(defmacro ^:no-warn-on-redef let
2094+
"Let bindings with destructuring support."
2095+
[bindings & body]
2096+
(let [bindings (->> (partition 2 bindings)
2097+
(mapcat destructure))]
2098+
`(let* [~@bindings]
2099+
~@body)))
2100+

‎src/basilisp/lang/compiler.py

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -693,7 +693,7 @@ def _fn_arities(ctx: CompilerContext, form: llist.List) -> Iterable[FunctionArit
693693
Single arity functions yield the rest:
694694
695695
(fn a [] :a) ;=> '(([] :a))"""
696-
if not all(map(lambda f: isinstance(f, llist.List) and isinstance(f.first, vec.Vector), form)):
696+
if not all(map(lambda f: isinstance(f, (llist.List, lseq.Seq)) and isinstance(f.first, vec.Vector), form)):
697697
assert isinstance(form.first, vec.Vector)
698698
_assert_recur_is_tail(ctx, form)
699699
yield len(form.first), False, form

0 commit comments

Comments
 (0)