feat: Derive (#1120)

* core: add derive

* fix: fix errors with set!

Notably, don't type check dynamic bindings (which can be set to
whatever) and eliminate a hang that resulted from not handling an error
at the end of the `set!` call. Also refactors some of the code in
efforts to make it a bit cleaner.

Also adds an error when `set!` can't find the variable one calls set!
on.

* feat: better derive

* test: add error test for derive

* document derive

* add derive to core documentation to generate

* core: add derive

* fix: fix errors with set!

Notably, don't type check dynamic bindings (which can be set to
whatever) and eliminate a hang that resulted from not handling an error
at the end of the `set!` call. Also refactors some of the code in
efforts to make it a bit cleaner.

Also adds an error when `set!` can't find the variable one calls set!
on.

* feat: better derive

* document derive

* feat: first completely working version of derive

* feat: make name of derivable customizable (thanks @scolsen)

* refactor: implement doc edits provided by @scolsen

* feat: change argument order for derive

* fix: change deriver error test

* test: add derive tests

* fix: change order of derive back

* docs: fix typo in derive document

Co-authored-by: scottolsen <scg.olsen@gmail.com>

core/Core.carp

@@ -20,6 +20,7 @@
 (load-once "Bool.carp")
 (load-once "Macros.carp")
 (load-once "List.carp")
+(load-once "Derive.carp")
 (load-once "Gensym.carp")
 (load-once "ControlMacros.carp")
 (load-once "Project.carp")

core/Derive.carp

@@ -0,0 +1,96 @@
+(doc Derive "is a mechanism for deriving interfaces automatically.
+
+Please reference [the documentation](https://github.com/carp-lang/Carp/blob/master/docs/Derive.md)
+for more information.")
+(defmodule Derive
+  (hidden derivers)
+  (defdynamic derivers '())
+
+  (doc make-deriver "is a mechanism for providing your own deriver by providing
+the interface name `f`, the arguments it takes `args`, and a function that can
+generate a body when given a type `body`.
+
+Example:
+```
+(make-deriver 'zero []
+  (fn [t]
+    (cons 'init
+      (map (fn [_] '(zero)) (members t)))))
+```")
+  (defndynamic make-deriver [f args body]
+    (set! Derive.derivers
+      (cons
+        (list f
+          (fn [t name]
+            (list 'defmodule t
+              (list 'defn name args
+                (body t))
+              (list 'implements f (Symbol.prefix t name)))))
+        Derive.derivers)))
+
+  (doc make-update-deriver "is a convenience function for creating a deriver
+for functions that you could pass into `update-<member>` style functions.")
+  (defndynamic make-update-deriver [interface]
+    (make-deriver interface ['o]
+      (fn [t]
+        (reduce
+          (fn [acc m]
+            (list (Symbol.concat ['update- (car m)]) acc (list 'ref interface)))
+          'o
+          (eval (list 'members t))))))
+
+  (hidden get-deriver)
+  (defndynamic get-deriver [f derivers]
+    (if (empty? derivers)
+      '()
+      (if (= (caar derivers) f)
+        (car derivers)
+        (get-deriver f (cdr derivers)))))
+
+  (doc derivable? "checks whether a quoted interface name `f` is currently
+derivable.")
+  (defndynamic derivable? [f]
+    (let [deriver (get-deriver f Derive.derivers)]
+      (not (empty? deriver))))
+
+  (doc derivables "returns the list of currently derivable interfaces.")
+  (defndynamic derivables []
+    (map car Derive.derivers))
+
+  (doc derive "derives an interface function `f` for a type `t`.
+
+Optionally, it also takes an argument `overrride` that overrides the name of
+the generated function to avoid collisions.")
+  (defmacro derive [t f :rest override]
+    (let [name (if (empty? override) f (car override))
+          deriver (get-deriver f Derive.derivers)]
+      (if (empty? deriver)
+        (macro-error (String.concat ["no deriver found for interface " (str f) "!"]))
+        (eval ((cadr deriver) t name))))))
+
+(use Derive)
+
+(make-deriver '= ['o1 'o2]
+  (fn [t]
+    (reduce
+      (fn [acc m]
+        (list 'and (list '= (list (car m) 'o1) (list (car m) 'o2)) acc))
+      true
+      (eval (list 'members t)))))
+
+(make-deriver 'zero []
+  (fn [t]
+    (cons 'init
+      (map (fn [_] '(zero)) (eval (list 'members t))))))
+
+(make-deriver 'str ['o]
+  (fn [t]
+    (let [mems (eval (list 'members t))]
+      (cons 'fmt
+        (cons
+          (String.concat
+            (append
+              (append ["(" (str t)]
+                      (collect-into (map (fn [_] " %s") mems) array))
+              [")"]))
+          (map (fn [m] (list 'ref (list 'str (list (car m) 'o)))) mems))))))

core/String.carp

@@ -298,45 +298,8 @@
   (implements prn IntRef.prn)
   (defn str [x] (Int.str @x))
   (implements str IntRef.str)
-)
-
-(defmodule BoolRef
-  (defn prn [x] (Bool.str @x))
-  (implements prn BoolRef.prn)
-  (defn str [x] (Bool.str @x))
-  (implements str BoolRef.str)
-)
-
-(defmodule Byte (defn prn [x] (Byte.str x)) (implements prn Byte.prn))
-(defmodule ByteRef
-  (defn prn [x] (Byte.str @x))
-  (implements prn ByteRef.prn)
-  (defn str [x] (Byte.str @x))
-  (implements str ByteRef.str)
-)
-
-(defmodule Long (defn prn [x] (Long.str x)) (implements prn Long.prn))
-(defmodule LongRef
-  (defn prn [x] (Long.str @x))
-  (implements prn LongRef.prn)
-  (defn str [x] (Long.str @x))
-  (implements str LongRef.str)
-)
-
-(defmodule Float (defn prn [x] (Float.str x)) (implements prn Float.prn))
-(defmodule FloatRef
-  (defn prn [x] (Float.str @x))
-  (implements prn FloatRef.prn)
-  (defn str [x] (Float.str @x))
-  (implements str FloatRef.str)
-)
-
-(defmodule Double (defn prn [x] (Double.str x)) (implements prn Double.prn))
-(defmodule DoubleRef
-  (defn prn [x] (Double.str @x))
-  (implements prn DoubleRef.prn)
-  (defn str [x] (Double.str @x))
-  (implements str DoubleRef.str)
+  (defn format [s x] (Int.format s @x))
+  (implements format IntRef.format)
 )
 
 (defmodule Bool (defn prn [x] (Bool.str x)) (implements prn Bool.prn))
@@ -345,6 +308,48 @@
   (implements prn BoolRef.prn)
   (defn str [x] (Bool.str @x))
   (implements str BoolRef.str)
+  (defn format [s x] (Bool.format s @x))
+  (implements format BoolRef.format)
+)
+
+(defmodule Byte (defn prn [x] (Byte.str x)) (implements prn Byte.prn))
+(defmodule ByteRef
+  (defn prn [x] (Byte.str @x))
+  (implements prn ByteRef.prn)
+  (defn str [x] (Byte.str @x))
+  (implements str ByteRef.str)
+  (defn format [s x] (Byte.format s @x))
+  (implements format ByteRef.format)
+)
+
+(defmodule Long (defn prn [x] (Long.str x)) (implements prn Long.prn))
+(defmodule LongRef
+  (defn prn [x] (Long.str @x))
+  (implements prn LongRef.prn)
+  (defn str [x] (Long.str @x))
+  (implements str LongRef.str)
+  (defn format [s x] (Long.format s @x))
+  (implements format LongRef.format)
+)
+
+(defmodule Float (defn prn [x] (Float.str x)) (implements prn Float.prn))
+(defmodule FloatRef
+  (defn prn [x] (Float.str @x))
+  (implements prn FloatRef.prn)
+  (defn str [x] (Float.str @x))
+  (implements str FloatRef.str)
+  (defn format [s x] (Float.format s @x))
+  (implements format FloatRef.format)
+)
+
+(defmodule Double (defn prn [x] (Double.str x)) (implements prn Double.prn))
+(defmodule DoubleRef
+  (defn prn [x] (Double.str @x))
+  (implements prn DoubleRef.prn)
+  (defn str [x] (Double.str @x))
+  (implements str DoubleRef.str)
+  (defn format [s x] (Double.format s @x))
+  (implements format DoubleRef.format)
 )
 
 (defmodule Array (defn prn [x] (Array.str x)) (implements prn Array.prn))

docs/Derive.md

@@ -0,0 +1,113 @@
+# Derive
+
+`derive` is a mechanism that automatically determines how to implement
+interfaces for datatypes based on their members. It also allows you to write
+your own rules for `derive`, called a `deriver`.
+
+If you’d like to learn how to `derive` interfaces for your types, read the
+[first section](#i-using-derive) of this document. If you’d like to provide a
+deriver for an interface, read [the second section](#ii-writing-derivers) of
+this document.
+
+## I: Using `derive`
+
+In most cases, using `derive` should be as simple as calling it with the type
+name and interface to implement:
+
+```clojure
+(deftype Point [
+  x Int
+  y Int
+])
+(derive Point zero)
+(derive Point =)
+
+; if you’d like to generate a different function name
+; pass it as a third argument. This is useful to avoid
+; name collisions
+(derive Point str my-str)
+```
+
+The code above will provide implementations of `zero` and `=` for the type
+`Point` based on its members. The prerequisites for this to work
+are that types are *concrete*—there are no type variables present—and *its
+members implement the interface*. This is because the definition of both
+functions hinges on the definition of its members: `zero` on a type is just
+`zero` of all its members, equality of a type just equality of all of its
+members.
+
+Carp only provides automatic derivation of `=`, `zero`, and `str`. Since the
+code you depend on might provide other derivers, you can inspect them by
+calling `(derivables)`. If you want to find out if a certain interface is
+derivable, you can call `(derivable? <interface>)`. Please note that the
+interface name needs to be quoted.
+
+If either of the preconditions above is not met, you will have to write your
+own version of these functions, and may not use `derive`.
+
+Some users might want to be able to derive update interfaces that take a type,
+do the same thing to all its members, and return it. A good example for this
+in the context of `Point` is `inc`.
+
+While generally this might require you to write your own deriver—see [section
+II](#ii-writing-derivers) of this document to learn how to do that—, Carp
+provides a special dynamic function called `make-update-deriver`. It takes a
+unary interface that updates a value and returns it, and extrapolates a
+definition for the encompassing type. This is what this would look like for
+`Point`:
+
+```clojure
+(make-update-deriver 'inc) ; notice the quote
+(derive Point inc)
+
+(inc (Point.zero)) ; => (Point 1 1)
+```
+
+While this can be useful at times, it is limited to the special case of
+functions outlined above: it can only used on functions you would also be able
+to pass into `update-<member>` style functions.
+
+## II: Writing derivers
+
+Sometimes you might want to provide your own derivation strategy for other
+interfaces than the ones provide out of the box. In these cases you can provide
+your own deriver using `make-deriver`.
+
+The dynamic function `make-deriver` takes three arguments: the quoted name of
+the interface, the names of the arguments it will be passed, and a function
+that, given a type, knows how to generate an implementation for that type.
+
+This might sound a little strange, so let’s consider the deriver for `zero` as
+an example:
+
+```clojure
+(make-deriver 'zero []
+  (fn [t]
+    (cons 'init
+      (map (fn [_] '(zero)) (members t)))))
+```
+
+It usually makes sense to read `make-deriver` similar to a function definition:
+its interface name is `zero`, which takes no argument, and we know that if
+we’re given a type we can create a definition for `zero` if we just emit a
+call to `zero` for every member, wrapped in an `init`. Thus the definition for
+`zero` for the type `Point` from above will end up looking like this:
+
+```clojure
+(init (zero) (zero))
+```
+
+`derive` itself will emit all the surrounding boilerplate, such that the entire
+call to `(derive Point zero)` will be rewritten to:
+
+```clojure
+(defmodule Point
+  (defn zero []
+    (init (zero) (zero)))
+  (implements Point.zero zero)
+)
+```
+
+This means that all a deriver has to know is how to generate a function body
+when it’s given a type. Since it also has control over the argument names, it
+can use the arguments in its definition as well.

docs/core/generate_core_docs.carp

@@ -18,6 +18,7 @@
            Byte
            Char
            Debug
+           Derive
            Double
            Dynamic
            Float

examples/derive.carp

@@ -0,0 +1,18 @@
+; let’s make inc and dec derivable
+(make-update-deriver 'inc)
+(make-update-deriver 'dec)
+
+(deftype T [x Int y Int z Int])
+(derive T inc)
+(derive T dec)
+(derive T zero)
+(derive T str)
+(derive T = eq)
+
+(defn main []
+  (do
+    (println* &(T.inc (T.init 1 2 3)))
+    (println* &(T.dec (T.init 1 2 3)))
+    (println* &(T.zero))
+    (println* (= &(T.init 1 2 3) &(T.init 1 2 3)))
+    (println* (= &(T.init 1 2 3) &(T.init 1 3 2)))))

test/derive.carp

@@ -0,0 +1,43 @@
+(make-update-deriver 'inc)
+(make-update-deriver 'dec)
+
+(deftype T [x Int y Int z Int])
+(derive T inc)
+(derive T dec)
+(derive T zero)
+(derive T str)
+(derive T = eq)
+
+(load "Test.carp")
+(use Test)
+
+(deftest test
+  (assert-true test
+               (= &(T.init 0 0 0) &(T.init 0 0 0))
+               "deriving = works I"
+  )
+  (assert-false test
+                (= &(T.init 0 0 0) &(T.init 1 0 0))
+                "deriving = works II"
+  )
+  (assert-equal test
+                &(T.init 0 0 0)
+                &(T.zero)
+                "deriving zero works"
+  )
+  (assert-equal test
+                &(T.init 2 3 4)
+                &(T.inc (T.init 1 2 3))
+                "deriving inc works"
+  )
+  (assert-equal test
+                &(T.init 0 1 2)
+                &(T.dec (T.init 1 2 3))
+                "deriving dec works"
+  )
+  (assert-equal test
+                "(T 0 0 0)"
+                &(T.str &(T.zero))
+                "deriving str works"
+  )
+)

test/output/test/test-for-errors/derive-without-child-impl.carp.output.expected

@@ -0,0 +1,8 @@
+derive-without-child-impl.carp:9:23 Can't find matching lookup for symbol 'inc' of type (Fn [T1] T1)
+None of the possibilities have the correct signature:
+    Pointer.inc : (Fn [(Ptr a)] (Ptr a))
+    Byte.inc : (Fn [Byte] Byte)
+    Int.inc : (Fn [Int] Int)
+    Long.inc : (Fn [Long] Long)
+    Double.inc : (Fn [Double] Double)
+    Float.inc : (Fn [Float] Float)

test/test-for-errors/derive-without-child-impl.carp

@@ -0,0 +1,10 @@
+(Project.config "file-path-print-length" "short")
+
+(deftype T1 [])
+
+(deftype T2 [
+  t T1
+])
+
+(make-update-deriver 'inc)
+(derive T2 inc)