aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/target/jvm/type/descriptor.lux
blob: 6f36f544b8fe79640320d41006c6923d87992f8c (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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
(.module:
  [library
   [lux (#- int char)
    [abstract
     [equivalence (#+ Equivalence)]]
    [data
     ["." maybe]
     ["." text ("#\." equivalence)
      ["%" format (#+ format)]]
     [collection
      ["." list ("#\." functor)]]]
    [math
     [number
      ["n" nat]]]
    [type
     abstract]]]
  ["." // #_
   [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter Declaration)]
   ["/#" // #_
    [encoding
     ["#." name (#+ Internal External)]]]])

(abstract: #export (Descriptor category)
  Text

  (def: #export descriptor
    (-> (Descriptor Any) Text)
    (|>> :representation))

  (template [<sigil> <category> <name>]
    [(def: #export <name>
       (Descriptor <category>)
       (:abstraction <sigil>))]

    ["V" Void void]
    ["Z" Primitive boolean]
    ["B" Primitive byte]
    ["S" Primitive short]
    ["I" Primitive int]
    ["J" Primitive long]
    ["F" Primitive float]
    ["D" Primitive double]
    ["C" Primitive char]
    )

  (def: #export class_prefix "L")
  (def: #export class_suffix ";")

  (def: #export class
    (-> External (Descriptor Class))
    (|>> ///name.internal
         ///name.read
         (text.enclosed [..class_prefix ..class_suffix])
         :abstraction))

  (def: #export (declaration name)
    (-> External (Descriptor Declaration))
    (:transmutation (..class name)))

  (def: #export as_class
    (-> (Descriptor Declaration) (Descriptor Class))
    (|>> :transmutation))

  (template [<name> <category>]
    [(def: #export <name>
       (Descriptor <category>)
       (:transmutation
        (..class "java.lang.Object")))]

    [var Var]
    [wildcard Parameter]
    )

  (def: #export (lower descriptor)
    (-> (Descriptor Class) (Descriptor Parameter))
    ..wildcard)

  (def: #export upper
    (-> (Descriptor Class) (Descriptor Parameter))
    (|>> :transmutation))
  
  (def: #export array_prefix "[")

  (def: #export array
    (-> (Descriptor Value)
        (Descriptor Array))
    (|>> :representation
         (format ..array_prefix)
         :abstraction))

  (def: #export (method [inputs output])
    (-> [(List (Descriptor Value))
         (Descriptor Return)]
        (Descriptor Method))
    (:abstraction
     (format (|> inputs
                 (list\map ..descriptor)
                 (text.join_with "")
                 (text.enclosed ["(" ")"]))
             (:representation output))))

  (implementation: #export equivalence
    (All [category] (Equivalence (Descriptor category)))
    
    (def: (= parameter subject)
      (text\= (:representation parameter) (:representation subject))))

  (def: #export class_name
    (-> (Descriptor Object) Internal)
    (let [prefix_size (text.size ..class_prefix)
          suffix_size (text.size ..class_suffix)]
      (function (_ descriptor)
        (let [repr (:representation descriptor)]
          (if (text.starts_with? ..array_prefix repr)
            (///name.internal repr)
            (|> repr
                (text.clip prefix_size
                           (|> (text.size repr)
                               (n.- prefix_size)
                               (n.- suffix_size)))
                (\ maybe.monad map ///name.internal)
                maybe.assume))))))
  )