diff --git a/example/list.seh b/example/list.seh deleted file mode 100644 index 8b445c0..0000000 --- a/example/list.seh +++ /dev/null @@ -1,36 +0,0 @@ -(template (list-T ?T) - (struct list-?T - ((?T value) - ((* list-?T) next)))) - -(template (make-list-T ?T is-public?) - (,@(if 'is-public? '(pub) '()) fn (* list-?T) make-list-?T () - (var (* list-?T) list (cast (* list-?T) (malloc (sizeof list-?T)))) - (= (-> list next) NULL) - list)) - -(template (add-value-list-?T ?T is-public?) - (,@(if 'is-public? '(pub) '()) fn void add-value-list-?T ((list-?T *list) (T value)) - (while (!= (-> list next) NULL) - (= list (-> list next))) - (= (-> list next) (make-list-?T)) - (= (-> list value) value))) - -(template (length-list-?T ?T is-public?) - (,@(if 'is-public? '(pub) '()) fn size-t length-list-?T ((list-?T *list)) - (var size-t n 0) - (while (!= (-> list next) NULL) - (= list (-> list next)) - (++ n)) - n)) - -(template (is-empty-list-?T ?T is-public?) - (,@(if 'is-public? '(pub) '()) fn bool is-empty-list-?T ((list-?T *list)) - (== (-> list next) NULL))) - -(template (list-for-each list-var elt-var what-do) - (var int elt-var (-> list-var value)) - (while (!= (-> list-var next) NULL) - what-do - (= list-var (-> list-var next)) - (= elt-var (-> list-var value)))) diff --git a/example/list.sex b/example/list.sex new file mode 100644 index 0000000..62b2e9c --- /dev/null +++ b/example/list.sex @@ -0,0 +1,37 @@ +(pub template (list-T ?T) + (struct list-?T + ((?T value) + ((* list-?T) next)))) + +(pub template (make-list-T ?T is-public?) + (,@(if 'is-public? '(pub) '()) fn (* list-?T) make-list-?T () + (var (* list-?T) list (cast (* list-?T) (malloc (sizeof list-?T)))) + (= (-> list next) NULL) + list)) + +(pub template (add-value-list-T ?T is-public?) + (,@(if 'is-public? '(pub) '()) fn void add-value-list-?T ((list-?T *list) (?T value)) + (while (!= (-> list next) NULL) + (= list (-> list next))) + (= (-> list next) (make-list-?T)) + (= (-> list value) value))) + +(pub template (length-list-T ?T is-public?) + (,@(if 'is-public? '(pub) '()) fn size-t length-list-?T ((list-?T *list)) + (var size-t n 0) + (while (!= (-> list next) NULL) + (= list (-> list next)) + (++ n)) + n)) + +(pub template (is-empty-list-T ?T is-public?) + (,@(if 'is-public? '(pub) '()) fn bool is-empty-list-?T ((list-?T *list)) + (== (-> list next) NULL))) + +(pub template (list-for-each list-type list-var elt-type elt-var what-do) + (var (pointer list-type) list-var-2 list-var) + (var elt-type elt-var (-> list-var-2 value)) + (while (!= (-> list-var-2 next) NULL) + what-do + (= list-var-2 (-> list-var-2 next)) + (= elt-var (-> list-var-2 value)))) diff --git a/example/test-list.sex b/example/test-list.sex index 73bfdfc..912e341 100644 --- a/example/test-list.sex +++ b/example/test-list.sex @@ -5,7 +5,7 @@ (chicken-import srfi-1 brev-separate) ; list routines, e.g. fold -(chicken-load "list.seh") +(import list) (chicken-define (imports-test a b c) (fold + 0 (list 1 2 3 a b c))) @@ -19,10 +19,10 @@ (var foo f #((= .a-field 1.2))) (list-T int) -(make-list-T int) -(add-value-list-T int) -(length-list-T int) -(is-empty-list-T int) +(make-list-T int #f) +(add-value-list-T int #f) +(length-list-T int #f) +(is-empty-list-T int #f) (extern fn void puk ((int a) (float b))) (fn int bar () ,(imports-test 10 20 30)) @@ -38,32 +38,13 @@ (add-value-list-int l 3) (add-value-list-int l 4) (printf "Size of the list: %zu\n" (length-list-int l)) - (list-for-each l v + (list-for-each list-int l int v (printf "%d " v)) (printf "\n") - (printf "%zu\n" l->next) + (printf "Size of the list: %zu\n" (length-list-int l)) + (printf "%p\n" l->next) 0) -(pub fn segs-renderer* create-renderer ()) -(pub fn void clear-command-buffer ((segs-renderer *r))) -(pub fn void add-render-command ((segs-renderer *r) ((fn void ()) command))) -(pub fn void commit-command-buffer ((segs-renderer *r))) - -(template (list-T ?T) - (struct list-?T - ((?T value) - ((* list-?T) next)))) - -(template (list-for-each type list-var elt-var body) - (var type elt-var (-> list-var value)) - (while (!= (-> list-var next) NULL) - body - (= list-var (-> list-var next)) - (= elt-var (-> list-var value)))) - -; ... somewhere later -(list-T int) - (pub fn void print-list (((const list-int) *l)) - (list-for-each int l v (printf "%d " v)) + (list-for-each (const list-int) l int v (printf "%d " v)) (printf "\n")) diff --git a/sex-mode.el b/sex-mode.el index 23e47d1..c4f9c90 100644 --- a/sex-mode.el +++ b/sex-mode.el @@ -34,6 +34,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.") "chicken-load" "define" "extern" + "import" "include" "fn" "pub" @@ -80,6 +81,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.") (put 'template 'lisp-indent-function 'defun) (put 'struct 'lisp-indent-function 'defun) (put 'var 'lisp-indent-function 0) +(put 'import 'lisp-indent-function 1) ;;;###autoload (define-derived-mode sex-mode lisp-data-mode "Sex" diff --git a/sexc.scm b/sexc.scm index 1e4a1df..4145914 100644 --- a/sexc.scm +++ b/sexc.scm @@ -86,7 +86,7 @@ ;; another special case - template ((template? form) - (append (fold + (append (fold-right walk-generic (list) (eval form)) @@ -95,11 +95,10 @@ ;; toplevel, or a start of a regular list form (else (let ((new-acc (list))) - (cons (reverse - (fold - walk-generic - new-acc - form)) + (cons (fold-right + walk-generic + new-acc + form) acc))))) (define (normalize-fn-form form) @@ -141,7 +140,10 @@ (walk-function form #f acc)) ((var) (append (walk-generic (list 'static (cdr form)) (list)) acc)) - (else (error "Pub what?")))) + ((define import include struct template typedef union var) + ;; ignore here, used in generating public interface + (process-form (cdr form) acc)) + (else (error "Pub what?" (cadr form))))) (define (template? form) (and (list? form) @@ -151,9 +153,9 @@ (define (walk-sex-tree form acc) (if (list? form) (if (template? form) - (fold (fn (walk-sex-tree x y)) - acc - (eval form)) + (fold-right (fn (walk-sex-tree x y)) + acc + (eval form)) (case (car form) ((fn) (walk-function form #t acc)) ((extern) (walk-extern form acc)) @@ -174,6 +176,11 @@ (load (cadr form)) acc) ((chicken-import) (eval (cons 'import (cdr form))) acc) + ((import) + (append (process-raw-forms + + (import-modules (cdr form)) (list)) + acc)) (else (walk-sex-tree form acc)))) @@ -190,10 +197,84 @@ (define (emit-c forms) (for-each (lambda (form) - (fmt #t (c-expr form)) - (fmt #t "\n")) + (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 @@ -208,6 +289,9 @@ (required #f) (value #f) (single-char #\E)) + (public-interface "Get module's public interface" + (required #f) + (value #f)) (help "Show this help" (required #f) (value #f) @@ -250,27 +334,49 @@ '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-input-from-file (pathname-strip-directory file) - (fn (read-forms (list))))) + (with-directory file + (with-input-from-file (pathname-strip-directory file) + (fn (read-forms (list)))))) (define (set-working-directory file) (change-directory (normalize-pathname - (make-absolute-pathname - (current-directory) - (pathname-directory file))))) + (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) + (with-output-to-file output + (fn (what))))) (define (preprocess-or-macroexpand sex-forms output args) - (if (not (eq? output 'default)) - (with-output-to-file output - (lambda () - (if (get-arg args 'macro-expand #f) - (map pp sex-forms) - (emit-c sex-forms)))) - (if (get-arg args 'macro-expand #f) - (map pp sex-forms) - (emit-c sex-forms)))) + (write-to-file-or-stdout + output + (lambda () + (if (get-arg args 'macro-expand #f) + (map pp sex-forms) + (emit-c sex-forms))))) (define (get-env-var name) (get-environment-variable name)) @@ -287,35 +393,56 @@ (lambda () (emit-c sex-forms))) (call-with-values - (lambda () (process compiler (append (list temp-c-out "-o" out-file) - (if (get-arg args 'compile-object #f) - (list "-c") - (list)) - (get-c-compiler-args args)))) + (lambda () + (process compiler (append (list temp-c-out "-o" out-file) + (if (get-arg args 'compile-object #f) + (list "-c") + (list)) + (get-c-compiler-args args)))) (lambda (out-port in-port pid) (process-wait pid))))) +(define (process-input input raw-forms) + (let ((current-dir (current-directory))) + (unless (eq? input 'stdin) + (set-working-directory input)) + (prog1 + (process-raw-forms raw-forms (list)) + (change-directory current-dir)))) + (define (main) (let* ((raw-args (command-line-arguments)) - (current-dir (current-directory)) (args (getopt-long raw-args opts-grammar)) (output (get-arg args 'output 'default)) (help (help-arg? args)) - (input (get-input-file args))) - (if help (print-help) - (let* ((raw-forms - (if (eq? input 'stdin) - (read-forms (list)) - (begin - (set-working-directory input) - (read-from-file input)))) - (sex-forms (process-raw-forms raw-forms (list)))) - (change-directory current-dir) - (if (or (get-arg args 'macro-expand #f) - (get-arg args 'preprocess #f)) - ;; Preprocess or macroexpand - (preprocess-or-macroexpand sex-forms output args) - ;; Compile file! - (compile-to-file sex-forms output args)))))) + (input (get-input-file args)) + (current-dir (current-directory))) + (call/cc + (lambda (return) + (when help + (print-help) + (return #f)) + (when (get-arg args 'public-interface #f) + (assert (not (eq? input 'stdin)) "Error: --public-interface requires file argument") + + (write-to-file-or-stdout + output + (fn + (map pp (reverse + (read-public-interface input))))) + (return #f)) + (load-persistent-module-paths) + + (let* ((raw-forms + (if (eq? input 'stdin) + (read-forms (list)) + (read-from-file input))) + (sex-forms (process-input input raw-forms))) + (if (or (get-arg args 'macro-expand #f) + (get-arg args 'preprocess #f)) + ;; Preprocess or macroexpand + (preprocess-or-macroexpand sex-forms output args) + ;; Compile file! + (compile-to-file sex-forms output args)))))))