implement modules

example/list.seh

@@ -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))))

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))))

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)
+(make-list-T int #f)
-(add-value-list-T int)
+(add-value-list-T int #f)
-(length-list-T int)
+(length-list-T int #f)
-(is-empty-list-T int)
+(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"))

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"

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
+      (cons (fold-right
-             (fold
+             walk-generic
-              walk-generic
+             new-acc
-              new-acc
+             form)
-              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))
+          (fold-right (fn (walk-sex-tree x y))
-                acc
+                      acc
-                (eval form))
+                      (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 (c-expr form) nl))
-              (fmt #t "\n"))
             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)
+  (with-directory file
-    (fn (read-forms (list)))))
+   (with-input-from-file (pathname-strip-directory file)
+     (fn (read-forms (list))))))
 
 (define (set-working-directory file)
   (change-directory
    (normalize-pathname
-    (make-absolute-pathname
+    (if (absolute-pathname? file)
-     (current-directory)
+        (pathname-directory 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))
+  (write-to-file-or-stdout
-      (with-output-to-file output
+   output
-        (lambda ()
+   (lambda ()
-          (if (get-arg args 'macro-expand #f)
+    (if (get-arg args 'macro-expand #f)
-              (map pp sex-forms)
+        (map pp sex-forms)
-              (emit-c sex-forms))))
+        (emit-c sex-forms)))))
-      (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)
+        (lambda ()
-                                             (if (get-arg args 'compile-object #f)
+          (process compiler (append (list temp-c-out "-o" out-file)
-                                                 (list "-c")
+                                    (if (get-arg args 'compile-object #f)
-                                                 (list))
+                                        (list "-c")
-                                             (get-c-compiler-args args))))
+                                        (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)))
+         (input (get-input-file args))
-    (if help (print-help)
+         (current-dir (current-directory)))
-        (let* ((raw-forms
+    (call/cc
-                (if (eq? input 'stdin)
+     (lambda (return)
-                    (read-forms (list))
+       (when help
-                    (begin
+         (print-help)
-                      (set-working-directory input)
+         (return #f))
-                      (read-from-file input))))
+       (when (get-arg args 'public-interface #f)
-               (sex-forms (process-raw-forms raw-forms (list))))
+         (assert (not (eq? input 'stdin)) "Error: --public-interface requires file argument")
-          (change-directory current-dir)
+
-          (if (or (get-arg args 'macro-expand #f)
+         (write-to-file-or-stdout
-                  (get-arg args 'preprocess #f))
+          output
-              ;; Preprocess or macroexpand
+          (fn
-              (preprocess-or-macroexpand sex-forms output args)
+           (map pp (reverse
-              ;; Compile file!
+                    (read-public-interface input)))))
-              (compile-to-file sex-forms output args))))))
+         (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)))))))