From 0a8f78ec333b8193d1155b5839aea67bb62cf480 Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Sat, 10 Aug 2019 22:40:17 +0100 Subject: [PATCH 1/1] Recognize the integer types. There's a lot of these, and writing the whole lot out by hand is really much less rewarding than writing a variety of Cartesian-product- expanding programs. The really fun part was the TeX version... --- doc/SYMBOLS | 113 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/clang.tex | 15 +++++++ doc/list-exports | 36 ++++++++++++++++ doc/misc.tex | 9 ++++ doc/sod.sty | 35 ++++++++++++++++ src/c-types-impl.lisp | 13 ++++++ src/utilities.lisp | 19 +++++++++ 7 files changed, 240 insertions(+) diff --git a/doc/SYMBOLS b/doc/SYMBOLS index cd3dbed..fc98f01 100644 --- a/doc/SYMBOLS +++ b/doc/SYMBOLS @@ -41,6 +41,20 @@ c-types-impl.lisp c-type-float-complex variable c-type-float-imaginary variable c-type-int variable + c-type-int-fast16-t variable + c-type-int-fast32-t variable + c-type-int-fast64-t variable + c-type-int-fast8-t variable + c-type-int-least16-t variable + c-type-int-least32-t variable + c-type-int-least64-t variable + c-type-int-least8-t variable + c-type-int16-t variable + c-type-int32-t variable + c-type-int64-t variable + c-type-int8-t variable + c-type-intmax-t variable + c-type-intptr-t variable c-type-long variable c-type-long-double variable c-type-long-double-complex variable @@ -52,6 +66,20 @@ c-types-impl.lisp c-type-signed-char variable c-type-size-t variable c-type-tag generic + c-type-uint-fast16-t variable + c-type-uint-fast32-t variable + c-type-uint-fast64-t variable + c-type-uint-fast8-t variable + c-type-uint-least16-t variable + c-type-uint-least32-t variable + c-type-uint-least64-t variable + c-type-uint-least8-t variable + c-type-uint16-t variable + c-type-uint32-t variable + c-type-uint64-t variable + c-type-uint8-t variable + c-type-uintmax-t variable + c-type-uintptr-t variable c-type-unsigned variable c-type-unsigned-char variable c-type-unsigned-long variable @@ -79,6 +107,20 @@ c-types-impl.lisp func c-type-form cl:function function class c-type-form sod-utilities:int c-type-spec c-type-form opthandler + int-fast16-t c-type-spec c-type-form + int-fast32-t c-type-spec c-type-form + int-fast64-t c-type-spec c-type-form + int-fast8-t c-type-spec c-type-form + int-least16-t c-type-spec c-type-form + int-least32-t c-type-spec c-type-form + int-least64-t c-type-spec c-type-form + int-least8-t c-type-spec c-type-form + int16-t c-type-spec c-type-form + int32-t c-type-spec c-type-form + int64-t c-type-spec c-type-form + int8-t c-type-spec c-type-form + intmax-t c-type-spec c-type-form + intptr-t c-type-spec c-type-form kind-c-tagged-type generic llong c-type-spec long c-type-spec c-type-form @@ -130,6 +172,20 @@ c-types-impl.lisp tagged-c-type class uchar c-type-spec uint c-type-spec + uint-fast16-t c-type-spec c-type-form + uint-fast32-t c-type-spec c-type-form + uint-fast64-t c-type-spec c-type-form + uint-fast8-t c-type-spec c-type-form + uint-least16-t c-type-spec c-type-form + uint-least32-t c-type-spec c-type-form + uint-least64-t c-type-spec c-type-form + uint-least8-t c-type-spec c-type-form + uint16-t c-type-spec c-type-form + uint32-t c-type-spec c-type-form + uint64-t c-type-spec c-type-form + uint8-t c-type-spec c-type-form + uintmax-t c-type-spec c-type-form + uintptr-t c-type-spec c-type-form ullong c-type-spec ulong c-type-spec cl:union function c-type-form @@ -1040,6 +1096,20 @@ expand-c-type-form (eql fn) t (eql fun) t (eql func) t + (eql int-fast16-t) t + (eql int-fast32-t) t + (eql int-fast64-t) t + (eql int-fast8-t) t + (eql int-least16-t) t + (eql int-least32-t) t + (eql int-least64-t) t + (eql int-least8-t) t + (eql int16-t) t + (eql int32-t) t + (eql int64-t) t + (eql int8-t) t + (eql intmax-t) t + (eql intptr-t) t (eql long) t (eql long-double) t (eql long-double-complex) t @@ -1053,6 +1123,20 @@ expand-c-type-form (eql size-t) t (eql specs) t (eql struct) t + (eql uint-fast16-t) t + (eql uint-fast32-t) t + (eql uint-fast64-t) t + (eql uint-fast8-t) t + (eql uint-least16-t) t + (eql uint-least32-t) t + (eql uint-least64-t) t + (eql uint-least8-t) t + (eql uint16-t) t + (eql uint32-t) t + (eql uint64-t) t + (eql uint8-t) t + (eql uintmax-t) t + (eql uintptr-t) t (eql unsigned) t (eql unsigned-char) t (eql unsigned-long) t @@ -1078,6 +1162,20 @@ expand-c-type-spec (eql double-imaginary) (eql float-complex) (eql float-imaginary) + (eql int-fast16-t) + (eql int-fast32-t) + (eql int-fast64-t) + (eql int-fast8-t) + (eql int-least16-t) + (eql int-least32-t) + (eql int-least64-t) + (eql int-least8-t) + (eql int16-t) + (eql int32-t) + (eql int64-t) + (eql int8-t) + (eql intmax-t) + (eql intptr-t) (eql llong) (eql long) (eql long-double) @@ -1105,6 +1203,20 @@ expand-c-type-spec (eql sshort) (eql uchar) (eql uint) + (eql uint-fast16-t) + (eql uint-fast32-t) + (eql uint-fast64-t) + (eql uint-fast8-t) + (eql uint-least16-t) + (eql uint-least32-t) + (eql uint-least64-t) + (eql uint-least8-t) + (eql uint16-t) + (eql uint32-t) + (eql uint64-t) + (eql uint8-t) + (eql uintmax-t) + (eql uintptr-t) (eql ullong) (eql ulong) (eql unsigned) @@ -2355,6 +2467,7 @@ utilities.lisp compose function copy-instance function copy-instance-using-class generic + cross-product function default-slot macro define-access-wrapper macro define-on-demand-slot macro diff --git a/doc/clang.tex b/doc/clang.tex index 0213269..e7a5b0e 100644 --- a/doc/clang.tex +++ b/doc/clang.tex @@ -515,6 +515,9 @@ In Sod, the leaf types are \x{double} \x{long-double} \x{float-imaginary} \x{double-imaginary} \x{long-double-imaginary} \x{float-complex} \x{double-complex} \x{long-double-complex} \x{va-list} \x{void} + \crossproduct\x{{{int}{uint}}{{}{-least}{-fast}}{{8}{16}{32}{64}}{{-t}}} + \crossproduct\x{{{int}{uint}}{{ptr}{max}}{{-t}}} + A number of symbolic type specifiers for builtin types are predefined as shown in \xref{tab:codegen.c-types.simple}. These are all defined as if by @|define-simple-c-type|, so can be used to construct qualified types. @@ -549,6 +552,18 @@ In Sod, the leaf types are @|ullong| \\ \hlx{v} @|size_t| & @|size-t| \\ \hlx{} @|ptrdiff_t| & @|ptrdiff-t| \\ \hlx{v} + @|int$n$_t| & @|int$n$-t| + (for $n \in \{ @|8|, @|16|, @|32|, @|64| \}$) + \\ \hlx{} + @|uint$n$_t| & @|uint$n$-t| \\ \hlx{} + @|int_least$n$_t| & @|int_least$n$-t| \\ \hlx{} + @|uint_least$n$_t| & @|uint_least$n$-t| \\ \hlx{} + @|int_fast$n$_t| & @|int_fast$n$-t| \\ \hlx{} + @|uint_fast$n$_t| & @|uint_fast$n$-t| \\ \hlx{v} + @|intptr_t| & @|intptr-t| \\ \hlx{} + @|uintptr_t| & @|uintptr-t| \\ \hlx{} + @|intmax_t| & @|intmax-t| \\ \hlx{} + @|uintmax_t| & @|uintmax-t| \\ \hlx{v} @|float| & @|float| \\ \hlx{} @|double| & @|double| \\ \hlx{} @|long double| & @|long-double| \\ \hlx{v} diff --git a/doc/list-exports b/doc/list-exports index 3a444e1..9fc38bb 100755 --- a/doc/list-exports +++ b/doc/list-exports @@ -159,6 +159,42 @@ (and export (list* (symbolicate 'c-type- (car names)) names))))) +(defmethod form-list-exports + ((head (eql 'sod::define-cross-product-types)) tail) + "Return the symbols exported by a `define-cross-product-types' form. + + This is a scummy internal macro in `c-types-impl.lisp'. The syntax is + + (define-cross-product-types PIECES) + + Each piece can be a list of strings, or an atomic string (which is + equivalent to a list containing just that string). For each string formed + by concatenating one element from each list in order, define a C type with + that name; the Lisp name is constructed by translating the letters to + uppercase and replacing underscores by hyphens. For each such name, + export `NAME' and `c-type-NAME'." + + ;; Huh. I feel a hack coming on. + (mapcar (lambda (row) + (intern (with-output-to-string (out) + (dolist (s row) + (dotimes (i (length s)) + (let ((ch (char s i))) + (if (char= ch #\_) + (write-char #\- out) + (write-char (char-upcase ch) out)))))))) + (reduce (lambda (piece tails) + (mapcan (lambda (tail) + (mapcar (lambda (head) + (cons head tail)) + (if (listp piece) piece + (list piece)))) + tails)) + (cons '("" "c-type_") tail) + :from-end t + :initial-value '(nil)))) + + (defmethod form-list-exports ((head (eql 'cl:macrolet)) tail) "Return the symbols expored by a toplevel `macrolet' form. diff --git a/doc/misc.tex b/doc/misc.tex index ac89b6c..859ec51 100644 --- a/doc/misc.tex +++ b/doc/misc.tex @@ -505,6 +505,15 @@ be implemented fairly easily using @|merge-lists| below. the partial order. \end{describe} +\begin{describe}{fun}{cross-product \&rest @} + Return the cross product of the @. + + Each arguments may be a list, or a (non-nil) atom, which is equivalent to a + singleton list containing just that atom. Return a list of all possible + lists which can be constructed by taking one item from each argument list + in turn, in an arbitrary order. +\end{describe} + \begin{describe}{fun} {find-duplicates @ @ \&key :key :test} Call @ on each pair of duplicate items in a @. diff --git a/doc/sod.sty b/doc/sod.sty index 4d2f407..44fe07a 100644 --- a/doc/sod.sty +++ b/doc/sod.sty @@ -237,6 +237,41 @@ %% Show a backslash by the right-hand margin; for multiline macros etc. \def\macsl{\`\textbackslash\hskip\leftmargin} +%% \maplist{THING}{{ITEM}...}: Invoke THING{ITEM} for each ITEM in turn. +\def\maplist#1#2{\map@i{#1}#2\q@} +\def\map@i#1{\def\next@{\map@ii{#1}}\futurelet\ch@\next@} +\def\map@ii#1{\ifx\ch@\q@\expandafter\@gobble% + \else\def\next@{\map@iii{#1}}\expandafter\next@\fi} +\def\map@iii#1#2{#1{#2}\map@i{#1}} + +%% \crossproduct{THING}{{LIST}...} where each LIST is {ITEM}... +%% For each possible way of selecting one ITEM from each LIST, in order, +%% invoke THING{{ITEM}...} +\toksdef\cprod@new=0 +\toksdef\cprod@old=2 +\toksdef\cprod@head=4 +\toksdef\cprod@tail=6 +\def\crossproduct#1#2{% + \cprod@new{{}}% + \maplist{\cprod@f{#1}}{#2}% + \cprod@head{#1}% + \edef\next@{\noexpand\maplist{\the\cprod@head}{\the\cprod@new}} + \next@% +} +\def\cprod@f#1#2{% + \cprod@old\cprod@new\cprod@new{}% + \maplist\cprod@g{#2}% +} +\def\cprod@g#1{% + \cprod@head{#1}% + \expandafter\maplist\expandafter\cprod@h\expandafter{\the\cprod@old}% +} +\def\cprod@h#1{% + \cprod@tail{#1}% + \cprod@new\expandafter{\the\expandafter\cprod@new\expandafter{% + \the\expandafter\cprod@tail\the\cprod@head}}% +} + %%%-------------------------------------------------------------------------- %%% Machinery for describing functions, etc. diff --git a/src/c-types-impl.lisp b/src/c-types-impl.lisp index a5969d4..e5ead1b 100644 --- a/src/c-types-impl.lisp +++ b/src/c-types-impl.lisp @@ -292,6 +292,19 @@ (define-simple-c-type size-t "size_t" :export t) (define-simple-c-type ptrdiff-t "ptrdiff_t" :export t) +(macrolet ((define-cross-product-types (&rest pieces) + `(progn + ,@(mapcar (lambda (row) + (let* ((c-name (apply #'concatenate 'string row)) + (lisp-name (intern + (frob-identifier c-name)))) + `(define-simple-c-type ,lisp-name ,c-name + :export t))) + (apply #'cross-product pieces))))) + (define-cross-product-types ("int" "uint") ("" "_least" "_fast") + ("8" "16" "32" "64") "_t") + (define-cross-product-types ("int" "uint") ("ptr" "max") "_t")) + ;;;-------------------------------------------------------------------------- ;;; Tagged types (enums, structs and unions). diff --git a/src/utilities.lisp b/src/utilities.lisp index 1670f55..25733e8 100644 --- a/src/utilities.lisp +++ b/src/utilities.lisp @@ -451,6 +451,25 @@ and return the result of appending all of the resulting lists." (reduce #'append (apply #'mapcar function list more-lists) :from-end t)) +(export 'cross-product) +(defun cross-product (&rest pieces) + "Return the cross product of the PIECES. + + Each arguments may be a list, or a (non-nil) atom, which is equivalent to + a singleton list containing just that atom. Return a list of all possible + lists which can be constructed by taking one item from each argument list + in turn, in an arbitrary order." + (reduce (lambda (piece tails) + (mapcan (lambda (tail) + (mapcar (lambda (head) + (cons head tail)) + (if (listp piece) piece + (list piece)))) + tails)) + pieces + :from-end t + :initial-value '(nil))) + (export 'distinguished-point-shortest-paths) (defun distinguished-point-shortest-paths (root neighbours-func) "Moderately efficient shortest-paths-from-root computation. -- 2.11.0