Implement type aliases

Author: AlexKnauth

hackett-doc/scribblings/hackett/reference.scrbl

@@ -107,7 +107,7 @@ following combination of @racket[def], @racket[lambda], and @racket[case*]:
 The @racket[defn] form is generally preferred when defining top-level functions.
 
 @(hackett-examples
-  (defn square : (t:-> t:Integer t:Integer)
+  (defn square : {t:Integer t:-> t:Integer}
     [[x] {x * x}])
   (eval:check (square 5) 25))}
 
@@ -308,6 +308,49 @@ specified controls the fixity used by the associated @racket[type-constructor-id
   {(Leaf 1) :&: (Leaf 2) :&: (Leaf 3)})}
 @(close-eval data-examples-eval)
 
+@subsection[#:tag "reference-type-alias"]{Defining type aliases}
+
+@(define alias-examples-eval (make-hackett-eval))
+@defform[#:literals [left right]
+         (type type-clause type-expr)
+         #:grammar
+         ([type-clause name-id
+                       (code:line (name-id param-id ...+))])]{
+
+Defines a @deftech{type alias} named @racket[name-id]. Uses of @racket[name-id] are equivalent to
+uses of the type specified in @racket[type-expr]. If @racket[type-clause] is a bare @racket[name-id],
+then @racket[name-id] is bound directly to the type alias.
+
+@(hackett-examples
+  #:eval alias-examples-eval
+  (type Num Double)
+  (def n : Num 1.5)
+  (#:type n))
+
+@margin-note{
+  Type aliases with @racket[param-id]s can only be used with prefix notation, using
+  @racket[(name-id type-argument ...)] rather than
+  @racket[{type-argument name-id type-argument}].}
+
+If @racket[param-id]s are specified, then uses of the type alias must supply as many arguments as
+there are @racket[param-id]s. The arguments are supplied like those to a type constructor—i.e. 
+@racket[(name-id type-argument ...)]—and the resulting type is @racket[type-expr] with each
+@racket[param-id] substituted with the corresponding @racket[type-argument].
+
+Though the application of a type alias is syntactically similar to the application of a type
+constructor, type aliases are effectively type-level macros, and they may not be partially applied.
+All uses of a type alias must be fully saturated.
+
+@(hackett-examples
+  #:eval alias-examples-eval
+  (type (Predicate a) {a t:-> t:Bool})
+  (def zero? : (Predicate t:Integer) (== 0))
+  (#:type zero?)
+  (eval:check (zero? 0) True)
+  (eval:check ((: zero? (Predicate t:Integer)) 0) True)
+  (eval:error (: zero? Predicate)))
+@(close-eval alias-examples-eval)}
+
 @subsection[#:tag "reference-numbers"]{Numbers}
 
 @deftype[t:Integer]{

hackett-lib/hackett/base.rkt

@@ -1,11 +1,13 @@
 #lang racket/base
 
 (require (only-in hackett/private/adt case* case λ λ* lambda lambda* defn _)
+         (only-in hackett/private/type-alias type)
          (only-in hackett/private/class instance derive-instance)
          (except-in hackett/private/kernel λ lambda)
          hackett/private/provide
          (only-in hackett/private/toplevel @%top-interaction))
 (provide (all-from-out hackett/private/adt)
+         (all-from-out hackett/private/type-alias)
          (all-from-out hackett/private/class)
          (all-from-out hackett/private/kernel)
          (all-from-out hackett/private/provide)

hackett-lib/hackett/private/infix.rkt

@@ -35,7 +35,9 @@
 (define (infix-operator? x)
   (and (has-prop:infix-operator? x)
        (operator-fixity? (infix-operator-fixity x))))
-  
+
+; Infix transformer bindings; use the make-infix-variable-like-transformer constructor instead of
+; creating instances of this struct directly.
 (struct infix-variable-like-transformer (procedure fixity)
   #:property prop:procedure (struct-field-index procedure)
   #:property prop:infix-operator

hackett-lib/hackett/private/type-alias.rkt

@@ -0,0 +1,59 @@
+#lang curly-fn racket/base
+
+(require (for-syntax racket/base
+                     racket/format
+
+                     hackett/private/infix
+                     hackett/private/typecheck
+                     hackett/private/util/stx)
+         syntax/parse/define
+
+         (only-in hackett/private/adt type-constructor-spec))
+
+(provide type)
+
+(begin-for-syntax
+  ; Alias transformer bindings; use the make-alias-transformer constructor instead of creating
+  ; instances of this struct directly.
+  (struct alias-transformer (procedure)
+    #:property prop:procedure (struct-field-index procedure))
+
+  (define (make-alias-transformer args type-template)
+    (let ([arity (length args)])
+      (alias-transformer
+       (cond
+         [(zero? arity)
+          (make-variable-like-transformer type-template)]
+         [else
+          (syntax-parser
+            [(_ t:type ...)
+             #:fail-unless (= (length (attribute t)) arity)
+                           (~a "expected " arity " argument(s) to type alias, got "
+                               (length (attribute t)))
+             (insts type-template (map cons args (attribute t)))]
+            [:id
+             #:fail-when #t (~a "expected " arity " argument(s) to type alias")
+             (error "unreachable")])])))))
+
+
+(define-syntax-parser type
+  [(_ ctor-spec:type-constructor-spec {~type type-template:expr})
+   #:with [ctor-spec*:type-constructor-spec] (type-namespace-introduce #'ctor-spec)
+   #:fail-when (attribute ctor-spec.fixity) "type aliases do not support infix notation"
+
+   ; Create a dummy internal definition context with args.
+   #:do [(define intdef-ctx (syntax-local-make-definition-context))
+         (syntax-local-bind-syntaxes (attribute ctor-spec*.arg) #f intdef-ctx)]
+   #:with [arg* ...] (map #{internal-definition-context-introduce intdef-ctx %}
+                          (attribute ctor-spec*.arg))
+
+   ; Expanding the type in `ctx` checks immediately that it is a valid type,
+   ; rather than deferring that check to when the type alias is applied.
+   #:with {~var type-template- (type intdef-ctx)} #'type-template
+   #'(begin
+       (define-values [] type-template-.residual)
+       (define-syntax ctor-spec*.tag
+         (make-alias-transformer
+          (list (quote-syntax arg*) ...)
+          (quote-syntax type-template-.expansion))))])
+

hackett-test/tests/hackett/integration/type-alias.rkt

@@ -0,0 +1,31 @@
+#lang hackett
+
+(require hackett/private/test
+         (only-in racket/base submod)
+         (submod tests/hackett/typecheck assertions))
+
+(type X Integer)
+(def x : X 5)
+(typecheck-fail (: "" X))
+
+(type (Arr a b) {a -> b})
+(type (Pred a) (Arr a Bool))
+(type (BiRel a) {a -> a -> Bool})
+
+(type Y (forall [a b] (Monoid b) => (Either a b)))
+
+(typecheck-fail
+ (λ ([x : (Arr Bool)]) ; not enough args to alias
+   x))
+
+(defn never : (forall [a] (Pred a))
+  [[x] False])
+
+(test {(never 5) ==! False})
+(test {(never "asdasaf") ==! False})
+
+(def int= : (BiRel Integer)
+  ==)
+
+(test {{4 int= 6} ==! False})
+(test {{4 int= 4} ==! True})