Compare commits
4 Commits
65964f2aa0
...
refactor-t
| Author | SHA1 | Date | |
|---|---|---|---|
| b157315e3d | |||
| 24b3e71969 | |||
| a951fd81b6 | |||
| 196694f18e |
1
.gitignore
vendored
1
.gitignore
vendored
@@ -1,4 +1,5 @@
|
|||||||
*.o
|
*.o
|
||||||
*.import.scm
|
*.import.scm
|
||||||
|
*.link
|
||||||
sexc
|
sexc
|
||||||
sex-tests
|
sex-tests
|
||||||
|
|||||||
64
Makefile
64
Makefile
@@ -1,24 +1,60 @@
|
|||||||
CHICKEN_C = csc
|
CHICKEN_C = csc
|
||||||
CSC_FLAGS += -K prefix
|
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.
|
||||||
|
|
||||||
# Order matters
|
MODULE_FLAGS = -emit-all-import-libraries -module-registration -c
|
||||||
MODULES = utils macros reader module-system semen sex-fmt-c fmt-c-writer sexc
|
|
||||||
|
# Order matters, since module check correctness on compilation
|
||||||
|
MODULES = utils sex-macros reader sex-modules semen sex-fmt-c fmt-c-writer sexc
|
||||||
OBJ = $(MODULES:%=%.o)
|
OBJ = $(MODULES:%=%.o)
|
||||||
|
|
||||||
sexc: $(OBJ) main.o
|
sexc: $(OBJ) main.scm
|
||||||
$(CHICKEN_C) $(CSC_FLAGS) $^ -o $@
|
$(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
|
||||||
|
|
||||||
main.o: main.scm
|
#------------------------------------------------------------------
|
||||||
$(CHICKEN_C) $(CSC_FLAGS) $< -c -o $@
|
|
||||||
|
|
||||||
%.o: %.scm
|
utils.o: utils.module.scm utils.scm
|
||||||
$(CHICKEN_C) $(CSC_FLAGS) $< -e -c -J -o $@ -unit $(@:%.o=%)
|
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) utils.module.scm -o utils.o -unit utils
|
||||||
|
|
||||||
sex-tests: $(OBJ) tests/*.scm
|
sex-macros.o: sex-macros.module.scm sex-macros.scm
|
||||||
cd ./tests && $(CHICKEN_C) $(CSC_FLAGS) run.scm -c -o sex-tests.o
|
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) sex-macros.module.scm -o sex-macros.o -unit sex-macros
|
||||||
$(CHICKEN_C) $(CSC_FLAGS) $(OBJ) ./tests/sex-tests.o -o sex-tests
|
|
||||||
|
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
|
||||||
|
|
||||||
|
sex-tests:
|
||||||
|
$(MAKE) -C tests sex-tests
|
||||||
|
cp ./tests/sex-tests ./
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
rm -f $(OBJ) main.o ./tests/sex-tests.o
|
rm -f $(OBJ) main.o
|
||||||
rm -f $(IMPORTS)
|
rm -f *.import.scm
|
||||||
|
rm -f *.link
|
||||||
rm -f sexc sex-tests
|
rm -f sexc sex-tests
|
||||||
|
|||||||
3
fmt-c-writer.module.scm
Normal file
3
fmt-c-writer.module.scm
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
(module fmt-c-writer (emit-c
|
||||||
|
sex-fmt-current-file)
|
||||||
|
"fmt-c-writer.scm")
|
||||||
@@ -1,7 +1,5 @@
|
|||||||
;;; Sex fmt-c output writer
|
;;; Sex fmt-c output writer
|
||||||
|
|
||||||
(module fmt-c-writer (emit-c
|
|
||||||
sex-fmt-current-file)
|
|
||||||
(import
|
(import
|
||||||
scheme
|
scheme
|
||||||
(chicken base)
|
(chicken base)
|
||||||
@@ -282,4 +280,4 @@
|
|||||||
(sex-fmt-line-num start-line)
|
(sex-fmt-line-num start-line)
|
||||||
(fmt #t (line-directive-string) nl)))
|
(fmt #t (line-directive-string) nl)))
|
||||||
(fmt #t (c-expr (process-toplevel-form form)) nl))
|
(fmt #t (c-expr (process-toplevel-form form)) nl))
|
||||||
sex-forms)))
|
sex-forms))
|
||||||
|
|||||||
45
macros.scm
45
macros.scm
@@ -1,45 +0,0 @@
|
|||||||
(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))))
|
|
||||||
@@ -1,92 +0,0 @@
|
|||||||
(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 ":")))))))
|
|
||||||
3
reader.module.scm
Normal file
3
reader.module.scm
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
(module reader (read-from-file
|
||||||
|
read-raw-forms)
|
||||||
|
"reader.scm")
|
||||||
@@ -1,5 +1,3 @@
|
|||||||
(module reader (read-from-file
|
|
||||||
read-raw-forms)
|
|
||||||
(import
|
(import
|
||||||
scheme
|
scheme
|
||||||
(chicken base)
|
(chicken base)
|
||||||
@@ -61,4 +59,4 @@
|
|||||||
(cons r acc)))))))
|
(cons r acc)))))))
|
||||||
(if (eq? input-source 'stdin)
|
(if (eq? input-source 'stdin)
|
||||||
(read-forms (list))
|
(read-forms (list))
|
||||||
(read-from-file input-source))))
|
(read-from-file input-source)))
|
||||||
|
|||||||
2
semen.module.scm
Normal file
2
semen.module.scm
Normal file
@@ -0,0 +1,2 @@
|
|||||||
|
(module semen ()
|
||||||
|
"semen.scm")
|
||||||
26
semen.scm
26
semen.scm
@@ -1,6 +1,5 @@
|
|||||||
;;; Sex semantic engine
|
;;; Sex semantic engine
|
||||||
|
|
||||||
(module semen ()
|
|
||||||
(import
|
(import
|
||||||
scheme
|
scheme
|
||||||
(chicken base)
|
(chicken base)
|
||||||
@@ -8,9 +7,9 @@
|
|||||||
(chicken string)
|
(chicken string)
|
||||||
(chicken module)
|
(chicken module)
|
||||||
fmt
|
fmt
|
||||||
macros
|
sex-macros
|
||||||
|
sex-modules
|
||||||
matchable ; pattern matching
|
matchable ; pattern matching
|
||||||
module-system
|
|
||||||
srfi-1 ; list routines
|
srfi-1 ; list routines
|
||||||
srfi-69 ; hash tables
|
srfi-69 ; hash tables
|
||||||
utils
|
utils
|
||||||
@@ -147,23 +146,23 @@
|
|||||||
expanded
|
expanded
|
||||||
fn-walker
|
fn-walker
|
||||||
(begin
|
(begin
|
||||||
(set! (hash-table-ref env #:fn-name) (sex-fn-name expanded))
|
(set! (hash-table-ref env :fn-name) (sex-fn-name expanded))
|
||||||
(set! (hash-table-ref env #:lambda-counter) 0)
|
(set! (hash-table-ref env :lambda-counter) 0)
|
||||||
(set! (hash-table-ref env #:lambda-aux-code) (list))
|
(set! (hash-table-ref env :lambda-aux-code) (list))
|
||||||
env))))
|
env))))
|
||||||
|
|
||||||
(cons processed
|
(cons processed
|
||||||
(append (hash-table-ref env #:lambda-aux-code) acc))))
|
(append (hash-table-ref env :lambda-aux-code) acc))))
|
||||||
|
|
||||||
(define (fn-walker form env)
|
(define (fn-walker form env)
|
||||||
(if (eq? 'lambda (car form))
|
(if (eq? 'lambda (car form))
|
||||||
(let ((lambda-name (make-lambda-name (hash-table-ref env #:fn-name)
|
(let ((lambda-name (make-lambda-name (hash-table-ref env :fn-name)
|
||||||
(hash-table-ref env #:lambda-counter))))
|
(hash-table-ref env :lambda-counter))))
|
||||||
(set! (hash-table-ref env #:lambda-aux-code)
|
(set! (hash-table-ref env :lambda-aux-code)
|
||||||
(append (make-aux-lambda-struct lambda-name form)
|
(append (make-aux-lambda-struct lambda-name form)
|
||||||
(hash-table-ref env #:lambda-aux-code)))
|
(hash-table-ref env :lambda-aux-code)))
|
||||||
(set! (hash-table-ref env #:lambda-counter)
|
(set! (hash-table-ref env :lambda-counter)
|
||||||
(+ (hash-table-ref env #:lambda-counter) 1))
|
(+ (hash-table-ref env :lambda-counter) 1))
|
||||||
lambda-name)
|
lambda-name)
|
||||||
form))
|
form))
|
||||||
|
|
||||||
@@ -238,4 +237,3 @@ Returns #f if the form is not a function, returns the form otherwise"
|
|||||||
(if (sex-fn-public? fn-form)
|
(if (sex-fn-public? fn-form)
|
||||||
(drop fn-form 5)
|
(drop fn-form 5)
|
||||||
(drop fn-form 4)))
|
(drop fn-form 4)))
|
||||||
)
|
|
||||||
|
|||||||
@@ -112,7 +112,7 @@
|
|||||||
(lambda (st)
|
(lambda (st)
|
||||||
((fmt-let 'op op
|
((fmt-let 'op op
|
||||||
(if (and (c-op<= (fmt-op st) op)
|
(if (and (c-op<= (fmt-op st) op)
|
||||||
(not (vector? st)))
|
(not (vector? x)))
|
||||||
(c-paren x)
|
(c-paren x)
|
||||||
x))
|
x))
|
||||||
st)))
|
st)))
|
||||||
|
|||||||
8
sex-macros.module.scm
Normal file
8
sex-macros.module.scm
Normal file
@@ -0,0 +1,8 @@
|
|||||||
|
(module sex-macros
|
||||||
|
(register-macro
|
||||||
|
cat
|
||||||
|
get-macro
|
||||||
|
macro?
|
||||||
|
apply-macro
|
||||||
|
defmacro)
|
||||||
|
"sex-macros.scm")
|
||||||
38
sex-macros.scm
Normal file
38
sex-macros.scm
Normal file
@@ -0,0 +1,38 @@
|
|||||||
|
(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)))
|
||||||
@@ -51,7 +51,9 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
|
|||||||
;; Keywords
|
;; Keywords
|
||||||
(list (concat "("
|
(list (concat "("
|
||||||
(regexp-opt '(
|
(regexp-opt '(
|
||||||
|
"begin"
|
||||||
"case"
|
"case"
|
||||||
|
"default"
|
||||||
"do"
|
"do"
|
||||||
"if"
|
"if"
|
||||||
"for"
|
"for"
|
||||||
@@ -83,6 +85,8 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
|
|||||||
(put 'union 'lisp-indent-function 'defun)
|
(put 'union 'lisp-indent-function 'defun)
|
||||||
(put 'var 'lisp-indent-function 0)
|
(put 'var 'lisp-indent-function 0)
|
||||||
(put 'import 'lisp-indent-function 1)
|
(put 'import 'lisp-indent-function 1)
|
||||||
|
(put 'switch 'lisp-indent-function 1)
|
||||||
|
(put 'case 'lisp-indent-function 1)
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(define-derived-mode sex-mode lisp-data-mode "Sex"
|
(define-derived-mode sex-mode lisp-data-mode "Sex"
|
||||||
|
|||||||
5
sex-modules.module.scm
Normal file
5
sex-modules.module.scm
Normal file
@@ -0,0 +1,5 @@
|
|||||||
|
(module sex-modules
|
||||||
|
(get-modules-public-forms
|
||||||
|
load-persistent-module-paths
|
||||||
|
read-public-interface)
|
||||||
|
"sex-modules.scm")
|
||||||
87
sex-modules.scm
Normal file
87
sex-modules.scm
Normal file
@@ -0,0 +1,87 @@
|
|||||||
|
(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
sexc.module.scm
Normal file
1
sexc.module.scm
Normal file
@@ -0,0 +1 @@
|
|||||||
|
(module sexc (main) "sexc.scm")
|
||||||
7
sexc.scm
7
sexc.scm
@@ -1,4 +1,3 @@
|
|||||||
(module sexc (main)
|
|
||||||
(import scheme
|
(import scheme
|
||||||
brev-separate
|
brev-separate
|
||||||
(chicken base)
|
(chicken base)
|
||||||
@@ -11,8 +10,8 @@
|
|||||||
fmt
|
fmt
|
||||||
fmt-c-writer
|
fmt-c-writer
|
||||||
getopt-long
|
getopt-long
|
||||||
macros
|
sex-macros
|
||||||
module-system
|
sex-modules
|
||||||
reader
|
reader
|
||||||
semen
|
semen
|
||||||
srfi-1 ; list routines
|
srfi-1 ; list routines
|
||||||
@@ -164,4 +163,4 @@
|
|||||||
;; Emit processed and macro-expanded sex code, or emit C code
|
;; Emit processed and macro-expanded sex code, or emit C code
|
||||||
(emit-c-or-sex sex-forms output args)
|
(emit-c-or-sex sex-forms output args)
|
||||||
;; Compile file!
|
;; Compile file!
|
||||||
(compile-to-file sex-forms output args))))))))
|
(compile-to-file sex-forms output args)))))))
|
||||||
|
|||||||
@@ -1 +1,45 @@
|
|||||||
|
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,3 +1,5 @@
|
|||||||
|
(import fmt-c-writer)
|
||||||
|
|
||||||
(test-group "basic"
|
(test-group "basic"
|
||||||
|
|
||||||
;; unkebabify
|
;; unkebabify
|
||||||
|
|||||||
3
tests/fmt-c-writer.module.scm
Normal file
3
tests/fmt-c-writer.module.scm
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
(module fmt-c-writer
|
||||||
|
*
|
||||||
|
"../fmt-c-writer.scm")
|
||||||
3
tests/reader.module.scm
Normal file
3
tests/reader.module.scm
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
(module reader
|
||||||
|
*
|
||||||
|
"../reader.scm")
|
||||||
@@ -1,4 +1,5 @@
|
|||||||
(import (chicken port))
|
(import (chicken port)
|
||||||
|
reader)
|
||||||
|
|
||||||
(define-syntax reader-test
|
(define-syntax reader-test
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
|
|||||||
@@ -1,10 +1,4 @@
|
|||||||
(declare (uses fmt-c-writer
|
|
||||||
semen))
|
|
||||||
|
|
||||||
(import
|
(import
|
||||||
(chicken process)
|
|
||||||
(chicken process-context)
|
|
||||||
srfi-1
|
|
||||||
test)
|
test)
|
||||||
|
|
||||||
(include "basic.scm")
|
(include "basic.scm")
|
||||||
|
|||||||
2
tests/semen.module.scm
Normal file
2
tests/semen.module.scm
Normal file
@@ -0,0 +1,2 @@
|
|||||||
|
(module semen *
|
||||||
|
"../semen.scm")
|
||||||
@@ -1,4 +1,5 @@
|
|||||||
(import srfi-69)
|
(import srfi-69
|
||||||
|
semen)
|
||||||
|
|
||||||
(define print-str-fn
|
(define print-str-fn
|
||||||
'(fn void print-str ((string s))
|
'(fn void print-str ((string s))
|
||||||
@@ -38,11 +39,11 @@
|
|||||||
(define (form-identity form env)
|
(define (form-identity form env)
|
||||||
form)
|
form)
|
||||||
|
|
||||||
(test 'a (semen-walk-form 'a form-identity (make-hash-table)))
|
(test 'a (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 b c) (walk-form '(a b c) form-identity (make-hash-table)))
|
||||||
|
|
||||||
(test 'a (semen-macro-expand 'a))
|
(test 'a (macro-expand 'a))
|
||||||
(test '(a b c) (semen-macro-expand '(a b c)))
|
(test '(a b c) (macro-expand '(a b c)))
|
||||||
|
|
||||||
(let ((sex-code-macro
|
(let ((sex-code-macro
|
||||||
'((defmacro (x10 a)
|
'((defmacro (x10 a)
|
||||||
|
|||||||
3
tests/sex-macros.module.scm
Normal file
3
tests/sex-macros.module.scm
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
(module sex-macros
|
||||||
|
*
|
||||||
|
"../sex-macros.scm")
|
||||||
3
tests/sex-modules.module.scm
Normal file
3
tests/sex-modules.module.scm
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
(module sex-modules
|
||||||
|
*
|
||||||
|
"../sex-modules.scm")
|
||||||
1
tests/sexc.module.scm
Normal file
1
tests/sexc.module.scm
Normal file
@@ -0,0 +1 @@
|
|||||||
|
(module sexc (main) "../sexc.scm")
|
||||||
3
tests/utils.module.scm
Normal file
3
tests/utils.module.scm
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
(module utils
|
||||||
|
*
|
||||||
|
"../utils.scm")
|
||||||
@@ -1,3 +1,5 @@
|
|||||||
|
(import utils)
|
||||||
|
|
||||||
(test-group "utils"
|
(test-group "utils"
|
||||||
|
|
||||||
(test
|
(test
|
||||||
|
|||||||
@@ -1 +0,0 @@
|
|||||||
(import (chicken process-context))
|
|
||||||
10
utils.module.scm
Normal file
10
utils.module.scm
Normal file
@@ -0,0 +1,10 @@
|
|||||||
|
(module utils
|
||||||
|
(get-env-var
|
||||||
|
set-working-directory
|
||||||
|
to-absolute-pathname
|
||||||
|
list-split
|
||||||
|
list-join
|
||||||
|
recons
|
||||||
|
with-directory
|
||||||
|
)
|
||||||
|
"utils.scm")
|
||||||
11
utils.scm
11
utils.scm
@@ -1,13 +1,3 @@
|
|||||||
(module utils
|
|
||||||
(get-env-var
|
|
||||||
set-working-directory
|
|
||||||
to-absolute-pathname
|
|
||||||
list-split
|
|
||||||
list-join
|
|
||||||
recons
|
|
||||||
with-directory
|
|
||||||
)
|
|
||||||
|
|
||||||
(import
|
(import
|
||||||
scheme
|
scheme
|
||||||
(chicken base)
|
(chicken base)
|
||||||
@@ -74,4 +64,3 @@
|
|||||||
(eq? new-cdr (cdr old-cons)))
|
(eq? new-cdr (cdr old-cons)))
|
||||||
old-cons
|
old-cons
|
||||||
(cons new-car new-cdr)))
|
(cons new-car new-cdr)))
|
||||||
)
|
|
||||||
|
|||||||
Reference in New Issue
Block a user