From f8edadc1a85055cddf0f08f3ca46acc70586d04b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@gmail.com>
Date: Thu, 21 Jan 2016 18:50:12 +0100
Subject: [PATCH] Nearly finished dotlang.

---
 graph-lib/__DEBUG_dotlang.rkt     | 27 +++++++++++++++++++
 graph-lib/graph/dotlang.rkt       | 45 ++++++++++++++++++++++---------
 graph-lib/graph/test-map4-get.rkt |  1 -
 graph-lib/main.rkt                |  1 +
 4 files changed, 60 insertions(+), 14 deletions(-)
 create mode 100644 graph-lib/__DEBUG_dotlang.rkt

diff --git a/graph-lib/__DEBUG_dotlang.rkt b/graph-lib/__DEBUG_dotlang.rkt
new file mode 100644
index 00000000..c38000a2
--- /dev/null
+++ b/graph-lib/__DEBUG_dotlang.rkt
@@ -0,0 +1,27 @@
+#lang s-exp "graph/dotlang.rkt"
+
+(require "graph/graph4.lp2.rkt")
+(require "graph/map4.rkt")
+(require (submod "graph/graph3.lp2.rkt" test))
+(require "type-expander/type-expander.lp2.rkt")
+(require "graph/structure.lp2.rkt")
+(require "graph/variant.lp2.rkt")
+(require "lib/low.rkt")
+
+#|
+.aa.bb..cc.d
+…aa...bb..cc.d
+…aa.….bb..cc.d
+.aa.….bb..cc.d
+(newline)
+aa.bb..cc.d
+aa...bb..cc.d
+aa…bb..cc.d
+aa.….bb..cc.d
+(newline)
+…aa.…bb..cc.d ;; TODO: should cause error
+…aa….bb..cc.d ;; TODO: should cause error
+|#
+
+g.streets…houses…owner.name
+(map: (curry map (λget owner name)) g.streets…houses)
\ No newline at end of file
diff --git a/graph-lib/graph/dotlang.rkt b/graph-lib/graph/dotlang.rkt
index eddc803c..cd564383 100644
--- a/graph-lib/graph/dotlang.rkt
+++ b/graph-lib/graph/dotlang.rkt
@@ -2,25 +2,44 @@
 
 (module dotlang racket
   (require typed/racket)
+  
   (provide (except-out (all-from-out typed/racket) #%top)
            (rename-out [new-#%top #%top]))
   
-  (require (for-syntax racket/string))
+  (require "graph4.lp2.rkt"
+           "../lib/low-untyped.rkt"
+           (for-syntax racket/string
+                       syntax/parse
+                       racket/syntax
+                       "../lib/low-untyped.rkt"))
   
-  (define-syntax-rule (dot . xyz)
-    '(dot . xyz))
+  (define-syntax/parse (dot x:id)
+    (let* ([str (symbol->string (syntax-e #'x))]
+           [components (regexp-match* #px"([^.…]|\\.\\.+)+|…" str)]
+           [unescaped (map (λ (m) (regexp-replace* #px"\\.(\\.+)" m "\\1"))
+                           components)]
+           [identifiers (map (λ (u) (datum->syntax #'x (string->symbol u)))
+                             unescaped)]
+           [leading-dot? (regexp-match #px"^(\\.|…)" str)]
+           [trailing-dot? (regexp-match #px"\\.$" str)])
+      (define/with-syntax (id …) identifiers)
+      (cond
+        [leading-dot? #'(λget id …)]
+        [trailing-dot? (raise-syntax-error 'dot "Found trailing dot" #'x)]
+        [else #'(get id …)])))
   
   (define-syntax (new-#%top stx)
     (syntax-case stx ()
       [(_  . x)
-       (let ([components (string-split (symbol->string (syntax->datum #'x))
-                                       ".")])
-         (if (> (length components) 1)
-             #`(dot . #,components)
-             #'(#%top . x)))])))
+       (if (regexp-match #rx"\\." (symbol->string (syntax-e #'x)))
+           #`(dot x)
+           #'(#%top . x))])))
 
-(module test (submod ".." dotlang)
-  (require typed/rackunit)
-  (let ((foo.bar 42))
-    (check-equal? foo.bar 42))
-  (check-equal? foo.bar '(dot "foo" "bar")))
+(require 'dotlang)
+(provide (all-from-out 'dotlang))
+
+#;(module test (submod ".." dotlang)
+    (require typed/rackunit)
+    (let ((foo.bar 42))
+      (check-equal? foo.bar 42))
+    (check-equal? foo.bar '(dot "foo" "bar")))
diff --git a/graph-lib/graph/test-map4-get.rkt b/graph-lib/graph/test-map4-get.rkt
index 1baaf15d..69c349d6 100644
--- a/graph-lib/graph/test-map4-get.rkt
+++ b/graph-lib/graph/test-map4-get.rkt
@@ -2,7 +2,6 @@
 
 (module test typed/racket
   (require (submod "graph3.lp2.rkt" test))
-  (require "graph3.lp2.rkt")
   (require "graph4.lp2.rkt")
   (require "map4.rkt")
   (require "structure.lp2.rkt")
diff --git a/graph-lib/main.rkt b/graph-lib/main.rkt
index a48fa80d..86e61baf 100644
--- a/graph-lib/main.rkt
+++ b/graph-lib/main.rkt
@@ -1,6 +1,7 @@
 #lang typed/racket
 
 (require (submod "graph/test-map4-get.rkt" test))
+(require "__DEBUG_dotlang.rkt")
 
 (require "type-expander/type-expander.lp2.rkt")
 (require "type-expander/multi-id.lp2.rkt")