Add racket language for labeled hypergraphs

6 files changed, 141 insertions, 0 deletions

diff --git a/racket/circuits/expander.rkt b/racket/circuits/expander.rkt
new file mode 100644
index 0000000..66948c4
--- /dev/null
+++ b/racket/circuits/expander.rkt
@@ -0,0 +1,15 @@
+#lang racket/base
+
+;; Hypergraph module language
+(require "hypergraph.rkt")
+(provide #%app #%module-begin define new-node)
+
+;; Don't provide quote or new-edge
+
+;; Primitive cells (gates)
+(define (and a b c) (new-edge 'and a b c))
+(define (or a b c) (new-edge 'or a b c))
+(define (not a b) (new-edge 'not a b))
+(define (zero a) (new-edge 'zero a))
+(define (one a) (new-edge 'one a))
+(provide and or not zero one)
diff --git a/racket/circuits/hypergraph.rkt b/racket/circuits/hypergraph.rkt
new file mode 100644
index 0000000..e0496e4
--- /dev/null
+++ b/racket/circuits/hypergraph.rkt
@@ -0,0 +1,36 @@
+#lang racket
+
+;; Top-level syntax transformer
+;; displays hypergraph after evaluating module
+(define-syntax-rule (hypergraph-mb expr ...)
+  (#%module-begin
+    expr
+    ...
+    (displayln `(hypergraph ,node-num))
+    (for-each displayln graph)))
+
+;; Need application, quotation, and defines
+(provide quote define #%app)
+
+;; As well as #%module-begin implicit form
+(provide
+  (rename-out
+    [hypergraph-mb #%module-begin]))
+
+;; Internal state
+(define graph empty)
+(define node-num 0)
+
+;; Create a fresh node
+(define (new-node)
+  (let ([fresh-num node-num])
+    (set! node-num (+ node-num 1))
+    fresh-num))
+
+;; Create a new hyperedge
+(define (new-edge label . nodes)
+  (set! graph (cons (cons label nodes) graph)))
+
+;; User code constructs hypergraph using
+;; new-node and new-edge
+(provide new-node new-edge)
diff --git a/racket/circuits/lexer.rkt b/racket/circuits/lexer.rkt
new file mode 100644
index 0000000..5d3dc82
--- /dev/null
+++ b/racket/circuits/lexer.rkt
@@ -0,0 +1,33 @@
+#lang racket/base
+(require parser-tools/lex)
+(require (prefix-in : parser-tools/lex-sre))
+
+(define-tokens basic-tokens (ID))
+(define-empty-tokens punct-tokens (LPAREN RPAREN EOF COMMA SEMICOLON LBRACE RBRACE))
+(define-empty-tokens keyword-tokens (WIRE MODULE))
+
+(define-lex-abbrev ident-special-char (char-set "_|~+-^&#!"))
+
+;; Lexer for circuits DSL
+(define circuits-lexer
+  (lexer
+    [(eof) (token-EOF)]
+    ["(" (token-LPAREN)]
+    [")" (token-RPAREN)]
+    ["{" (token-LBRACE)]
+    ["}" (token-RBRACE)]
+    ["," (token-COMMA)]
+    [";" (token-SEMICOLON)]
+    ["wire" (token-WIRE)]
+    ["module" (token-MODULE)]
+    [(:: "//" (:* (:- any-char (char-set "\n"))) "\n")
+     (circuits-lexer input-port)]
+    [(::
+       (:or alphabetic ident-special-char)
+       (:* (:or alphabetic numeric ident-special-char)))
+     (token-ID (string->symbol lexeme))]
+    [whitespace (circuits-lexer input-port)]))
+
+(provide basic-tokens punct-tokens keyword-tokens)
+
+(provide circuits-lexer)
diff --git a/racket/circuits/main.rkt b/racket/circuits/main.rkt
new file mode 100644
index 0000000..6c12362
--- /dev/null
+++ b/racket/circuits/main.rkt
@@ -0,0 +1,5 @@
+#lang racket/base
+
+(module reader racket
+  (require "reader.rkt")
+  (provide read read-syntax))
diff --git a/racket/circuits/parser.rkt b/racket/circuits/parser.rkt
new file mode 100644
index 0000000..6287be3
--- /dev/null
+++ b/racket/circuits/parser.rkt
@@ -0,0 +1,35 @@
+#lang racket/base
+(require parser-tools/yacc)
+
+;; Needed for tokens
+(require "lexer.rkt")
+
+;; Parser for circuits DSL
+(define circuits-parser
+  (parser
+    [start decls]
+    [end EOF]
+    [error void]
+    [tokens basic-tokens punct-tokens keyword-tokens]
+    [grammar
+      (decls
+        [(decl) $1]
+        [(decl decls) (append $1 $2)])
+      (decl
+        [(wire-decl) $1]
+        [(module-decl) (list $1)]
+        [(module-inst-decl) (list $1)])
+      (idents
+        [(ID) (list $1)]
+        [(ID COMMA idents) (cons $1 $3)])
+      (wire-decl
+        [(WIRE idents SEMICOLON)
+         (map (lambda (x) `(define ,x (new-node))) $2)])
+      (module-decl
+        [(MODULE ID LPAREN idents RPAREN LBRACE decls RBRACE)
+         `(define (,$2 ,@$4) ,@$7)])
+      (module-inst-decl
+        [(ID LPAREN idents RPAREN SEMICOLON)
+         `(,$1 ,@$3)])]))
+
+(provide circuits-parser)
diff --git a/racket/circuits/reader.rkt b/racket/circuits/reader.rkt
new file mode 100644
index 0000000..66a8afa
--- /dev/null
+++ b/racket/circuits/reader.rkt
@@ -0,0 +1,17 @@
+#lang racket/base
+
+(require "lexer.rkt" "parser.rkt")
+
+(define (read in)
+  (syntax->datum (read-syntax #f in)))
+
+;; Parse the input and produce a module syntax object
+;; to be expanded using the circuits module language
+(define (read-syntax path input-port)
+  (define (tokenizer) (circuits-lexer input-port))
+  (define parse-tree (circuits-parser tokenizer))
+  (datum->syntax #f
+    `(module circuits-module circuits/expander
+      ,@parse-tree)))
+
+(provide read read-syntax)