core: Add module type.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 14 Oct 2018 06:15:22 +0000 (08:15 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 14 Oct 2018 06:15:22 +0000 (08:15 +0200)
* src/module.c: New file.
* build-aux/snarf.sh: Snarf it.
* src/mes.c: Include it.

build-aux/mes-snarf.scm
build-aux/snarf.sh
mes/module/mes/type-0.mes
scaffold/boot/51-module.scm
scaffold/boot/52-define-module.scm
scaffold/boot/60-let-syntax-expanded.scm
scaffold/boot/60-let-syntax.scm
src/mes.c
src/module.c [new file with mode: 0644]

index 1bc4ffc6f80f8bea5e6b35d282a7238005af588a..d01d337ccd2bcd4ef262714f9cdcc7e5373659b5 100755 (executable)
@@ -146,8 +146,8 @@ exec ${GUILE-guile} --no-auto-compile -L $(dirname $0) -C $(dirname $0) -e '(mes
        (format #f "g_cells[cell_~a].string = MAKE_STRING (scm_~a.string);\n" (function.name f) (function.name f))
        (format #f "g_cells[cell_~a].car = MAKE_STRING (scm_~a.car);\n" (function.name f) (function.name f)))
    (if %gcc?
-       (format #f "a = acons (make_symbol (scm_~a.string), ~a, a);\n\n" (function.name f) (function-cell-name f))
-       (format #f "a = acons (make_symbol (scm_~a.car), ~a, a);\n\n" (function.name f) (function-cell-name f)))))
+       (format #f "a = acons (list_to_symbol (scm_~a.string), ~a, a);\n\n" (function.name f) (function-cell-name f))
+       (format #f "a = acons (list_to_symbol (scm_~a.car), ~a, a);\n\n" (function.name f) (function-cell-name f)))))
 
 (define (disjoin . predicates)
   (lambda (. arguments)
index 5b264691f0b4292fba979e7a1e7292a03ee66fcc..98b6e3e3bdd615cfa2cec0475894f5cb96afec34 100755 (executable)
@@ -31,6 +31,7 @@ trace "SNARF$snarf  gc.c"     ${srcdest}build-aux/mes-snarf.scm $1 src/gc.c
 trace "SNARF$snarf  lib.c"    ${srcdest}build-aux/mes-snarf.scm $1 src/lib.c
 trace "SNARF$snarf  math.c"   ${srcdest}build-aux/mes-snarf.scm $1 src/math.c
 trace "SNARF$snarf  mes.c"    ${srcdest}build-aux/mes-snarf.scm $1 src/mes.c
+trace "SNARF$snarf  module.c" ${srcdest}build-aux/mes-snarf.scm $1 src/module.c
 trace "SNARF$snarf  posix.c"  ${srcdest}build-aux/mes-snarf.scm $1 src/posix.c
 trace "SNARF$snarf  reader.c" ${srcdest}build-aux/mes-snarf.scm $1 src/reader.c
 trace "SNARF$snarf  struct.c" ${srcdest}build-aux/mes-snarf.scm $1 src/struct.c
index a7b1059cc9c8ce5507ef882b34d2f29f6754d4fa..4db75f9c4b422d0e47d409fd947f1569b7f59b61 100644 (file)
 
 (define (string->symbol s)
   (if (not (pair? (core:car s))) '()
-      (core:lookup-symbol (core:car s))))
+      (list->symbol (core:car s))))
 
 (define (symbol->keyword s)
   (core:make-cell <cell:keyword> (symbol->list s) 0))
index 17fe40f2d25c6dd5ad22ad4967268b4cf3484e4c..2457d75f1d3ada1e237bee3bf76e828820f42e52 100644 (file)
@@ -81,7 +81,7 @@
     (list 'load (list string-append %moduledir file)))
 
   (define (string->symbol s)
-    (core:lookup-symbol (core:car s)))
+    (list->symbol (core:car s)))
 
   (define (symbol->list s)
     (core:car s))
index 65b4426802e0c1f64851a0c47f9a8ec01cd9ec61..a7150162ece6bd859bfdf5441548e4be84170717 100644 (file)
@@ -69,7 +69,7 @@
 ;;;;;;;;;;;;;;;;;;
 
   (define (string->symbol s)
-    (core:lookup-symbol (core:car s)))
+    (list->symbol (core:car s)))
 
   (define-macro (load file)
     (list 'primitive-load file))
index 301f71c3e1ac86e85d0f572fd05f55f9731c98ad..4c66e11eca3630a1a3f7fb056ed187408bf7357d 100644 (file)
 
   (define (string->symbol s)
     (if (not (pair? (core:car s))) '()
-        (core:lookup-symbol (core:car s))))
+        (list->symbol (core:car s))))
 
   (define <cell:string> 10)
   (define (string? x)
     (eq? (core:type x) <cell:string>))
-  
+
   (define <cell:vector> 14)
   (define (vector? x)
     (eq? (core:type x) <cell:vector>))
+
   ;; (define (body x)
   ;; (core:cdr (core:cdr (core:cdr (cdr (assq 'x (current-module)))))))
   ;; (define (closure x)
         (and (segment-template? pattern)
              (or (null? (cddr pattern))
                  (syntax-error0 "segment matching not implemented" pattern))))
-    
+
       (define (segment-template? pattern)
         (and (pair? pattern)
              (pair? (cdr pattern))
              (memq (cadr pattern) indicators-for-zero-or-more)))
-    
+
       (define indicators-for-zero-or-more (list (string->symbol "...") '---))
-    
+
       (lambda (exp r c)
 
         (define %input (r '%input))     ;Gensym these, if you like.
                                        0
                                        (meta-variables pattern 0 '())))))
               (syntax-error2 "ill-formed syntax rule" rule)))
-      
+
         ;; Generate code to test whether input expression matches pattern
 
         (define (process-match input pattern)
                  `((eq? ,input ',pattern)))
                 (else
                  `((equal? ,input ',pattern)))))
-      
+
         (define (process-segment-match input pattern)
           ;;(core:display-error "process-segment-match:") (core:write-error input) (core:display-error "\n")
           ;;(core:display-error "              pattern:") (core:write-error pattern) (core:display-error "\n")
                         (and (pair? l)
                              ,@conjuncts
                              (loop (cdr l)))))))))
-      
+
         ;; Generate code to take apart the input expression
         ;; This is pretty bad, but it seems to work (can't say why).
 
                         (if (not condition)
                             (begin exp ...))))))
    (xwhen #f 42)))
-
-
index d5602258d0c90707cfdf8d51db2c080f573523f5..b6619b68c3db815a0b5d4caa18e88d1151d5d7ad 100644 (file)
 
   (define (string->symbol s)
     (if (not (pair? (core:car s))) '()
-        (core:lookup-symbol (core:car s))))
+        (list->symbol (core:car s))))
 
   (define (string? x)
     (eq? (core:type x) <cell:string>))
-  
+
   (define (vector? x)
     (eq? (core:type x) <cell:vector>))
+
   ;; (define (body x)
   ;; (core:cdr (core:cdr (core:cdr (cdr (assq 'x (current-module)))))))
   ;; (define (closure x)
         (and (segment-template? pattern)
              (or (null? (cddr pattern))
                  (syntax-error "segment matching not implemented" pattern))))
-    
+
       (define (segment-template? pattern)
         (and (pair? pattern)
              (pair? (cdr pattern))
              (memq (cadr pattern) indicators-for-zero-or-more)))
-    
+
       (define indicators-for-zero-or-more (list (string->symbol "...") '---))
-    
+
       (lambda (exp r c)
 
         (define %input (r '%input))     ;Gensym these, if you like.
                                        0
                                        (meta-variables pattern 0 '())))))
               (syntax-error "ill-formed syntax rule" rule)))
-      
+
         ;; Generate code to test whether input expression matches pattern
 
         (define (process-match input pattern)
                  `((eq? ,input ',pattern)))
                 (else
                  `((equal? ,input ',pattern)))))
-      
+
         (define (process-segment-match input pattern)
           ;;(core:display-error "process-segment-match:") (core:write-error input) (core:display-error "\n")
           ;;(core:display-error "              pattern:") (core:write-error pattern) (core:display-error "\n")
                         (and (pair? l)
                              ,@conjuncts
                              (loop (cdr l)))))))))
-      
+
         ;; Generate code to take apart the input expression
         ;; This is pretty bad, but it seems to work (can't say why).
 
                         (if (not condition)
                             (begin exp ...))))))
    (xwhen #f 42)))
-
index 11b021377d35e39e6f674f0865f867f3d87be8aa..ebdb5a27bfd8632c45492cfcf4c39241ea800eac 100644 (file)
--- a/src/mes.c
+++ b/src/mes.c
@@ -279,6 +279,7 @@ int g_function = 0;
 #include "lib.mes.h"
 #include "math.mes.h"
 #include "mes.mes.h"
+#include "module.mes.h"
 #include "posix.mes.h"
 #include "reader.mes.h"
 #include "struct.mes.h"
@@ -288,6 +289,7 @@ int g_function = 0;
 #include "lib.h"
 #include "math.h"
 #include "mes.h"
+#include "module.h"
 #include "posix.h"
 #include "reader.h"
 #include "struct.h"
@@ -1611,6 +1613,7 @@ mes_g_stack (SCM a) ///((internal))
 
 //\f Environment setup
 
+#include "module.c"
 #include "posix.c"
 #include "math.c"
 #include "lib.c"
@@ -2207,6 +2210,7 @@ a = acons (list_to_symbol (scm_getenv_.string), cell_getenv_, a);
 #include "mes.mes.i"
 
   // Do not sort: Order of these includes define builtins
+#include "module.mes.i"
 #include "posix.mes.i"
 #include "math.mes.i"
 #include "lib.mes.i"
@@ -2219,6 +2223,7 @@ a = acons (list_to_symbol (scm_getenv_.string), cell_getenv_, a);
 #include "lib.mes.environment.i"
 #include "math.mes.environment.i"
 #include "mes.mes.environment.i"
+#include "module.mes.environment.i"
 #include "posix.mes.environment.i"
 #include "reader.mes.environment.i"
 #include "struct.mes.environment.i"
@@ -2227,6 +2232,7 @@ a = acons (list_to_symbol (scm_getenv_.string), cell_getenv_, a);
 #include "mes.i"
 
   // Do not sort: Order of these includes define builtins
+#include "module.i"
 #include "posix.i"
 #include "math.i"
 #include "lib.i"
@@ -2239,6 +2245,7 @@ a = acons (list_to_symbol (scm_getenv_.string), cell_getenv_, a);
 #include "lib.environment.i"
 #include "math.environment.i"
 #include "mes.environment.i"
+#include "module.environment.i"
 #include "posix.environment.i"
 #include "reader.environment.i"
 #include "struct.environment.i"
diff --git a/src/module.c b/src/module.c
new file mode 100644 (file)
index 0000000..e7f244b
--- /dev/null
@@ -0,0 +1,40 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+SCM
+make_initial_module (SCM a)
+{
+  SCM fields = cell_nil;
+  fields = cons (cstring_to_symbol ("globals"), fields);
+  fields = cons (cstring_to_symbol ("locals"), fields);
+  fields = cons (cstring_to_symbol ("name"), fields);
+  fields = cons (cstring_to_symbol ("<module>"), fields);
+  SCM module_type = make_struct (cstring_to_symbol ("record-type"), fields, cell_unspecified);
+  SCM module_type_name = cstring_to_symbol ("<module>");
+  a = acons (module_type_name, module_type, a);
+  SCM values = cell_nil;
+  SCM name = cons (cstring_to_symbol ("boot"), cell_nil);
+  SCM globals = cell_nil;
+  values = cons (a, values);
+  values = cons (globals, values);
+  values = cons (name, values);
+  SCM module = make_struct (module_type_name, values, cell_unspecified);
+  return module;
+}