summary refs log tree commit diff
path: root/source/xi/plugin_manager.ml
blob: 3c6cdf05822f8626e21b1087b70b1aa99d2ce129 (plain) (blame)
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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
open Xi_lib
open Plugin_register

type plugin = string * (module Plugin.PLUGIN)

module Getters = struct

  let make_live_variables_analysis (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_live_variables_analysis with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_dominators_analysis (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_dominators_analysis with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_reachability_analysis (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_reachability_analysis with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_scheduler (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_scheduler with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_natural_loops_analysis (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_natural_loops_analysis with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_spill_costs_analysis (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_spill_costs_analysis with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let lexer_and_parser (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.lexer_and_parser with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_typechecker (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_typechecker with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_translator (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_translator with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_jump_threading (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_jump_threading with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_constant_folding (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_constant_folding with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_hilower (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_hilower with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_callconv (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_callconv with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_mipslower (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_mipslower with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_register_allocator (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_register_allocator with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_dead_code_elimination (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_dead_code_elimination with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_codegen (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_codegen with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_constant_folding_analysis (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_constant_folding_analysis with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_interference_graph_analysis (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_interference_graph_analysis with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None

  let make_spilling (name, plugin) =
    let module Plugin = (val plugin : Plugin.PLUGIN) in
    match Plugin.make_spilling with
    | Some x -> Some (name, Plugin.version, x)
    | None -> None
end

module Resolver = struct

  let rec find_module name getter = function
    | [] ->
      failwith @@ Format.sprintf "Cannot find %s" name
    | x::xs ->
      match getter x with
      | Some (modname, version, impl) ->
        Format.eprintf "module %s=%s:%s\n%!" name modname version;
        impl
      | None -> 
        find_module name getter xs

  let make_live_variables_analysis = find_module "MakeLiveVariablesAnalysis" Getters.make_live_variables_analysis

  let make_dominators_analysis = find_module "MakeDominanceAnalysis" Getters.make_dominators_analysis

  let make_reachability_analysis = find_module "MakeReachabilityAnalysis" Getters.make_reachability_analysis

  let make_scheduler = find_module "MakeScheduler" Getters.make_scheduler

  let make_natural_loops_analysis = find_module "MakeNaturalLoopsAnalysis" Getters.make_natural_loops_analysis

  let make_spill_costs_analysis = find_module "MakeSpillCostsAnalysis" Getters.make_spill_costs_analysis

  let lexer_and_parser = find_module "LexerAndParser" Getters.lexer_and_parser

  let make_typechecker = find_module "MakeTypechecker" Getters.make_typechecker

  let make_translator = find_module "MakeTranslator" Getters.make_translator

  let make_jump_threading = find_module "MakeJumpThreading" Getters.make_jump_threading

  let make_constant_folding = find_module "MakeConstantFolding" Getters.make_constant_folding

  let make_hilower = find_module "MakeHiLower" Getters.make_hilower

  let make_callconv = find_module "MakeCallConv" Getters.make_callconv

  let make_mipslower = find_module "MakeMipsLower" Getters.make_mipslower

  let make_register_allocator = find_module "MakeRegisterAllocator" Getters.make_register_allocator

  let make_dead_code_elimination = find_module "MakeDeadCodeElimination" Getters.make_dead_code_elimination

  let make_codegen = find_module "MakeCodegen" Getters.make_codegen

  let make_constant_folding_analysis = find_module "MakeConstantFoldingAnalysis" Getters.make_constant_folding_analysis

  let make_interference_graph_analysis = find_module "MakeInterferenceGraphAnalysis" Getters.make_interference_graph_analysis

  let make_spilling = find_module "MakeSpilling" Getters.make_spilling

end

let resolve_compiler_toolbox regdescr =
  let module MakeLiveVariablesAnalysis = (val Resolver.make_live_variables_analysis !register) in
  let module MakeDominatorsAnalysis = (val Resolver.make_dominators_analysis !register) in
  let module MakeNaturalLoopsAnalysis = (val Resolver.make_natural_loops_analysis !register) in
  let module MakeSpillCostsAnalysis = (val Resolver.make_spill_costs_analysis !register) in
  let module MakeScheduler = (val Resolver.make_scheduler !register) in
  let module MakeConstantFoldingAnalysis = (val Resolver.make_constant_folding_analysis !register) in
  let module MakeInterferenceGraphAnalysis = (val Resolver.make_interference_graph_analysis !register) in
  let module MakeSpilling = (val Resolver.make_spilling !register) in
  let module MakeReachabilityAnalysis = (val Resolver.make_reachability_analysis !register) in
  let module M = struct
    module LiveVariablesAnalysis = MakeLiveVariablesAnalysis()
    module DominatorsAnalysis = MakeDominatorsAnalysis()
    module Scheduler = MakeScheduler()
    module NaturalLoopsAnalysis = MakeNaturalLoopsAnalysis()
    module SpillCostsAnalysis = MakeSpillCostsAnalysis()
    module RegistersDescription = (val regdescr : Ir_arch.REGISTERS_DESCRIPTION)
    module ConstantFoldingAnalysis = MakeConstantFoldingAnalysis()
    module InterferenceGraphAnalysis = MakeInterferenceGraphAnalysis()
    module Spilling = MakeSpilling()
    module ReachabilityAnalysis = MakeReachabilityAnalysis()
  end in
  (module M : Iface.COMPILER_TOOLBOX)

let resolve_compiler_steps regdescr =
  let module CompilerToolbox = (val resolve_compiler_toolbox regdescr : Iface.COMPILER_TOOLBOX) in 
  let module LexerAndParser = (val Resolver.lexer_and_parser !register) in
  let module MakeTypechecker = (val Resolver.make_typechecker !register) in 
  let module MakeTranslator = (val Resolver.make_translator !register) in
  let module MakeJumpThreading = (val Resolver.make_jump_threading !register) in
  let module MakeConstantFolding = (val Resolver.make_constant_folding !register) in
  let module MakeHiLower = (val Resolver.make_hilower !register) in
  let module MakeCallConv = (val Resolver.make_callconv !register) in
  let module MakeMipsLower = (val Resolver.make_mipslower !register) in
  let module MakeRegisterAllocator = (val Resolver.make_register_allocator !register) in
  let module MakeDeadCodeElimination = (val Resolver.make_dead_code_elimination !register) in
  let module MakeCodegen = (val Resolver.make_codegen !register) in

  let module Steps = struct
    module Toolbox = CompilerToolbox
    module LexerAndParser = LexerAndParser
    module Typechecker = MakeTypechecker()
    module Translator = MakeTranslator()
    module JumpThreading = MakeJumpThreading()
    module HiLower = MakeHiLower(CompilerToolbox)
    module CallConv = MakeCallConv(CompilerToolbox)
    module MipsLower = MakeMipsLower(CompilerToolbox)
    module RegisterAllocator = MakeRegisterAllocator(CompilerToolbox)
    module ConstantFolding = MakeConstantFolding(CompilerToolbox)
    module DeadCodeElimination = MakeDeadCodeElimination(CompilerToolbox)
    module Codegen = MakeCodegen(CompilerToolbox)
  end in 

  (module Steps : Iface.COMPILER_STEPS)

let load_plugin path = 
  try 
    Plugin_register.current_file := Filename.basename path;
    Dynlink.loadfile path;
    Plugin_register.current_file := "";
  with Dynlink.Error e ->
    failwith @@ Format.sprintf "Cannot load plugin '%s': %s" path (Dynlink.error_message e)