expose define-module+

Fix missing dependencies in info.rkt

racket/remixd.rkt

@@ -0,0 +1,3 @@
+#lang racket/base
+(require (only-in remix/stx0 lang lang* module+ define-module+ define-module*+))
+(provide lang lang* module+ define-module+ define-module*+)

remix/README

@@ -1,6 +1,30 @@
+TODO remove ;
+
 TODO add ; back into braces but don't have , because of conflict with
 its ,
 
+TODO look at udelim
+
+TODO look at Unicode Bidi_Paired_Bracket_Type property values of Open
+＆ Close: http://xahlee.info/comp/unicode_matching_brackets.html
+
+TODO require uses the #%required binding from the module to let the
+server do something to the client namespace --- This could be used to
+propagate static bindings for things like type-classes outward
+
+TODO require* like def* to put have extensible #%module-begin (called #%require*d)
+
+TODO require* at the top-interaction hacks it
+
+TODO implement match def-transformer and see how it looks
+
+TOOD look into Greg's request
+https://mail.google.com/mail/u/0/#inbox/1574317e1974dbf5
+
+(def id              42
+     (list a b c)    (list 1 2 3)
+     (values in out) (tcp-connect "host" 3000))
+
 TODO think about interface language part of theory/interface/modules
 
 TODO add syntax property for def transformer on RHS (for function call
@@ -82,7 +106,7 @@ TODO "define"-transformers for attaching meta-information to definitions, like d
 
 TODO Bindings & keywords everywhere
 
-TODO Less representation contraints
+TODO Less representation constraints
 
 TODO Meaningless eq? semantics
 

remix/exp/unit-test.rkt

@@ -0,0 +1,18 @@
+#lang racket/base
+
+(define-signature ^eq
+  ==)
+
+(define-unit (@eq-symbol)
+  (export ^eq)
+  (define == symbol=?))
+
+
+(define-unit
+  (@eq-pair
+   [(^prefix a: ^eq) (@eq-symbol)]
+   [(^prefix b: ^eq) (@eq-symbol)])
+
+  (define (== x y)
+    (and (a:== (car x) (car y))
+         (b:== (cdr x) (cdr y)))))

remix/exp/unit.rkt

@@ -0,0 +1,11 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+#lang remix
+(require* remix/unit0)
+
+(import foo) ; =>
+(import [(^exactly foo) foo])
+
+(require remix/set0)
+(import [(^prefix bid: ^set) remix/stx/bound-id]
+        [(^prefix bit: ^set) (remix/set/bit 20)])
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

remix/module.rkt

@@ -0,0 +1,150 @@
+;; XXX implement @lang+ and @lang*+
+(module module '#%kernel
+  (#%require racket/private/more-scheme
+             racket/private/modbeg
+             (for-syntax '#%kernel
+                         racket/private/stxcase-scheme
+                         racket/private/more-scheme
+                         racket/private/letstx-scheme
+                         racket/private/qqstx))
+
+  (#%provide module+
+             define-module+
+             define-module*+)
+
+  (begin-for-syntax
+    (define-values (expect-identifier-for)
+      (lambda (whole-stx stx where can-be-false?)
+        (define-values (v) (syntax-e stx))
+        (unless (or (and can-be-false? (not v))
+                    (symbol? v))
+          (raise-syntax-error #f
+                              (format
+                               "expected an identifier for ~a, found something else"
+                               where)
+                              whole-stx
+                              stx))))
+
+    (define-values (do-define-module+)
+      (lambda (this which-module stx)
+        (case (syntax-local-context)
+          [(module-begin)
+           (quasisyntax/loc stx (begin #,stx))]
+          [(module)
+           (syntax-case stx ()
+             [(_ the-module+ the-submodule the-module-lang)
+              (begin
+                (expect-identifier-for stx #'the-module+ "the module+ form" #f)
+                (expect-identifier-for stx #'the-submodule "a submodule" #f)
+                (expect-identifier-for stx #'the-module-lang "the module language" #t)
+                (quasisyntax/loc stx
+                  (define-syntaxes (the-module+)
+                    (lambda (module+-stx)
+                      (do-module+-for #'#,which-module
+                                      #'the-submodule
+                                      (syntax-local-introduce #'the-module-lang)
+                                      (syntax-local-introduce #'the-module-lang)
+                                      module+-stx)))))])])))
+
+    (define-values (do-module+-for)
+      (lambda (which-module-stx the-submodule-stx the-module-lang-stx context-stx stx)
+        (case (syntax-local-context)
+          [(module-begin)
+           (quasisyntax/loc stx (begin #,stx))]
+          [(module)
+           (syntax-case stx ()
+             [(_ #:declared)
+              (quasisyntax/loc stx
+                (define-module
+                  #,which-module-stx
+                  #,the-submodule-stx
+                  #,the-module-lang-stx))]
+             [(_ e ...)
+              (begin
+                (when (hash-has-key? submodule->defined? (syntax-e the-submodule-stx))
+                  (raise-syntax-error #f "submodule is already declared" stx))
+                ;; This looks it up the first time and is allowed to create a
+                ;; list and lift a module-end declaration if necessary:
+                (let ([stxs-box (get-stxs-box which-module-stx
+                                              context-stx
+                                              the-submodule-stx
+                                              the-module-lang-stx
+                                              #t)])
+                  (set-box!
+                   stxs-box
+                   (append (reverse (syntax->list (syntax-local-introduce #'(e ...))))
+                           (unbox stxs-box))))
+                (syntax/loc stx (begin)))])]
+          [else
+           (raise-syntax-error #f
+                               "allowed only in a module body"
+                               stx)]))))
+
+  (define-syntaxes (define-module+)
+    (lambda (stx)
+      (do-define-module+ 'define-module+ #'module stx)))
+
+  (define-syntaxes (define-module*+)
+    (lambda (stx)
+      (do-define-module+ 'define-module*+ #'module* stx)))
+
+  (define-syntaxes (module+)
+    (lambda (stx)
+      (syntax-case stx ()
+        [(_ the-submodule e ...)
+         (begin
+           (expect-identifier-for stx #'the-submodule "a submodule" #f)
+           (do-module+-for #'module* #'the-submodule #'#f
+                           stx
+                           #'(fake-the-submodule+ e ...)))])))
+
+  (begin-for-syntax
+    ;; The following table is newly instantiated for each module
+    ;; expansion that uses `module+', so it is effectively
+    ;; module-local:
+    (define-values (submodule->stxs-box) (make-weak-hash))
+    (define-values (get-stxs-box)
+      (lambda (which-module-stx form-stx the-submodule-stx the-module-lang-stx lift?)
+        (hash-ref! submodule->stxs-box (syntax-e the-submodule-stx)
+                   (lambda ()
+                     (when lift?
+                       (syntax-local-lift-module-end-declaration
+                        ;; Use the lexical context of the first `module+'
+                        ;; form as the context of the implicit `#%module-begin':
+                        (datum->syntax
+                         form-stx
+                         (list #'define-module
+                               which-module-stx
+                               the-submodule-stx
+                               the-module-lang-stx)
+                         form-stx)))
+                     (box null)))))
+
+    (define-values (submodule->defined?) (make-weak-hash))
+    (define-values (defined-or-define!)
+      (lambda (the-submodule-stx)
+        (let-values ([(k) (syntax-e the-submodule-stx)])
+          (begin0 (hash-ref submodule->defined? k #t)
+            (hash-ref! submodule->defined? k #f))))))
+
+  ;; A use of this form is lifted to the end of the enclosing module
+  ;; for each submodule created by `module+':
+  (define-syntaxes (define-module)
+    (lambda (stx)
+      (syntax-case stx ()
+        [(_ which-module the-submodule the-module-lang)
+         (cond
+           [(defined-or-define! #'the-submodule)
+            (let ([stxs-box (get-stxs-box #f #f #'the-submodule #f #f)])
+              ;; Propagate the lexical context of the first `module+'
+              ;; for the implicit `#%module-begin':
+              (datum->syntax
+               stx
+               (list*
+                #'which-module
+                #'the-submodule
+                #'the-module-lang
+                (map syntax-local-introduce (reverse (unbox stxs-box))))
+               stx))]
+           [else
+            (syntax/loc stx (begin))])]))))

remix/stx0.rkt

@@ -6,6 +6,7 @@
                      racket/syntax
                      syntax/parse)
          remix/semi
+         remix/module
          syntax/quote
          syntax/parse/define
          remix/stx/singleton-struct0
@@ -363,6 +364,33 @@
                         (remix-block . answer-body)
                         #,(syntax/loc #'more (remix-cond . more)))))]))
 
+(begin-for-syntax
+  (require remix/stx/raw0)
+  (define (do-lang caller-id module-stx stx)
+    (syntax-case stx ()
+      [(_ module-name s ...)
+       (identifier? #'module-name)
+       (let ()
+         (define ip
+           (syntax-strings->input-port
+            (syntax-source stx)
+            (syntax->list #'(s ...))))
+         (define mb
+           (parameterize ([read-accept-reader #t]
+                          [read-accept-lang #t])
+             (read-syntax #'module-name ip)))
+         (syntax-case mb ()
+           [(_ _ module-lang body)
+            (quasisyntax/loc stx
+              (#,module-stx module-name module-lang body))]
+           [_
+            (raise-syntax-error caller-id "Body did not read as module" stx mb)]))])))
+
+(define-syntax (lang stx)
+  (do-lang 'lang #'module stx))
+(define-syntax (lang* stx)
+  (do-lang 'lang* #'module* stx))
+
 (provide def def*
          (for-syntax gen:def-transformer
                      def-transformer?
@@ -399,6 +427,10 @@
          module
          module*
          module+
+         define-module+
+         define-module*+
+         lang
+         lang*
          for-syntax
          provide)
 

remix/tests/layout.rkt

@@ -23,7 +23,7 @@
   ;; You will get an allocation function named #:alloc
   (def [posn p1] (posn.#:alloc [x 5] [y 7]))
   ;; XXX (def [posn p1] #:alloc [x 5] [y 7]) <--- def transformer for allocation
-  ;; XXX (def [posn p1] (posn [x 5] [y 7])) <--- default use is allocation
+  ;; XXX (def [posn p1] [x 5] [y 7]) <--- default use is allocation
   ;; And accessors
   {p1.x ≡ 5}
   {p1.y ≡ 7}
@@ -33,7 +33,7 @@
   {(posn.x p1) ≡ 5}
   ;; You will also get a copying function
   (def [posn p2] (p1.#:set [y {p1.y + 2}]))
-  ;; XXX (def [posn p2] (posn p1 [y {p1.y + 2}])) <---- default use with expr is copy
+  ;; XXX (def [posn p2] p1 [y {p1.y + 2}]) <---- default use with expr is copy
   ;; Notice that these built-in functions are keywords, so that they
   ;; can't conflict with the fields you've defined.
   {p2.x ≡ 5}

remix/tests/module.rkt

@@ -0,0 +1,63 @@
+#lang racket/base
+(require "../module.rkt")
+
+;; A normal `module` declaration can use a different module-language
+(module og-duck racket/base
+  (provide num-eggs quack)
+  (define num-eggs 2)
+  (define (quack n)
+    (unless (zero? n)
+      (printf "quack\n")
+      (quack (sub1 n)))))
+;; And be required by the parent module
+(require (prefix-in og: 'og-duck))
+(og:quack og:num-eggs)
+
+;; module+ can't do this though, because there's nowhere to write down
+;; that you don't want to use (module* .... #f ....)
+(module+ tests
+  (printf "Old module+..."))
+
+(module+ tests
+  (printf "works!\n"))
+
+;; define-module+ lets you define a new `module+` like form
+;; specialized for a particular module. This, however, is like
+;; `module` and not `module*`, so it can't require the parent
+(define-module+ duck+
+  ;; You tell it what the name of the module to define is
+  duck
+  ;; And what the module language is
+  racket/base)
+
+;; Now we start filling in the module
+(duck+ (provide num-eggs quack)
+       (define num-eggs 2))
+(duck+ (define (quack n)
+         (unless (zero? n)
+           (printf "quack\n")
+           (quack (sub1 n)))))
+
+;; Since this is a 'module', we need to finish declaring it at some
+;; point if we want the parent to get it. If we didn't want that, we
+;; wouldn't need to use this form.
+(duck+ #:declared)
+
+;; So, here we can get at it:
+(require 'duck)
+(quack num-eggs)
+
+;; This is a syntax error because `duck` is declared
+#;(duck+ (printf "Yo!\n"))
+
+(define nine 9)
+(provide nine)
+
+;; We can, of course, defined a `module*` like this.
+(define-module*+ main+
+  main racket/base)
+(main+ (require (submod "..")))
+(main+ (displayln nine))
+;; We aren't required to put in #:declared and probably never would
+;; for `define-module*+`
+

tests/racket/remixd.rkt

@@ -0,0 +1,77 @@
+#lang at-exp racket/base
+
+;; Some remix macros just work:
+(require remix/datalog0)
+
+(define graph (make-theory))
+@datalog[graph]{
+ edge(a, b). edge(b, c). edge(c, d). edge(d, a).
+ path(X, Y) :- edge(X, Y).
+ path(X, Y) :- edge(X, Z), path(Z, Y).
+ path(X, Y)?
+}
+
+;; But others from remix/stx are specially exposed
+(require racket/remixd)
+
+@lang[typed]{
+#lang typed/racket
+
+(: f (Float -> Float))
+(define (f x)
+  (+ x 5.0))
+
+(f 8.0)
+
+(provide f)
+}
+
+(module+ test
+  (require (submod ".." typed)
+           unstable/error)
+  (f 0.0)
+  (with-handlers ([exn:fail?
+                   (λ (x)
+                     (parameterize ([current-error-port (current-output-port)])
+                       (error-display x)))])
+    (f 5)))
+
+(define (g x)
+  (+ x 6.0))
+(provide g)
+
+@lang*[main]{
+#lang typed/racket
+(require/typed (submod "..")
+  [g (Float -> Float)])
+
+(g 1.0)
+}
+
+;; This works with different readers too, not just s-exprs
+
+@lang[db]{
+#lang datalog
+
+edge(a, b). edge(b, c). edge(c, d). edge(d, a).
+path(X, Y) :- edge(X, Y).
+path(X, Y) :- edge(X, Z), path(Z, Y).
+path(X, Y)?
+}
+
+(module+ test
+  (require (submod ".." db)))
+
+;; But if the reader itself uses @, then you need to quote it
+
+@lang[document]|{
+#lang scribble/manual
+
+@title{How to use Racket}
+
+It's pretty awesome
+}|
+
+(module+ test
+  (require (prefix-in doc: (submod ".." document)))
+  doc:doc)