Refactor abbrev modules in TR
Removed redundant whitespace and lines. Reworded/reformatted comments for consistency. original commit: 89c71b4e0486f34e801b00d0d611ae4f6ef03ef1
This commit is contained in:
Asumu Takikawa
parent
1ee060a9aa
commit
538bcb518e
|
|
@ -1,5 +1,9 @@
|
|||
#lang racket/base
|
||||
|
||||
;; This module provides abbreviations that are used to construct types
|
||||
;; and data that show up in types. These are intended for internal use
|
||||
;; within Typed Racket implementation code.
|
||||
|
||||
(require "../utils/utils.rkt"
|
||||
racket/list
|
||||
racket/match
|
||||
|
|
@ -21,17 +25,14 @@
|
|||
racket/tcp racket/flonum
|
||||
'#%place) ;; avoid the other dependencies of `racket/place`
|
||||
|
||||
|
||||
(provide (except-out (all-defined-out) make-Base)
|
||||
(all-from-out "base-abbrev.rkt" "match-expanders.rkt"))
|
||||
|
||||
;; all the types defined here are not numeric
|
||||
;; All the types defined here are not numeric
|
||||
(define (make-Base name contract predicate)
|
||||
(make-Base* name contract predicate #f))
|
||||
|
||||
;; convenient constructors
|
||||
|
||||
|
||||
;; Convenient constructors
|
||||
(define -App make-App)
|
||||
(define -mpair make-MPair)
|
||||
(define -Param make-Param)
|
||||
|
|
@ -42,26 +43,21 @@
|
|||
(define -set make-Set)
|
||||
(define -vec make-Vector)
|
||||
(define -future make-Future)
|
||||
|
||||
(define (-seq . args) (make-Sequence args))
|
||||
|
||||
(define (one-of/c . args)
|
||||
(apply Un (map -val args)))
|
||||
|
||||
(define (-opt t) (Un (-val #f) t))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define (-Tuple l)
|
||||
(foldr -pair (-val '()) l))
|
||||
|
||||
(define (-Tuple* l b)
|
||||
(foldr -pair b l))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;; convenient constructor for Values
|
||||
;; Convenient constructor for Values
|
||||
;; (wraps arg types with Result)
|
||||
(define/cond-contract (-values args)
|
||||
(c:-> (c:listof Type/c) (c:or/c Type/c Values?))
|
||||
|
|
@ -69,7 +65,7 @@
|
|||
;[(list t) t]
|
||||
[_ (make-Values (for/list ([i (in-list args)]) (-result i)))]))
|
||||
|
||||
;; convenient constructor for ValuesDots
|
||||
;; Convenient constructor for ValuesDots
|
||||
;; (wraps arg types with Result)
|
||||
(define/cond-contract (-values-dots args dty dbound)
|
||||
(c:-> (c:listof Type/c) Type/c (c:or/c symbol? c:natural-number/c)
|
||||
|
|
@ -77,19 +73,14 @@
|
|||
(make-ValuesDots (for/list ([i (in-list args)]) (-result i))
|
||||
dty dbound))
|
||||
|
||||
;; basic types
|
||||
|
||||
|
||||
|
||||
;; Basic types
|
||||
(define -Listof (-poly (list-elem) (make-Listof list-elem)))
|
||||
|
||||
(define/decl -Boolean (Un -False -True))
|
||||
(define/decl -Undefined
|
||||
(make-Base 'Undefined
|
||||
#'(lambda (x) (equal? (letrec ([y y]) y) x)) ; initial value of letrec bindings
|
||||
(lambda (x) (equal? (letrec ([y y]) y) x))))
|
||||
(define/decl -Bytes (make-Base 'Bytes #'bytes? bytes?))
|
||||
|
||||
(define/decl -Base-Regexp (make-Base 'Base-Regexp
|
||||
#'(and/c regexp? (not/c pregexp?))
|
||||
(conjoin regexp? (negate pregexp?))))
|
||||
|
|
@ -97,7 +88,6 @@
|
|||
#'pregexp?
|
||||
pregexp?))
|
||||
(define/decl -Regexp (Un -PRegexp -Base-Regexp))
|
||||
|
||||
(define/decl -Byte-Base-Regexp
|
||||
(make-Base 'Byte-Base-Regexp
|
||||
#'(and/c byte-regexp? (not/c byte-pregexp?))
|
||||
|
|
@ -105,16 +95,7 @@
|
|||
(define/decl -Byte-PRegexp
|
||||
(make-Base 'Byte-PRegexp #'byte-pregexp? byte-pregexp?))
|
||||
(define/decl -Byte-Regexp (Un -Byte-Base-Regexp -Byte-PRegexp))
|
||||
|
||||
(define/decl -Pattern (Un -Bytes -Regexp -Byte-Regexp -String))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define/decl -Keyword (make-Base 'Keyword #'keyword? keyword?))
|
||||
(define/decl -Thread (make-Base 'Thread #'thread? thread?))
|
||||
(define/decl -Module-Path
|
||||
|
|
@ -151,9 +132,7 @@
|
|||
(define/decl -Input-Port (make-Base 'Input-Port #'input-port? input-port?))
|
||||
(define/decl -TCP-Listener (make-Base 'TCP-Listener #'tcp-listener? tcp-listener?))
|
||||
(define/decl -UDP-Socket (make-Base 'UDP-Socket #'udp? udp?))
|
||||
|
||||
(define/decl -FlVector (make-Base 'FlVector #'flvector? flvector?))
|
||||
|
||||
(define -Syntax make-Syntax)
|
||||
(define/decl In-Syntax
|
||||
(-mu e
|
||||
|
|
@ -162,9 +141,7 @@
|
|||
(make-Box (-Syntax e))
|
||||
(make-Listof (-Syntax e))
|
||||
(-pair (-Syntax e) (-Syntax e)))))
|
||||
|
||||
(define/decl Any-Syntax (-Syntax In-Syntax))
|
||||
|
||||
(define (-Sexpof t)
|
||||
(-mu sexp
|
||||
(Un (-val '())
|
||||
|
|
@ -173,24 +150,13 @@
|
|||
(make-Vector sexp)
|
||||
(make-Box sexp)
|
||||
t)))
|
||||
|
||||
(define/decl -Sexp (-Sexpof (Un)))
|
||||
|
||||
(define Syntax-Sexp (-Sexpof Any-Syntax))
|
||||
|
||||
(define Ident (-Syntax -Symbol))
|
||||
|
||||
|
||||
|
||||
|
||||
(define -HT make-Hashtable)
|
||||
|
||||
(define/decl -HashTop (make-HashtableTop))
|
||||
(define/decl -VectorTop (make-VectorTop))
|
||||
|
||||
|
||||
(define/decl -Port (Un -Output-Port -Input-Port))
|
||||
|
||||
(define/decl -SomeSystemPath (Un -Path -OtherSystemPath))
|
||||
(define/decl -Pathlike (Un -String -Path))
|
||||
(define/decl -SomeSystemPathlike (Un -String -SomeSystemPath))
|
||||
|
|
@ -198,36 +164,21 @@
|
|||
(define/decl -SomeSystemPathlike*
|
||||
(Un -String -SomeSystemPath(-val 'up) (-val 'same)))
|
||||
(define/decl -PathConventionType (Un (-val 'unix) (-val 'windows)))
|
||||
|
||||
|
||||
|
||||
(define/decl -Pretty-Print-Style-Table
|
||||
(make-Base 'Pretty-Print-Style-Table #'pretty-print-style-table? pretty-print-style-table?))
|
||||
|
||||
|
||||
(define/decl -Read-Table
|
||||
(make-Base 'Read-Table #'readtable? readtable?))
|
||||
|
||||
(define/decl -Special-Comment
|
||||
(make-Base 'Special-Comment #'special-comment? special-comment?))
|
||||
|
||||
(define/decl -Custodian (make-Base 'Custodian #'custodian? custodian?))
|
||||
|
||||
(define/decl -Parameterization (make-Base 'Parameterization #'parameterization? parameterization?))
|
||||
|
||||
|
||||
(define/decl -Inspector (make-Base 'Inspector #'inspector inspector?))
|
||||
|
||||
(define/decl -Namespace-Anchor (make-Base 'Namespace-Anchor #'namespace-anchor? namespace-anchor?))
|
||||
|
||||
(define/decl -Variable-Reference (make-Base 'Variable-Reference #'variable-reference? variable-reference?))
|
||||
|
||||
|
||||
(define/decl -Internal-Definition-Context
|
||||
(make-Base 'Internal-Definition-Context
|
||||
#'internal-definition-context?
|
||||
internal-definition-context?))
|
||||
|
||||
(define/decl -Subprocess
|
||||
(make-Base 'Subprocess #'subprocess? subprocess?))
|
||||
(define/decl -Security-Guard
|
||||
|
|
@ -238,47 +189,33 @@
|
|||
(make-Base 'Struct-Type-Property #'struct-type-property? struct-type-property?))
|
||||
(define/decl -Impersonator-Property
|
||||
(make-Base 'Impersonator-Property #'impersonator-property? impersonator-property?))
|
||||
|
||||
|
||||
|
||||
|
||||
(define/decl -Semaphore (make-Base 'Semaphore #'semaphore? semaphore?))
|
||||
(define/decl -Bytes-Converter (make-Base 'Bytes-Converter #'bytes-converter? bytes-converter?))
|
||||
(define/decl -Pseudo-Random-Generator
|
||||
(make-Base 'Pseudo-Random-Generator #'pseudo-random-generator? pseudo-random-generator?))
|
||||
|
||||
|
||||
(define/decl -Logger (make-Base 'Logger #'logger? logger?))
|
||||
(define/decl -Log-Receiver (make-Base 'LogReceiver #'log-receiver? log-receiver?))
|
||||
(define/decl -Log-Level (one-of/c 'fatal 'error 'warning 'info 'debug))
|
||||
|
||||
|
||||
(define/decl -Place (make-Base 'Place #'place? place?))
|
||||
(define/decl -Base-Place-Channel
|
||||
(make-Base 'Base-Place-Channel #'(and/c place-channel? (not/c place?)) (conjoin place-channel? (negate place?))))
|
||||
|
||||
(define/decl -Place-Channel (Un -Place -Base-Place-Channel))
|
||||
|
||||
(define/decl -Will-Executor
|
||||
(make-Base 'Will-Executor #'will-executor? will-executor?))
|
||||
|
||||
|
||||
|
||||
;; Paths
|
||||
(define/decl -car (make-CarPE))
|
||||
(define/decl -cdr (make-CdrPE))
|
||||
(define/decl -syntax-e (make-SyntaxPE))
|
||||
(define/decl -force (make-ForcePE))
|
||||
|
||||
|
||||
;; function type constructors
|
||||
|
||||
(define/decl top-func (make-Function (list (make-top-arr))))
|
||||
|
||||
|
||||
;; Structs
|
||||
(define (-struct name parent flds [proc #f] [poly #f] [pred #'dummy])
|
||||
(make-Struct name parent flds proc poly pred))
|
||||
|
||||
;; Function type constructors
|
||||
(define/decl top-func (make-Function (list (make-top-arr))))
|
||||
|
||||
(define (asym-pred dom rng filter)
|
||||
(make-Function (list (make-arr* (list dom) rng #:filters filter))))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,9 +1,12 @@
|
|||
#lang racket/base
|
||||
;; This file is for the abbreviations need to implement union.rkt
|
||||
|
||||
(require "../utils/utils.rkt")
|
||||
;; This file is for the abbreviations needed to implement union.rkt
|
||||
;;
|
||||
;; The "abbrev.rkt" module imports this module, re-exports it, and
|
||||
;; extends it with more types and type abbreviations.
|
||||
|
||||
(require (rep type-rep filter-rep object-rep rep-utils)
|
||||
(require "../utils/utils.rkt"
|
||||
(rep type-rep filter-rep object-rep rep-utils)
|
||||
(env mvar-env)
|
||||
racket/match racket/list (prefix-in c: (contract-req))
|
||||
(for-syntax racket/base syntax/parse racket/list)
|
||||
|
|
@ -28,7 +31,7 @@
|
|||
(begin (define id e)
|
||||
(declare-predefined-type! id)))
|
||||
|
||||
;Top and error types
|
||||
;; Top and error types
|
||||
(define/decl Univ (make-Univ))
|
||||
(define/decl -Bottom (make-Union null))
|
||||
(define/decl Err (make-Error))
|
||||
|
|
@ -36,11 +39,10 @@
|
|||
(define/decl -False (make-Value #f))
|
||||
(define/decl -True (make-Value #t))
|
||||
|
||||
;A Type that corresponds to the any contract for the
|
||||
;return type of functions
|
||||
;; A Type that corresponds to the any contract for the
|
||||
;; return type of functions
|
||||
(define/decl ManyUniv (make-AnyValues))
|
||||
|
||||
;;Convinient constructors
|
||||
(define -val make-Value)
|
||||
|
||||
;; Char type and List type (needed because of how sequences are checked in subtype)
|
||||
|
|
@ -60,11 +62,7 @@
|
|||
(define (-lst* #:tail [tail (-val null)] . args)
|
||||
(for/fold ([tl tail]) ([a (in-list (reverse args))]) (-pair a tl)))
|
||||
|
||||
|
||||
;; Simple union type, does not check for overlaps
|
||||
|
||||
|
||||
;; Union constructor
|
||||
;; Simple union type constructor, does not check for overlaps
|
||||
;; Normalizes representation by sorting types.
|
||||
;; Type * -> Type
|
||||
;; The input types can be union types, but should not have a complicated
|
||||
|
|
@ -101,18 +99,17 @@
|
|||
(let ([var (-v var)])
|
||||
(make-Mu 'var ty))]))
|
||||
|
||||
;;Results
|
||||
;; Results
|
||||
(define/cond-contract (-result t [f -no-filter] [o -no-obj])
|
||||
(c:->* (Type/c) (FilterSet? Object?) Result?)
|
||||
(make-Result t f o))
|
||||
|
||||
;;Filters
|
||||
;; Filters
|
||||
(define/decl -top (make-Top))
|
||||
(define/decl -bot (make-Bot))
|
||||
(define/decl -no-filter (make-FilterSet -top -top))
|
||||
(define/decl -no-obj (make-Empty))
|
||||
|
||||
|
||||
(define/cond-contract (-FS + -)
|
||||
(c:-> Filter/c Filter/c FilterSet?)
|
||||
(make-FilterSet + -))
|
||||
|
|
@ -144,7 +141,6 @@
|
|||
[(Path: p i) (-not-filter t i p)]
|
||||
[_ -top]))
|
||||
|
||||
|
||||
;; Function types
|
||||
(define/cond-contract (make-arr* dom rng
|
||||
#:rest [rest #f] #:drest [drest #f] #:kws [kws null]
|
||||
|
|
@ -266,8 +262,7 @@
|
|||
(define (make-arr-dots dom rng dty dbound)
|
||||
(make-arr* dom rng #:drest (cons dty dbound)))
|
||||
|
||||
|
||||
;; convenient syntax
|
||||
;; Convenient syntax for polymorphic types
|
||||
(define-syntax -poly
|
||||
(syntax-rules ()
|
||||
[(_ (vars ...) ty)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user