From 356986134f8bdf05b4bd2aa81c9adbf3c59b4907 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Thu, 5 Mar 2015 16:40:43 +0000
Subject: [PATCH] #lang prospect

---
 prospect/lang.rkt        | 63 ++++++++++++++++++++++++++++++++++++++++
 prospect/lang/reader.rkt |  2 ++
 2 files changed, 65 insertions(+)
 create mode 100644 prospect/lang.rkt
 create mode 100644 prospect/lang/reader.rkt

diff --git a/prospect/lang.rkt b/prospect/lang.rkt
new file mode 100644
index 0000000..77f5142
--- /dev/null
+++ b/prospect/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 ...)) (cdr 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 ...))))]))
diff --git a/prospect/lang/reader.rkt b/prospect/lang/reader.rkt
new file mode 100644
index 0000000..c8863ef
--- /dev/null
+++ b/prospect/lang/reader.rkt
@@ -0,0 +1,2 @@
+#lang s-exp syntax/module-reader
+prospect/lang