say what is wrong with a pointer type, and stop mangling fn ones
The guard against nested pointer chains searched every sublist for a `*', including the ones that hold a type of their own. A function type with a pointer parameter, while the same type with an int parameter passed. (* [char 4]) was let through as well and came out as `vector-ref char 4 * p'. A `*' inside an array or a function type belongs to that type, so the search stops there. What the flat conversion cannot express is now named: a fn type is a function pointer already, and a pointer to an array is not supported. Parameters of a function type are walked without their names. C writes a parameter name into a declarator and a type has none, so fmt-c prints whatever it is handed there as a type: `(s (* char))' came out as `char(*) s'. fmt-c printed a nameless array declarator's #f into the C, which showed up in these parameters.
This commit is contained in:
@@ -276,7 +276,7 @@ forms, and what remains."
|
||||
;; it's a strong semantic cue
|
||||
`(%array ,(walk-type (maybe-unwrap-type array-type)))))
|
||||
(('fn arglist ret-type)
|
||||
`(%fun ,(walk-type ret-type) ,(walk-arglist arglist)))
|
||||
`(%fun ,(walk-type ret-type) ,(walk-arg-types arglist)))
|
||||
(('fn . _)
|
||||
(sex-error form "malformed function type" form))
|
||||
|
||||
@@ -288,8 +288,13 @@ forms, and what remains."
|
||||
(else
|
||||
(type-convert-to-c form))))
|
||||
|
||||
;;; An array or a function type
|
||||
(define (structured-type? form)
|
||||
(and (pair? form) (memq (car form) '(¤ fn))))
|
||||
|
||||
(define (has-pointer-star? form)
|
||||
(and (pair? form)
|
||||
(not (structured-type? form))
|
||||
(or (memq '* form)
|
||||
(any has-pointer-star? (filter pair? form)))))
|
||||
|
||||
@@ -301,6 +306,10 @@ forms, and what remains."
|
||||
(and (pair? type)
|
||||
(any has-pointer-star? (filter pair? type))))
|
||||
|
||||
(define (nested-structured-type type)
|
||||
(and (pair? type)
|
||||
(find structured-type? (filter pair? type))))
|
||||
|
||||
(define (type-convert-to-c type)
|
||||
;; Our pointers to C pointers
|
||||
;; int -> int
|
||||
@@ -308,6 +317,12 @@ forms, and what remains."
|
||||
;; const * const char -> const char * const
|
||||
(when (nested-pointer? type)
|
||||
(sex-error type "pointer chains are written flat, as (* * T), not nested" type))
|
||||
(let ((inner (nested-structured-type type)))
|
||||
(when inner
|
||||
(if (eq? (car inner) 'fn)
|
||||
;; (fn ...) is spelled as the pointer it already is in C
|
||||
(sex-error type "a fn type is a function pointer already: write (fn ...), not (* (fn ...))" type)
|
||||
(sex-error type "a pointer to an array is not supported" type))))
|
||||
(if (atom? type) (atom-to-fmt-c type)
|
||||
(flatten
|
||||
(tree-map atom-to-fmt-c
|
||||
@@ -331,26 +346,39 @@ forms, and what remains."
|
||||
((¤ * const volatile struct union) #t)
|
||||
(else #f)))
|
||||
|
||||
;;; Does the parameter name itself?
|
||||
;;; (f1 float) does
|
||||
;;; (float), (const char) and (¤ float 4) do not
|
||||
(define (named-arg? arg)
|
||||
(and (pair? arg)
|
||||
(pair? (cdr arg)) ; 1 element args are always type
|
||||
(not (eq? (car arg) '¤))
|
||||
(not (is-probably-type arg))))
|
||||
|
||||
;;; The type of one parameter
|
||||
(define (arg-type arg)
|
||||
(if (named-arg? arg)
|
||||
(walk-type (maybe-unwrap-type (cdr arg)))
|
||||
;; A lone type may arrive wrapped in parens of its own, and those
|
||||
;; are not part of it: ((* const char))
|
||||
;; Plain names e.g. (int) are left as is
|
||||
(walk-type (if (and (pair? arg) (null? (cdr arg)) (pair? (car arg)))
|
||||
(car arg)
|
||||
arg))))
|
||||
|
||||
(define (walk-arglist form)
|
||||
;; E.g.:
|
||||
;; ((float) (int) (const char) (* const char) (¤ (* const struct res) 32))
|
||||
;; ((f1 float) (f2 float) (f3 float) (res (¤ float 4)))
|
||||
(map (fn
|
||||
(match x
|
||||
(('¤ . _) (walk-type x))
|
||||
|
||||
;; yeah shitty, but I don't know yet how to determine if the
|
||||
;; first entry is part of the type and not an argument name
|
||||
;; :(
|
||||
((? is-probably-type) (walk-type x))
|
||||
|
||||
;; 1 element args are always type
|
||||
((_) (walk-type x))
|
||||
|
||||
((var . type) (append (list (walk-type (maybe-unwrap-type type)))
|
||||
(list (walk-type var))))))
|
||||
(map (lambda (arg)
|
||||
(if (named-arg? arg)
|
||||
(list (arg-type arg) (walk-type (car arg)))
|
||||
(arg-type arg)))
|
||||
(remove comment-form? form)))
|
||||
|
||||
(define (walk-arg-types form)
|
||||
(map arg-type (remove comment-form? form)))
|
||||
|
||||
(define (walk-function form)
|
||||
;; (fn ret-type name arglist body) -> normal function
|
||||
;; (fn ret-type name arglist) -> prototype
|
||||
|
||||
@@ -737,10 +737,13 @@
|
||||
(cat (c-type (cadr type) #f)
|
||||
" (*" (or name "") ")("
|
||||
(fmt-join (lambda (x) (c-type x #f)) (caddr type) ", ") ")"))
|
||||
;; MODIFIED FROM UPSTREAM fmt-c: a nameless declarator -- an
|
||||
;; array parameter of a function type, where C has no room
|
||||
;; for a name -- arrives as #f, and upstream printed it
|
||||
((%array)
|
||||
(let ((name (cat name "[" (if (pair? (cddr type))
|
||||
(c-expr (caddr type))
|
||||
"")
|
||||
(let ((name (cat (or name "") "[" (if (pair? (cddr type))
|
||||
(c-expr (caddr type))
|
||||
"")
|
||||
"]")))
|
||||
(c-type (cadr type) name)))
|
||||
((%pointer *)
|
||||
@@ -773,10 +776,13 @@
|
||||
(cat (c-type (cadr type) #f)
|
||||
" (*" (or name "") ")("
|
||||
(fmt-join (lambda (x) (c-type x #f)) (caddr type) ", ") ")"))
|
||||
;; MODIFIED FROM UPSTREAM fmt-c: a nameless declarator -- an
|
||||
;; array parameter of a function type, where C has no room
|
||||
;; for a name -- arrives as #f, and upstream printed it
|
||||
((%array)
|
||||
(let ((name (cat name "[" (if (pair? (cddr type))
|
||||
(c-expr (caddr type))
|
||||
"")
|
||||
(let ((name (cat (or name "") "[" (if (pair? (cddr type))
|
||||
(c-expr (caddr type))
|
||||
"")
|
||||
"]")))
|
||||
(c-type (cadr type) name)))
|
||||
((%pointer *)
|
||||
|
||||
Reference in New Issue
Block a user