Skip to content

Commit 829a6e1

Browse files
Fuco1Fuco1
committed
feat(analysis): add initial analysis of keyword arguments
1 parent cd09e67 commit 829a6e1

File tree

6 files changed

+210
-95
lines changed

6 files changed

+210
-95
lines changed

‎elsa-analyser.el‎

Lines changed: 65 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -922,8 +922,8 @@ If no type annotation is provided, find the value type through
922922
((not expected)
923923
(push (list overload overload-index
924924
(format
925-
"Argument %d is present but the function signature does not define it. Missing overload?"
926-
(1+ index)))
925+
"Argument %s is present but the function signature does not define it. Missing overload?"
926+
(if (numberp index) (1+ index) index)))
927927
overloads-errors))
928928
((trinary-false-p acceptablep)
929929
(push (list overload overload-index
@@ -934,16 +934,15 @@ If no type annotation is provided, find the value type through
934934
;; possible type is (const "whatever")
935935
(elsa-with-temp-explainer explainer
936936
(elsa-explain-and-indent explainer
937-
("Argument %d accepts type `%s' but received `%s'"
938-
(1+ index)
937+
("Argument %s accepts type `%s' but received `%s'"
938+
(if (numberp index) (1+ index) index)
939939
(elsa-type-describe expected-normalized)
940940
(elsa-type-describe actual))
941941
(elsa-type-accept expected-normalized actual explainer))
942942
explainer))
943943
overloads-errors)))
944944
(and expected (trinary-possible-p acceptablep))))
945945
overloads))
946-
;; (elsa-log "good-overloads %s" (mapconcat (lambda (x) (elsa-tostring (car x))) good-overloads " "))
947946
(if good-overloads
948947
;; If we have multiple overloads where the argument is of a
949948
;; concrete type, that is not a sum or intersection (where the
@@ -955,9 +954,7 @@ If no type annotation is provided, find the value type through
955954
;; pick the last (smallest) one.
956955
(if (= (length good-overloads) 1)
957956
(setq new-overloads good-overloads)
958-
(setq new-overloads (elsa--simplify-overloads good-overloads index))
959-
;; (elsa-log "new-overloads %s" (mapconcat (lambda (x) (elsa-tostring (car x))) new-overloads " "))
960-
)
957+
(setq new-overloads (elsa--simplify-overloads good-overloads index)))
961958
(setq new-overloads nil)
962959
(elsa-state-add-message state
963960
(if (< 1 (length overloads-errors))
@@ -975,7 +972,9 @@ If no type annotation is provided, find the value type through
975972
(elsa-make-error argument-form
976973
explainer
977974
:code "no-overloads"))
978-
(elsa-make-error argument-form
975+
(elsa-make-error (if (keywordp index)
976+
(oref argument-form previous)
977+
argument-form)
979978
(let ((expl-or-fmt (nth 2 (car overloads-errors))))
980979
(if (elsa-explainer-p expl-or-fmt)
981980
(elsa--reset-depth expl-or-fmt)
@@ -1011,35 +1010,37 @@ SCOPE and STATE are the scope and state objects."
10111010
(setq spec (elsa--analyse-normalize-spec spec form))
10121011
(let* ((name (elsa-get-name head))
10131012
(type (elsa-get-type head))
1014-
(narrow-type (elsa-function-get-narrow-type name)))
1013+
(narrow-type (elsa-function-get-narrow-type name))
1014+
(num-of-args (length args))
1015+
(min 0)
1016+
(max num-of-args))
10151017
(-each (-zip args spec)
10161018
(-lambda ((arg . analysep))
10171019
(when analysep
10181020
(elsa--analyse-form arg scope state))))
10191021
;; check arity
10201022
(when name
1021-
(-let (((min . max) (elsa-fn-arity state name))
1022-
(num-of-args (length args)))
1023-
(when (eq max 'undefined)
1024-
(elsa-state-add-message state
1025-
(elsa-make-warning head
1026-
"Function `%s' is missing arglist definition. Maybe it is called before being declared?"
1027-
name)))
1028-
(when (< num-of-args min)
1029-
(elsa-state-add-message state
1030-
(elsa-make-error head
1031-
"Function `%s' expects at least %d %s but received %d"
1032-
name min
1033-
(elsa-pluralize "argument" min)
1034-
num-of-args)))
1035-
(when (and (not (memq max '(many unevalled undefined)))
1036-
(> num-of-args max))
1037-
(elsa-state-add-message state
1038-
(elsa-make-error head
1039-
"Function `%s' expects at most %d %s but received %d"
1040-
name max
1041-
(elsa-pluralize "argument" max)
1042-
num-of-args)))))
1023+
(-setq (min . max) (elsa-fn-arity state name))
1024+
(when (eq max 'undefined)
1025+
(elsa-state-add-message state
1026+
(elsa-make-warning head
1027+
"Function `%s' is missing arglist definition. Maybe it is called before being declared?"
1028+
name)))
1029+
(when (< num-of-args min)
1030+
(elsa-state-add-message state
1031+
(elsa-make-error head
1032+
"Function `%s' expects at least %d %s but received %d"
1033+
name min
1034+
(elsa-pluralize "argument" min)
1035+
num-of-args)))
1036+
(when (and (not (memq max '(many unevalled undefined)))
1037+
(> num-of-args max))
1038+
(elsa-state-add-message state
1039+
(elsa-make-error head
1040+
"Function `%s' expects at most %d %s but received %d"
1041+
name max
1042+
(elsa-pluralize "argument" max)
1043+
num-of-args))))
10431044
;; check the types
10441045
(when type
10451046
;; analyse the arguments
@@ -1054,13 +1055,38 @@ SCOPE and STATE are the scope and state objects."
10541055
(overloads (--map-indexed (cons it it-index) all-overloads)))
10551056
(-each-indexed args
10561057
(lambda (index argument-form)
1057-
(let ((check-results (elsa--check-argument-for-index
1058-
index argument-form overloads state
1059-
all-overloads overloads-errors)))
1060-
(setq overloads-errors
1061-
(append overloads-errors (plist-get check-results :errors)))
1062-
(setq overloads (plist-get check-results :overloads))
1063-
(unless overloads (throw 'no-overloads nil)))))
1058+
(when-let ((arg-idx (cond
1059+
((< index min) index)
1060+
((symbolp max)
1061+
;; this is most likely a
1062+
;; keyword argument, so we
1063+
;; check if it's a keyword
1064+
;; and if so pass it forward
1065+
(cond
1066+
;; if this index is a
1067+
;; keyword, we just skip to
1068+
;; the next argument form.
1069+
((and (elsa-form-keyword-p argument-form)
1070+
(cl-evenp (- index min)))
1071+
nil)
1072+
;; if the previous form was
1073+
;; a keyword, that's the
1074+
;; thing we need to look up
1075+
((elsa-form-keyword-p
1076+
(oref argument-form previous))
1077+
(elsa-form-to-lisp
1078+
(oref argument-form previous)))
1079+
(t index)))
1080+
(t index))))
1081+
(let ((check-results
1082+
(elsa--check-argument-for-index
1083+
arg-idx
1084+
argument-form overloads state
1085+
all-overloads overloads-errors)))
1086+
(setq overloads-errors
1087+
(append overloads-errors (plist-get check-results :errors)))
1088+
(setq overloads (plist-get check-results :overloads))
1089+
(unless overloads (throw 'no-overloads nil))))))
10641090
(mapcar #'car overloads))))))
10651091
;; set the return type of the form according to the return type
10661092
;; of the function's declaration

‎elsa-extension-eieio.el‎

Lines changed: 53 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -105,7 +105,8 @@
105105
(--each slots
106106
(let ((slot (elsa-structure-slot
107107
:name (car it)
108-
:type (plist-get (cdr it) :type))))
108+
:type (plist-get (cdr it) :type)
109+
:initarg (plist-get (cdr it) :initarg))))
109110
(puthash (oref slot name) slot ht)))
110111
ht))
111112

@@ -127,44 +128,59 @@
127128
(copy-sequence pts)))
128129
(list p)))
129130
parents))
130-
parents-names)))
131-
132-
(elsa-state-add-defclass state
133-
(elsa-defclass
134-
:name name
135-
:slots (elsa-eieio--create-slots
136-
(mapcar
137-
(lambda (slot)
138-
(let* ((slot-name (elsa-get-name slot))
139-
(type-form (map-elt (elsa-cdr slot) :type))
140-
(type-lisp (elsa-form-to-lisp type-form))
141-
(elsa-type (or (and type-lisp
142-
(or (elsa--cl-type-to-elsa-type type-lisp)
143-
(elsa-type-mixed)))
144-
(elsa-type-mixed)))
145-
(accessor (map-elt (elsa-cdr slot) :accessor)))
146-
147-
(when accessor
148-
(elsa-state-add-method state
149-
(elsa-defun
150-
:name (elsa-get-name accessor)
151-
:defun-type 'cl-defmethod
152-
:type (elsa-function-type
153-
:args (list (elsa--make-type `(class ,name)))
154-
:return elsa-type)
155-
:arglist (list 'this))))
156-
157-
(list slot-name :type elsa-type)))
158-
(elsa-form-sequence slots)))
159-
:parents (let ((-compare-fn (-on #'eq #'car)))
160-
(-uniq (cons (cons name parents-names) parents-tree)))))
131+
parents-names))
132+
(class nil))
133+
134+
(setq
135+
class
136+
(elsa-defclass
137+
:name name
138+
:slots (elsa-eieio--create-slots
139+
(mapcar
140+
(lambda (slot)
141+
(let* ((slot-name (elsa-get-name slot))
142+
(type-form (map-elt (elsa-cdr slot) :type))
143+
(type-lisp (elsa-form-to-lisp type-form))
144+
(elsa-type (or (and type-lisp
145+
(or (elsa--cl-type-to-elsa-type type-lisp)
146+
(elsa-type-mixed)))
147+
(elsa-type-mixed)))
148+
(accessor (map-elt (elsa-cdr slot) :accessor))
149+
(initarg (map-elt (elsa-cdr slot) :initarg)))
150+
151+
(when accessor
152+
(elsa-state-add-method state
153+
(elsa-defun
154+
:name (elsa-get-name accessor)
155+
:defun-type 'cl-defmethod
156+
:type (elsa-function-type
157+
:args (list (elsa--make-type `(class ,name)))
158+
:return elsa-type)
159+
:arglist (list 'this))))
160+
161+
(list slot-name
162+
:type elsa-type
163+
:initarg (elsa-get-name initarg))))
164+
(elsa-form-sequence slots)))
165+
:parents (let ((-compare-fn (-on #'eq #'car)))
166+
(-uniq (cons (cons name parents-names) parents-tree)))))
167+
168+
(elsa-state-add-defclass state class)
161169

162170
;; add the constructor
163-
(elsa-state-add-defun state
164-
(elsa-defun
165-
:name name
166-
:type (elsa--make-type `(function (&rest mixed) (class ,name)))
167-
:arglist (list '&rest 'args)))
171+
(let ((kw-args (->> (elsa-get-slots class)
172+
(--filter (oref it initarg))
173+
(--map (list (oref it initarg)
174+
(oref it type)))
175+
(elsa-type-make-plist-hashtable)
176+
(elsa-type-keys :slots))))
177+
(elsa-state-add-defun state
178+
(elsa-defun
179+
:name name
180+
:type (elsa-function-type
181+
:args (list kw-args)
182+
:return (elsa--make-type `(class ,name)))
183+
:arglist (list '&rest 'args))))
168184

169185
;; add the type predicate
170186
(elsa-state-add-defun state

‎elsa-structure-slot.el‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,7 @@
3535
((name
3636
:type symbol
3737
:initarg :name
38+
:accessor elsa-get-name
3839
:documentation "Slot name.")
3940
(initarg
4041
:type (or symbol null)
@@ -44,6 +45,7 @@
4445
(type
4546
:type elsa-type
4647
:initarg :type
48+
:accessor elsa-get-type
4749
:documentation "Slot Elsa type."))
4850
:documentation "Data about a slot in interface-like structure.
4951

‎elsa-type-helpers.el‎

Lines changed: 9 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -158,7 +158,8 @@ Returns trinary value."
158158
(oset list-type car-type item-type)
159159
(oset list-type cdr-type item-type)
160160
list-type))
161-
(`(plist . ,slots)
161+
((and `(,type . ,slots)
162+
(guard (memq type '(plist keys))))
162163
(let* ((decl (-split-on '&extends slots))
163164
(slot-pairs (-partition 2 (unless (eq '&extends (car slots))
164165
(car decl))))
@@ -173,8 +174,10 @@ Returns trinary value."
173174
:name (car slot)
174175
:type (elsa--make-type (cadr slot)))
175176
table)))
176-
(elsa-type-plist :slots table
177-
:extends interfaces)))
177+
(if (eq type 'plist)
178+
(elsa-type-plist :slots table
179+
:extends interfaces)
180+
(elsa-type-keys :slots table))))
178181
(`(interface ,name . ,slots)
179182
(let* ((decl (-split-on '&extends slots))
180183
(slot-pairs (-partition 2 (unless (eq '&extends (car slots))
@@ -331,6 +334,9 @@ might not make sense."
331334
332335
If overloads are not comparable, select all of them.
333336
337+
INDEX is the position in the arglist or a keyword for named
338+
arguments.
339+
334340
Items in LIST are of form (TYPE . OVERLOAD-INDEX)."
335341
(-mapcat
336342
#'car

‎elsa-types.el‎

Lines changed: 38 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -209,14 +209,17 @@ A callable type can be called either directly as a list form or
209209
with `funcall' or `apply' (or with other similar functions)."
210210
nil)
211211

212-
;; (elsa-function-type-nth-arg :: (function (mixed int) mixed))
212+
;; (elsa-function-type-nth-arg :: (function (mixed (or int symbol)) mixed))
213213
(cl-defgeneric elsa-function-type-nth-arg (_this _n)
214-
"Return type of Nth argument.
214+
"Return type of Nth argument or named argument.
215215
216216
For non-callable functions, return nil.
217217
218-
If N is more than the arity of the function and the last argument
219-
is variadic, return that type, otherwise return nil."
218+
If N is more or equal to the arity of the function and the last
219+
argument is variadic, return that type, otherwise return nil.
220+
221+
If N is not a number, it is assumed to be a slot name which we
222+
look up in the last keys argument type."
220223
nil)
221224

222225
(defclass elsa-type-empty (elsa-type elsa-simple-type eieio-singleton) ()
@@ -748,6 +751,24 @@ One key and value pair is called a slot.
748751
An example of plist is (:one 1 :two 2). Elsa currently supports
749752
symbols as keys.")
750753

754+
(defun elsa-type-make-plist-hashtable (pairs)
755+
"Make hashtable of slots from PAIRS of keywords and types.
756+
757+
Each item of PAIRS is a list (KEYWORD ELSA-TYPE)"
758+
(let ((hashtable (make-hash-table)))
759+
(dolist (pair pairs)
760+
(let ((keyword (car pair))
761+
(type (cadr pair)))
762+
(puthash keyword (elsa-structure-slot :name keyword :type type) hashtable)))
763+
hashtable))
764+
765+
(defclass elsa-type-keys (elsa-type-plist) ()
766+
"This is a type of keyword arguments and available slots.
767+
768+
It is the same as plist except it is only used to denote that
769+
this plist type is supposed to be expanded into key-value pairs
770+
rather than consumed as a single value in the argument list.")
771+
751772
(cl-defmethod elsa-type-accept ((this elsa-type-plist) (other elsa-type-plist) &optional explainer)
752773
(elsa-with-explainer explainer
753774
(elsa--fmt-explain-type-0-does-not-accept-type-1
@@ -758,7 +779,8 @@ symbols as keys.")
758779
(let* ((slots (oref this slots))
759780
(keys (-sort #'string< (hash-table-keys slots)))
760781
(extends (-sort #'string< (oref this extends))))
761-
(format "(plist %s%s)"
782+
(format "(%s %s%s)"
783+
(if (elsa-type-plist-p this) "plist" "keys")
762784
(mapconcat
763785
(lambda (key)
764786
(let ((slot (gethash key slots)))
@@ -863,16 +885,19 @@ then this is a supertype of other."
863885
(cl-defmethod elsa-type-callable-p ((_this elsa-function-type)) t)
864886

865887
(cl-defmethod elsa-function-type-nth-arg ((this elsa-function-type) n)
866-
(let* ((args (oref this args))
867-
(type (nth n args)))
888+
(let* ((args (oref this args)))
868889
(cond
869-
((eq type nil)
890+
((symbolp n)
891+
(let ((last-type (-last-item args)))
892+
(when (elsa-type-keys-p last-type)
893+
(when-let ((slot (elsa-get-slot last-type n)))
894+
(elsa-get-type slot)))))
895+
((<= (1- (length args)) n)
870896
(let ((last-type (-last-item args)))
871-
(when (elsa-variadic-type-p last-type)
872-
(oref last-type item-type))))
873-
((elsa-variadic-type-p type)
874-
(oref type item-type))
875-
(t type))))
897+
(if (elsa-variadic-type-p last-type)
898+
(oref last-type item-type)
899+
last-type)))
900+
(t (nth n args)))))
876901

877902
(cl-defmethod elsa-type-get-args ((this elsa-function-type))
878903
"Get argument types of THIS function type."

0 commit comments

Comments
 (0)