Racket/python infrastructure

implementations/python/.gitignore

@@ -0,0 +1 @@
+*.pyc

implementations/python/Makefile

@@ -0,0 +1,3 @@
+test:
+	python2 -m unittest test_preserves
+	python3 -m unittest test_preserves

implementations/racket/.gitignore

@@ -0,0 +1 @@
+compiled/

implementations/racket/Makefile

@@ -0,0 +1,16 @@
+PACKAGENAME=preserves
+COLLECTS=preserves
+
+all: setup
+
+clean:
+	find . -name compiled -type d | xargs rm -rf
+
+setup:
+	raco setup $(COLLECTS)
+
+link:
+	raco pkg install --link -n $(PACKAGENAME) $$(pwd)
+
+unlink:
+	raco pkg remove $(PACKAGENAME)

implementations/racket/info.rkt

@@ -0,0 +1,5 @@
+#lang setup/infotab
+(define collection 'multi)
+(define deps '("base"
+	       "bitsyntax"
+               "rackunit-lib"))

implementations/racket/preserves/main.rkt

@@ -16,12 +16,9 @@
 (require racket/match)
 (require racket/set)
 (require bitsyntax)
-(require syndicate/support/struct)
+(require "struct.rkt")
 (require (only-in syntax/readerr raise-read-error))
 
-(require imperative-syndicate/assertions)
-(require imperative-syndicate/pattern)
-
 (struct stream-of (kind generator) #:transparent)
 
 (struct record (label fields) #:transparent)
@@ -587,6 +584,10 @@
            (check-equal? (d (expected b ...)) back loc)
            ))))
 
+  (struct discard () #:prefab)
+  (struct capture (detail) #:prefab)
+  (struct observe (specification) #:prefab)
+
   (cross-check "capture(discard())" (capture (discard)) (#x91 #x80))
   (cross-check "observe(speak(discard(), capture(discard())))"
                (observe (speak (discard) (capture (discard))))

implementations/racket/preserves/struct.rkt

@@ -0,0 +1,35 @@
+#lang racket/base
+;; Misc support routines not (yet) provided by racket itself
+
+(provide non-object-struct?
+         struct-type-name
+         struct-type-constructor-arity
+         struct->struct-type)
+
+(require (only-in racket/class object?))
+
+;; Any -> Boolean
+;; Racket objects are structures, so we reject them explicitly for
+;; now, leaving them opaque to unification.
+(define (non-object-struct? x)
+  (and (struct? x)
+       (not (object? x))))
+
+;; struct-type -> Symbol
+;; Extract just the name of the given struct-type.
+(define (struct-type-name st)
+  (define-values (name x2 x3 x4 x5 x6 x7 x8) (struct-type-info st))
+  name)
+
+;; StructType -> Natural
+(define (struct-type-constructor-arity st)
+  (define-values (x1 arity x3 x4 x5 x6 x7 x8) (struct-type-info st))
+  arity)
+
+;; Structure -> StructType
+;; Errors when given any struct that isn't completely transparent/prefab.
+(define (struct->struct-type p)
+  (define-values (t skipped?) (struct-info p))
+  (when skipped? (error 'struct->struct-type "Cannot reflect on struct instance ~v" p))
+  t)
+