Support for identity in map:, cleaned up a bit the tests.
This commit is contained in:
Georges Dupéron
parent
4370e693a2
commit
8daf54f964
|
|
@ -1,92 +0,0 @@
|
|||
#lang typed/racket
|
||||
|
||||
#|
|
||||
(require "structure.lp2.rkt")
|
||||
(require "variant.lp2.rkt")
|
||||
(require "../type-expander/type-expander.lp2.rkt")
|
||||
(require "../lib/low.rkt")
|
||||
|
||||
((tagged t a b c) 1 'b "c")
|
||||
((tagged t a [b] c) 1 'b "c")
|
||||
((tagged t [a] [b] [c]) 1 'b "c")
|
||||
((tagged t [a : Number] [b : Symbol] [c : String]) 1 'b "c")
|
||||
(tagged t [a : Number 1] [b : Symbol 'b] [c : String "c"])
|
||||
(tagged t [a 1] [b 'b] [c "c"])
|
||||
|
||||
(tagged t [a 1] [b 'b] [c "c"])
|
||||
|
||||
(define-tagged tabc t [a 1] [b 'b] [c "c"])
|
||||
|#
|
||||
|
||||
(require "__DEBUG_require.rkt")
|
||||
|
||||
(map: (λget houses) (get g streets))
|
||||
(map: (λget houses … owner name) (get g streets))
|
||||
(map: (∘ (curry map (∘ (λget name) (λget owner))) (λget houses))
|
||||
(get g streets))
|
||||
(map: (∘ (curry map (∘ string-length (λget name) (λget owner))) (λget houses))
|
||||
(get g streets))
|
||||
|
||||
;; (map: (compose (curry map identity) (λget houses …)) (get g streets))
|
||||
;; (map: (compose (λget houses …) (λ #:∀ (A) ([x : A]) x)) (get g streets))
|
||||
;; (map: (compose (λget houses …) (curry map (λget owner))) (get g streets))
|
||||
;; => TODO: Crashes ../type-expander/type-expander.lp2.rkt:90:7:
|
||||
;; syntax-local-bind-syntaxes: contract violation
|
||||
; expected: (listof identifier?)
|
||||
; given: (#<syntax:/home/georges/phc/racket/graph-lib/graph/map.rkt:130:18
|
||||
; (has-get Out houses …)>)
|
||||
; argument position: 1st
|
||||
; other arguments...:
|
||||
|
||||
#|
|
||||
(get '((1 2) (3)) … …)
|
||||
(structure-get (cadr (force g)) people)
|
||||
(get g people)
|
||||
(get g streets cadr houses car owner name)
|
||||
((λget people) g)
|
||||
((λget owner name) (get g streets cadr houses car))
|
||||
(get g streets … houses … owner name)
|
||||
((λget streets … houses … owner name) g)
|
||||
(let ([f (λget streets … houses … owner name)]) f)
|
||||
;(map: (λget houses … owner name) (get g streets))
|
||||
|#
|
||||
|
||||
|
||||
#|
|
||||
(define #:∀ (A) (map-force [l : (Listof (Promise A))])
|
||||
(map (inst force A) l))
|
||||
|
||||
(map-force (get g people))
|
||||
(map-force (get g streets))
|
||||
|#
|
||||
|
||||
#|
|
||||
(let ()
|
||||
(map-force (second g))
|
||||
(cars (map-force (second g)))
|
||||
(map-force (third g))
|
||||
(map-force (append* (cars (cdrs (cdrs (map-force (second g)))))))
|
||||
(void))
|
||||
|
||||
#|
|
||||
#R(map-force (second g))
|
||||
#R(map-force (third g))
|
||||
|
||||
(newline)
|
||||
|
||||
#R(force (car (second g)))
|
||||
#R(force (cadr (force (car (caddr (force (car (second g))))))))
|
||||
|
||||
(newline)
|
||||
;|#
|
||||
|
||||
(define (forceall [fuel : Integer] [x : Any]) : Any
|
||||
(if (> fuel 0)
|
||||
(cond [(list? x) (map (curry forceall fuel) x)]
|
||||
[(promise? x) (forceall (sub1 fuel) (force x))]
|
||||
[else x])
|
||||
x))
|
||||
|
||||
(forceall 5 g)
|
||||
|
||||
|#
|
||||
|
|
@ -1,19 +0,0 @@
|
|||
#lang typed/racket
|
||||
|
||||
(require (submod "graph3.lp2.rkt" test))
|
||||
(require "graph3.lp2.rkt")
|
||||
(require "graph4.lp2.rkt")
|
||||
(require "map4.rkt")
|
||||
(require "structure.lp2.rkt")
|
||||
(require "variant.lp2.rkt")
|
||||
(require "../lib/low.rkt")
|
||||
(require "../type-expander/type-expander.lp2.rkt")
|
||||
|
||||
(provide (all-from-out (submod "graph3.lp2.rkt" test)
|
||||
"graph3.lp2.rkt"
|
||||
"graph4.lp2.rkt"
|
||||
"map4.rkt"
|
||||
"structure.lp2.rkt"
|
||||
"variant.lp2.rkt"
|
||||
"../lib/low.rkt"
|
||||
"../type-expander/type-expander.lp2.rkt"))
|
||||
|
|
@ -291,12 +291,12 @@
|
|||
: (Listof Number)
|
||||
'(1 2 3))
|
||||
|
||||
(check-equal?: (map: (curry map car) '([(1 a) (2 b)] [(3 c)]))
|
||||
: (Listof Number)
|
||||
'((1 a) (3 c)))
|
||||
#;(check-equal?: (map: (curry map: car) '([(1 a) (2 b)] [(3 c)]))
|
||||
: (Listof Number)
|
||||
'((1 a) (3 c)))
|
||||
(check-equal?: (map: (curry map car) '([{1 a} {2 b}] [{3 c}]))
|
||||
: (Listof (Listof Number))
|
||||
'([1 2] [3]))
|
||||
#;(check-equal?: (map: (curry map: car) '([{1 a} {2 b}] [{3 c}]))
|
||||
: (Listof (Listof Number))
|
||||
'([1 2] [3]))
|
||||
|
||||
(check-equal?: (map: (curry map (curry map car))
|
||||
'([((1 a) (2 b)) ((3 c))] [((4))]))
|
||||
|
|
|
|||
|
|
@ -4,7 +4,6 @@
|
|||
racket/function
|
||||
syntax/stx
|
||||
syntax/parse
|
||||
syntax/parse/experimental/template
|
||||
"../lib/low-untyped.rkt")
|
||||
"../lib/low.rkt"
|
||||
"graph4.lp2.rkt"
|
||||
|
|
@ -51,14 +50,23 @@
|
|||
(syntax-parse stx
|
||||
[(_ {∀-type:id …} A:expr B:expr 0)
|
||||
#'(ann (λ (f x) (f x))
|
||||
(∀ (∀-type …) (→ (→ A B) A B)))]
|
||||
(∀ (∀-type …)
|
||||
(→ (→ A B) A B)
|
||||
;; Use the type below to allow identity functions, but it's more
|
||||
;; heavy on the typechecker
|
||||
#;(case→ (→ (→ A B) A B)
|
||||
(→ (→ A A) A A))))]
|
||||
[(_ (~and norun #:norun) … {∀-type:id …} A:expr B:expr d:≥0)
|
||||
(define/with-syntax local-map (generate-temporary #'map))
|
||||
#`(dbg norun …
|
||||
(let ()
|
||||
(: local-map (∀ (∀-type …) (→ (→ A B)
|
||||
(Deep-Listof d A)
|
||||
(Deep-Listof d B))))
|
||||
(: local-map
|
||||
(∀ (∀-type …)
|
||||
(→ (→ A B) (Deep-Listof d A) (Deep-Listof d B))
|
||||
;; Use the type below to allow identity functions, but it's
|
||||
;; more heavy on the typechecker
|
||||
#;(case→ (→ (→ A B) (Deep-Listof d A) (Deep-Listof d B))
|
||||
(→ (→ A A) (Deep-Listof d A) (Deep-Listof d A)))))
|
||||
(define (local-map f l)
|
||||
(if (null? l)
|
||||
'()
|
||||
|
|
@ -170,10 +178,12 @@
|
|||
(syntax-parse stx
|
||||
[((~literal curry) (~literal map) f:expr)
|
||||
(transform-map: (add1 depth) #'f)]
|
||||
[((~literal ∘) f:expr …)
|
||||
[((~literal compose) f:expr …)
|
||||
(define/syntax-parse (([dd ff] …) …)
|
||||
(stx-map (curry transform-map: depth) #'(f …)))
|
||||
#`[(dd ff) … …]]
|
||||
[(~literal identity) #'[]]
|
||||
[(~literal values) #'[]]
|
||||
[f:expr
|
||||
#`[(#,depth f)]]))
|
||||
|
||||
|
|
@ -194,4 +204,151 @@
|
|||
(curry map (∘)))
|
||||
'([1 2] [3]))
|
||||
: (Listof Number)
|
||||
'(3 2)))
|
||||
'(3 2)))
|
||||
|
||||
(module+ test
|
||||
;(require (submod "..")
|
||||
; "../lib/low.rkt")
|
||||
|
||||
(check-equal?: (map: add1 '(1 2 3))
|
||||
: (Listof Number)
|
||||
'(2 3 4))
|
||||
(check-equal?: (map: (compose add1) '(1 2 3))
|
||||
: (Listof Number)
|
||||
'(2 3 4))
|
||||
(check-equal?: (map: (∘ identity add1) '(1 2 3))
|
||||
: (Listof Number)
|
||||
'(2 3 4))
|
||||
(check-equal?: (map: (∘ add1 identity) '(1 2 3))
|
||||
: (Listof Number)
|
||||
'(2 3 4))
|
||||
(check-equal?: (map: (∘ number->string add1) '(1 2 9))
|
||||
: (Listof String)
|
||||
'("2" "3" "10"))
|
||||
(check-equal?: (map: (∘ string-length number->string add1) '(1 2 9))
|
||||
: (Listof Number)
|
||||
'(1 1 2))
|
||||
(check-equal?: (map: car '((1 2) (2) (9 10 11)))
|
||||
: (Listof Number)
|
||||
'(1 2 9))
|
||||
(check-equal?: (map: (∘ add1 car) '((1 2) (2) (9 10 11)))
|
||||
: (Listof Number)
|
||||
'(2 3 10))
|
||||
(check-equal?: (map: (∘ string-length number->string add1 car cdr)
|
||||
'((1 2) (2 3) (8 9 10)))
|
||||
: (Listof Number)
|
||||
'(1 1 2))
|
||||
(check-equal?: (map: identity '(1 2 3))
|
||||
: (Listof Number)
|
||||
'(1 2 3))
|
||||
(check-equal?: (map: values '(1 2 3))
|
||||
: (Listof Number)
|
||||
'(1 2 3))
|
||||
(check-equal?: (map: (compose) '(1 2 3))
|
||||
: (Listof Number)
|
||||
'(1 2 3))
|
||||
(check-equal?: (map: (compose identity) '(1 2 3))
|
||||
: (Listof Number)
|
||||
'(1 2 3))
|
||||
(check-equal?: (map: (∘ identity values identity values) '(1 2 3))
|
||||
: (Listof Number)
|
||||
'(1 2 3))
|
||||
(check-equal?: (map: (∘ length (curry map add1)) '((1 2) (3)))
|
||||
: (Listof Number)
|
||||
'(2 1))
|
||||
(check-equal?: (map: (curry map add1) '((1 2) (3)))
|
||||
: (Listof (Listof Number))
|
||||
'((2 3) (4)))
|
||||
|
||||
(define (numlist [x : Number]) (list x))
|
||||
(check-equal?: (map: (∘ (curry map add1) numlist) '(1 2 3))
|
||||
: (Listof (Listof Number))
|
||||
'((2) (3) (4)))
|
||||
|
||||
(check-equal?: (map: (∘ (curry map add1) (λ ([x : Number]) (list x)))
|
||||
'(1 2 3))
|
||||
: (Listof (Listof Number))
|
||||
'((2) (3) (4)))
|
||||
|
||||
(begin
|
||||
;; Some of the tests below use (curry map: …), and don't work, because
|
||||
;; typed/racket wraps the map: identifier with a contract, so the identifier
|
||||
;; seen outside the module is not the same as the one used in the
|
||||
;; syntax-parse ~literal clause.
|
||||
|
||||
(check-equal?: (map: (curry map add1) '((1 2 3) (4 5)))
|
||||
: (Listof (Listof Number))
|
||||
'((2 3 4) (5 6)))
|
||||
#;(check-equal?: (map: (curry map: add1) '((1 2 3) (4 5)))
|
||||
: (Listof (Listof Number))
|
||||
'((2 3 4) (5 6)))
|
||||
|
||||
(check-equal?: (map: (curry map (compose number->string add1))
|
||||
'((1 2 3) (4 5)))
|
||||
: (Listof (Listof String))
|
||||
'(("2" "3" "4") ("5" "6")))
|
||||
#;(check-equal?: (map: (curry map: (compose number->string add1))
|
||||
'((1 2 3) (4 5)))
|
||||
: (Listof (Listof String))
|
||||
'(("2" "3" "4") ("5" "6")))
|
||||
|
||||
(check-equal?: (map: add1 '(1 2 3))
|
||||
: (Listof Number)
|
||||
'(2 3 4))
|
||||
|
||||
(check-equal?: (map: car '((1 a) (2 b) (3 c)))
|
||||
: (Listof Number)
|
||||
'(1 2 3))
|
||||
|
||||
(check-equal?: (map: (curry map car) '([{1 a} {2 b}] [{3 c}]))
|
||||
: (Listof (Listof Number))
|
||||
'([1 2] [3]))
|
||||
#;(check-equal?: (map: (curry map: car) '([{1 a} {2 b}] [{3 c}]))
|
||||
: (Listof (Listof Number))
|
||||
'([1 2] [3]))
|
||||
|
||||
(check-equal?: (map: (curry map (curry map car))
|
||||
'([((1 a) (2 b)) ((3 c))] [((4))]))
|
||||
: (Listof (Listof (Listof Number)))
|
||||
'([(1 2) (3)] [(4)]))
|
||||
#;(check-equal?: (map: (curry map (curry map: car))
|
||||
'([((1 a) (2 b)) ((3 c))] [((4))]))
|
||||
: (Listof (Listof (Listof Number)))
|
||||
'([(1 2) (3)] [(4)]))
|
||||
#;(check-equal?: (map: (curry map: (curry map car))
|
||||
'([((1 a) (2 b)) ((3 c))] [((4))]))
|
||||
: (Listof (Listof (Listof Number)))
|
||||
'([(1 2) (3)] [(4)]))
|
||||
#;(check-equal?: (map: (curry map: (curry map: car))
|
||||
'([((1 a) (2 b)) ((3 c))] [((4))]))
|
||||
: (Listof (Listof (Listof Number)))
|
||||
'([(1 2) (3)] [(4)])))
|
||||
|
||||
(check-equal?: (map: car '((1 b x) (2 c) (3 d)))
|
||||
: (Listof Number)
|
||||
'(1 2 3))
|
||||
(check-equal?: (map: cdr '((1 b x) (2 c) (3 d)))
|
||||
: (Listof (Listof Symbol))
|
||||
'((b x) (c) (d)))
|
||||
(check-equal?: (map: car (map: cdr '((1 b x) (2 c) (3 d))))
|
||||
: (Listof Symbol)
|
||||
'(b c d))
|
||||
(check-equal?: (map: (compose) '((1 b x) (2 c) (3 d)))
|
||||
: (Listof (Listof (U Number Symbol)))
|
||||
'((1 b x) (2 c) (3 d)))
|
||||
(check-equal?: (map: (compose car) '((1 b x) (2 c) (3 d)))
|
||||
: (Listof Number)
|
||||
'(1 2 3))
|
||||
(check-equal?: (map: (compose cdr) '((1 b x) (2 c) (3 d)))
|
||||
: (Listof (Listof Symbol))
|
||||
'((b x) (c) (d)))
|
||||
(check-equal?: (map: (compose car cdr) '((1 b x) (2 c) (3 d)))
|
||||
: (Listof Symbol)
|
||||
'(b c d))
|
||||
(check-equal?: (map: (compose add1 car) '((1 b x) (2 c) (3 d)))
|
||||
: (Listof Number)
|
||||
'(2 3 4))
|
||||
#|
|
||||
(check-equal?: (map: + '(1 2 3) '(4 5 6))
|
||||
: (Listof Number)
|
||||
'(5 7 9))|#)
|
||||
46
graph-lib/graph/test-map4-get.rkt
Normal file
46
graph-lib/graph/test-map4-get.rkt
Normal file
|
|
@ -0,0 +1,46 @@
|
|||
#lang typed/racket
|
||||
|
||||
(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")
|
||||
(require "variant.lp2.rkt")
|
||||
(require "../lib/low.rkt")
|
||||
(require "../type-expander/type-expander.lp2.rkt")
|
||||
|
||||
((tagged t a b c) 1 'b "c")
|
||||
((tagged t a [b] c) 1 'b "c")
|
||||
((tagged t [a] [b] [c]) 1 'b "c")
|
||||
((tagged t [a : Number] [b : Symbol] [c : String]) 1 'b "c")
|
||||
(tagged t [a : Number 1] [b : Symbol 'b] [c : String "c"])
|
||||
(tagged t [a 1] [b 'b] [c "c"])
|
||||
|
||||
(tagged t [a 1] [b 'b] [c "c"])
|
||||
|
||||
(define-tagged tabc [a 1] [b 'b] [c "c"])
|
||||
|
||||
(map: (λget houses) (get g streets))
|
||||
(map: (λget houses … owner name) (get g streets))
|
||||
(map: (∘ (curry map (∘ (λget name) (λget owner))) (λget houses))
|
||||
(get g streets))
|
||||
(map: (∘ (curry map (∘ string-length (λget name) (λget owner))) (λget houses))
|
||||
(get g streets))
|
||||
|
||||
(map: (compose (curry map identity) (λget houses …)) (get g streets))
|
||||
;; Can be allowed by changing (→ (→ A B) A B) in a couple of places in map: to
|
||||
;; a case→, but it's more heavy on the typechecker, and it's an uncommon case.
|
||||
;(map: (compose (λget houses …) (λ #:∀ (A) ([x : A]) x)) (get g streets))
|
||||
(map: (compose (curry map (λget owner)) (λget houses …)) (get g streets))
|
||||
|
||||
(get '((1 2) (3)) … …)
|
||||
(structure-get (cadr (force g)) people)
|
||||
(get g people)
|
||||
(get g streets cadr houses car owner name)
|
||||
((λget people) g)
|
||||
((λget owner name) (get g streets cadr houses car))
|
||||
(get g streets … houses … owner name)
|
||||
((λget streets … houses … owner name) g)
|
||||
(let ([f (λget streets … houses … owner name)]) f)
|
||||
(map: (λget houses … owner name) (get g streets)))
|
||||
|
|
@ -1,10 +1,11 @@
|
|||
#lang typed/racket
|
||||
|
||||
(require (submod "graph/test-map4-get.rkt" test))
|
||||
|
||||
(require "type-expander/type-expander.lp2.rkt")
|
||||
(require "type-expander/multi-id.lp2.rkt")
|
||||
(require "graph/variant.lp2.rkt")
|
||||
|
||||
|
||||
(define-type from (List (Pairof Number Boolean)
|
||||
(Listof (U Number (Pairof Number String)))))
|
||||
(define-type to (List (Pairof String Boolean)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user