Nearly finished dotlang.
This commit is contained in:
parent
b8f8297f83
commit
f8edadc1a8
27
graph-lib/__DEBUG_dotlang.rkt
Normal file
27
graph-lib/__DEBUG_dotlang.rkt
Normal file
|
@ -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)
|
|
@ -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")))
|
||||
|
|
|
@ -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")
|
||||
|
|
|
@ -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")
|
||||
|
|
Loading…
Reference in New Issue
Block a user