forked from alex-eg/sex
show the cases the comments were describing
This commit is contained in:
131
semen.scm
131
semen.scm
@@ -299,12 +299,15 @@
|
||||
;;;
|
||||
;;; `(do (var c int 9) ...)' declares a `c' that ends with the block, so
|
||||
;;; a closure-typed `c' outside it is still a closure after it. Every
|
||||
;;; form whose body C brackets opens a frame; innermost first.
|
||||
;;; form whose body C brackets opens a frame; innermost first:
|
||||
;;;
|
||||
;;; One frame per form is enough, rather than one per arm: a `case' label
|
||||
;;; opens no scope in C either, and a declaration is not a statement, so
|
||||
;;; the only way to write one in an `if' arm is the `do' that already
|
||||
;;; brings its own.
|
||||
;;; (var v double 3.75)
|
||||
;;; (while (< v 0) (var v char 1) ...)
|
||||
;;; (var m _ (+ v 1)) ; double, not char
|
||||
;;;
|
||||
;;; One frame per form, not one per arm: a `case' label opens no scope
|
||||
;;; in C, and an `if' arm can only declare inside a `do', which brings
|
||||
;;; its own.
|
||||
|
||||
(define (declare-name! env name type)
|
||||
(hash-table-set! (car (hash-table-ref env :scopes)) name type))
|
||||
@@ -383,10 +386,11 @@
|
||||
|
||||
((var)
|
||||
;; the initializer is walked before the name it binds is in
|
||||
;; scope; the type is resolved rather than walked, a `fn' type's
|
||||
;; parameter list being indistinguishable from a call -- walking
|
||||
;; `(fn ((c int)) int)' with a closure named `c' in scope would
|
||||
;; rewrite the parameter as a call of it
|
||||
;; scope; the type is resolved rather than walked, a parameter
|
||||
;; list being shaped like a call:
|
||||
;;
|
||||
;; (var c (closure ((int)) int) ...)
|
||||
;; (var fp (fn ((c int)) int) ...) ; int (*fp)(int)
|
||||
(let* ((prefix (if (>= (length form) 3)
|
||||
(append (take form 2)
|
||||
(list (resolve-closure-types
|
||||
@@ -427,9 +431,9 @@
|
||||
(else
|
||||
(let ((closure (receiver-closure-type (car form) env)))
|
||||
(if closure
|
||||
;; the receiver is walked first: a closure written where it
|
||||
;; is called registers its struct on the way, and the call
|
||||
;; helper's signature mentions that struct
|
||||
;; the receiver is walked first: `((closure ((x int)) int
|
||||
;; () ...) 5)' registers `struct ƛint_int' on the way, and
|
||||
;; the call helper's signature names it
|
||||
(let ((receiver (walk-statement (car form) env)))
|
||||
(copy-form-source!
|
||||
form
|
||||
@@ -530,10 +534,12 @@
|
||||
(else (pair (cdr params) (- remaining 1)
|
||||
(cons (unwrap-type (car params)) acc))))))
|
||||
|
||||
;;; A `fn' header has its macros expanded and its closure types
|
||||
;;; resolved without being walked; a `var' type is the same thing in the
|
||||
;;; same position, and gets the same two. A macro standing in for a type
|
||||
;;; may still ask `(type-of x)' while it does so.
|
||||
;;; What a `fn' header gets, a `var' type gets -- macro expansion and
|
||||
;;; closure resolution, no walk:
|
||||
;;;
|
||||
;;; (defmacro (ty) 'int) (var x (ty) 0) -> int x = 0;
|
||||
;;;
|
||||
;;; and the macro may ask `(type-of x)' while it stands in for a type.
|
||||
(define (expand-type type env)
|
||||
(let ((expanded
|
||||
(parameterize ((current-type-of
|
||||
@@ -594,8 +600,8 @@
|
||||
(and (symbol? (car expr)) (get-return-type (car expr))))
|
||||
(else
|
||||
(case (car expr)
|
||||
;; subscripting an array gives its element type, and a pointer
|
||||
;; subscripts the same way
|
||||
;; (¤ pts 1), pts : (¤ struct point 2) -> (struct point)
|
||||
;; (¤ p 1), p : (* int) -> int
|
||||
((¤) (let ((base (expression-type (second expr) env)))
|
||||
(or (array-element-type base) (pointer-target base))))
|
||||
;; unary `&' takes an address; with two operands it is bitwise and
|
||||
@@ -613,9 +619,8 @@
|
||||
(cddr expr)))
|
||||
((cast) (and (= 3 (length expr)) (third expr)))
|
||||
((sizeof) 'size-t)
|
||||
;; a closure literal is its own type: the first three elements
|
||||
;; already spell one, so calling one where it is written resolves
|
||||
;; like calling one through a name
|
||||
;; `(closure ((x int)) int () ...)' is a `(closure ((int)) int)',
|
||||
;; so `((closure ((x int)) int () (return x)) 5)' is a call
|
||||
((closure) (and (closure-expression? expr)
|
||||
`(closure ,(arglist-types (second expr)) ,(third expr))))
|
||||
;; `c-and' and `c-or' are the names from before `&&' and `||'
|
||||
@@ -623,11 +628,11 @@
|
||||
((+ - / %) (arithmetic-type expr env))
|
||||
;; the bitwise operators join like the arithmetic ones
|
||||
((^ |\||) (arithmetic-type expr env))
|
||||
;; a shift does not join: the result is the promoted left operand,
|
||||
;; and the right one says only how far
|
||||
;; a shift is the promoted left operand, not a join:
|
||||
;; (<< l b), l : long -> long; (>> c b), c : char -> int
|
||||
((<< >>) (promoted-type (expression-type (second expr) env)))
|
||||
;; ...and an increment is not a join either -- it is the operand,
|
||||
;; unpromoted, being what is written back to it
|
||||
;; ...and an increment is the operand unpromoted:
|
||||
;; (++ c), c : char -> char
|
||||
((++ --) (expression-type (second expr) env))
|
||||
;; otherwise a call: a closure answers with its own return type,
|
||||
;; anything else with what its signature says
|
||||
@@ -661,37 +666,36 @@
|
||||
(cond
|
||||
((or (ptr-type? l) (array-type? l)) (decayed left l))
|
||||
((or (ptr-type? r) (array-type? r)) (decayed right r))
|
||||
;; one type on both sides needs no ranking, which is the only way
|
||||
;; a name we never parsed a declaration for joins at all
|
||||
;; one type on both sides needs no ranking:
|
||||
;; (+ n n), n : size-t -> size-t
|
||||
((and (prim-type? l) (prim-type? r) (equal? (prim-name l) (prim-name r)))
|
||||
(promoted left l))
|
||||
((or (unrankable? l) (unrankable? r)) '?)
|
||||
((< (conversion-rank l) (conversion-rank r)) (promoted right r))
|
||||
((> (conversion-rank l) (conversion-rank r)) (promoted left l))
|
||||
;; at equal rank C takes the unsigned one, whichever side it is
|
||||
;; written on
|
||||
;; (+ i u) and (+ u i) are both unsigned int
|
||||
((unsigned-type? r) (promoted right r))
|
||||
(else (promoted left l)))))))
|
||||
|
||||
;;; A name we never parsed a declaration for -- `size-t', `GLuint' --
|
||||
;;; has no rank we can know, so a join that would have to compare one
|
||||
;;; answers `?' instead of taking whichever operand came first.
|
||||
;;; `resolve-wildcard' turns that into "write it out", which is the only
|
||||
;;; honest thing to say about it.
|
||||
;;; `size-t', `GLuint': no declaration parsed, so no rank to compare.
|
||||
;;;
|
||||
;;; (var m _ (+ 1 n)) n : size-t -> type of this is unknown
|
||||
;;; (var m size-t (+ 1 n)) -> size_t m = 1 + n;
|
||||
(define (unrankable? type)
|
||||
(and (prim-type? type) (not (c-primitive? type))))
|
||||
|
||||
(define (unsigned-type? type)
|
||||
(and (prim-type? type) (memq 'unsigned (prim-name type)) #t))
|
||||
|
||||
;;; Anything narrower than `int' is promoted to one before the
|
||||
;;; arithmetic happens, so two `char's join as `int' and not as `char'.
|
||||
;;; Operands of the same type reach here too, which is the whole point:
|
||||
;;; `(+ c c)' is where the promotion is invisible and the truncation is
|
||||
;;; not. `unsigned' alone is `unsigned int' and stays as written.
|
||||
;;; An array is a pointer to its first element the moment it is an
|
||||
;;; operand, so `(+ a 1)' is a `(* int)' and not the `(¤ int 4)' that
|
||||
;;; `a' was declared as -- which is not a type an initializer can have.
|
||||
;;; Narrower than `int' promotes to one:
|
||||
;;;
|
||||
;;; (+ c c) c : char 100 -> int 200, not char -56
|
||||
;;; (+ h h) h : short 30000 -> int 60000, not short -5536
|
||||
;;; (+ u u) u : unsigned -> unsigned -- `unsigned' is unsigned int
|
||||
;;; An array operand is a pointer to its first element:
|
||||
;;;
|
||||
;;; (var p _ (+ a 1)) a : (¤ int 4) -> int * p = a + 1;
|
||||
;;; not int p[4] = a + 1;
|
||||
(define (decayed written type)
|
||||
(if (array-type? type) (unparse-type (decay type)) written))
|
||||
|
||||
@@ -776,11 +780,11 @@
|
||||
|
||||
(define +closure-env-bytes+ 16)
|
||||
|
||||
;;; +closure-env-bytes+ for maximum capacity, and an alignment wide
|
||||
;;; enough for anything that fits in them, hence union. `max_align_t'
|
||||
;;; would say that in one word, but it is C11 and the target is C99, so
|
||||
;;; the widest built-ins say it instead: a union is aligned for the
|
||||
;;; strictest of its members.
|
||||
;;; +closure-env-bytes+ for capacity, the widest built-ins for
|
||||
;;; alignment, hence union -- a union takes the strictest alignment of
|
||||
;;; its members. `max_align_t' would say the second in one word:
|
||||
;;;
|
||||
;;; sexc hello-world.sex -- -std=c99 unknown type name 'max_align_t'
|
||||
(define +closure-env-type+ 'ƛenv)
|
||||
|
||||
(define (closure-env-declaration)
|
||||
@@ -854,15 +858,14 @@
|
||||
*pending-closure-structs*)))))
|
||||
(delete-duplicates (aggregates-in type))))
|
||||
|
||||
;;; Where one argument ends and the next begins has to survive the
|
||||
;;; flattening, or `((long long))' and `((long) (long))' mangle alike and
|
||||
;;; the second signature silently reuses the first one's struct. Words
|
||||
;;; within an argument keep the single separator; the arguments take a
|
||||
;;; doubled one.
|
||||
;;; The words inside an argument take the single separator, the
|
||||
;;; arguments a doubled one:
|
||||
;;;
|
||||
;;; Not proof against a type name that mangles to a trailing `_' of its
|
||||
;;; own -- for that the arguments would have to carry their lengths, and
|
||||
;;; the name in the C is worth more than the last of the ambiguity.
|
||||
;;; (closure ((long long)) int) -> ƛlong_long_int
|
||||
;;; (closure ((long) (long)) int) -> ƛlong__long_int
|
||||
;;;
|
||||
;;; A word whose first character mangles to `_' still aliases the
|
||||
;;; doubled separator: `((a -b))' and `((a) (b))' are both `a__b'.
|
||||
(define (mangle-arglist args)
|
||||
(if (null? args)
|
||||
"void"
|
||||
@@ -1040,8 +1043,8 @@
|
||||
(let ((name (capture-name capture)))
|
||||
(unless (symbol? name)
|
||||
(sex-error form "a closure capture needs a name" capture))
|
||||
;; the same lookup either way: a capture that borrows a name can
|
||||
;; borrow a global's or a function's, not only a local's
|
||||
;; the same lookup either way, so `(closure ((x int)) int (scale)
|
||||
;; ...)' borrows a global's `scale' as readily as a local's
|
||||
(let ((type (expression-type (capture-argument capture) env)))
|
||||
(unless type
|
||||
(sex-error form "cannot infer what is captured as" name))
|
||||
@@ -1128,23 +1131,21 @@
|
||||
((union) (add-union name form))
|
||||
((enum) (add-enum name form))))))
|
||||
|
||||
;;; A toplevel form has no function around it and so no scope chain. A
|
||||
;;; name in a global's initializer is another global's or a function's,
|
||||
;;; which `get-name-type' answers without one.
|
||||
;;; No function around a toplevel form, so no scope chain: what a
|
||||
;;; global's initializer names comes from `get-name-type' alone.
|
||||
(define (make-toplevel-env)
|
||||
(let ((env (make-hash-table)))
|
||||
(set! (hash-table-ref env :scopes) (list))
|
||||
env))
|
||||
|
||||
(define (process-global-var sex-var acc)
|
||||
;; A global is not walked for lambdas, but its type still has to stop
|
||||
;; saying `closure' before the writer sees it, and a `_' still has to
|
||||
;; be written out: the writer has no spelling for one either way.
|
||||
;; A global is not walked for lambdas, but the writer spells neither
|
||||
;; `closure' nor `_': `(var n _ 1)' has to reach it as `int n = 1'
|
||||
(let* ((resolved (resolve-closure-types sex-var))
|
||||
(qualifier (and (memq (car resolved) '(pub extern)) (car resolved)))
|
||||
(core (if qualifier (cdr resolved) resolved))
|
||||
;; `extern' declares without initializing, so there is nothing
|
||||
;; for a `_' to be worked out from
|
||||
;; `(extern var n int)' has no initializer to work a `_' out
|
||||
;; from
|
||||
(core (if (eq? 'extern qualifier)
|
||||
core
|
||||
(resolve-wildcard core (make-toplevel-env))))
|
||||
|
||||
Reference in New Issue
Block a user