pkulev/sex
1
0
Fork 0
forked from alex-eg/sex
Code Pull Requests Activity

say what is wrong with a pointer type, and stop mangling fn ones

Browse Source 
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:
alex-eg
2026-09-21 00:54:37 +03:00
parent 381ad21d8b
commit 534e9ef56b
2 changed files with 55 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files

58
fmt-c-writer.scm
View File

@@ -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

18
sex-fmt-c.scm
View File

@@ -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 *)