aboutsummaryrefslogtreecommitdiff
path: root/src/lux/host/generics.clj
blob: df04d93056d6a03f1d49a4d8b499306912723d58 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
;;  Copyright (c) Eduardo Julian. All rights reserved.
;;  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
;;  If a copy of the MPL was not distributed with this file,
;;  You can obtain one at http://mozilla.org/MPL/2.0/.

(ns lux.host.generics
  (:require (clojure [template :refer [do-template]])
            clojure.core.match
            clojure.core.match.array
            (lux [base :as & :refer [|do return* return fail fail* |let |case]]
                 [host :as &host])))

(defn super-class-name [super]
  "(-> GenericSuperClassDecl Text)"
  (|let [[super-name super-params] super]
    super-name))

(defn gclass->signature [super]
  "(-> GenericClass Text)"
  (|case super
    (&/$GTypeVar name)
    (str "T" name ";")
    
    (&/$GClass name params)
    (|let [params-sigs (->> params (&/|map gclass->signature) (&/|interpose " ") (&/fold str ""))]
      (str "L" (&host/->class name) "<" params-sigs ">" ";"))))

(defn gsuper-decl->signature [super]
  "(-> GenericSuperClassDecl Text)"
  (|let [[super-name super-params] super
         params-sigs (->> super-params (&/|map gclass->signature) (&/|interpose " ") (&/fold str ""))]
    (str "L" (&host/->class super-name) "<" params-sigs ">" ";")))

(defn gclass-decl->signature [class-decl supers]
  "(-> GenericClassDecl (List GenericSuperClassDecl) Text)"
  (|let [[class-name class-vars] class-decl
         vars-section (str "<" (->> class-vars (&/|interpose " ") (&/fold str "")) ">")
         super-section (->> (&/|map gsuper-decl->signature supers) (&/|interpose " ") (&/fold str ""))]
    (str vars-section super-section)))

(let [object-simple-signature (&host/->type-signature "java.lang.Object")]
  (defn gclass->simple-signature [gclass]
    "(-> GenericClass Text)"
    (|case gclass
      (&/$GTypeVar name)
      object-simple-signature
      
      (&/$GClass name params)
      (&host/->type-signature name))))