/*
*
*/
%{
#include <tcl.h>
#include <ctype.h>
#include <math.h>
#include <string.h>
#include <stdlib.h>
#include <assert.h>
#ifdef STANDALONE
#include <fcntl.h>
#include <sys/mman.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <err.h>
#include <unistd.h>
#endif
struct context {
const char *text;
int remaining, lineno;
Tcl_Interp *I;
int result;
Tcl_Obj *obj;
#ifdef STANDALONE
const char *fname;
#endif
};
#ifdef STANDALONE
static void yyerror(const char *s);
#else
static void tclyyerror(struct context *, const char *);
#define yyerror(msg) tclyyerror(context, msg)
#endif
enum constants { FALSEO, TRUEO, NULLO, NUMCONSTANTS };
static Tcl_Obj * staticobj(enum constants);
static int jsonlex(struct context *context);
#define YYPARSE_PARAM_TYPE void *
#define YYPARSE_PARAM context
#define YYPARSE_PARAM_DECL
#define yylex() jsonlex(context)
#ifndef YYBISON
static int yyparse(YYPARSE_PARAM_TYPE YYPARSE_PARAM);
#endif
%}
%union {
Tcl_Obj *obj;
struct {
Tcl_Obj *key;
Tcl_Obj *val;
} keyval;
};
%token STRING CONSTANT
%type <obj> tree
%type <obj> json
%type <obj> object
%type <obj> list
%type <obj> values
%type <obj> members
%type <obj> value
%type <obj> string
%type <keyval> member
%%
tree: json
{
struct context *c = context;
if (c->I)
Tcl_SetObjResult(c->I, $1);
c->result = TCL_OK;
}
;
json:
object
| list
;
object : '{' members '}'
{
$$ = $2;
}
| '{' '}'
{
$$ = Tcl_NewObj();
}
;
list : '[' values ']'
{
$$ = $2;
}
| '[' ']'
{
$$ = Tcl_NewObj();
}
;
values : value
{
$$ = Tcl_NewListObj(1, &$1);
}
| values ',' value
{
Tcl_ListObjAppendElement(NULL, $1, $3);
$$ = $1;
}
;
members : member
{
$$ = Tcl_NewDictObj();
Tcl_DictObjPut(NULL, $$, $1.key, $1.val);
}
| members ',' member
{
Tcl_DictObjPut(NULL, $1, $3.key, $3.val);
$$ = $1;
}
;
member : string ':' value
{
$$.key = $1;
$$.val = $3;
}
;
string : STRING
{
$$ = ((struct context *)context)->obj;
}
;
value : CONSTANT
{
$$ = ((struct context *)context)->obj;
}
| string
| object
| list
;
%%
#include <err.h>
Tcl_Obj *
staticobj(enum constants constant)
{
static Tcl_Obj *objects[NUMCONSTANTS];
Tcl_Obj **p;
assert(constant >= 0 && constant < NUMCONSTANTS);
p = objects + constant;
if (*p == NULL) {
if (constant == NULLO)
*p = Tcl_NewStringObj("null", 4);
else {
*p = Tcl_NewBooleanObj(constant);
(*p)->bytes = constant ? (void *)"true" :
(void *)"false";
(*p)->length = constant ? sizeof("true") :
sizeof("false") - 1;
}
}
Tcl_IncrRefCount(*p);
return *p;
}
int
jsonlex(struct context *context)
{
const char *bp = NULL;
#define DRAIN(n) context->text += n, context->remaining -= n
enum {
PLAIN = 0x0000ff00,
INSTR = 0x00ff0000
} lstate;
double d;
long long ll;
char *end;
const char *p;
int initialized = 0;
#define STORESTRINGSEGMENT() \
if (initialized) { \
if (context->text != bp) { \
Tcl_AppendToObj(context->obj, \
bp, context->text - bp); \
} \
} else { \
context->obj = Tcl_NewStringObj( \
bp, context->text - bp); \
initialized = 1; \
}
while (context->remaining) {
switch (*context->text) {
case '\n':
context->lineno++;
/* FALLTHROUGH */
case ' ':
case '\t':
case '\r':
DRAIN(1);
continue;
}
break;
}
for (lstate = PLAIN; context->remaining > 0; DRAIN(1)) {
if (lstate == INSTR) {
if (*context->text == '"') {
/*
* End of quoted string
*/
STORESTRINGSEGMENT();
DRAIN(1);
return STRING;
}
if (*context->text == '\\') {
/*
* Escaped sequence
*/
char buf[TCL_UTF_MAX];
int len, consumed;
STORESTRINGSEGMENT();
/*
* XXX Tcl_UtfBackslash() may be more
* XXX permissive, than JSON standard.
* XXX But that may be a good thing:
* XXX "be generous in what you accept".
*/
len = Tcl_UtfBackslash(context->text,
&consumed, buf);
DRAIN(consumed - 1);
bp = context->text + 1;
Tcl_AppendToObj(context->obj, buf, len);
}
continue;
}
switch (*context->text) {
case ',':
case '{':
case ':':
case '}':
case '[':
case ']':
DRAIN(1);
return context->text[-1];
case 't':
if ((context->remaining < 4) ||
strncmp("rue", context->text + 1, 3))
goto bareword;
DRAIN(4);
context->obj = staticobj(TRUEO);
return CONSTANT;
case 'f':
if ((context->remaining < 5) ||
strncmp("alse", context->text + 1, 4))
goto bareword;
DRAIN(5);
context->obj = staticobj(FALSEO);
return CONSTANT;
case 'n':
if ((context->remaining < 4) ||
strncmp("ull", context->text + 1, 3))
goto bareword;
DRAIN(4);
context->obj = staticobj(NULLO);
return CONSTANT;
case '"':
bp = context->text + 1;
lstate = INSTR;
continue;
case '\\':
yyerror("Escape character outside of string");
return -1;
}
/*
* We already considered the null, true, and false
* above, so it can only be a number now. Let's see,
* whether it is a floating-point or an integer and
* finish...
*/
d = strtod(context->text, &end);
if (end == context->text)
goto bareword; /* Nothing parsed */
/*
* See, if there was anything other than digit there:
*/
for (p = context->text; p != end; p++) {
if (*p >= '0' && *p <= '9')
continue;
context->obj = Tcl_NewDoubleObj(d);
goto donewithnumber;
}
/*
* Didn't find any non-digits, presume integer:
*/
ll = strtoll(context->text, &end, 10);
if (context->text == end)
goto bareword;
context->obj = Tcl_NewWideIntObj(ll);
donewithnumber:
context->remaining -= (end - context->text);
context->text = end;
return CONSTANT;
}
return 0;
bareword:
yyerror("Bare word encountered");
return -1;
}
#ifdef STANDALONE
static struct context Context;
int
main(int argc, char **argv)
{
int i, fd;
char *mapped;
struct stat sb;
/* yydebug = 1; */
for (i = 1; i < argc; i++) {
fd = open(argv[i], O_RDONLY);
if (fd == -1) {
warn("opening %s", argv[i]);
continue;
}
if (fstat(fd, &sb) == -1) {
warn("fstat-ing %d after opening %s", fd, argv[i]);
goto next;
}
mapped = mmap(NULL, sb.st_size, PROT_READ|PROT_WRITE,
MAP_NOCORE|MAP_NOSYNC, fd, 0);
if (mapped == MAP_FAILED) {
warn("mmaping %lld bytes of %d after opening %s",
(long long)sb.st_size, fd, argv[i]);
goto next;
}
memset(&Context, 0, sizeof(Context));
Context.text = mapped;
Context.lineno = 1;
Context.fname = argv[i];
Context.remaining = sb.st_size; /* The file better fit in size_t */
mapped[Context.remaining] = '\0'; /* XXX may crash here */
yyparse(&Context);
if (munmap(mapped, sb.st_size) == -1)
warn("munmap of %s", argv[i]);
next:
close(fd);
}
}
static void
yyerror(const char *s)
{
fprintf(stderr, "%s on %s:%d: %.107s\n", s, Context.fname,
Context.lineno, Context.text);
exit(1);
}
#else
static void
tclyyerror(struct context *context, const char *message)
{
char *fullmessage, *yytext;
int yyleng;
yytext = Tcl_GetStringFromObj(context->obj, &yyleng);
fullmessage = Tcl_Alloc(strlen(message) + 63 + yyleng);
sprintf(fullmessage, "%s %d bytes before end, around ``%.*s''",
message, context->remaining, yyleng, yytext);
Tcl_SetResult(context->I, fullmessage, TCL_DYNAMIC);
}
static int
json2dict(ClientData cd, Tcl_Interp *I, int objc, Tcl_Obj * const *objv)
{
struct context context = { NULL };
if (objc != 2) {
Tcl_WrongNumArgs(I, 1, objv, "JSON-text");
return TCL_ERROR;
}
context.text = Tcl_GetStringFromObj(objv[1], &context.remaining);
context.I = I;
context.result = TCL_ERROR;
yyparse(&context);
return context.result;
}
Tcl_AppInitProc Jsonmi_Init;
int
Jsonmi_Init(Tcl_Interp *I)
{
Tcl_CreateObjCommand(I, "jsonmi::json2dict", json2dict, NULL, NULL);
return Tcl_PkgProvide(I, "jsonmi", "1.1");
}
#endif
