aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/control/function/polymorphism/type.lux
blob: 475c3053b0aec2e20af54fc959fb33e9d1238493 (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
(.require
 [library
  [lux (.except def)
   [abstract
    [monad (.only do)]]
   [control
    ["?" parser (.use "[1]#[0]" monad)]]
   [data
    ["[0]" text (.use "[1]#[0]" equivalence)]
    [collection
     ["[0]" list (.use "[1]#[0]" functor)]]]
   ["[0]" meta (.only)
    ["[0]" code (.only)
     ["?[1]" \\parser (.only Parser)]]
    ["[0]" macro (.only with_symbols)
     ["[0]" context]
     [syntax (.only syntax)
      ["[0]" export]]]
    [type
     [implicit (.only a/an)]]]]])

(type Polymorphism
  (Record
   [#name Text
    #export_policy Code
    #interface Code
    #method Code]))

(context.def
  [stack]
  [expression]
  [declaration]
  Polymorphism)

(.def .public def
  (syntax (_ [[export_policy name parameters type methods]
              (export.with
                (all ?.and
                     ?code.local
                     (?code.tuple (?.many ?code.local))
                     ?code.any
                     (?.many ?code.any)))])
    (<| (do meta.monad
          [@ meta.current_module_name
           g!interface (macro.symbol name)
           g!method (macro.symbol name)])
        (with_symbols [g!_ g!inputs])
        (..declaration [#name name #export_policy export_policy #interface g!interface #method g!method])
        (let [name (code.local name)
              parameters (list#each code.local parameters)])
        (` (these (type (, export_policy) (, g!interface)
                    (Interface
                     (is (All ((, g!_) (,* parameters))
                           (, type))
                         (, g!method))))
                  (.def (, export_policy) (, name)
                    (syntax ((, g!_) [(, g!inputs) (?.many ?code.any)])
                      (of meta.monad (,' in)
                          (list (` (a/an (, g!method) ((,' .,*) (, g!inputs))))))))
                  (,* methods))))))

(.def method_declaration
  (Parser [Text (List Code)])
  (?.either (?code.form (?.and ?code.local (?.some ?code.any)))
            (?.and ?code.local (?#in (list)))))

(.def .public method
  (syntax (_ [[[name inputs] specialization body]
              (all ?.and
                   ..method_declaration
                   (?code.tuple (?.many ?code.any))
                   ?code.any)])
    (do meta.monad
      [it (context.search (|>> (the #name) (text#= name)) ..stack)
       .let [name (code.local name)]]
      (with_symbols [g!self]
        (in (list (` (.def (, (the #export_policy it)) (, g!self)
                       ((, (the #interface it)) (,* specialization))
                       (implementation
                        (.def ((, (the #method it)) (,* inputs))
                          (, body)))))))))))