#lang minimart

minimart/examples/example-lang.rkt

@@ -0,0 +1,33 @@
+#lang minimart
+
+(require (only-in racket/port read-line-evt))
+
+(define (r e s)
+  (match e
+    [(message body _ _) (transition s (send `(got ,body) #:meta-level 1))]
+    [_ #f]))
+
+(define (b e n)
+  (match e
+    [#f (if (< n 10)
+	    (transition (+ n 1) (send `(hello ,n)))
+	    #f)]
+    [_ #f]))
+
+(spawn-world (spawn r (void) (list (sub ?)))
+	     (spawn b 0))
+
+(define (spy e s)
+  (when e (log-info "SPY: ~v" e))
+  #f)
+
+(spawn spy (void) (list (sub ? #:level 1000) (pub ? #:level 1000)))
+
+(define (echoer e s)
+  (match e
+    [(message (event _ (list (? eof-object?))) _ _) (transition s (quit))]
+    [(message (event _ (list line)) _ _) (transition s (send `(got-line ,line)))]
+    [_ #f]))
+
+(spawn echoer (void) (list (sub (event (read-line-evt (current-input-port) 'any) ?)
+				#:meta-level 1)))

minimart/lang.rkt

@@ -0,0 +1,63 @@
+#lang racket/base
+
+(require (for-syntax racket/base))
+
+(require racket/match)
+(require "main.rkt")
+
+(provide (rename-out [module-begin #%module-begin])
+	 (except-out (all-from-out racket/base) #%module-begin)
+	 (all-from-out racket/match)
+	 (all-from-out "main.rkt")
+	 (for-syntax (all-from-out racket/base)))
+
+(define-syntax (module-begin stx)
+  (unless (eq? (syntax-local-context) 'module-begin)
+    (raise-syntax-error #f "allowed only around a module body" stx))
+  (syntax-case stx ()
+    [(_ forms ...)
+     (let ()
+       (define (accumulate-actions action-ids final-forms forms)
+	 (if (null? forms)
+	     (let ((final-stx
+		    #`(#%module-begin #,@(reverse final-forms)
+				      (run-ground #,@(reverse action-ids)))))
+	       ;;(pretty-print (syntax->datum final-stx))
+	       final-stx)
+	     (syntax-case (local-expand (car forms)
+					'module
+					(syntax->list #'(quote 
+							 quote-syntax #%top
+							 lambda case-lambda
+							 let-values letrec-values
+							 begin begin0 set!
+							 with-continuation-mark
+							 if #%app #%expression
+							 define-values define-syntaxes
+							 begin-for-syntax
+							 module module*
+							 #%module-begin 
+							 #%require #%provide 
+							 #%variable-reference))) ()
+	       [(head rest ...)
+		(if (free-identifier=? #'head #'begin)
+		    (accumulate-actions action-ids
+					final-forms
+					(append (syntax->list #'(rest ...)) forms))
+		    (if (ormap (lambda (i) (free-identifier=? #'head i))
+			       (syntax->list #'(define-values define-syntaxes begin-for-syntax
+						 module module*
+						 #%module-begin 
+						 #%require #%provide)))
+			(accumulate-actions action-ids
+					    (cons (car forms) final-forms)
+					    (cdr forms))
+			(accumulate-action (car forms) action-ids final-forms (cdr forms))))]
+	       [non-pair-syntax
+		(accumulate-action (car forms) action-ids final-forms (cdr forms))])))
+       (define (accumulate-action action action-ids final-forms remaining-forms)
+	 (define temp (car (generate-temporaries (list action))))
+	 (accumulate-actions (cons temp action-ids)
+			     (cons #`(define #,temp #,action) final-forms)
+			     remaining-forms))
+       (accumulate-actions '() '() (syntax->list #'(forms ...))))]))

minimart/lang/reader.rkt

@@ -0,0 +1,2 @@
+#lang s-exp syntax/module-reader
+minimart/lang