From 316eaa90010420a5858aeb19b68e0a38c9bcdce7 Mon Sep 17 00:00:00 2001
From: Ben Greenman <benjaminlgreenman@gmail.com>
Date: Wed, 4 May 2016 21:36:57 -0400
Subject: [PATCH] [icfp] micro implementation of vector/length

---
 icfp-2016/src/mini/README.md  |  4 +++
 icfp-2016/src/mini/vector.rkt | 53 +++++++++++++++++++++++++++++++++++
 2 files changed, 57 insertions(+)
 create mode 100644 icfp-2016/src/mini/README.md
 create mode 100644 icfp-2016/src/mini/vector.rkt

diff --git a/icfp-2016/src/mini/README.md b/icfp-2016/src/mini/README.md
new file mode 100644
index 0000000..c2986b8
--- /dev/null
+++ b/icfp-2016/src/mini/README.md
@@ -0,0 +1,4 @@
+mini
+===
+
+Runnable code from Section 5
diff --git a/icfp-2016/src/mini/vector.rkt b/icfp-2016/src/mini/vector.rkt
new file mode 100644
index 0000000..3e7413b
--- /dev/null
+++ b/icfp-2016/src/mini/vector.rkt
@@ -0,0 +1,53 @@
+#lang typed/racket/base
+
+;; Micro implementation of trivial/vector
+;;  following the prose from Section 5.
+;;
+;; Missing:
+;; - syntax-properties (for recursion)
+;; - let/define
+;; - predicate -> syntax class
+
+(module A typed/racket/base
+  (require (for-syntax racket/base syntax/parse))
+
+  (begin-for-syntax
+  (define ((make-alias orig-id elaborate) stx)
+    (or (elaborate stx)
+        (syntax-parse stx
+         [_:id
+          orig-id]
+         [(_ e* ...)
+          #`(#,orig-id e* ...)])))
+
+  (define vector?
+    (syntax-parser #:literals (make-vector)
+     [(_ #(e ...))
+      (length (syntax->datum #'(e ...)))]
+     [_ #f]))
+
+  (define-syntax-class vector/length
+    #:attributes (evidence expanded)
+    (pattern e
+     #:with e+ (expand-expr #'e)
+     #:with len (vector? #'e+)
+     #:when (syntax->datum #'len)
+     #:attr evidence #'len
+     #:attr expanded #'e+))
+
+  (define (expand-expr e)
+    (local-expand e 'expression '()))
+  )
+
+  (define-syntax vector-length
+    (make-alias #'vector-length
+      (syntax-parser
+       [(_ v:vector/length)
+        #''v.evidence]
+       [_ #f])))
+
+(provide vector-length))
+
+
+(require 'A)
+(ann (vector-length '#(0)) One)