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

move Sex to better types

Browse Source 
Types, fns and vars are now written in another, better, more intuitive
and readable way.

Types:
"pointer to const char" is "* const char"
"array of pointers to volatile int" is "[* volatile int]"
Read left to right

Vars (as well as fn args, struct fields):
(var name type)
(struct vec3 ((x float) (y float) (z float))
(fn vec3-add ((v1 vec3) (v2 vec3)) vec3 ...)

Also fns are now have return types after arg list.

* is now must not be attached to any type name (or variable for that
matter)
This commit is contained in:
alex-eg
2025-10-21 21:38:41 +03:00
committed by Pavel Kulyov
parent 2228ab3b50
commit 48a3d06925
8 changed files with 318 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
example/fns.sex
View File

@@ -1,10 +1,10 @@
;;; Prototypes
(fn void puk ())
(fn puk () void)
(pub fn void plak ())
(pub fn plak () void)
;;; Functions
(fn int foo () (return 1))
(fn foo () int (return 1))
(pub fn void bar ((int a) (int b))
(pub fn bar ((a int) (b int)) void
(printf "%d\n" (+ a b)))

6
example/hello-world.sex
View File

@@ -1,9 +1,9 @@
(include stdio.h)
(pub fn int main ((int argc) (char **argv))
(pub fn main ((argc int) (argv [* const char])) int
(puts "Hello from Sex!")
(var (array char 512) name)
(var name [char 512])
(puts "What is your name?")
(scanf "%s" (cast char* &name))
(scanf "%s" (cast (& name) (* char)))
(printf "Hello, %s!\n" name)
(return 0))

41
example/lambdas.sex
View File

@@ -1,21 +1,21 @@
(include stdio.h)
(fn int sum ((int a) (int b))
(fn sum ((a int) (b int)) int
(return (+ a b)))
(pub fn int main ()
(var int a 10)
(var int b 20)
(var (fn int ((int) (int))) sum-fn sum)
(pub fn main () int
(var a int 10)
(var b int 20)
(var (fn ((int) (int)) int) sum-fn sum)
(var (fn int ((int) (int))) sum-lambda
(var (fn ((int) (int)) int) sum-lambda
(lambda int ((int a) (int b)) ()
(lambda ((a int) (b int)) int ()
(return (+ a b))))
(var (fn int ((int))) sum-lambda-2
(var (fn ((int)) int) sum-lambda-2
(lambda int ((int a)) ()
(lambda ((a int)) int ()
(return (+ a 20))))
(printf "Hello from main fn!\n")
@@ -24,15 +24,28 @@
(printf "Calling fn ptr: %d\n" (sum-fn a b))
(printf "Calling lambda: %d\n" (sum-lambda a b))
(printf "Calling other lambda: %d\n" (sum-lambda-2 a))
(printf "Calling lambda inplace: %d\n" ((lambda int ((int a) (int b)) ()
(printf "Calling lambda inplace: %d\n" ((lambda ((a int) (b int)) int ()
(return (+ a b 100)))
a b))
(var (fn int ((int))) l-1
(lambda int ((int a)) ()
(var (fn int ((int))) l-2
(lambda int ((int a)) ()
(var (fn ((int)) int) l-1
(lambda ((a int)) int ()
(var (fn ((int)) int) l-2
(lambda ((a int)) int ()
(return (+ 60 a))))
(return (+ 600 (l-2 a)))))
(printf "Calling nested lambdas: %d\n" (l-1 6))
;; Not supported yet
;; Closure
;; (var (fn (fn ((int)) int) ((int))) make-adder
;; (lambda (fn int ((int a))) ()
;; (return (lambda int ((int b)) (a)
;; (return (+ a b))))))
;;
;; (var (fn int ((int))) add-10
;; (make-adder 10))
;; (var (fn int ((int))) add-20
;; (make-adder 20))
;; (printf "Calling closures: %d\n" (add-10 24))
(return 0))

23
example/list.sex
View File

@@ -1,21 +1,21 @@
(pub defmacro (list-T type)
(let ((list-type (cat 'list- type)))
`(struct ,list-type
((,type value)
((* (struct ,list-type)) next)))))
((value ,type)
(next (* struct ,list-type))))))
(pub defmacro (make-list-T type is-public?)
(let ((list-type (list 'struct (cat 'list- type)))
(fn-name (cat 'make-list- type)))
`(,@(if is-public? '(pub) '()) fn (* ,list-type) ,fn-name ()
(var (* ,list-type) list (cast (* ,list-type) (malloc (sizeof ,list-type))))
`(,@(if is-public? '(pub) '()) fn ,fn-name () (* ,list-type)
(var list (* ,list-type) (cast (malloc (sizeof ,list-type)) (* ,list-type)))
(= (-> list next) NULL)
(return list))))
(pub defmacro (add-value-list-T type is-public?)
(let ((list-type (list 'struct (cat 'list- type)))
(fn-name (cat 'add-value-list- type)))
`(,@(if is-public? '(pub) '()) fn void ,fn-name ((,list-type *list) (,type value))
`(,@(if is-public? '(pub) '()) fn ,fn-name ((list * ,list-type) (value ,type)) void
(while (!= (-> list next) NULL)
(= list (-> list next)))
(= (-> list next) (,(cat 'make-list- type)))
@@ -24,23 +24,24 @@
(pub defmacro (length-list-T type is-public?)
(let ((fn-name (cat 'length-list- type))
(list-type (list 'struct (cat 'list- type))))
`(,@(if is-public? '(pub) '()) fn size-t ,fn-name ((,list-type *list))
(var size-t n 0)
`(,@(if is-public? '(pub) '()) fn ,fn-name ((list ,(cons '* list-type))) size-t
(var n size-t 0)
(while (!= (-> list next) NULL)
(= list (-> list next))
(++ n))
(return n))))
(pub defmacro (is-empty-list-T type is-public?)
`(,@(if is-public? '(pub) '()) fn bool ,(cat 'is-empty-list- type)
((,(list 'struct (cat 'list- type)) *list))
`(,@(if is-public? '(pub) '()) fn ,(cat 'is-empty-list- type)
((list ,(list '* 'struct (cat 'list- type))))
bool
(return (== (-> list next) NULL))))
(pub defmacro (list-for-each list-type list-var elt-type elt-var what-do)
(let ((list-var-2 (cat list-var '-2)))
`(begin
(var (pointer ,list-type) ,list-var-2 ,list-var)
(var ,elt-type ,elt-var (-> ,list-var-2 value))
(var ,list-var-2 (* ,list-type) ,list-var)
(var ,elt-var ,elt-type (-> ,list-var-2 value))
(while (!= (-> ,list-var-2 next) NULL)
,what-do
(= ,list-var-2 (-> ,list-var-2 next))

29
example/test-list.sex
View File

@@ -5,12 +5,12 @@
(import list)
(struct foo
((float a-field)
(int b)
((const char *) c)
((fn bool ((bool val))) not)))
((a-field float)
(b int)
(c (* const char))
(not (fn ((val bool)) bool))))
(var (struct foo) f)
(var f (struct foo))
(list-T int)
(make-list-T int #f)
@@ -18,15 +18,16 @@
(length-list-T int #f)
(is-empty-list-T int #f)
(extern fn void puk ((int a) (float b)))
(pub fn bool baz () (return true))
(extern fn puk ((a int) (b float)) void)
(pub fn baz () bool
(return true))
(extern var int i)
(var int j)
(pub var int k)
(extern var i int)
(var j int)
(pub var k int)
(pub fn int main ()
(var (struct list-int) *l (make-list-int))
(pub fn main () int
(var l (* struct list-int) (make-list-int))
(printf "Size of the list: %lu\n" (length-list-int l))
(add-value-list-int l 3)
(add-value-list-int l 4)
@@ -35,9 +36,9 @@
(printf "%d " v))
(printf "\n")
(printf "Size of the list: %lu\n" (length-list-int l))
(printf "%p\n" (cast void* l->next))
(printf "%p\n" (cast l->next (* void)))
(return 0))
(pub fn void print-list (((const struct list-int) *l))
(pub fn print-list ((l (* const struct list-int))) void
(list-for-each (const struct list-int) l int v (printf "%d " v))
(printf "\n"))

155
fmt-c-writer.scm
View File

@@ -2,14 +2,17 @@
(declare (unit fmt-c-writer)
(uses fmt-c
semen))
semen
utils))
(import (chicken string)
brev-separate
fmt
matchable
regex
srfi-1 ; lists
srfi-13 ; strings
tree
)
(define (unkebabify sym)
@@ -27,15 +30,13 @@
(case atom
((fn) '%fun)
((prototype) '%prototype)
((var) '%var)
((begin) '%block-begin)
((define) '%define)
((pointer) '%pointer)
((array) '%array)
((attribute) '%attribute)
((@) 'vector-ref)
((¤) 'vector-ref)
((include) '%include)
((cast) '%cast)
;; uh things we do for c89 compatibility
((bool) 'int)
((true) 1)
@@ -71,21 +72,133 @@
(char=? #\. (string-ref (symbol->string (car form)) 0)))
(cons (make-field-access form) acc))
;; variable declaration inside function
((eq? (car form) 'var)
(cons (walk-var form) acc))
;; (cast expr type) -> (%cast type expr)
((eq? (car form) 'cast)
(cons (list '%cast
(walk-type (drop form 2))
(car (walk-generic (second form) (list))))
acc))
;; toplevel, or a start of a regular list form
(else
(let ((new-acc (list)))
(cons (fold-right
walk-generic
new-acc
form)
acc)))))
(cons (fold-right
walk-generic
(list)
form)
acc))))
(define (walk-var form)
;; (var a int) -> (%var int a)
;; (var a (const int) 32) -> (%var (const int) a 32)
;; (var b [const char 512]) -> (%var (%array (const char) 512) b)
;; note: [...] is actually (¤ ...) after reading
;; (var c (fn ((int) (float)) void)) -> (%var (%fun void ((int) (float))) c)
(append
(list '%var)
(list (walk-type (flatten (third form))))
(list (atom-to-fmt-c (second form)))
(if (null? (drop form 3))
(list)
(car (walk-generic (drop form 3) (list)))) ; optional init expression
))
(define (walk-type form)
;; int -> int
;; (const int) -> const int
;; [const char 512] ->(¤ (const char) 512) -> (%array (const char) 512)
;; [float 8] -> (%array float 8)
;; (* const char) -> (const char *)
;; (const * const * const char) -> (const char * const * const)
;; (fn ((int) (float)) void) -> (%fun void ((int) (float)))
(match form
(('¤ . array-type)
(if (integer? (last array-type))
;; sized array
(let ((type (drop-right array-type 1))
(size (last array-type)))
`(%array ,(walk-type (flatten type))
,size))
;; sugar for pointer... Do we really need it? Guess why not,
;; it's a strong semantic cue
`(%array ,(walk-type (flatten array-type)))))
(('fn arglist ret-type)
`(%fun ,(walk-type ret-type) ,(walk-arglist arglist)))
;; Special case: nested structs/unions
(('struct ((field-names field-types) ...) . attrs)
(append `(struct ,(process-struct-fields field-names field-types))
(if (null? attrs)
(list)
(list (map atom-to-fmt-c attrs)))))
(('union ((field-names field-types) ...) . attrs)
(append `(union ,(process-struct-fields field-names field-types))
(if (null? attrs)
(list)
(list (map atom-to-fmt-c attrs)))))
(else
(type-convert-to-c form))))
(define (type-convert-to-c type)
;; Our pointers to C pointers
;; int -> int
;; * const char -> const char *
;; const * const char -> const char * const
(if (atom? type) (atom-to-fmt-c type)
(tree-map atom-to-fmt-c
(fold-right append (list)
(list-join (reverse (list-split type '*))
'(*))))))
(define (walk-fn-def form)
(match form
(('fn name args ret-type . maybe-body)
`(%fun
,(walk-type ret-type)
,(car (walk-generic name (list)))
,(walk-arglist args)
.
,maybe-body))))
;;; Todo: isn't there a better way?
(define (is-probably-type form)
(case (car form)
((¤ * const volatile struct union) #t)
(else #f)))
(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 (if (= 1 (length type))
(car type)
type)))
(list (walk-type var))))))
form))
(define (normalize-fn-form form)
;; (fn ret-type name arglist body) -> normal function
;; (fn ret-type name arglist) -> prototype
(if (>= (length form) 5)
form
(cons 'prototype (cdr form))))
(walk-fn-def form)
(cons 'prototype (cdr (walk-fn-def form)))))
(define (walk-function form static)
(if static
@@ -94,6 +207,19 @@
(walk-generic (normalize-fn-form (cdr form))
(list))))
(define (process-struct-fields names types)
(zip (map walk-type types) (map atom-to-fmt-c names)))
(define (walk-struct form)
(match form
((type name ((field-names field-types) ...) . attrs)
(list (append `(,type ,(atom-to-fmt-c name)
,(process-struct-fields field-names field-types))
(if (null? attrs)
(list)
(list (map atom-to-fmt-c attrs))))))
(else (error "Malformed aggregate definition " form))))
(define (walk-extern form)
(case (cadr form)
((fn)
@@ -107,7 +233,7 @@
((fn)
(walk-function form #f))
((var)
(walk-generic (list 'static (cdr form)) (list)))
(walk-generic (walk-var (cdr form)) (list)))
((define defmacro import include struct typedef union var)
;; ignore here, used in generating public interface
(process-toplevel-form (cdr form)))
@@ -116,10 +242,13 @@
(define (process-toplevel-form form)
;; todo: rewrite to match
;; for some reason should return list in a list; TODO: rewrite
(case (car form)
((fn) (walk-function form #t))
((var) (walk-generic (list 'static (walk-var form)) (list)))
((extern) (walk-extern form))
((pub) (walk-public form))
((struct union) (walk-struct form))
(else (walk-generic form (list)))))
(define (emit-c sex-forms)

114
tests/fmt-c-writer.scm Normal file
View File

@@ -0,0 +1,114 @@
;;; Types
(test-group "fmt-writer"
(test
'(const int)
(walk-type '(const int)))
(test
'(%array (const char) 512)
(walk-type '(¤ const char 512)))
(test
'(%array (float 512))
(walk-type '(¤ (float 512))))
(test
'(%array (const char) 512)
(walk-type '(¤ (const char) 512)))
(test
'(%array (const char))
(walk-type '(¤ const char)))
(test
'(%array (const char))
(walk-type '(¤ (const char))))
(test
'(%array (float) 8)
(walk-type '(¤ float 8)))
(test
"Pointer to const char"
'(const char *)
(walk-type '(* const char)))
(test
"Const pointer to const char"
'(const char * const)
(walk-type '(const * const char)))
(test
'(%fun void ((int) (float) (struct what *)))
(walk-type '(fn ((int) (float) (* struct what)) void)))
(test
'(%fun void ((int) (%array (float)) (struct what *)))
(walk-type '(fn ((int) (¤ float) (* struct what)) void)))
;;; Variable defs
(test
'(%var (%array (float) 8) a)
(walk-var '(var a (¤ float 8))))
(test
'(%var (int *) a (& n))
(walk-var '(var a (* int) (& n))))
(test
'(%var (const int *) a (& n))
(walk-var '(var a (* const int) (& n))))
(test
'(%var (struct suc) s)
(walk-var '(var s (struct suc))))
(test
'(%var (struct suc) s (hoge piyo))
(walk-var '(var s (struct suc) (hoge piyo))))
(test
'(%var (struct suc *) s (hoge piyo))
(walk-var '(var s (* struct suc) (hoge piyo))))
;;; Fn defs
(test
'(%fun void puk ((int) (%array (float) 8)))
(walk-fn-def '(fn puk ((int) (¤ float 8)) void)))
(test
'(%fun int main ((int argc) ((%array (const char)) argv))
(return 0))
(walk-fn-def
'(fn main ((argc int) (argv (¤ const char))) int
(return 0))))
(test
'(%fun int quxu (((struct piq *) bar))
(return 0))
(walk-fn-def
'(fn quxu ((bar (* struct piq))) int
(return 0))))
(test
'(%fun int quxu (((struct piq *) bar) ((%array (struct tt *)) ploop))
(return 0))
(walk-fn-def
'(fn quxu ((bar (* struct piq)) (ploop (¤ * struct tt))) int
(return 0))))
;; Structs
(test
'(struct no_kebab ((int a) (float f)))
(walk-struct '(struct no-kebab ((a int) (f float)))))
(test
'(struct mega_kebab ((int a)
((struct ((int year) (int month) (int day))) dob)
((%fun int ((int) (%array (int)))) min)))
(walk-struct '(struct mega-kebab
((a int)
(dob (struct ((year int)
(month int)
(day int))))
(min (fn ((int) (¤ int)) bool)))))))

1
tests/run.scm
View File

@@ -10,6 +10,7 @@
(include "basic.scm")
(include "semen.scm")
(include "reader.scm")
(include "fmt-c-writer.scm")
(include "utils.scm")
;;; Should be the last in the test suite