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
let print s = Format.ifprintf Format.std_formatter "%s@." s
module M () = struct
module Lexer = Lexer
module Parser = Parser
type ast = Lang.t
module Types = Types.Make ()
type ast_t = Types.type_expression
let expected_ext = Some "dddddml"
module Pp = Pp.Make (Types)
module Error = Error.Make (struct
module Pp = Pp
module Types = Types
end)
let normalize ast =
print "analysing scope..." ;
let module M = Scope_analysis.Make (struct
module Error = Error
end) in
let ast = M.expr ast in
let module Env = struct
let get_old_name = Hashtbl.find M.old_names
end in
print "usage analysis..." ;
let module M = Usage_analysis.Make (struct
let get_old_name = Env.get_old_name
module Error = Error
end) in
M.expr ast ;
print "type analysis..." ;
let module M = Type_analysis.Make (struct
module Error = Error
end) in
let get_cons_type = M.expr ast in
print "infering types..." ;
let module M = Type_inference.Make (struct
let get_cons_type = get_cons_type
module Error = Error
module Types = Types
end) in
let t = M.expr ast in
print "type checking..." ;
let module M = Type_check.Make (struct
let get_type = Hashtbl.find M.infered
let get_cons_type = get_cons_type
module Error = Error
module Types = Types
end) in
M.expr ast ;
print "OK !" ;
print "simplification analysis..." ;
let module M = Simplification_analysis.Make (struct
let get_old_name = Env.get_old_name
module Error = Error
module Pp = Pp
end) in
M.expr ast ;
print "scope reduction analysis..." ;
let module M = Scope_reduction.Make (struct
let get_old_name = Env.get_old_name
module Error = Error
module Pp = Pp
end) in
M.expr ast ;
print "duplication analysis..." ;
let module M = Duplication_detection.Make (struct
module Error = Error
end) in
M.expr ast ; (ast, t)
let eval ast =
let module M = Eval.Eval () in
try
let ast, t = normalize ast in
let result = M.expr ast in
Ok (Format.asprintf "%a" Pp.fprintf_et (result, t))
with e -> Error (Format.asprintf "%a" Error.fprintf e)
let eval_lambdalift ast =
let module M = Eval.Eval () in
let module Lambda_lifting = Lambda_lifting.Make () in
let ast, _t = normalize ast in
let ast_lambda = Lambda_lifting.expr ast in
Format.printf "%a@." Pp.fprintf_expr ast_lambda
end
module Make () = struct
module M = M ()
include Complice.Comp.Make (M)
let _ = Lexer.Helper.reset ()
type ast_t = M.ast_t
let expected_ext = Some "dddddml"
module Pp = M.Pp
module Error = M.Error
let eval_lambdalift = M.eval_lambdalift
end