From dcbd8e039b74143c9b97f6055e2eb5321428637e Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Wed, 21 Aug 2024 20:23:23 -0700
Subject: Add: required slots to def:class, change fast to typed

---
 def.asd      | 12 ++++++++++--
 def.lisp     | 23 ++++++++++++++++-------
 package.lisp |  2 +-
 3 files changed, 27 insertions(+), 10 deletions(-)

diff --git a/def.asd b/def.asd
index 4209383..9c997ce 100644
--- a/def.asd
+++ b/def.asd
@@ -9,5 +9,13 @@
   :serial t
   :components ((:file "package")
                (:file "util")
-               (:file "def")
-               (:file "generic")))
+               (:file "def")))
+
+(asdf:defsystem #:def/generic
+  :description "Alternate generic function implementation"
+  :author "colin <colin@cicadas.surf>"
+  :license "Unlicense"
+  :version "0.0.1"
+  :depends-on (#:def #:alexandria)
+  :serial t
+  :components ((:file "generic")))
diff --git a/def.lisp b/def.lisp
index 6b517ed..65fd695 100644
--- a/def.lisp
+++ b/def.lisp
@@ -76,7 +76,14 @@ E.g.
              (intern (format nil "~a-~a" name slot))
              slot))
        (singlep (x)
-         (find x '(:prefix :ro :wo :noarg) :test #'eq))
+         (find x '(:prefix :ro :wo :noarg :required) :test #'eq))
+
+       (handle-required (slot required? kwargs)
+         (if (and required? (not (find :initform kwargs)))
+             (list* :initform `(error ,(format nil "~s is required" slot))
+                    kwargs)
+             kwargs))
+
        (parse-slot-spec-expr (expr)
          " (names ... &key kwargs)"
          (multiple-value-bind (slot-names kwargs) (take-until #'keywordp expr)
@@ -84,9 +91,11 @@ E.g.
              (let ((prefix-accessor? (find ':prefix singles :test #'eq))
                    (read-only? (find ':ro singles :test #'eq))
                    (write-only? (find ':wo singles :test #'eq))
-                   (no-arg? (find ':noarg singles :test #'eq)))
+                   (no-arg? (find ':noarg singles :test #'eq))
+                   (required? (find ':required singles :test #'eq)))
                (assert (not (and read-only? write-only?)) ()
                        "A slot cannot be both read-only (:ro) and write-only (:wo).")
+
                (loop
                  :with accessor-type := (cond (read-only? :reader)
                                               (write-only? :writer)
@@ -100,7 +109,7 @@ E.g.
                        ,accessor-type ,(make-accessor-name slot prefix-accessor?)
                        ,@(unless no-arg?
                            (list :initarg (alexandria:make-keyword slot)))
-                       ,@kwargs
+                       ,@(handle-required slot required? kwargs)
                        :documentation ,doc))
                  :else 
                    :collect
@@ -108,7 +117,7 @@ E.g.
                    ,accessor-type ,(make-accessor-name slot prefix-accessor?)
                    ,@(unless no-arg?
                        (list :initarg (alexandria:make-keyword slot)))
-                   ,@kwargs))))))
+                   ,@(handle-required slot required? kwargs)))))))
 
        (parse-class-options (kwargs)
          (loop :for (key val . more) :on kwargs :by #'cddr
@@ -128,8 +137,8 @@ E.g.
          ,@options))))
 
 
-(defmacro fast (name (&rest lambda-list) -> return-type &body body)
-  "A fastfun is one for which every parameter is typed, a return type is
+(defmacro typed (name (&rest lambda-list) -> return-type &body body)
+  "A typed function is one for which every parameter is typed, a return type is
 declared. DEF:FAST generates an optimized DEFUN.
 
 Each positional parameter must be a list (VAR TYPE) &KEY &REST and
@@ -139,7 +148,7 @@ arguments.
 
 E.g. 
 
-(def::fast sum-ints ((x integer) (y integer) &optional (z integer 0)) -> integer
+(def:typed sum-ints ((x integer) (y integer) &optional (z integer 0)) -> integer
     \"Sums integers\"
     (+ x y z))
 "
diff --git a/package.lisp b/package.lisp
index cec336f..2a87a7e 100644
--- a/package.lisp
+++ b/package.lisp
@@ -3,4 +3,4 @@
 (defpackage #:def
   (:use #:cl)
   (:shadow #:var #:class #:method)
-  (:export #:class #:var #:const #:fast #:generic #:method))
+  (:export #:class #:var #:const #:typed #:generic #:method))
-- 
cgit v1.2.3