Commit | Line | Data |
9d759b64 |
1 | package DX::Utils; |
2 | |
3 | use strictures 2; |
4 | use Exporter 'import'; |
5 | |
efad53c4 |
6 | my @const = ( |
d5511afa |
7 | my @dep_types = qw(EXISTENCE_OF TYPE_OF INDICES_OF CONTENTS_OF), |
efad53c4 |
8 | my @ev_types = qw(VALUE_SET VALUE_EXISTS), |
9 | ); |
9d759b64 |
10 | |
efad53c4 |
11 | our @EXPORT_OK = ( |
12 | @const, |
29daa554 |
13 | (my @builders = qw(rspace rstrat res string number dict proposition)), |
c99dbb05 |
14 | 'deparse', '*trace', 'expand_deps', |
efad53c4 |
15 | ); |
16 | |
17 | our %EXPORT_TAGS = ( |
18 | all => \@EXPORT_OK, |
19 | dep_types => \@dep_types, |
20 | event_types => \@ev_types, |
21 | builders => \@builders, |
22 | ); |
23 | |
24 | require constant; |
25 | |
26 | # use constant INDICES_OF => \*INDICES_OF; |
27 | |
28 | constant->import(+{ |
29 | map {; no strict 'refs'; $_ => \*$_ } @const |
30 | }); |
31 | |
d5511afa |
32 | # $EXISTENCE_OF = 1, ... |
efad53c4 |
33 | |
34 | do { no strict 'refs'; ${$dep_types[$_-1]} = $_ } for 1..@dep_types; |
35 | |
36 | # VALUE_EXISTS needs to trigger indices checks on its parent |
37 | |
38 | our $VALUE_EXISTS = 1; |
39 | |
40 | # VALUE_EXISTS triggers all types, VALUE_SET all but EXISTENCE_OF |
41 | |
d5511afa |
42 | our @VALUE_EXISTS = (EXISTENCE_OF(), TYPE_OF(), INDICES_OF(), CONTENTS_OF()); |
43 | our @VALUE_SET = (TYPE_OF(), INDICES_OF(), CONTENTS_OF()); |
9d759b64 |
44 | |
bcee3a69 |
45 | sub trace { } |
372a400c |
46 | |
7248abc9 |
47 | sub _expand_dep { |
48 | my ($type, @path) = @{$_[0]}; |
49 | my @expanded = map { |
50 | ref() ? @{$_->value_path or return ()} : $_ |
51 | } @path; |
52 | return [ $type, @expanded ]; |
53 | } |
54 | |
c99dbb05 |
55 | sub expand_deps { |
7248abc9 |
56 | [ map _expand_dep($_), @{$_[0]} ] |
57 | } |
58 | |
7f385fb2 |
59 | sub rspace { |
60 | require DX::ResolutionSpace; |
61 | DX::ResolutionSpace->new(@_); |
62 | } |
63 | |
64 | sub rstrat { |
65 | require DX::ResolutionStrategy; |
66 | DX::ResolutionStrategy->new(@_); |
67 | } |
68 | |
69 | sub res { |
70 | require DX::Resolution; |
71 | DX::Resolution->new(@_); |
72 | } |
73 | |
9d759b64 |
74 | sub string { |
3e465d5d |
75 | require DX::Value::String; |
9d759b64 |
76 | DX::Value::String->new(string_value => $_[0]) |
77 | } |
78 | |
79 | sub number { |
3e465d5d |
80 | require DX::Value::Number; |
9d759b64 |
81 | DX::Value::Number->new(number_value => $_[0]); |
82 | } |
83 | |
efad53c4 |
84 | sub dict { |
3e465d5d |
85 | require DX::Value::Dict; |
efad53c4 |
86 | DX::Value::Dict->new( |
87 | members => { @_ }, |
88 | ); |
89 | } |
90 | |
91 | sub proposition { |
92 | my ($pred, @args) = @_; |
3e465d5d |
93 | require DX::Proposition; |
efad53c4 |
94 | DX::Proposition->new( |
95 | predicate => $pred, |
96 | args => \@args, |
97 | ); |
98 | } |
99 | |
1e812b19 |
100 | { |
3e465d5d |
101 | my $dp; |
1e812b19 |
102 | |
103 | sub deparse { |
3e465d5d |
104 | $dp ||= do { |
1444edde |
105 | require DX::TraceFormatter; |
106 | DX::TraceFormatter->new; |
3e465d5d |
107 | }; |
1e812b19 |
108 | my ($thing) = @_; |
c25fbf05 |
109 | $dp->format($thing); |
1e812b19 |
110 | } |
111 | } |
112 | |
9d759b64 |
113 | 1; |