alex-eg
1f445f0f9b
Two things out of one mechanism. `_' as a type means "work it out from
the initializer", so (var n _ (strlen s)) stops needing size-t spelled
out; `type-of' hands a macro the type of an expression, so a macro can
dispatch on what it was handed rather than on what was declared. Both
read the same answers from two sides.
Algorithm W's core, intra-procedural, with the extensions C forces:
- an unknown type, since (include stdio.h) brings in names we never
parsed. Unification is consistency rather than equality, so
anything touching an unparsed declaration stops constraining
instead of rejecting a program that compiled yesterday;
- the usual arithmetic conversions, since `+' is not a function of
one type;
- checking mode for initializers, since #(0 0) has no type of its own
and takes one from its context. #(T : ...) is the way out of that.
What it wanted on the way:
- what type a *name* has, which neither the typedef nor the tag
database recorded. One table serves functions and variables, since
a function type already has a surface spelling;
- a scope chain, so a (var c int 9) inside a do ends with the block;
- form-type, keyed by cons cell, so one form has one type;
- macros expanded during the walk rather than before it, so type-of
is answered in the scope the macro was written in.
Closures take the same machinery: a receiver whose type comes from a
call, captures written (name expr) and typed from the expression, and
conversion from a bare function wherever a closure is expected.
type-match grew `_' on the pattern side, since (closure ((int)) int)
and (closure ((float)) int) were separate clauses for one case.
221 lines
9.0 KiB
Scheme
221 lines
9.0 KiB
Scheme
;;; The type database.
|
|
;;;
|
|
;;; Names here are prefixed so they cannot collide with the types the
|
|
;;; other suites register: the database is one table in the linked
|
|
;;; binary, and semen fills it in whenever a suite compiles a struct.
|
|
|
|
(import types)
|
|
|
|
(test-group "types"
|
|
|
|
(add-struct 't-point '(struct t-point ((x int) (y int))))
|
|
(test "fields come back as (name type)"
|
|
'((x int) (y int))
|
|
(get-fields 't-point))
|
|
(test "and the whole entry is tagged"
|
|
'(struct t-point ((x int) (y int)))
|
|
(get-type-info 't-point))
|
|
|
|
;; Fields are written with the type last, so one entry can declare
|
|
;; several names. They come back as one field each.
|
|
(add-struct 't-settings
|
|
'(pub struct t-settings ((x y w h u32) (title (* const char)))))
|
|
(test "names sharing a type are split apart"
|
|
'((x u32) (y u32) (w u32) (h u32) (title (* const char)))
|
|
(get-fields 't-settings))
|
|
|
|
(add-struct 't-commented '(struct t-commented ((comment " hi") (a int))))
|
|
(test "a comment among the fields is not a field"
|
|
'((a int))
|
|
(get-fields 't-commented))
|
|
|
|
(add-union 't-value '(union t-value ((i int) (f float))))
|
|
(test "unions have fields too"
|
|
'((i int) (f float))
|
|
(get-fields 't-value))
|
|
|
|
(add-enum 't-color '(enum t-color (red green blue)))
|
|
(test "enums keep their values"
|
|
'(enum t-color (red green blue))
|
|
(get-type-info 't-color))
|
|
(test "but have no fields"
|
|
#f
|
|
(get-fields 't-color))
|
|
|
|
(add-typedef 't-u8 '(typedef t-u8 uint8-t))
|
|
(test "a typedef resolves to its target"
|
|
'uint8-t
|
|
(get-underlying-type 't-u8))
|
|
(add-typedef 't-byte '(typedef t-byte t-u8))
|
|
(test "and chains are followed to the end"
|
|
'uint8-t
|
|
(get-underlying-type 't-byte))
|
|
(test "a struct is not a typedef"
|
|
#f
|
|
(get-underlying-type 't-point))
|
|
|
|
;; Reflection through an alias. Both spellings of the target occur:
|
|
;; (typedef point-t point) and (typedef point-t (struct point)).
|
|
(add-typedef 't-point-t '(typedef t-point-t t-point))
|
|
(test "a typedef to a struct has the struct's fields"
|
|
'((x int) (y int))
|
|
(get-fields 't-point-t))
|
|
(add-typedef 't-point-s '(typedef t-point-s (struct t-point)))
|
|
(test "written the other way round too"
|
|
'((x int) (y int))
|
|
(get-fields 't-point-s))
|
|
(add-typedef 't-point-2 '(typedef t-point-2 t-point-t))
|
|
(test "and through a chain of them"
|
|
'((x int) (y int))
|
|
(get-fields 't-point-2))
|
|
(test "map-fields follows an alias as well"
|
|
'((x int) (y int))
|
|
(map-fields 't-point-t (lambda (name type) (list name type))))
|
|
(add-typedef 't-color-t '(typedef t-color-t t-color))
|
|
(test "an aliased enum is still named as it was declared"
|
|
'((red (enum t-color)) (green (enum t-color)) (blue (enum t-color)))
|
|
(map-fields 't-color-t (lambda (name type) (list name type))))
|
|
(test "a typedef to a primitive has no fields"
|
|
#f
|
|
(get-fields 't-u8))
|
|
|
|
;; C keeps typedefs and ordinary identifiers apart, and the canonical way
|
|
;; to declare a struct uses both names at once. Neither declaration
|
|
;; may stand on the other.
|
|
(add-struct 't-node '(struct t-node ((next (* t-node)) (v int))))
|
|
(add-typedef 't-node '(typedef t-node (struct t-node)))
|
|
(test "a typedef of a struct's own name keeps the struct reachable"
|
|
'((next (* t-node)) (v int))
|
|
(get-fields 't-node))
|
|
(test "and the tag is there under its own name"
|
|
'(struct t-node ((next (* t-node)) (v int)))
|
|
(get-tag-info 't-node))
|
|
(add-struct 't-rect '(struct t-rect ((w int) (h int))))
|
|
(add-define 't-rect '(define t-rect 3))
|
|
(test "a define of a tag's name does not hide the fields"
|
|
'((w int) (h int))
|
|
(get-fields 't-rect))
|
|
|
|
;; A type built over a struct is not that struct. Handing back the
|
|
;; element's fields would have a macro write v->x for an array
|
|
(add-typedef 't-points '(typedef t-points (¤ t-point 4)))
|
|
(test "an array of a struct has no fields of its own"
|
|
#f
|
|
(get-fields 't-points))
|
|
(add-typedef 't-point-p '(typedef t-point-p (* t-point)))
|
|
(test "nor does a pointer to one"
|
|
#f
|
|
(get-fields 't-point-p))
|
|
(add-typedef 't-cb '(typedef t-cb (fn ((t-point)) void)))
|
|
(test "nor a function type over one"
|
|
#f
|
|
(get-fields 't-cb))
|
|
|
|
;; A typedef can be written to lead back to itself. Resolving it must
|
|
;; stop rather than spin
|
|
(add-typedef 't-loop-a '(typedef t-loop-a t-loop-b))
|
|
(add-typedef 't-loop-b '(typedef t-loop-b t-loop-a))
|
|
(test "a typedef cycle terminates"
|
|
't-loop-a
|
|
(get-underlying-type 't-loop-a))
|
|
(test "and has no fields"
|
|
#f
|
|
(get-fields 't-loop-a))
|
|
|
|
;; A #define keeps its value forms -- there can be more than one.
|
|
(add-define 't-maxn '(define t-maxn 8))
|
|
(test "defines are recorded"
|
|
'(define t-maxn (8))
|
|
(get-type-info 't-maxn))
|
|
|
|
;; map-fields walks an aggregate, handing each field to a function.
|
|
(test "map-fields visits every field"
|
|
'((x int) (y int))
|
|
(map-fields 't-point (lambda (name type) (list name type))))
|
|
(test "and splits shared names apart too"
|
|
'(x y w h title)
|
|
(map-fields 't-settings (lambda (name type) name)))
|
|
;; An enumerator's type is the enum itself.
|
|
(test "enum values are fields whose type is the enum"
|
|
'((red (enum t-color)) (green (enum t-color)) (blue (enum t-color)))
|
|
(map-fields 't-color (lambda (name type) (list name type))))
|
|
(test "a typedef has no fields to map"
|
|
#f
|
|
(map-fields 't-u8 (lambda (name type) name)))
|
|
(test "nor does an undeclared name"
|
|
#f
|
|
(map-fields 't-nothing (lambda (name type) name)))
|
|
|
|
;; type-match compares whole types, since a type is a form.
|
|
(test "a bare type matches" 'yes (type-match 'int (int 'yes) (else 'no)))
|
|
(test "so does a compound one" 'yes (type-match '(* const char)
|
|
(int 'no)
|
|
((* const char) 'yes)
|
|
(else 'no)))
|
|
;; The [int 10] of the docstring is Sex notation: the Sex reader turns
|
|
;; brackets into a ¤ form, while CHICKEN reads them as plain parens.
|
|
;; In a .scm file the array type has to be written out.
|
|
(test "and an array" 'yes (type-match '(¤ int 10)
|
|
((¤ int 10) 'yes)
|
|
(else 'no)))
|
|
(test "else catches the rest" 'no (type-match '(* void) (int 'yes) (else 'no)))
|
|
(test "a near miss does not match" 'no (type-match '(¤ int 20)
|
|
((¤ int 10) 'yes)
|
|
(else 'no)))
|
|
(test "no clause matching and no else is #f"
|
|
#f
|
|
(type-match 'float (int 'yes)))
|
|
|
|
;; `_' in a pattern matches anything in that position; written last it
|
|
;; takes the rest, since a type's words are spread and not nested
|
|
(test "a wildcard matches an atom"
|
|
'yes (type-match 'int (_ 'yes) (else 'no)))
|
|
(test "a pointer to anything"
|
|
'yes (type-match '(* int) ((* _) 'yes) (else 'no)))
|
|
(test "including one spelled with qualifiers"
|
|
'yes (type-match '(* const char) ((* _) 'yes) (else 'no)))
|
|
(test "an array of anything, any length"
|
|
'yes (type-match '(¤ int 4) ((¤ _ _) 'yes) (else 'no)))
|
|
(test "but a sized pattern does not match an unsized array"
|
|
'no (type-match '(¤ int) ((¤ _ _) 'yes) (else 'no)))
|
|
(test "an aggregate of any tag"
|
|
'yes (type-match '(struct point) ((struct _) 'yes) (else 'no)))
|
|
(test "and the keyword still has to agree"
|
|
'no (type-match '(union point) ((struct _) 'yes) (else 'no)))
|
|
(test "a closure of any signature"
|
|
'yes (type-match '(closure ((float)) int) ((closure _ _) 'yes) (else 'no)))
|
|
(test "an exact pattern is still exact"
|
|
'no (type-match '(* int) ((* const char) 'yes) (else 'no)))
|
|
|
|
(test "an undeclared name has no entry"
|
|
#f
|
|
(get-type-info 't-never-declared))
|
|
(test "and no fields"
|
|
#f
|
|
(get-fields 't-never-declared))
|
|
|
|
;; What type a *name* has -- the third table, which functions and
|
|
;; variables share because a function type has a surface spelling
|
|
(add-name-type! 't-sum '(fn ((int) (int)) int))
|
|
(add-name-type! 't-origin '(struct t-point))
|
|
(test "a function's signature comes back whole"
|
|
'(fn ((int) (int)) int)
|
|
(get-name-type 't-sum))
|
|
(test "and a variable's type"
|
|
'(struct t-point)
|
|
(get-name-type 't-origin))
|
|
(test "the return type is what a call site wants"
|
|
'int
|
|
(get-return-type 't-sum))
|
|
(test "a variable has no return type"
|
|
#f
|
|
(get-return-type 't-origin))
|
|
;; not an error: this is how a name from an included C header looks,
|
|
;; and the caller decides what to make of it
|
|
(test "an undeclared name has no type"
|
|
#f
|
|
(get-name-type 't-never-declared))
|
|
(test "nor a return type"
|
|
#f
|
|
(get-return-type 't-never-declared)))
|