[Guile-commits] 06/10: Add notion of declarative modules

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 356ea0971996c81997481f7e1f9cf27cdd594a34
Author: Andy Wingo <address@hidden>
Date:   Fri Aug 16 17:19:55 2019 +0200

    Add notion of declarative modules
    
    * doc/ref/api-modules.texi (Declarative Modules): New subsection.
    * module/ice-9/boot-9.scm (module): Change eval-closure slot, which was
      deprecated and unused, to be a "declarative?" slot, indicating that
      definitions from the module are declarative.
      (user-modules-declarative?): New parameter.
      (make-fresh-user-module): Set declarative according to parameter.
      (define-module*, define-module): Add #:declarative? keyword argument,
      defaulting to the value of user-modules-declarative? parameter when
      the module was expanded.
      (guile-user): This module is not declarative.
    
    * module/language/tree-il/letrectify.scm (compute-declarative-toplevels):
      Use the new declarative? module flag.
---
 doc/ref/api-modules.texi               | 66 +++++++++++++++++++++++++++++++++-
 module/ice-9/boot-9.scm                | 63 +++++++++++++++++++-------------
 module/language/tree-il/letrectify.scm |  8 ++---
 3 files changed, 106 insertions(+), 31 deletions(-)

diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi
index 8f18b1e..eb8cc1a 100644
--- a/doc/ref/api-modules.texi
+++ b/doc/ref/api-modules.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000-2004, 2007-2014
+@c Copyright (C)  1996, 1997, 2000-2004, 2007-2014, 2019
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -49,6 +49,7 @@ be used for interacting with the module system.
 * R6RS Libraries::              The library and import forms.
 * Variables::                   First-class variables.
 * Module System Reflection::    First-class modules.
+* Declarative Modules::         Allowing Guile to reason about modules.
 * Accessing Modules from C::    How to work with modules with C code.
 * provide and require::         The SLIB feature mechanism.
 * Environments::                R5RS top-level environments.
@@ -911,6 +912,69 @@ environment.  If you find yourself using one of them, 
please contact the
 Guile developers so that we can commit to stability for that interface.
 
 
+@node Declarative Modules
+@subsection Declarative Modules
+
+The first-class access to modules and module variables described in the
+previous subsection is very powerful and allows Guile users to build
+many tools to dynamically learn things about their Guile systems.
+However, as Scheme godparent Mathias Felleisen wrote in ``On the
+Expressive Power of Programming Languages'', a more expressive language
+is necessarily harder to reason about.  There are transformations that
+Guile's compiler would like to make which can't be done if every
+top-level binding is subject to mutation at any time.
+
+Consider this module:
+
+@example
+(define-module (boxes)
+  #:export (make-box box-ref box-set! box-swap!))
+
+(define (make-box x) (list x))
+(define (box-ref box) (car box))
+(define (box-set! box x) (set-car! box x))
+(define (box-swap! box x)
+  (let ((y (box-ref box)))
+    (box-set! box x)
+    y))
+@end example
+
+Ideally you'd like for the @code{box-ref} in @code{box-swap!} to be
+inlined to @code{car}.  Guile's compiler can do this, but only if it
+knows that @code{box-ref}'s definition is what it appears to be in the
+text.  However, in the general case it could be that a programmer could
+reach into the @code{(boxes)} module at any time and change the value of
+@code{box-ref}.
+
+To allow Guile to reason about the values of top-levels from a module, a
+module can be marked as @dfn{declarative}.  This flag applies only to
+the subset of top-level definitions that are themselves declarative:
+those that are defined within the compilation unit, and not assigned
+(@code{set!}) or redefined within the compilation unit.
+
+To explicitly mark a module as being declarative, pass the
+@code{#:declarative?} keyword argument when declaring a module:
+
+@example
+(define-module (boxes)
+  #:export (make-box box-ref box-set! box-swap!)
+  #:declarative? #t)
+@end example
+
+By default, modules are compiled declaratively if the
+@code{user-modules-declarative?} parameter is true when the
+module is compiled.
+
+@deffn {Scheme Parameter} user-modules-declarative-by-default?
+A boolean indicating whether definitions in modules created by
+@code{define-module} or implicitly as part of a compilation unit without
+an explicit module can be treated as declarative.
+@end deffn
+
+Because it's usually what you want, the default value of
+@code{user-modules-declarative?} is @code{#t}.
+
+
 @node Accessing Modules from C
 @subsection Accessing Modules from C
 
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index a4d3d94..d6dd50d 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1,6 +1,6 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
 
-;;;; Copyright (C) 1995-2014, 2016-2018  Free Software Foundation, Inc.
+;;;; Copyright (C) 1995-2014, 2016-2019  Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -1744,7 +1744,10 @@ name extensions listed in %load-extensions."
 ;;; Every module object is of the type 'module-type', which is a record
 ;;; consisting of the following members:
 ;;;
-;;; - eval-closure: A deprecated field, to be removed in Guile 2.2.
+;;; - declarative?: a boolean flag indicating whether this module's
+;;;   singly-defined bindings are used in a declarative way.
+;;;   Declarative definitions can be better optimized by the compiler.
+;;;   See "Declarative Modules" in the manual, for more.
 ;;;
 ;;; - obarray: a hash table that maps symbols to variable objects.  In this
 ;;;   hash table, the definitions are found that are local to the module (that
@@ -1964,7 +1967,7 @@ name extensions listed in %load-extensions."
     (obarray
      uses
      binder
-     eval-closure
+     declarative?
      (transformer #:no-getter)
      (name #:no-getter)
      kind
@@ -2638,6 +2641,8 @@ deterministic."
         (nested-define-module! module name m)
         m)))
 
+(define user-modules-declarative? (make-parameter #t))
+
 (define (beautify-user-module! module)
   (let ((interface (module-public-interface module)))
     (if (or (not interface)
@@ -2683,6 +2688,7 @@ deterministic."
 (define (make-fresh-user-module)
   (let ((m (make-module)))
     (beautify-user-module! m)
+    (set-module-declarative?! m (user-modules-declarative?))
     m))
 
 ;; NOTE: This binding is used in libguile/modules.c.
@@ -2830,7 +2836,7 @@ error if selected binding does not exist in the used 
module."
 (define* (define-module* name
            #:key filename pure version (imports '()) (exports '())
            (replacements '()) (re-exports '()) (autoloads '())
-           (duplicates #f) transformer)
+           (duplicates #f) transformer declarative?)
   (define (list-of pred l)
     (or (null? l)
         (and (pair? l) (pred (car l)) (list-of pred (cdr l)))))
@@ -2846,6 +2852,7 @@ error if selected binding does not exist in the used 
module."
   ;;
   (let ((module (resolve-module name #f)))
     (beautify-user-module! module)
+    (set-module-declarative?! module declarative?)
     (when filename
       (set-module-filename! module filename))
     (when pure
@@ -3270,7 +3277,7 @@ but it fails to load."
           ((kw val . in)
            (loop #'in (cons* #'val #'kw out))))))
 
-    (define (parse args imp exp rex rep aut)
+    (define (parse args imp exp rex rep aut dec)
       ;; Just quote everything except #:use-module and #:use-syntax.  We
       ;; need to know about all arguments regardless since we want to turn
       ;; symbols that look like keywords into real keywords, and the
@@ -3282,53 +3289,58 @@ but it fails to load."
                (exp (if (null? exp) '() #`(#:exports '#,exp)))
                (rex (if (null? rex) '() #`(#:re-exports '#,rex)))
                (rep (if (null? rep) '() #`(#:replacements '#,rep)))
-               (aut (if (null? aut) '() #`(#:autoloads '#,aut))))
-           #`(#,@imp #,@exp #,@rex #,@rep #,@aut)))
+               (aut (if (null? aut) '() #`(#:autoloads '#,aut)))
+               (dec (if dec '() #`(#:declarative?
+                                   #,(user-modules-declarative?)))))
+           #`(#,@imp #,@exp #,@rex #,@rep #,@aut #,@dec)))
         ;; The user wanted #:foo, but wrote :foo. Fix it.
         ((sym . args) (keyword-like? #'sym)
          (parse #`(#,(->keyword (syntax->datum #'sym)) . args)
-                  imp exp rex rep aut))
+                  imp exp rex rep aut dec))
         ((kw . args) (not (keyword? (syntax->datum #'kw)))
          (syntax-violation 'define-module "expected keyword arg" x #'kw))
         ((#:no-backtrace . args)
          ;; Ignore this one.
-         (parse #'args imp exp rex rep aut))
+         (parse #'args imp exp rex rep aut dec))
         ((#:pure . args)
-         #`(#:pure #t . #,(parse #'args imp exp rex rep aut)))
+         #`(#:pure #t . #,(parse #'args imp exp rex rep aut dec)))
         ((kw)
          (syntax-violation 'define-module "keyword arg without value" x #'kw))
         ((#:version (v ...) . args)
-         #`(#:version '(v ...) . #,(parse #'args imp exp rex rep aut)))
+         #`(#:version '(v ...) . #,(parse #'args imp exp rex rep aut dec)))
         ((#:duplicates (d ...) . args)
-         #`(#:duplicates '(d ...) . #,(parse #'args imp exp rex rep aut)))
+         #`(#:duplicates '(d ...) . #,(parse #'args imp exp rex rep aut dec)))
         ((#:filename f . args)
-         #`(#:filename 'f . #,(parse #'args imp exp rex rep aut)))
+         #`(#:filename 'f . #,(parse #'args imp exp rex rep aut dec)))
+        ((#:declarative? d . args)
+         #`(#:declarative? 'd . #,(parse #'args imp exp rex rep aut #t)))
         ((#:use-module (name name* ...) . args)
          (and (and-map symbol? (syntax->datum #'(name name* ...))))
-         (parse #'args #`(#,@imp ((name name* ...))) exp rex rep aut))
+         (parse #'args #`(#,@imp ((name name* ...))) exp rex rep aut dec))
         ((#:use-syntax (name name* ...) . args)
          (and (and-map symbol? (syntax->datum #'(name name* ...))))
          #`(#:transformer '(name name* ...)
-            . #,(parse #'args #`(#,@imp ((name name* ...))) exp rex rep aut)))
+            . #,(parse #'args #`(#,@imp ((name name* ...))) exp rex
+                       rep aut dec)))
         ((#:use-module ((name name* ...) arg ...) . args)
          (and (and-map symbol? (syntax->datum #'(name name* ...))))
          (parse #'args
                 #`(#,@imp ((name name* ...) #,@(parse-iface #'(arg ...))))
-                exp rex rep aut))
+                exp rex rep aut dec))
         ((#:export (ex ...) . args)
-         (parse #'args imp #`(#,@exp ex ...) rex rep aut))
+         (parse #'args imp #`(#,@exp ex ...) rex rep aut dec))
         ((#:export-syntax (ex ...) . args)
-         (parse #'args imp #`(#,@exp ex ...) rex rep aut))
+         (parse #'args imp #`(#,@exp ex ...) rex rep aut dec))
         ((#:re-export (re ...) . args)
-         (parse #'args imp exp #`(#,@rex re ...) rep aut))
+         (parse #'args imp exp #`(#,@rex re ...) rep aut dec))
         ((#:re-export-syntax (re ...) . args)
-         (parse #'args imp exp #`(#,@rex re ...) rep aut))
+         (parse #'args imp exp #`(#,@rex re ...) rep aut dec))
         ((#:replace (r ...) . args)
-         (parse #'args imp exp rex #`(#,@rep r ...) aut))
+         (parse #'args imp exp rex #`(#,@rep r ...) aut dec))
         ((#:replace-syntax (r ...) . args)
-         (parse #'args imp exp rex #`(#,@rep r ...) aut))
+         (parse #'args imp exp rex #`(#,@rep r ...) aut dec))
         ((#:autoload name bindings . args)
-         (parse #'args imp exp rex rep #`(#,@aut name bindings)))
+         (parse #'args imp exp rex rep #`(#,@aut name bindings) dec))
         ((kw val . args)
          (syntax-violation 'define-module "unknown keyword or bad argument"
                            #'kw #'val))))
@@ -3337,7 +3349,7 @@ but it fails to load."
       ((_ (name name* ...) arg ...)
        (and-map symbol? (syntax->datum #'(name name* ...)))
        (with-syntax (((quoted-arg ...)
-                      (parse #'(arg ...) '() '() '() '() '()))
+                      (parse #'(arg ...) '() '() '() '() '() #f))
                      ;; Ideally the filename is either a string or #f;
                      ;; this hack is to work around a case in which
                      ;; port-filename returns a symbol (`socket') for
@@ -4106,7 +4118,8 @@ when none is available, reading FILE-NAME with READER."
 ;; Set filename to #f to prevent reload.
 (define-module (guile-user)
   #:autoload (system base compile) (compile compile-file)
-  #:filename #f)
+  #:filename #f
+  #:declarative? #f)
 
 ;; Remain in the `(guile)' module at compilation-time so that the
 ;; `-Wunused-toplevel' warning works as expected.
diff --git a/module/language/tree-il/letrectify.scm 
b/module/language/tree-il/letrectify.scm
index 2299f5b..0802a72 100644
--- a/module/language/tree-il/letrectify.scm
+++ b/module/language/tree-il/letrectify.scm
@@ -91,8 +91,6 @@
 (define (tree-il-for-each f x)
   (for-each-fold x (lambda (x) (f x) (values)) (lambda (x) (values))))
 
-(define (module-conventional-bindings? mod) #t)
-
 (define (compute-declarative-toplevels x)
   (define dynamic (make-hash-table))
   (define defined (make-hash-table))
@@ -114,15 +112,15 @@
        (_ (values))))
    x)
   (let ((declarative (make-hash-table)))
-    (define (conventional-module? mod)
+    (define (declarative-module? mod)
       (let ((m (resolve-module mod #f #:ensure #f)))
-        (and m (module-conventional-bindings? m))))
+        (and m (module-declarative? m))))
     (hash-for-each (lambda (k expr)
                      (match k
                        ((mod . name)
                         (unless (or (hash-ref assigned k)
                                     (hashq-ref dynamic name)
-                                    (not (conventional-module? mod)))
+                                    (not (declarative-module? mod)))
                           (hash-set! declarative k expr)))))
                    defined)
     declarative))