From bc54ae6a05e727bacd1ee9f9beda4e3e6fcf0b0e Mon Sep 17 00:00:00 2001 From: alex-eg Date: Wed, 30 Jul 2025 17:34:09 +0300 Subject: [PATCH] modularize Sex compiler --- Makefile | 2 +- modules.scm | 86 +++++++++++++++++++++++++++++++++++++ sexc.scm | 108 ++--------------------------------------------- templates.scm | 2 +- utils.macros.scm | 15 +++++++ utils.scm | 19 +++++++++ 6 files changed, 126 insertions(+), 106 deletions(-) create mode 100644 modules.scm create mode 100644 utils.macros.scm create mode 100644 utils.scm diff --git a/Makefile b/Makefile index ce57a7b..73e593e 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ CHICKEN_C = csc -MODULES = sexc templates main +MODULES = sexc main modules templates utils OBJ = $(MODULES:%=%.o) # chicken flags diff --git a/modules.scm b/modules.scm new file mode 100644 index 0000000..7dc004e --- /dev/null +++ b/modules.scm @@ -0,0 +1,86 @@ +(declare (unit sex-modules) ; you CAN'T have unit named + ; modules, things start to + ; break. Probably some + ; internal chicken name + (uses utils)) + +(import brev-separate + (chicken file) + (chicken load) + (chicken pathname) + (chicken string) + fmt + srfi-1) + +(define +persistent-module-paths+ (list)) + +(define (import-modules 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))) + +(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 import include struct template 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 ":")))))) diff --git a/sexc.scm b/sexc.scm index 6c55d28..ce68f5c 100644 --- a/sexc.scm +++ b/sexc.scm @@ -1,5 +1,8 @@ (declare (unit sexc) - (uses templates)) + (uses sex-modules + templates)) + +(include "utils.macros.scm") (import brev-separate (chicken file) @@ -200,81 +203,6 @@ (fmt #t (c-expr form) nl)) forms)) -;;; Module stuff - -(define (import-modules 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))) - -(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 import include struct template typedef union var) - (cons (cdr form) acc)) - (else (error "Pub what? " (cadr form))))) - (else acc))) - -(define +persistent-module-paths+ (list)) - -(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 ":")))))) - ;;; Main function facilities (define opts-grammar @@ -337,36 +265,11 @@ 'stdin (car rest-args)))) -(define-syntax prog1 - (syntax-rules () - ((prog1 form . forms) - (let ((res form)) - (begin . forms) - res)))) - -(define-syntax with-directory - (syntax-rules () - ((with-directory path form . forms) - (let ((current-dir (current-directory))) - (set-working-directory path) - (prog1 - (begin form . forms) - (change-directory current-dir)))))) - (define (read-from-file file) (with-directory file (with-input-from-file (pathname-strip-directory file) (fn (read-forms (list)))))) -(define (set-working-directory file) - (change-directory - (normalize-pathname - (if (absolute-pathname? file) - (pathname-directory file) - (make-absolute-pathname - (current-directory) - (pathname-directory file)))))) - (define (write-to-file-or-stdout output what) (if (eq? output 'default) (what) @@ -381,9 +284,6 @@ (map pp sex-forms) (emit-c sex-forms))))) -(define (get-env-var name) - (get-environment-variable name)) - (define (compile-to-file sex-forms output args) (let ((compiler (or (get-arg args 'c-compiler #f) (get-env-var "SEX_CC") diff --git a/templates.scm b/templates.scm index 4510a12..c967e20 100644 --- a/templates.scm +++ b/templates.scm @@ -1,8 +1,8 @@ (declare (unit templates)) (import - (chicken plist) brev-separate + (chicken plist) fmt regex srfi-1 ; list routines diff --git a/utils.macros.scm b/utils.macros.scm new file mode 100644 index 0000000..190209c --- /dev/null +++ b/utils.macros.scm @@ -0,0 +1,15 @@ +(define-syntax prog1 + (syntax-rules () + ((prog1 form . forms) + (let ((res form)) + (begin . forms) + res)))) + +(define-syntax with-directory + (syntax-rules () + ((with-directory path form . forms) + (let ((current-dir (current-directory))) + (set-working-directory path) + (prog1 + (begin form . forms) + (change-directory current-dir)))))) diff --git a/utils.scm b/utils.scm new file mode 100644 index 0000000..dd0506e --- /dev/null +++ b/utils.scm @@ -0,0 +1,19 @@ +(declare (unit utils)) + +(include "utils.macros.scm") + +(import + (chicken pathname) + (chicken process-context)) + +(define (get-env-var name) + (get-environment-variable name)) + +(define (set-working-directory file) + (change-directory + (normalize-pathname + (if (absolute-pathname? file) + (pathname-directory file) + (make-absolute-pathname + (current-directory) + (pathname-directory file))))))