diff --git a/graph/README b/graph/README
index c4e91719..945b6d02 100644
--- a/graph/README
+++ b/graph/README
@@ -203,10 +203,6 @@ Library functions and utilities
Wrapper around lib/low.rkt that allows using it from a untyped racket file.
-* lib/untyped/ids.rkt
-
- Some untyped racket utilities to manipulate identifiers inside macros.
-
* lib/untyped/for-star-list-star.rkt
A utility macro similar to for*/list to iterate over collections and return a
@@ -214,8 +210,7 @@ Library functions and utilities
* lib/untyped.rkt
- Aggregates lib/low-untyped.rkt, lib/untyped/ids.rkt and
- lib/untyped/for-star-list-star.rkt.
+ Aggregates lib/low-untyped.rkt, and lib/untyped/for-star-list-star.rkt.
* lib/test-framework.rkt
diff --git a/graph/lib/low.rkt b/graph/lib/low.rkt
index 503d9c32..cbf95464 100644
--- a/graph/lib/low.rkt
+++ b/graph/lib/low.rkt
@@ -4,6 +4,30 @@
(: degub (∀ (T) (→ T T)))
(define (degub x) (display "degub:") (displayln x) x)
+;; ==== low/typed-untyped-module.rkt ====
+
+(define-syntax define-modules
+ (syntax-rules (no-submodule)
+ [(_ ([no-submodule] [name lang] ...) . body)
+ (begin (begin . body)
+ (module name lang . body) ...)]
+ [(_ ([name lang] ...) . body)
+ (begin (module name lang . body) ...)]))
+
+#|
+;; TODO: tests: test with a macro and check that we can use it in untyped.
+;; TODO: tests: test with two mini-languages with different semantics for some
+;; function.
+(define-modules ([foo typed/racket] [foo-untyped typed/racket/no-check])
+ (provide x)
+ (: x (→ Syntax Syntax))
+ (define (x s) s))
+
+(module test racket
+ (require (submod ".." foo-untyped))
+ (x #'a))
+|#
+
;; ==== low/require-provide.rkt ====
(provide require/provide)
@@ -179,6 +203,11 @@
(syntax-e b)
(syntax-e a))])
'(3 2 1))
+
+ (check-equal? (match #'(1 2 3)
+ [(stx-list a ...) (map (inst syntax-e Positive-Byte) a)])
+ '(1 2 3))
+
#;(check-equal? (match #`(1 . (2 3)) [(stx-list a b c) (list (syntax-e c)
(syntax-e b)
(syntax-e a))])
@@ -342,3 +371,129 @@
(rename-out [match-lambda match-λ]
[match-lambda* match-λ*]
[match-lambda** match-λ**]))
+
+
+;; ==== ids.rkt ====
+
+(define-modules ([no-submodule] [ids-untyped typed/racket/no-check])
+ (provide format-ids
+ hyphen-ids
+ format-temp-ids
+ #|t/gen-temp|#)
+
+ (require/typed racket/syntax
+ [format-id (→ Syntax String (U String Identifier) * Identifier)])
+ ;(require racket/sequence) ;; in-syntax
+
+ (require "sequences.rkt"
+ #|"../low.rkt"|#) ;; my-in-syntax
+
+ (define-type S-Id-List
+ (U String
+ Identifier
+ (Listof String)
+ (Listof Identifier)
+ (Syntaxof (Listof Identifier))))
+
+ (: format-ids (→ (U Syntax (→ (U String Identifier) * Syntax))
+ String
+ S-Id-List *
+ (Listof Identifier)))
+ (define (format-ids lex-ctx format . vs)
+ (let* ([seqs
+ (map (λ ([v : S-Id-List])
+ (cond
+ [(string? v) (in-cycle (in-value v))]
+ [(identifier? v) (in-cycle (in-value v))]
+ [(list? v) (in-list v)]
+ [else (in-list (syntax->list v))]))
+ vs)]
+ [justconstants (andmap (λ (x) (or (string? x) (identifier? x))) vs)]
+ [seqlst (apply sequence-list seqs)])
+ (for/list : (Listof Identifier)
+ ([items seqlst]
+ [bound-length (if justconstants
+ (in-value 'yes)
+ (in-cycle (in-value 'no)))])
+
+ (apply format-id
+ (if (procedure? lex-ctx) (apply lex-ctx items) lex-ctx)
+ format
+ items))))
+
+ (: hyphen-ids (→ (U Syntax (→ (U String Identifier) * Syntax))
+ S-Id-List *
+ (Listof Identifier)))
+
+ (define (hyphen-ids lex-ctx . vs)
+ (apply format-ids
+ lex-ctx
+ (string-join (map (λ _ "~a") vs) "-")
+ vs))
+
+ (: format-temp-ids (→ String
+ S-Id-List *
+ (Listof Identifier)))
+
+ (define (format-temp-ids format . vs)
+ ;; Introduce the binding in a fresh scope.
+ (apply format-ids (λ _ ((make-syntax-introducer) #'())) format vs)))
+
+(module+ test
+ (require ;(submod "..")
+ ;"test-framework.rkt"
+ (for-syntax racket/syntax
+ (submod ".." ids-untyped)))
+
+ (check-equal? (format-ids #'a "~a-~a" #'() #'())
+ '())
+
+ (check-equal? (map syntax->datum
+ (format-ids #'a "~a-~a" #'(x1 x2 x3) #'(a b c)))
+ '(x1-a x2-b x3-c))
+
+ ;; Since the presence of "Syntax" in the parameters list makes format-ids
+ ;; require a chaperone contract instead of a flat contract, we can't run the
+ ;; two tests below directly, we would need to require the untyped version of
+ ;; this file, which causes a cycle in loading.
+
+ (define-syntax (test1 stx)
+ (syntax-case stx ()
+ [(_ (let1 d1) x y)
+ (begin
+ (define/with-syntax (foo-x foo-y)
+ (format-ids (λ (xy)
+ (if (string=? (symbol->string (syntax->datum xy))
+ "b")
+ stx
+ #'()))
+ "foo-~a"
+ #'(x y)))
+ #'(let1 d1 (let ((foo-b 2) (foo-c 'b)) (cons foo-x foo-y))))]))
+
+ (check-equal? (test1 (let ((foo-b 1) (foo-c 'a))) b c)
+ '(1 . b))
+
+ (define-syntax (fubar stx)
+ (define/with-syntax (v1 ...) #'(1 2 3))
+ (define/with-syntax (v2 ...) #'('a 'b 'c))
+ ;; the resulting ab and ab should be distinct identifiers:
+ (define/with-syntax (id1 ...) (format-temp-ids "~a" #'(ab cd ab)))
+ (define/with-syntax (id2 ...) (format-temp-ids "~a" #'(ab cd ab)))
+ #'(let ([id1 v1] ...)
+ (let ([id2 v2] ...)
+ (list (cons id1 id2) ...))))
+
+ (check-equal? (fubar) '((1 . a) (2 . b) (3 . c))))
+
+#|
+(define-template-metafunction (t/gen-temp stx)
+ (syntax-parse stx
+ [(_ . id:id)
+ #:with (temp) (generate-temporaries #'(id))
+ #'temp]
+ [(_ id:id ...)
+ (generate-temporaries #'(id ...))]))
+|#
+
+;; ==== end ====
\ No newline at end of file
diff --git a/graph/lib/sequences.rkt b/graph/lib/sequences.rkt
new file mode 100644
index 00000000..a382011b
--- /dev/null
+++ b/graph/lib/sequences.rkt
@@ -0,0 +1,45 @@
+#lang typed/racket
+
+(provide sequence-cons sequence-null sequence-list)
+
+(: sequence-cons (∀ (A B) (→ (Sequenceof A) (Sequenceof B)
+ (Sequenceof (cons A B)))))
+(define (sequence-cons sa sb)
+ (sequence-map (λ ([x : (List A B)]) (cons (car x) (cadr x)))
+ (in-values-sequence (in-parallel sa sb))))
+
+(: sequence-null (Sequenceof Null))
+(define sequence-null (in-cycle (in-value '())))
+
+;; sequence-list should have the type:
+;; (∀ (A ...) (→ (Sequenceof A) ... (Sequenceof (List A ...)))))
+;; But the type system rejects the two definitions below.
+(: sequence-list (∀ (A) (→ (Sequenceof A) *
+ (Sequenceof (Listof A)))))
+(define (sequence-list . sequences)
+ (if (null? sequences)
+ sequence-null
+ (sequence-cons (car sequences) (apply sequence-list (cdr sequences)))))
+
+#|
+(: sequence-list (∀ (A ...) (→ (Sequenceof A) ...
+ (Sequenceof (List A ...)))))
+(define (sequence-list . sequences)
+ (if (null? sequences)
+ sequence-null
+ (sequence-cons (car sequences) (apply sequence-list (cdr sequences)))))
+|#
+
+#|
+(: sequence-list (∀ (F R ...)
+ (case→ [→ (Sequenceof Null)]
+ [→ (Sequenceof F) (Sequenceof R) ...
+ (Sequenceof (List F R ...))])))
+(define sequence-list
+ (case-lambda
+ [()
+ sequence-null]
+ [(sequence . sequences)
+ (sequence-cons sequence (apply sequence-list sequences))]))
+|#
+
diff --git a/graph/lib/untyped.rkt b/graph/lib/untyped.rkt
index a894c58f..cfa38bdc 100644
--- a/graph/lib/untyped.rkt
+++ b/graph/lib/untyped.rkt
@@ -1,5 +1,4 @@
#lang typed/racket
(require "low-untyped.rkt")
-(require/provide "untyped/for-star-list-star.rkt"
- "untyped/ids.rkt")
\ No newline at end of file
+(require/provide "untyped/for-star-list-star.rkt")
diff --git a/graph/lib/untyped/ids.rkt b/graph/lib/untyped/ids.rkt
deleted file mode 100644
index 4f628484..00000000
--- a/graph/lib/untyped/ids.rkt
+++ /dev/null
@@ -1,114 +0,0 @@
-#lang racket
-
-(provide format-ids
- hyphen-ids
- format-temp-ids
- #|t/gen-temp|#)
-
-(require racket/syntax) ;; Used to bind format-id in macroexpansion below.
-(require racket/sequence) ;; Used to bind in-syntax in macroexpansion below.
-;; Used to bind in-syntax on older versions in macroexpansion below:
-;(require unstable/sequence)
-(require (for-syntax racket/syntax
- syntax/parse
- racket/string
- racket/sequence
- ;unstable/sequence ;; in-syntax on older versions
- #|syntax/parse/experimental/template|#)
- syntax/strip-context)
-
-;; Actually, this could be just a regular function:
-;; test (with list?, syntax? and combinations thereof) if we should iterate or
-;; just put the value as-is.
-(begin-for-syntax
- (define-syntax-class var-expr
- #:description
- (string-append "#'identifier or #'(identifier ooo), where ooo is a"
- " literal “...”, or #'(identifier ...), or an expression")
- (pattern (~and whole ((~literal syntax) var:id))
- #:with code #'(in-value whole))
- (pattern (~and whole ((~literal syntax) (var:id (~literal ...))))
- #:with code #'(in-syntax whole))
- (pattern (~and whole ((~literal syntax) (vars:id ...)))
- #:with (var . _) #`(vars ... #,(gensym 'empty))
- #:with code #'(in-syntax whole))
- (pattern expr:expr
- #:with var (gensym)
- #:with code #'(let ((s expr)) (if (string? s) (in-value s) s)))))
-
-;; TODO: infinite loop if we only have constants which ar handled with for-value
-(define-syntax (format-ids stx)
- (syntax-parse stx
- [(_ lexical-context:expr format:expr v:var-expr ...)
- (define/with-syntax (tmp ...) (generate-temporaries #'(v.var ...)))
- #'(let ([lex-ctx lexical-context])
- (for/list ([tmp v.code] ...)
- (format-id (if (procedure? lex-ctx) (lex-ctx tmp ...) lex-ctx)
- format
- tmp ...)))]))
-
-(define-syntax (hyphen-ids stx)
- (syntax-parse stx
- ;; TODO: allow single #'foo instead of (var expr), and use in-value
- [(_ lexical-context:expr v:var-expr ...)
- #`(format-ids lexical-context
- #,(string-join (for/list ([x (in-syntax #'(v ...))]) "~a")
- "-")
- v ...)]))
-
-(define-syntax (format-temp-ids stx)
- (syntax-parse stx
- [(_ . rest)
- ;; Introduce the binding in a fresh scope.
- #'(format-ids (λ _ ((make-syntax-introducer) #'())) . rest)]))
-
-#|
-(define-template-metafunction (t/gen-temp stx)
- (syntax-parse stx
- [(_ . id:id)
- #:with (temp) (generate-temporaries #'(id))
- #'temp]
- [(_ id:id ...)
- (generate-temporaries #'(id ...))]))
-|#
-
-(module* test racket
- (require (submod "..")
- rackunit
- (for-syntax racket/syntax
- (submod "..")))
-
- (check-equal? (format-ids #'a "~a-~a" #'() #'())
- '())
- (check-equal? (map syntax->datum
- (format-ids #'a "~a-~a" #'(x1 x2 x3) #'(a b c)))
- '(x1-a x2-b x3-c))
-
- (define-syntax (test1 stx)
- (syntax-case stx ()
- [(_ (let1 d1) x y)
- (begin
- (define/with-syntax (foo-x foo-y)
- (format-ids (λ (xy)
- (if (string=? (symbol->string (syntax->datum xy))
- "b")
- stx
- #'()))
- "foo-~a"
- #'(x y)))
- #'(let1 d1 (let ((foo-b 2) (foo-c 'b)) (cons foo-x foo-y))))]))
-
- (check-equal? (test1 (let ((foo-b 1) (foo-c 'a))) b c)
- '(1 . b))
-
- (define-syntax (fubar stx)
- (define/with-syntax (v1 ...) #'(1 2 3))
- (define/with-syntax (v2 ...) #'('a 'b 'c))
- ;; the resulting ab and ab should be distinct identifiers:
- (define/with-syntax (id1 ...) (format-temp-ids "~a" #'(ab cd ab)))
- (define/with-syntax (id2 ...) (format-temp-ids "~a" #'(ab cd ab)))
- #'(let ([id1 v1] ...)
- (let ([id2 v2] ...)
- (list (cons id1 id2) ...))))
-
- (check-equal? (fubar) '((1 . a) (2 . b) (3 . c))))