Compare commits
3 Commits
refactor-t
...
a80b8d9acf
| Author | SHA1 | Date | |
|---|---|---|---|
| a80b8d9acf | |||
| d039fa0cb9 | |||
| 559ed9c7fa |
1
.gitignore
vendored
1
.gitignore
vendored
@@ -1,5 +1,4 @@
|
||||
*.o
|
||||
*.import.scm
|
||||
*.link
|
||||
sexc
|
||||
sex-tests
|
||||
|
||||
75
Makefile
75
Makefile
@@ -1,60 +1,53 @@
|
||||
CHICKEN_C = csc
|
||||
CSC_FLAGS += -K prefix -static
|
||||
# What and why:
|
||||
# -emit-all-import-libraries: Emit import-libraries for all defined modules.
|
||||
# Used to generate .import.scm files so compiler would know how to use the modules.
|
||||
# Without it, csc fails with "cannot import from undefined module" error.
|
||||
# -module-registration: Always generate module registration code, even when
|
||||
# import libraries are emitted. Enables us to import from our modules at run time.
|
||||
# Used in macros, where we inject `(import (only sex-macros cat))' before the macro body.
|
||||
# Without it, sexc compiles scuccessfully, but is unable to process macros, failing with
|
||||
# "during expansion of (import ...) - cannot import from undefined module: sex-macros"
|
||||
# error.
|
||||
# -c: Stop after compilation to object files. This one is obvious.
|
||||
|
||||
MODULE_FLAGS = -emit-all-import-libraries -module-registration -c
|
||||
CSC_FLAGS += -K prefix
|
||||
|
||||
# Order matters, since module check correctness on compilation
|
||||
MODULES = utils sex-macros reader sex-modules semen sex-fmt-c fmt-c-writer sexc
|
||||
MODULES = utils macros reader module-system semen sex-fmt-c fmt-c-writer sexc
|
||||
OBJ = $(MODULES:%=%.o)
|
||||
IMPORTS = $(MODULES:%=%.import.scm)
|
||||
LINK = $(MODULES:%=%.link)
|
||||
|
||||
sexc: $(OBJ) main.scm
|
||||
$(CHICKEN_C) $(CSC_FLAGS) main.scm -o sexc-tmp -link sexc
|
||||
# otherwise csc hangs, probably because it tries to compile to sexc.o first
|
||||
mv sexc-tmp sexc
|
||||
sexc: $(OBJ) main.o
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $^ -o $@
|
||||
|
||||
main.o: main.scm
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $< -c -o $@ -link sexc
|
||||
|
||||
#------------------------------------------------------------------
|
||||
|
||||
utils.o: utils.module.scm utils.scm
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) utils.module.scm -o utils.o -unit utils
|
||||
utils.o: utils.scm
|
||||
$(CHICKEN_C) $(CSC_FLAGS) utils.scm -e -c -J -o utils.o -unit utils
|
||||
|
||||
sex-macros.o: sex-macros.module.scm sex-macros.scm
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) sex-macros.module.scm -o sex-macros.o -unit sex-macros
|
||||
macros.o: macros.scm
|
||||
$(CHICKEN_C) $(CSC_FLAGS) macros.scm -e -c -J -o macros.o -unit macros
|
||||
|
||||
reader.o: reader.module.scm reader.scm
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) reader.module.scm -o reader.o -unit reader
|
||||
reader.o:
|
||||
$(CHICKEN_C) $(CSC_FLAGS) reader.scm -e -c -J -o reader.o -unit reader
|
||||
|
||||
sex-modules.o: sex-modules.module.scm sex-modules.scm reader.o utils.o
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) sex-modules.module.scm -o sex-modules.o -unit sex-modules -link reader,utils
|
||||
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 reader,utils
|
||||
|
||||
semen.o: semen.module.scm semen.scm sex-macros.o sex-modules.o utils.o
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) semen.module.scm -o semen.o -unit semen -link sex-macros,sex-modules,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,module-system,utils
|
||||
|
||||
sex-fmt-c.o: sex-fmt-c.scm
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) sex-fmt-c.scm -o sex-fmt-c.o -unit sex-fmt-c
|
||||
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,utils
|
||||
|
||||
fmt-c-writer.o: fmt-c-writer.module.scm fmt-c-writer.scm sex-fmt-c.o utils.o
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) fmt-c-writer.module.scm -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,macros,module-system,reader,semen,utils
|
||||
|
||||
sexc.o: sexc.module.scm sexc.scm fmt-c-writer.o sex-macros.o sex-modules.o reader.o semen.o utils.o
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) sexc.module.scm -o sexc.o -unit sexc -link fmt-c-writer,sex-macros,sex-modules,reader,semen,utils
|
||||
%.link: %.o
|
||||
%.import.scm: %.o
|
||||
%.o: %.scm
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $< -e -c -J -o $@ -unit $(@:%.o=%)
|
||||
|
||||
sex-tests:
|
||||
$(MAKE) -C tests sex-tests
|
||||
cp ./tests/sex-tests ./
|
||||
|
||||
sex-tests: $(OBJ) tests/*.scm
|
||||
cd ./tests && $(CHICKEN_C) $(CSC_FLAGS) run.scm -c -o sex-tests.o
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(OBJ) ./tests/sex-tests.o -o sex-tests
|
||||
|
||||
clean:
|
||||
rm -f $(OBJ) main.o
|
||||
rm -f *.import.scm
|
||||
rm -f *.link
|
||||
rm -f $(OBJ) main.o ./tests/sex-tests.o
|
||||
rm -f $(IMPORTS)
|
||||
rm -f $(LINK) main.link
|
||||
rm -f sexc sex-tests
|
||||
|
||||
2
example/mini-test.sex
Normal file
2
example/mini-test.sex
Normal file
@@ -0,0 +1,2 @@
|
||||
(pub fn main () int
|
||||
(var l (* (struct list-int)) (make-list-int)))
|
||||
25
example/our-reader.sex
Normal file
25
example/our-reader.sex
Normal 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
6
example/structs.sex
Normal 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))])))
|
||||
@@ -1,3 +0,0 @@
|
||||
(module fmt-c-writer (emit-c
|
||||
sex-fmt-current-file)
|
||||
"fmt-c-writer.scm")
|
||||
@@ -1,5 +1,7 @@
|
||||
;;; Sex fmt-c output writer
|
||||
|
||||
(module fmt-c-writer (emit-c
|
||||
sex-fmt-current-file)
|
||||
(import
|
||||
scheme
|
||||
(chicken base)
|
||||
@@ -280,4 +282,4 @@
|
||||
(sex-fmt-line-num start-line)
|
||||
(fmt #t (line-directive-string) nl)))
|
||||
(fmt #t (c-expr (process-toplevel-form form)) nl))
|
||||
sex-forms))
|
||||
sex-forms)))
|
||||
|
||||
45
macros.scm
Normal file
45
macros.scm
Normal file
@@ -0,0 +1,45 @@
|
||||
(module macros
|
||||
(register-macro
|
||||
cat
|
||||
get-macro
|
||||
macro?
|
||||
apply-macro
|
||||
defmacro)
|
||||
(import
|
||||
scheme
|
||||
(only fmt fmt)
|
||||
(chicken base)
|
||||
(chicken plist)
|
||||
(chicken string))
|
||||
|
||||
(define (cat-syms s-1 s-2)
|
||||
(fmt #f s-1 s-2))
|
||||
|
||||
(define (cat sym-1 sym-2)
|
||||
(string->symbol (cat-syms sym-1 sym-2)))
|
||||
|
||||
(define (register-macro name arglist body)
|
||||
(put! name 'sex-macro
|
||||
`(lambda ,arglist
|
||||
(import scheme
|
||||
(only macros cat))
|
||||
,@body)))
|
||||
|
||||
(define (get-macro name)
|
||||
(eval (get name 'sex-macro)))
|
||||
|
||||
(define (macro? form)
|
||||
(and (list? form)
|
||||
(symbol? (car form))
|
||||
(get (car form) 'sex-macro)))
|
||||
|
||||
(define (apply-macro form)
|
||||
(assert (macro? form)
|
||||
(fmt #f (car form) " is not a macro"))
|
||||
(apply (get-macro (car form))
|
||||
(cdr form)))
|
||||
|
||||
(define (defmacro form)
|
||||
(let ((arglist (car form))
|
||||
(body (cdr form)))
|
||||
(register-macro (car arglist) (cdr arglist) body))))
|
||||
92
module-system.scm
Normal file
92
module-system.scm
Normal file
@@ -0,0 +1,92 @@
|
||||
(module module-system
|
||||
(get-modules-public-forms
|
||||
load-persistent-module-paths
|
||||
read-public-interface)
|
||||
|
||||
(import
|
||||
scheme
|
||||
brev-separate
|
||||
(chicken base)
|
||||
(chicken file)
|
||||
(chicken load)
|
||||
(chicken pathname)
|
||||
(chicken process-context)
|
||||
(chicken string)
|
||||
fmt
|
||||
reader
|
||||
srfi-1
|
||||
utils)
|
||||
|
||||
(define +persistent-module-paths+ (list))
|
||||
|
||||
(define (get-modules-public-forms module-list)
|
||||
;; Module list is a list of symbols
|
||||
;; How Sex handles modules:
|
||||
;; For each module in a list, construct path, find module by path in
|
||||
;; module path directories, extract public definitions from the
|
||||
;; module, paste them in current one in emulation of C include
|
||||
;; directives.
|
||||
(fold-right append (list)
|
||||
(map (fn (import-module (symbol->string x)))
|
||||
module-list)))
|
||||
|
||||
(define (import-module name)
|
||||
(let ((module-path (locate-module name)))
|
||||
(assert module-path (fmt #f "Failed to find module " name " in "
|
||||
(get-module-paths)))
|
||||
(read-public-interface module-path)))
|
||||
|
||||
(define (get-module-paths)
|
||||
(cons (current-directory)
|
||||
+persistent-module-paths+))
|
||||
|
||||
(define (locate-module name)
|
||||
;; Module locations: relative to file being compiled, or in what was
|
||||
;; in SEX_MODULE_PATH env var at the start of the process (see
|
||||
;; load-persistent-module-paths function)
|
||||
|
||||
(let ((search-paths (get-module-paths)))
|
||||
(let loop ((paths search-paths))
|
||||
(if (null? paths)
|
||||
#f
|
||||
(or (module-exists? name (car paths))
|
||||
(loop (cdr paths)))))))
|
||||
|
||||
(define (module-exists? name module-dir)
|
||||
;; returns absolute path to module, if it exists
|
||||
(and (directory-exists? module-dir)
|
||||
(let ((module-path (make-absolute-pathname module-dir name "sex")))
|
||||
(and (file-exists? module-path)
|
||||
(file-readable? module-path)
|
||||
module-path))))
|
||||
|
||||
(define (read-public-interface module-path)
|
||||
;; pub fns are reduced to prototypes, other pub forms are just pasted
|
||||
(let ((raw-forms (read-from-file module-path)))
|
||||
(fold
|
||||
process-public-interface-form
|
||||
(list)
|
||||
raw-forms)))
|
||||
|
||||
;;; TODO: use semen facilities to analyze modules
|
||||
(define (process-public-interface-form form acc)
|
||||
(case (car form)
|
||||
((pub)
|
||||
(case (cadr form)
|
||||
((fn) ; replace with prototype
|
||||
;; fn type name (arg-list) (body)
|
||||
;; 1 2 3 4 - we need first 4
|
||||
(cons (take (cdr form) 4) acc))
|
||||
((define defmacro import include struct typedef union var)
|
||||
(cons (cdr form) acc))
|
||||
(else (error "Pub what? " (cadr form)))))
|
||||
(else acc)))
|
||||
|
||||
(define (load-persistent-module-paths)
|
||||
(let ((sex-module-path-env-var
|
||||
(get-env-var "SEX_MODULE_PATH")))
|
||||
(when sex-module-path-env-var
|
||||
(set! +persistent-module-paths+
|
||||
(map (lambda (p)
|
||||
(make-absolute-pathname p #f #f))
|
||||
(string-split sex-module-path-env-var ":")))))))
|
||||
@@ -1,3 +0,0 @@
|
||||
(module reader (read-from-file
|
||||
read-raw-forms)
|
||||
"reader.scm")
|
||||
@@ -1,3 +1,5 @@
|
||||
(module reader (read-from-file
|
||||
read-raw-forms)
|
||||
(import
|
||||
scheme
|
||||
(chicken base)
|
||||
@@ -59,4 +61,4 @@
|
||||
(cons r acc)))))))
|
||||
(if (eq? input-source 'stdin)
|
||||
(read-forms (list))
|
||||
(read-from-file input-source)))
|
||||
(read-from-file input-source))))
|
||||
|
||||
@@ -1,2 +0,0 @@
|
||||
(module semen ()
|
||||
"semen.scm")
|
||||
@@ -1,5 +1,6 @@
|
||||
;;; Sex semantic engine
|
||||
|
||||
(module semen ()
|
||||
(import
|
||||
scheme
|
||||
(chicken base)
|
||||
@@ -7,9 +8,9 @@
|
||||
(chicken string)
|
||||
(chicken module)
|
||||
fmt
|
||||
sex-macros
|
||||
sex-modules
|
||||
macros
|
||||
matchable ; pattern matching
|
||||
module-system
|
||||
srfi-1 ; list routines
|
||||
srfi-69 ; hash tables
|
||||
utils
|
||||
@@ -237,3 +238,4 @@ Returns #f if the form is not a function, returns the form otherwise"
|
||||
(if (sex-fn-public? fn-form)
|
||||
(drop fn-form 5)
|
||||
(drop fn-form 4)))
|
||||
)
|
||||
|
||||
@@ -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) ")"))
|
||||
|
||||
|
||||
@@ -1,8 +0,0 @@
|
||||
(module sex-macros
|
||||
(register-macro
|
||||
cat
|
||||
get-macro
|
||||
macro?
|
||||
apply-macro
|
||||
defmacro)
|
||||
"sex-macros.scm")
|
||||
@@ -1,38 +0,0 @@
|
||||
(import
|
||||
scheme
|
||||
(only fmt fmt)
|
||||
(chicken base)
|
||||
(chicken plist)
|
||||
(chicken string))
|
||||
|
||||
(define (cat-syms s-1 s-2)
|
||||
(fmt #f s-1 s-2))
|
||||
|
||||
(define (cat sym-1 sym-2)
|
||||
(string->symbol (cat-syms sym-1 sym-2)))
|
||||
|
||||
(define (register-macro name arglist body)
|
||||
(put! name 'sex-macro
|
||||
`(lambda ,arglist
|
||||
(import scheme
|
||||
(only sex-macros cat))
|
||||
,@body)))
|
||||
|
||||
(define (get-macro name)
|
||||
(eval (get name 'sex-macro)))
|
||||
|
||||
(define (macro? form)
|
||||
(and (list? form)
|
||||
(symbol? (car form))
|
||||
(get (car form) 'sex-macro)))
|
||||
|
||||
(define (apply-macro form)
|
||||
(assert (macro? form)
|
||||
(fmt #f (car form) " is not a macro"))
|
||||
(apply (get-macro (car form))
|
||||
(cdr form)))
|
||||
|
||||
(define (defmacro form)
|
||||
(let ((arglist (car form))
|
||||
(body (cdr form)))
|
||||
(register-macro (car arglist) (cdr arglist) body)))
|
||||
@@ -1,5 +0,0 @@
|
||||
(module sex-modules
|
||||
(get-modules-public-forms
|
||||
load-persistent-module-paths
|
||||
read-public-interface)
|
||||
"sex-modules.scm")
|
||||
@@ -1,87 +0,0 @@
|
||||
(import
|
||||
scheme
|
||||
brev-separate
|
||||
(chicken base)
|
||||
(chicken file)
|
||||
(chicken load)
|
||||
(chicken pathname)
|
||||
(chicken process-context)
|
||||
(chicken string)
|
||||
fmt
|
||||
reader
|
||||
srfi-1
|
||||
utils)
|
||||
|
||||
(define +persistent-module-paths+ (list))
|
||||
|
||||
(define (get-modules-public-forms module-list)
|
||||
;; Module list is a list of symbols
|
||||
;; How Sex handles modules:
|
||||
;; For each module in a list, construct path, find module by path in
|
||||
;; module path directories, extract public definitions from the
|
||||
;; module, paste them in current one in emulation of C include
|
||||
;; directives.
|
||||
(fold-right append (list)
|
||||
(map (fn (import-module (symbol->string x)))
|
||||
module-list)))
|
||||
|
||||
(define (import-module name)
|
||||
(let ((module-path (locate-module name)))
|
||||
(assert module-path (fmt #f "Failed to find module " name " in "
|
||||
(get-module-paths)))
|
||||
(read-public-interface module-path)))
|
||||
|
||||
(define (get-module-paths)
|
||||
(cons (current-directory)
|
||||
+persistent-module-paths+))
|
||||
|
||||
(define (locate-module name)
|
||||
;; Module locations: relative to file being compiled, or in what was
|
||||
;; in SEX_MODULE_PATH env var at the start of the process (see
|
||||
;; load-persistent-module-paths function)
|
||||
|
||||
(let ((search-paths (get-module-paths)))
|
||||
(let loop ((paths search-paths))
|
||||
(if (null? paths)
|
||||
#f
|
||||
(or (module-exists? name (car paths))
|
||||
(loop (cdr paths)))))))
|
||||
|
||||
(define (module-exists? name module-dir)
|
||||
;; returns absolute path to module, if it exists
|
||||
(and (directory-exists? module-dir)
|
||||
(let ((module-path (make-absolute-pathname module-dir name "sex")))
|
||||
(and (file-exists? module-path)
|
||||
(file-readable? module-path)
|
||||
module-path))))
|
||||
|
||||
(define (read-public-interface module-path)
|
||||
;; pub fns are reduced to prototypes, other pub forms are just pasted
|
||||
(let ((raw-forms (read-from-file module-path)))
|
||||
(fold
|
||||
process-public-interface-form
|
||||
(list)
|
||||
raw-forms)))
|
||||
|
||||
;;; TODO: use semen facilities to analyze modules
|
||||
(define (process-public-interface-form form acc)
|
||||
(case (car form)
|
||||
((pub)
|
||||
(case (cadr form)
|
||||
((fn) ; replace with prototype
|
||||
;; fn type name (arg-list) (body)
|
||||
;; 1 2 3 4 - we need first 4
|
||||
(cons (take (cdr form) 4) acc))
|
||||
((define defmacro import include struct typedef union var)
|
||||
(cons (cdr form) acc))
|
||||
(else (error "Pub what? " (cadr form)))))
|
||||
(else acc)))
|
||||
|
||||
(define (load-persistent-module-paths)
|
||||
(let ((sex-module-path-env-var
|
||||
(get-env-var "SEX_MODULE_PATH")))
|
||||
(when sex-module-path-env-var
|
||||
(set! +persistent-module-paths+
|
||||
(map (lambda (p)
|
||||
(make-absolute-pathname p #f #f))
|
||||
(string-split sex-module-path-env-var ":"))))))
|
||||
@@ -1 +0,0 @@
|
||||
(module sexc (main) "sexc.scm")
|
||||
7
sexc.scm
7
sexc.scm
@@ -1,3 +1,4 @@
|
||||
(module sexc (main)
|
||||
(import scheme
|
||||
brev-separate
|
||||
(chicken base)
|
||||
@@ -10,8 +11,8 @@
|
||||
fmt
|
||||
fmt-c-writer
|
||||
getopt-long
|
||||
sex-macros
|
||||
sex-modules
|
||||
macros
|
||||
module-system
|
||||
reader
|
||||
semen
|
||||
srfi-1 ; list routines
|
||||
@@ -163,4 +164,4 @@
|
||||
;; Emit processed and macro-expanded sex code, or emit C code
|
||||
(emit-c-or-sex sex-forms output args)
|
||||
;; Compile file!
|
||||
(compile-to-file sex-forms output args)))))))
|
||||
(compile-to-file sex-forms output args))))))))
|
||||
|
||||
@@ -1,45 +1 @@
|
||||
CHICKEN_C = csc
|
||||
|
||||
CSC_FLAGS += -K prefix -static
|
||||
MODULE_FLAGS = -emit-all-import-libraries -module-registration -c
|
||||
|
||||
MODULES = utils sex-macros reader sex-modules semen sex-fmt-c fmt-c-writer sexc
|
||||
SEX_OBJ = $(MODULES:%=%.o)
|
||||
|
||||
TESTS = basic semen reader fmt-c-writer utils
|
||||
TEST_SRCS = $(TESTS:%=%.scm)
|
||||
|
||||
sex-tests: run.scm $(TEST_SRCS) $(SEX_OBJ)
|
||||
$(CHICKEN_C) $(CSC_FLAGS) run.scm -o sex-tests -link sexc
|
||||
|
||||
#------------------------------------------------------------------
|
||||
|
||||
utils.o: utils.module.scm ../utils.scm
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) utils.module.scm -o utils.o -unit utils
|
||||
|
||||
sex-macros.o: sex-macros.module.scm ../sex-macros.scm
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) sex-macros.module.scm -o sex-macros.o -unit sex-macros
|
||||
|
||||
reader.o: reader.module.scm ../reader.scm
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) reader.module.scm -o reader.o -unit reader
|
||||
|
||||
sex-modules.o: sex-modules.module.scm ../sex-modules.scm reader.o utils.o
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) sex-modules.module.scm -o sex-modules.o -unit sex-modules -link reader,utils
|
||||
|
||||
semen.o: semen.module.scm ../semen.scm sex-macros.o sex-modules.o utils.o
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) semen.module.scm -o semen.o -unit semen -link sex-macros,sex-modules,utils
|
||||
|
||||
sex-fmt-c.o: ../sex-fmt-c.scm
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) ../sex-fmt-c.scm -o sex-fmt-c.o -unit sex-fmt-c
|
||||
|
||||
fmt-c-writer.o: fmt-c-writer.module.scm ../fmt-c-writer.scm sex-fmt-c.o utils.o
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) fmt-c-writer.module.scm -o fmt-c-writer.o -unit fmt-c-writer -link sex-fmt-c,utils
|
||||
|
||||
sexc.o: sexc.module.scm ../sexc.scm fmt-c-writer.o sex-macros.o sex-modules.o reader.o semen.o utils.o
|
||||
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) sexc.module.scm -o sexc.o -unit sexc -link fmt-c-writer,sex-macros,sex-modules,reader,semen,utils
|
||||
|
||||
clean:
|
||||
rm -f $(OBJ)
|
||||
rm -f *.import.scm
|
||||
rm -f *.link
|
||||
rm -f sex-tests
|
||||
|
||||
@@ -1,5 +1,3 @@
|
||||
(import fmt-c-writer)
|
||||
|
||||
(test-group "basic"
|
||||
|
||||
;; unkebabify
|
||||
|
||||
@@ -1,3 +0,0 @@
|
||||
(module fmt-c-writer
|
||||
*
|
||||
"../fmt-c-writer.scm")
|
||||
@@ -1,3 +0,0 @@
|
||||
(module reader
|
||||
*
|
||||
"../reader.scm")
|
||||
@@ -1,5 +1,4 @@
|
||||
(import (chicken port)
|
||||
reader)
|
||||
(import (chicken port))
|
||||
|
||||
(define-syntax reader-test
|
||||
(syntax-rules ()
|
||||
|
||||
@@ -1,4 +1,10 @@
|
||||
(declare (uses fmt-c-writer
|
||||
semen))
|
||||
|
||||
(import
|
||||
(chicken process)
|
||||
(chicken process-context)
|
||||
srfi-1
|
||||
test)
|
||||
|
||||
(include "basic.scm")
|
||||
|
||||
@@ -1,2 +0,0 @@
|
||||
(module semen *
|
||||
"../semen.scm")
|
||||
@@ -1,5 +1,4 @@
|
||||
(import srfi-69
|
||||
semen)
|
||||
(import srfi-69)
|
||||
|
||||
(define print-str-fn
|
||||
'(fn void print-str ((string s))
|
||||
@@ -39,11 +38,11 @@
|
||||
(define (form-identity form env)
|
||||
form)
|
||||
|
||||
(test 'a (walk-form 'a form-identity (make-hash-table)))
|
||||
(test '(a b c) (walk-form '(a b c) form-identity (make-hash-table)))
|
||||
(test 'a (semen-walk-form 'a form-identity (make-hash-table)))
|
||||
(test '(a b c) (semen-walk-form '(a b c) form-identity (make-hash-table)))
|
||||
|
||||
(test 'a (macro-expand 'a))
|
||||
(test '(a b c) (macro-expand '(a b c)))
|
||||
(test 'a (semen-macro-expand 'a))
|
||||
(test '(a b c) (semen-macro-expand '(a b c)))
|
||||
|
||||
(let ((sex-code-macro
|
||||
'((defmacro (x10 a)
|
||||
|
||||
@@ -1,3 +0,0 @@
|
||||
(module sex-macros
|
||||
*
|
||||
"../sex-macros.scm")
|
||||
@@ -1,3 +0,0 @@
|
||||
(module sex-modules
|
||||
*
|
||||
"../sex-modules.scm")
|
||||
@@ -1 +0,0 @@
|
||||
(module sexc (main) "../sexc.scm")
|
||||
@@ -1,3 +0,0 @@
|
||||
(module utils
|
||||
*
|
||||
"../utils.scm")
|
||||
@@ -1,5 +1,3 @@
|
||||
(import utils)
|
||||
|
||||
(test-group "utils"
|
||||
|
||||
(test
|
||||
|
||||
34
tools/sextest/README.org
Normal file
34
tools/sextest/README.org
Normal 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
73
tools/sextest/sextest.sex
Normal 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))
|
||||
@@ -1,10 +0,0 @@
|
||||
(module utils
|
||||
(get-env-var
|
||||
set-working-directory
|
||||
to-absolute-pathname
|
||||
list-split
|
||||
list-join
|
||||
recons
|
||||
with-directory
|
||||
)
|
||||
"utils.scm")
|
||||
Reference in New Issue
Block a user