mirror of
https://github.com/carp-lang/Carp.git
synced 2024-07-14 16:40:26 +03:00
76 lines
2.5 KiB
Plaintext
76 lines
2.5 KiB
Plaintext
(defmodule Dynamic
|
|
(private deftuple-type-)
|
|
(hidden deftuple-type-)
|
|
(defndynamic deftuple-type- [name props]
|
|
`(deftype (%name %@props)
|
|
%(collect-into (flatten (map (fn [x] `(%x %x)) props)) array)))
|
|
|
|
(private deftuple-lt-)
|
|
(hidden deftuple-lt-)
|
|
(defndynamic deftuple-lt- [name props]
|
|
(if (empty? props)
|
|
'false
|
|
(let [fst (Symbol.prefix name (car props))]
|
|
(if (= (length props) 1)
|
|
`(< (%fst t1) (%fst t2))
|
|
`(if (= (%fst t1) (%fst t2))
|
|
%(deftuple-lt- name (cdr props))
|
|
(< (%fst t1) (%fst t2)))))))
|
|
|
|
; this is basically just a giant template
|
|
(private deftuple-module-)
|
|
(hidden deftuple-module-)
|
|
(defndynamic deftuple-module- [name props]
|
|
(let [module-name (Symbol.concat [name 'Ref])]
|
|
`(do
|
|
(defmodule %module-name
|
|
(defn < [t1 t2] %(deftuple-lt- name props))
|
|
(implements < %(Symbol.prefix module-name '<))
|
|
|
|
(defn > [t1 t2] (%(Symbol.prefix module-name '<) t2 t1))
|
|
(implements > %(Symbol.prefix module-name '>)))
|
|
|
|
(doc %name %(str "is a tuple of length " (length props) "."))
|
|
(defmodule %name
|
|
(doc init-from-refs
|
|
%(str "initializes a `" name "` from member references."))
|
|
%(let [prop-vars (map (fn [x] (Symbol.concat [x '-val])) props)]
|
|
`(defn init-from-refs %(collect-into prop-vars array)
|
|
(init %@(map (fn [x] `(copy %x)) prop-vars))))
|
|
|
|
(defn < [t1 t2]
|
|
(%(Symbol.prefix module-name '<) &t1 &t2))
|
|
(implements < %(Symbol.prefix name '<))
|
|
|
|
(defn > [t1 t2]
|
|
(%(Symbol.prefix module-name '>) &t1 &t2))
|
|
(implements > %(Symbol.prefix name '>))
|
|
|
|
(doc reverse
|
|
%(str "reverses a `" name "` by reversing its member positions."))
|
|
(defn reverse [t]
|
|
(init %@(map (fn [x] `(copy (%x t))) (reverse props))))))))
|
|
|
|
(doc deftuple "defines a tuple type.
|
|
|
|
For example:
|
|
```
|
|
; is the definition of Pair in the stdlib
|
|
(deftuple Pair a b)
|
|
```")
|
|
(defmacro deftuple [name :rest props]
|
|
(do
|
|
(eval (deftuple-type- name props))
|
|
(eval `(derive %name zero))
|
|
(eval `(derive %name =))
|
|
(eval (deftuple-module- name props))
|
|
))
|
|
)
|
|
|
|
(doc Pair "is a 2-tuple, i.e. a datatype with two members.")
|
|
(deftuple Pair a b)
|
|
(doc Triple "is a 3-tuple, i.e. a datatype with three members.")
|
|
(deftuple Triple a b c)
|
|
(doc Quadruple "is a 4-tuple, i.e. a datatype with four members.")
|
|
(deftuple Quadruple a b c d)
|