aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/target/jvm/type/lux.lux
blob: 243861bd41b216cec36b6f4e962138d98c40e401 (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
(.module:
  [lux (#- type)
   [abstract
    ["." monad (#+ do)]]
   [control
    ["." exception (#+ exception:)]]
   [data
    ["." text
     ["%" format (#+ format)]]
    [collection
     [array (#+ Array)]
     ["." dictionary (#+ Dictionary)]]]
   [type
    abstract
    ["." check (#+ Check) ("#@." monad)]]]
  ["." //
   ["#." reflection]
   ["/#" // #_
    [encoding
     ["#." name]]]])

(template [<name>]
  [(abstract: #export (<name> class) {} Any)]

  [Lower] [Upper]
  )

(type: #export Mapping
  (Dictionary //.Var Type))

(def: #export fresh
  Mapping
  (dictionary.new text.hash))

(exception: #export (unknown-var {var //.Var})
  (exception.report
   ["Var" (%.text var)]))

(def: (generic mapping input)
  (-> Mapping //.Generic (Check Type))
  (case input
    (#//.Var var)
    (case (dictionary.get var mapping)
      #.None
      (check.throw ..unknown-var var)
      
      (#.Some type)
      (check@wrap type))
    
    (#//.Wildcard wildcard)
    (case wildcard
      #.None
      (do check.monad
        [[id type] check.existential]
        (wrap type))
      
      (#.Some [bound limit])
      (do check.monad
        [limitT (generic mapping limit)]
        (case bound
          (^template [<tag> <ctor> <limit>]
            <tag>
            ## TODO: Re-enable Lower and Upper, instead of using the
            ## simplified limit.
            ## (wrap (.type (<ctor> limitT)))
            (wrap <limit>))
          ([#//.Lower ..Lower (primitive "java.lang.Object")]
           [#//.Upper ..Upper limitT]))))
    
    (#//.Class name parameters)
    (do check.monad
      [parametersT+ (monad.map @ (generic mapping) parameters)]
      (wrap (#.Primitive name parametersT+)))))

(def: #export (class mapping [name parameters])
  (-> Mapping //.Class (Check Type))
  (do check.monad
    [parametersT+ (monad.map @ (..generic mapping) parameters)]
    (wrap (#.Primitive name parametersT+))))

(def: #export (type mapping input)
  (-> Mapping //.Type (Check Type))
  (case input
    (#//.Primitive primitive)
    (check@wrap (case primitive
                  #//.Boolean (#.Primitive //reflection.boolean #.Nil)
                  #//.Byte (#.Primitive //reflection.byte #.Nil)
                  #//.Short (#.Primitive //reflection.short #.Nil)
                  #//.Int (#.Primitive //reflection.int #.Nil)
                  #//.Long (#.Primitive //reflection.long #.Nil)
                  #//.Float (#.Primitive //reflection.float #.Nil)
                  #//.Double (#.Primitive //reflection.double #.Nil)
                  #//.Char (#.Primitive //reflection.char #.Nil)))
    
    (#//.Generic generic)
    (..generic mapping generic)
    
    (#//.Array elementT)
    (case elementT
      (#//.Primitive primitive)
      (check@wrap (#.Primitive (|> input //reflection.class ///name.internal ///name.read) #.Nil))

      _
      (:: check.monad map
          (|>> Array .type)
          (type mapping elementT)))))

(def: #export (return mapping input)
  (-> Mapping (Maybe //.Type) (Check Type))
  (case input
    #.None
    (check@wrap Any)

    (#.Some input)
    (..type mapping input)))