This commit is contained in:
2026-03-24 21:19:03 +03:00
parent d039fa0cb9
commit a80b8d9acf
8 changed files with 150 additions and 5 deletions

View File

@@ -25,16 +25,16 @@ reader.o:
$(CHICKEN_C) $(CSC_FLAGS) reader.scm -e -c -J -o reader.o -unit reader
module-system.o: module-system.scm reader.import.scm utils.import.scm
$(CHICKEN_C) $(CSC_FLAGS) module-system.scm -e -c -J -o module-system.o -unit module-system -link utils
$(CHICKEN_C) $(CSC_FLAGS) module-system.scm -e -c -J -o module-system.o -unit module-system -link reader,utils
semen.o: semen.scm macros.import.scm module-system.import.scm utils.import.scm
$(CHICKEN_C) $(CSC_FLAGS) semen.scm -e -c -J -o semen.o -unit semen -link macros -link module-system -link utils
$(CHICKEN_C) $(CSC_FLAGS) semen.scm -e -c -J -o semen.o -unit semen -link macros,module-system,utils
fmt-c-writer.o: fmt-c-writer.scm sex-fmt-c.import.scm utils.import.scm
$(CHICKEN_C) $(CSC_FLAGS) fmt-c-writer.scm -e -c -J -o fmt-c-writer.o -unit fmt-c-writer -link sex-fmt-c -link utils
$(CHICKEN_C) $(CSC_FLAGS) fmt-c-writer.scm -e -c -J -o fmt-c-writer.o -unit fmt-c-writer -link sex-fmt-c,utils
sexc.o: sexc.scm fmt-c-writer.import.scm macros.import.scm module-system.import.scm reader.import.scm semen.import.scm utils.import.scm
$(CHICKEN_C) $(CSC_FLAGS) sexc.scm -e -c -J -o sexc.o -unit sexc -link fmt-c-writer -link macros -link module-system -link reader -link semen -link utils
$(CHICKEN_C) $(CSC_FLAGS) sexc.scm -e -c -J -o sexc.o -unit sexc -link fmt-c-writer,macros,module-system,reader,semen,utils
%.link: %.o
%.import.scm: %.o

2
example/mini-test.sex Normal file
View File

@@ -0,0 +1,2 @@
(pub fn main () int
(var l (* (struct list-int)) (make-list-int)))

25
example/our-reader.sex Normal file
View File

@@ -0,0 +1,25 @@
(include stdio.h)
(defmacro (plus . rest)
`(+ ,@rest))
(struct vertex
((pos (struct ((x u32) (y u32))))
(color (struct ((r float) (g float) (b float))))
(mask u32)))
(enum
(B A R))
;;; Main entry point
;;; Multi line comments should be packed
(pub fn main () int
;; the vertex
(var a (struct vertex) #(#(10 20)
#(0.3 0.5 0.7)
(c-bit-or B A R)))
(printf "%d %f %d\n" ; the printf
(plus a.pos.x a.pos.y)
(plus a.color.r a.color.g a.color.b)
a.mask)
(return 0))

6
example/structs.sex Normal file
View File

@@ -0,0 +1,6 @@
(struct settings
((b-x u32)
(l r t b x y w h u32)
(color (struct
((r g b a float))))
(colors [struct color ((r g b a float))])))

View File

@@ -105,6 +105,7 @@
(define (c-op< x y) (< (c-op-precedence x) (c-op-precedence y)))
(define (c-op<= x y) (<= (c-op-precedence x) (c-op-precedence y)))
(define (c-op>= x y) (>= (c-op-precedence x) (c-op-precedence y)))
(define (c-paren x) (cat "(" (c-expr x) ")"))
@@ -112,7 +113,7 @@
(lambda (st)
((fmt-let 'op op
(if (and (c-op<= (fmt-op st) op)
(not (vector? st)))
(not (vector? x)))
(c-paren x)
x))
st)))

View File

@@ -51,7 +51,9 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
;; Keywords
(list (concat "("
(regexp-opt '(
"begin"
"case"
"default"
"do"
"if"
"for"
@@ -83,6 +85,8 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
(put 'union 'lisp-indent-function 'defun)
(put 'var 'lisp-indent-function 0)
(put 'import 'lisp-indent-function 1)
(put 'switch 'lisp-indent-function 1)
(put 'case 'lisp-indent-function 1)
;;;###autoload
(define-derived-mode sex-mode lisp-data-mode "Sex"

34
tools/sextest/README.org Normal file
View File

@@ -0,0 +1,34 @@
* Sextest
A tool for testing sex compilator by using test programs.
The tools compiles them using the compiler, then runs with provided
input, then checks that the output and return code matches the test
specification.
* Test format
The test program consists of two sections: prelude and the test
program itself. Prelude contains four sections: compilation
parameters, such as flags to compiler; string to be
passed to program's stdin; output to match against
program's stdout; return code to match against what
program returns.
All sections start with respective name: :compilation, :stdout,
:stdin, :return.
Section names must be present, but all can be empty. Return code
defaults to 0 in such case.
* Example
some-test.sex:
#+begin_src
; :compilation
; :stdin
; :stdout Hello world!
; :return
(include stdio.h)
(pub fn main () int
(puts "Hello World!")
(printf "Hello, %s!\n" name)
(return 0))
#+end_src

73
tools/sextest/sextest.sex Normal file
View File

@@ -0,0 +1,73 @@
(include stdio.h)
(include unistd.h)
(include string.h)
(var COMP (* const char) ":compilation")
(var STDIN (* const char) ":stdin")
(var STDOUT (* const char) ":stdout")
(var RET (* const char) ":return")
(var test-file-path (* const char) NULL)
(var prelude-comp [const char 1024])
(var prelude-stdin [const char 1024])
(var prelude-stdout [const char 1024])
(var prelude-ret [const char 1024])
(fn print-usage () void
(printf "Usage: sextest ./path/to/test-file.sex\n"))
(fn read-file ((file-path (* const char))) void
(var f (* FILE) (fopen file-path "r"))
(if (== f NULL)
(begin
(printf "Failed to read file %s\n" file-path)
(return)))
;; should be more than enough
(var buffer [const char 1024])
(var i int 0)
(var c char)
(var section (* const char))
(while (!= EOF (= c (getc f)))
(switch c
(case (#\space #\newline #\tab #\return)
(= [buffer i] #\null)
(if (!= NULL section)
(begin
(memcpy i section buffer)))
(if (== 0 (strncmp buffer COMP 8ul)))
(= i 0))
(default
(if (== i (sizeof buffer))
(printf "Blast! The section is longer than %d, not going to work with this" (++/post i)))
(if (< i (sizeof buffer))
(= [buffer (++/post i)] c))))))
(fn get-section ((section-name (* const char))) (* const char)
;; Get section from test file by name.
;; Name must be one of: :compilation, :stdin, :stdout, :return
(if (== 0 (strncmp section-name COMP 8ul))
(return prelude-comp))
(if (== 0 (strncmp section-name STDIN 6ul))
(return prelude-stdin))
(if (== 0 (strncmp section-name STDOUT 7ul))
(return prelude-stdout))
(if (== 0 (strncmp section-name RET 7ul))
(return prelude-ret))
(printf "Expected section name, got %s\n" section-name)
(return NULL))
(pub fn main ((argc int) (argv [* const char])) int
(if (!= argc 2)
(begin
(print-usage)
(return 1)))
(var test-file-path (* const char) [argv 1])
(read-file test-file-path)
(return 0))