alex-eg/sex
1
0
Fork 1
Code Issues 3 Pull Requests 1 Actions Packages Projects 1 Releases Wiki Activity

Better types #15

Merged
alex-eg merged 27 commits from better-types into main 2025-10-30 16:05:44 +01:00
Conversation 16 Commits 27 Files Changed 18 +17 -19
2 changed files with 17 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit 3a9300ba72 - Show all commits

20
fmt-c-writer.scm
View File

@@ -46,6 +46,12 @@
(unkebabify atom)
atom))))
(define (maybe-unwrap-type type)
(if (and (list? type)
(= 1 (length type)))
(car type)
type))
pkulev commented 2025-10-28 17:50:25 +01:00 (Migrated from github.com)
Review
Copy Link

Looks like this code can be extracted into a function with a slight readability boost (if named properly).

Something like this:

(define (squeeze-typleton type-list)
  (if (and (list? (car type-list))
    ...
Looks like this code can be extracted into a function with a slight readability boost (if named properly). Something like this: ```scheme (define (squeeze-typleton type-list) (if (and (list? (car type-list)) ... ```
pkulev commented 2025-10-28 17:52:13 +01:00 (Migrated from github.com)
Review
Copy Link

And here we can reuse it

         `(%array ,(walk-type (squeeze-typleton array-type)))
And here we can reuse it ```suggestion `(%array ,(walk-type (squeeze-typleton array-type))) ```
pkulev commented 2025-10-28 17:59:15 +01:00 (Migrated from github.com)
Review
Copy Link

That function is a little complex, would be nice to have unit tests for it.

Also could fold-right be replaced with flatten?

  (if (atom? type) (atom-to-fmt-c type)
      (flatten
       (tree-map atom-to-fmt-c
                 (flatten
                             (list-join (reverse (list-split type '*))
                                        '(*)))))))

Gosh it's fucking torture to write and edit lisp snippets on github.

That function is a little complex, would be nice to have unit tests for it. Also could fold-right be replaced with flatten? ```suggestion (if (atom? type) (atom-to-fmt-c type) (flatten (tree-map atom-to-fmt-c (flatten (list-join (reverse (list-split type '*)) '(*))))))) ``` Gosh it's fucking torture to write and edit lisp snippets on github.
pkulev commented 2025-10-28 18:01:39 +01:00 (Migrated from github.com)
Review
Copy Link
;;; TODO: isn't there a better way?
```suggestion ;;; TODO: isn't there a better way? ```
pkulev commented 2025-10-29 14:53:09 +01:00 (Migrated from github.com)
Review
Copy Link

Oh! That's similar

          ((var . type) (append (list (walk-type (squeeze-typleton-or-maybe-better-name-huh type))...
Oh! That's similar ```suggestion ((var . type) (append (list (walk-type (squeeze-typleton-or-maybe-better-name-huh type))... ```
alex-eg commented 2025-10-30 00:08:18 +01:00 (Migrated from github.com)
Review
Copy Link

Yes. Qualifies as self-harm.

Yes. Qualifies as self-harm.
alex-eg commented 2025-10-30 00:08:30 +01:00 (Migrated from github.com)
Review
Copy Link

🤯

🤯
alex-eg commented 2025-10-30 00:08:47 +01:00 (Migrated from github.com)
Review
Copy Link

🤯

🤯
alex-eg commented 2025-10-30 09:52:56 +01:00 (Migrated from github.com)
Review
Copy Link

Also could fold-right be replaced with flatten?

In general, it could not:

(fold-right append (list) '(((1 2)) (3 4) (5 6)))
; ((1 2) 3 4 5 6)

However, here we can, I think. There shouldn't be any meaningful nesting in cv* type chains.

That function is a little complex, would be nice to have unit tests for it.

It's implicitly tested via all walk-type tests. However, I agree that it would be nice to have some test specifically for this function.

>Also could fold-right be replaced with flatten? In general, it could not: ``` (fold-right append (list) '(((1 2)) (3 4) (5 6))) ; ((1 2) 3 4 5 6) ``` However, here we can, I think. There shouldn't be any meaningful nesting in `cv*` type chains. > That function is a little complex, would be nice to have unit tests for it. It's implicitly tested via all `walk-type` tests. However, I agree that it would be nice to have some test specifically for this function.
(define (make-field-access form)
(assert
(= 2 (length form)) "Wrong field access format")
@@ -111,19 +117,13 @@
(if (integer? (last array-type))
;; sized array
(let* ((type-list (drop-right array-type 1))
(type (if (and (list? (car type-list))
(= 1 (length type-list)))
(car type-list)
type-list))
(type (maybe-unwrap-type type-list))
(size (last array-type)))
`(%array ,(walk-type type)
,size))
;; sugar for pointer... Do we really need it? Guess why not,
;; it's a strong semantic cue
`(%array ,(walk-type (if (and (list? (car array-type))
(= 1 (length array-type)))
(car array-type)
array-type)))))
`(%array ,(walk-type (maybe-unwrap-type array-type)))))
(('fn arglist ret-type)
`(%fun ,(walk-type ret-type) ,(walk-arglist arglist)))
@@ -179,9 +179,7 @@
;; 1 element args are always type
((_) (walk-type x))
((var . type) (append (list (walk-type (if (= 1 (length type))
(car type)
type)))
((var . type) (append (list (walk-type (maybe-unwrap-type type)))
(list (walk-type var))))))
form))

16
tests/fmt-c-writer.scm
View File

@@ -26,7 +26,7 @@
(walk-type '(¤ (const char))))
(test
'(%array (float) 8)
'(%array float 8)
(walk-type '(¤ float 8)))
(test
@@ -40,16 +40,16 @@
(walk-type '(const * const char)))
(test
'(%fun void ((int) (float) (struct what *)))
(walk-type '(fn ((int) (float) (* struct what)) void)))
'(%fun void ((int) (float) (%array (struct what * const))))
(walk-type '(fn ((int) (float) (¤ (const * struct what))) void)))
(test
'(%fun void ((int) (%array (float)) (struct what *)))
(walk-type '(fn ((int) (¤ float) (* struct what)) void)))
'(%fun void ((int) (%array float) (%array (struct what * const))))
(walk-type '(fn ((int) (¤ float) (¤ (const * struct what))) void)))
;;; Variable defs
(test
'(%var (%array (float) 8) a)
'(%var (%array float 8) a)
(walk-var '(var a (¤ float 8))))
(test
@@ -82,7 +82,7 @@
;;; Fn defs
(test
'(%fun void puk ((int) (%array (float) 8)))
'(%fun void puk ((int) (%array float 8)))
(walk-fn-def '(fn puk ((int) (¤ float 8)) void)))
(test
@@ -129,7 +129,7 @@
(test
'(struct mega_kebab ((int a)
((struct ((int year) (int month) (int day))) dob)
((%fun int ((int) (%array (int)))) min)))
((%fun int ((int) (%array int))) min)))
(walk-struct '(struct mega-kebab
((a int)
(dob (struct ((year int)