-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathplu_lua_syntax_ext.c
114 lines (95 loc) · 2.58 KB
/
plu_lua_syntax_ext.c
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
#include "plu_lua_syntax_ext.h"
#include "plu_debug.h"
#include "plu_global_state.h"
#include "plu_op.h"
#include "plu_lua.h"
void
plu_implement_lua_lexicals(pTHX_ SV *lcode)
{
/* This just delegates to Perl functions - regexes
* are really rather powerful and calling Perl regexes from
* C is like making mince with a colander and a plunger. */
SV *lexical_rv;
HV *lexical_hv;
AV *lexical_ary;
HE *he;
unsigned int i, n;
PADOFFSET padoff;
SV *name;
char *str;
STRLEN len;
/* First, scan the code for $foo.int and frients */
{
dSP;
int count;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(lcode);
PUTBACK;
count = call_pv("PLua::_scan_lua_code", G_SCALAR);
SPAGAIN;
if (count != 1)
croak("Panic: Scalar context and not exactly one return value? Madness!");
/* These lexicals will need looking up with pad_findmy */
lexical_rv = POPs;
lexical_hv = (HV *)SvRV(lexical_rv);
SvREFCNT_inc(lexical_rv);
PUTBACK;
FREETMPS;
LEAVE;
sv_2mortal(lexical_rv);
}
/* Now do all PAD lookups for lexicals in the HV */
/* Use a tmp array to avoid modifying a hash being looped over.
* This is obvioiusly possible by fuzzing with the HE, but
* my perl API fu is weak and I just want it working for now. FIXME */
lexical_ary = newAV();
sv_2mortal((SV *)lexical_ary);
(void)hv_iterinit(lexical_hv);
while ((he = hv_iternext(lexical_hv))) {
SV *k = hv_iterkeysv(he);
SvREFCNT_inc(k);
av_push(lexical_ary, k);
}
n = (unsigned int)av_len(lexical_ary)+1;
for (i = 0; i < n; ++i) {
name = *av_fetch(lexical_ary, i, 0);
str = SvPV(name, len);
padoff = pad_findmy(str, len, 0);
if (LIKELY( padoff != NOT_IN_PAD ))
(void)hv_store(lexical_hv, str, len, newSViv(padoff), 0);
/* No else needed - skipping from HV will cause exception in
* Perl code called further down. */
}
/* Now actually munge the code based on the PAD lookups. */
{
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(lcode);
XPUSHs(lexical_rv);
PUTBACK;
call_pv("PLua::_munge_lua_code", G_DISCARD);
FREETMPS;
LEAVE;
}
}
SV *
plu_implement_embedded_lua_function(pTHX_ SV *funcname, SV *paramlist, SV *lcode)
{
/* TODO carefully consider what happens to line numbers here */
char *str;
STRLEN len;
SV *rv = sv_2mortal(newSVpvs("function "));
sv_catsv_nomg(rv, funcname);
sv_catsv_nomg(rv, paramlist);
sv_catpvs(rv, "\n");
sv_catsv_nomg(rv, lcode);
str = SvPV(lcode, len);
if (str[len-1] != '\n')
sv_catpvs(rv, "\n");
sv_catpvs(rv, "end");
return rv;
}