A few more rewrites down the line from my previous question, this is the C version 11 based on the PostScript prototype version 12. The PostScript version is shorter, but it's some crazy ass PostScript gibberish that's like my own private dialect, so translating to C makes it easier to share with the world. I showed off a little in comp.lang.c during the final round of debugging.
According to Greenspun's 10th rule:
Any sufficiently complicated C or Fortran program contains an ad hoc, informally-specified, bug-ridden, slow implementation of half of Common Lisp.
I've attempted to break this rule by explicitly adopting and crafting a much more modest fraction of Common Lisp. Just a tiny fraction. More like a Scheme, or a Lisp 1, with no (eval). There are lists of things which could be an integer or a string or a symbol or a parser or an operator or a list. There's just enough lazy evaluation to support lazy streams but then I got too lazy to carry it all the way through. So there's a careful handling of suspensions in the *object.[ch] module, but in the *parser.[ch] module it just forces the first item off of the input list in parse_satisfy() and all other parsers build upon that as their base. So, satisfy() parsers comprise the leaf nodes of the parser graph.
Building a recursive loop in a graph of parsers requires allocating a "forwarding parser", ie. an empty parser which can be composed in a graph with other parsers and then filled in later. Both the regex_grammar() and ebnf_grammar() functions use this technique to create parser graphs with loops in them. The print() and print_list() functions, when trying to print a parser will in some configurations print its saved environment. For many parser graphs, this will print out the whole graph in an awkward but informative format. But the printing functions take care not to dive into the saved environment of a parser that was constructed as a forward(), because it's very likely to lead to an infinite loop.
To simplify the usage code, many of the constructors -- Parser(), Operator(), Suspension() -- which take a function pointer to build a "function object", each try to capture a print name for the function at the same time. This is done by interfacing the constructor functions with macros that can make a copy of the function pointer argument and use the preprocessor's # stringify operation.
Another consequence of simplification is the use of environments. Parsers and Suspensions and Operator objects all contain a pointer to an environment -- ie. the saved, closed or curried values that accompany the function pointer. But in many cases I've seemed to "get away with" not actually using the environment pointer to hold an association list. For simple things like predicate operators the code just stores the values directly in the environment slot or a simple cons structure to hold a few values in a little tree. This approach seemed to help keep simple things simple.
Parser objects for the most part use the environment to hold association lists. And the into() and bind() parsers take some care to propagate environment information to their child functions. This is essential for the behavior of parser into( parser p, symbol id, parser q ) combinator. The parser resulting from this function must pass the result from executing the parser p into the parser q by defining it with the symbol id. The parser q in this case should be the result of parser bind( parser p, operator op ) so that the op can receive this value in its environment.
For my own uses this feels like a safe restriction, but possibly it could limit the applicability of this code for certain applications that might need environment data to propagate around more, I guess.
As much as possible, I've tried to make the code read like pseudocode. So if you just look at the nouns and verbs in a line of code, that ought to give you some sense of what it's trying to do. The punctuation might get a little heavy in places, however.
The symbol type builds upon an enum for compile time symbols. So compile time symbols use the "code space" from 0 going up. That leaves EOF to resolve naturally to -1. And any dynamic symbols created by symbol symbol_from_string( string s ), if there are no previously allocated compile time symbols with the same printname, then a new dynamic symbol code is allocated in the code space from -2 going down. The effect of this can be seen in the test_ebnf() function. Any dynamically created symbols that arise from the productions string, in order to refer to them elsewhere in the code and have the symbol codes actually match, must be previously allocated. In the test_ebnf() function, in order to call assoc_symbol() on the result from the ebnf parser and actually get the start parser out of the association list, there must be a previous call to Symbol() with that enum name. So, if you were to comment out the call to Symbol(postal_address) from the beginning of the function it would fail at the end.
Any improvements to be made, to the interface or the implementation? I'd like to use this code to build compilers and interpreters for languages described by EBNF grammars. One notable missing feature is the ability to factor out left recursion from EBNF productions or parser graphs.
$ make count
wc pc11*[ch]
437 1879 11141 pc11object.c
101 517 3607 pc11object.h
639 2496 16281 pc11parser.c
81 322 1918 pc11parser.h
169 685 4904 pc11test.c
1427 5899 37851 total
CFLAGS= -std=c99 -g -Wall -Wpedantic -Wextra -Wno-unused-function -Wno-unused-parameter -Wno-switch -Wno-return-type -Wunused-variable
CFLAGS+= $(cflags)
test : pc11
./$<
pc11 : pc11object.o pc11parser.o pc11test.o
$(CC) $(CFLAGS) -o $@ $^ $(LDLIBS)
pc11object.o : pc11object.[ch]
pc11parser.o : pc11parser.[ch] pc11object.h
pc11test.o : pc11test.c pc11parser.h pc11object.h
clean :
rm *.o
count :
wc pc11*[ch]
/*
* The PP_NARG macro evaluates to the number of arguments that have been
* passed to it.
*
* Laurent Deniau, "__VA_NARG__," 17 January 2006, <comp.std.c> (29 November 2007).
*/
#define PP_NARG(...) PP_NARG_(__VA_ARGS__,PP_RSEQ_N())
#define PP_NARG_(...) PP_ARG_N(__VA_ARGS__)
#define PP_ARG_N( \
_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,N,...) N
#define PP_RSEQ_N() \
71,70, \
69,68,67,66,65,64,63,62,61,60, \
59,58,57,56,55,54,53,52,51,50, \
49,48,47,46,45,44,43,42,41,40, \
39,38,37,36,35,34,33,32,31,30, \
29,28,27,26,25,24,23,22,21,20, \
19,18,17,16,15,14,13,12,11,10, \
9,8,7,6,5,4,3,2,1,0
#define PC11OBJECT_H
#include <stdlib.h>
#include <stdio.h>
#include "ppnarg.h"
#define IS_THE_TARGET_OF_THE_HIDDEN_POINTER_ *
typedef union object IS_THE_TARGET_OF_THE_HIDDEN_POINTER_ object;
typedef object integer;
typedef object list;
typedef object suspension;
typedef object parser;
typedef object operator;
typedef operator binoperator;
typedef operator predicate;
typedef object symbol;
typedef object string;
typedef object boolean;
typedef object fSuspension( object env );
typedef object fParser( object env, list input );
typedef object fOperator( object env, object input );
typedef boolean fPredicate( object env, object input );
typedef object fBinOperator( object left, object right );
enum object_symbol_codes {
T,
END_OBJECT_SYMBOLS
};
typedef enum {
INVALID, INT, LIST, SUSPENSION, PARSER, OPERATOR, SYMBOL, STRING, VOID
} tag;
union object { tag t;
struct { tag t; int i; } Int;
struct { tag t; object first, rest; } List;
struct { tag t; object env; fSuspension *f; const char *printname; } Suspension;
struct { tag t; object env; fParser *f; const char *printname; } Parser;
struct { tag t; object env; fOperator *f; const char *printname; } Operator;
struct { tag t; int code; const char *printname; object data; } Symbol;
struct { tag t; char *str; int disposable; } String;
struct { tag t; object next; int forward; } Header;
struct { tag t; void *pointer; } Void;
};
extern object T_ /* = (union object[]){ {.t=1}, {.Symbol={SYMBOL, T, "T"}} } + 1 */,
NIL_ /* = (union object[]){ {.t=INVALID} } */;
static int
valid( object it ){ // valid will also convert a boolean T_ or NIL_ to an integer 1 or 0
return it
&& it->t <= VOID
&& it->t != INVALID;
}
integer Int( int i );
boolean Boolean( int b );
list one( object it );
list cons( object first, object rest );
suspension Suspension_( object env, fSuspension *f, const char *printname );
#define Suspension(env,f) Suspension_( env, f, __func__ )
parser Parser_( object env, fParser *f, const char *printname );
#define Parser(env,f) Parser_( env, f, __func__ )
operator Operator_( object env, fOperator *f, const char *printname );
#define Operator(env,f) Operator_( env, f, #f )
string String( char *str, int disposable );
symbol Symbol_( int code, const char *printname, object data );
#define Symbol(n) Symbol_( n, #n, NIL_ )
object Void( void *pointer );
int length( list ls );
string to_string( list ls );
void print( object a );
void print_list( object a );
object first( list it );
list rest( list it );
list take( int n, list it );
list drop( int n, list it );
object apply( operator op, object it );
list chars_from_str( char *str );
list chars_from_file( FILE *file );
list ucs4_from_utf8( list o );
list utf8_from_ucs4( list o );
list map( operator op, list it );
object collapse( fBinOperator *f, list it );
object reduce( fBinOperator *f, int n, object *po );
#define LIST(...) \
reduce( cons, PP_NARG(__VA_ARGS__), (object[]){ __VA_ARGS__ } )
boolean eq( object a, object b );
boolean eq_symbol( int code, object b );
list append( list start, list end );
list env( list tail, int n, ... );
object assoc( object key, list env );
object assoc_symbol( int code, list env );
symbol symbol_from_string( string s );
#define _BSD_SOURCE
#include "pc11object.h"
#include <stdarg.h>
#include <string.h>
#define OBJECT(...) new_( (union object[]){{ __VA_ARGS__ }} )
object T_ = (union object[]){ {.t=1}, {.Symbol={SYMBOL, T, "T"}} } + 1,
NIL_ = (union object[]){ {.t=INVALID} };
static object new_( object prototype );
integer
Int( int i ){
return OBJECT( .Int = { INT, i } );
}
boolean
Boolean( int b ){
return b ? T_ : NIL_;
}
list
one( object it ){
return cons( it, NIL_ );
}
list
cons( object first, object rest ){
return OBJECT( .List = { LIST, first, rest } );
}
suspension
Suspension_( object env, fSuspension *f, const char *printname ){
return OBJECT( .Suspension = { SUSPENSION, env, f, printname } );
}
parser
Parser_( object env, fParser *f, const char *printname ){
return OBJECT( .Parser = { PARSER, env, f, printname } );
}
operator
Operator_( object env, fOperator *f, const char *printname ){
return OBJECT( .Operator = { OPERATOR, env, f, printname } );
}
string
String( char *str, int disposable ){
return OBJECT( .String = { STRING, str, disposable } );
}
symbol
Symbol_( int code, const char *printname, object data ){
return OBJECT( .Symbol = { SYMBOL, code, printname, data } );
}
object
Void( void *pointer ){
return OBJECT( .Void = { VOID, pointer } );
}
int
length( list ls ){
return valid( ls ) ? valid( first( ls ) ) + length( rest( ls ) ) : 0;
}
int
string_length( object it ){
switch( it ? it->t : 0 ){
default: return 0;
case INT: return 1;
case STRING: return strlen( it->String.str );
case LIST: return string_length( first( it ) ) + string_length( rest( it ) );
}
}
void
fill_string( char **str, list it ){
switch( it ? it->t : 0 ){
default: return;
case INT:
*(*str)++ = it->Int.i;
return;
case STRING:
strcpy( *str, it->String.str );
*str += strlen( it->String.str );
return;
case LIST:
fill_string( str, first( it ) );
fill_string( str, rest( it ) );
return;
}
}
string
to_string( list ls ){
char *str = calloc( 1 + string_length( ls ), 1 );
string s = OBJECT( .String = { STRING, str, 1 } );
fill_string( &str, ls );
return s;
}
static int print_innards = 1;
static int print_chars = 1;
static int print_codes = 0;
void
print( object a ){
switch( a ? a->t : 0 ){
default: printf( "() " ); break;
case INT: printf( print_chars ? "'%c' " : "%d ", a->Int.i ); break;
case LIST: printf( "(" ), print( a->List.first ), printf( "." ),
print( a->List.rest ), printf( ")" ); break;
case SUSPENSION: printf( "...(%s) ", a->Suspension.printname ); break;
case PARSER: printf( "Parser(%s", a->Parser.printname ),
(print_innards & ! a[-1].Header.forward) &&
(printf( ", " ), print( a->Parser.env ),0),
printf( ") " ); break;
case OPERATOR: printf( "Oper(%s", a->Operator.printname ),
printf( ", " ), print( a->Operator.env ),
printf( ") " ); break;
case STRING: printf( "\"%s\" ", a->String.str ); break;
case SYMBOL: if( print_codes )
printf( "%d:%s ", a->Symbol.code, a->Symbol.printname );
else
printf( "%s ", a->Symbol.printname );
break;
case VOID: printf( "VOID " ); break;
}
}
static void
print_listn( object a ){
if( ! valid( a ) ) return;
switch( a->t ){
default: print( a ); break;
case LIST: print_list( first( a ) ),
print_listn( rest( a ) ); break;
}
}
void
print_list( object a ){
switch( a ? a->t : 0 ){
default: print( a ); break;
case LIST: printf( "(" ), print_list( first( a ) ),
print_listn( rest( a ) ), printf( ") " ); break;
}
}
object
force_( object it ){
if( it->t != SUSPENSION ) return it;
return force_( it->Suspension.f( it->Suspension.env ) );
}
static object force_first ( object it ){ \
*it = *force_( it ); \
return first( it ); \
} \
object first( list it ){ \
if( it->t == SUSPENSION ) return Suspension( it, force_first );
if( it->t != LIST ) return NIL_;
return it->List.first;
}
static object force_rest ( object it ){ \
*it = *force_( it ); \
return rest( it ); \
} \
object rest( list it ){ \
if( it->t == SUSPENSION ) return Suspension( it, force_rest );
if( it->t != LIST ) return NIL_;
return it->List.rest;
}
list
take( int n, list it ){
if( n == 0 ) return NIL_;
*it = *force_( it );
if( ! valid( it ) ) return NIL_;
return cons( first( it ), take( n-1, rest( it ) ) );
}
list
drop( int n, list it ){
if( n == 0 ) return it;
*it = *force_( it );
if( ! valid( it ) ) return NIL_;
return drop( n-1, rest( it ) );
}
static object
force_apply( list env ){
operator op = first( env );
object it = rest( env );
*it = *force_( it );
return apply( op, it );
}
object
apply( operator op, object it ){
if( it->t == SUSPENSION ) return Suspension( cons( op, it ), force_apply );
return op->Operator.f( op->Operator.env, it );
}
static list
force_chars_from_string( string s ){
char *str = s->String.str;
if( ! *str ) return one( Symbol( EOF ) );
return cons( Int( *str ), Suspension( String( str+1, 0 ), force_chars_from_string ) );
}
list
chars_from_str( char *str ){
if( ! str ) return NIL_;
return Suspension( String( str, 0 ), force_chars_from_string );
}
static list
force_chars_from_file( object file ){
FILE *f = file->Void.pointer;
int c = fgetc( f );
if( c == EOF ) return one( Symbol( EOF ) );
return cons( Int( c ), Suspension( file, force_chars_from_file ) );
}
list
chars_from_file( FILE *file ){
if( ! file ) return NIL_;
return Suspension( Void( file ), force_chars_from_file );
}
static int
leading_ones( object byte ){
if( byte->t != INT ) return 0;
int x = byte->Int.i;
return x&0x80 ? x&0x40 ? x&0x20 ? x&0x10 ? x&8 ? x&4 ? 6
: 5
: 4
: 3
: 2
: 1
: 0;
}
static int
mask_off( object byte, int m ){
if( byte->t != INT ) return 0;
int x = byte->Int.i;
return x & (m? (1<<(8-m))-1 :-1);
}
static list
force_ucs4_from_utf8( list input ){
*input = *force_( input );
object byte;
byte = first( input ), input = rest( input );
if( !valid(byte) ) return NIL_;
if( eq_symbol( EOF, byte ) ) return input;
int ones = leading_ones( byte );
int bits = mask_off( byte, ones );
int n = ones;
while( n-- > 1 ){
*input = *force_( input );
byte = first( input ), input = rest( input );
if( eq_symbol( EOF, byte ) ) return input;
bits = ( bits << 6 ) | ( byte->Int.i & 0x3f );
}
if( bits < ((int[]){0,0,0x80,0x800,0x10000,0x110000,0x4000000})[ ones ] )
fprintf( stderr, "Overlength encoding in utf8 char.\n" );
return cons( Int( bits ), Suspension( input, force_ucs4_from_utf8 ) );
}
list
ucs4_from_utf8( list input ){
if( ! input ) return NIL_;
return Suspension( input, force_ucs4_from_utf8 );
}
static list
force_utf8_from_ucs4( list input ){
*input = *force_( input );
object code = first( input );
if( eq_symbol( EOF, code ) ) return input;
int x = code->Int.i;
object next = Suspension( drop( 1, input ), force_utf8_from_ucs4 );
if( x <= 0x7f )
return cons( code, next );
if( x <= 0x7ff )
return LIST( Int( (x >> 6) | 0xc0 ),
Int( (x & 0x3f) | 0x80 ), next );
if( x <= 0xffff )
return LIST( Int( (x >> 12) | 0xe0 ),
Int( ( (x >> 6) & 0x3f ) | 0x80 ),
Int( ( x & 0x3f ) | 0x80 ), next );
if( x <= 0x10ffff )
return LIST( Int( (x >> 18) | 0xf0 ),
Int( ( (x >> 12) & 0x3f ) | 0x80 ),
Int( ( (x >> 6) & 0x3f ) | 0x80 ),
Int( ( x & 0x3f ) | 0x80 ), next );
if( x <= 0x3ffffff )
return LIST( Int( (x >> 24) | 0xf8 ),
Int( ( (x >> 18) & 0x3f ) | 0x80 ),
Int( ( (x >> 12) & 0x3f ) | 0x80 ),
Int( ( (x >> 6) & 0x3f ) | 0x80 ),
Int( ( x & 0x3f ) | 0x80 ), next );
if( x <= 0x3fffffff )
return LIST( Int( (x >> 30) | 0xfc ),
Int( ( (x >> 24) & 0x3f ) | 0x80 ),
Int( ( (x >> 18) & 0x3f ) | 0x80 ),
Int( ( (x >> 12) & 0x3f ) | 0x80 ),
Int( ( (x >> 6) & 0x3f ) | 0x80 ),
Int( ( x & 0x3f ) | 0x80 ), next );
fprintf( stderr, "Invalid unicode code point in ucs4 char.\n" );
return next;
}
list
utf8_from_ucs4( list input ){
if( ! input ) return NIL_;
return Suspension( input, force_utf8_from_ucs4 );
}
list
map( operator op, list it ){
if( ! valid( it ) ) return it;
return cons( apply( op, first( it ) ),
map( op, rest( it ) ) );
}
object
collapse( fBinOperator *f, list it ){
if( !valid( it ) ) return it;
object right = collapse( f, rest( it ) );
if( !valid( right ) ) return first( it );
return f( first( it ), right );
}
object
reduce( fBinOperator *f, int n, object *po ){
return n==1 ? *po : f( *po, reduce( f, n-1, po+1 ) );
}
boolean
eq( object a, object b ){
return Boolean(
!valid( a ) && !valid( b ) ? 1 :
!valid( a ) || !valid( b ) ? 0 :
a->t != b->t ? 0 :
a->t == SYMBOL ? a->Symbol.code == b->Symbol.code :
!memcmp( a, b, sizeof *a ) ? 1 : 0
);
}
boolean
eq_symbol( int code, object b ){
return eq( (union object[]){ {.Symbol = {SYMBOL, code, "", 0} } }, b );
}
list
append( list start, list end ){
if( ! valid( start ) ) return end;
return cons( first( start ), append( rest( start ), end ) );
}
list
env( list tail, int n, ... ){
va_list v;
va_start( v, n );
list r = tail;
while( n-- ){
object a = va_arg( v, object );
object b = va_arg( v, object );
r = cons( cons( a, b ), r );
}
va_end( v );
return r;
}
object
assoc( object key, list b ){
if( !valid( b ) ) return NIL_;
object pair = first( b );
if( valid( eq( key, first( pair ) ) ) )
return rest( pair );
else
return assoc( key, rest( b ) );
}
object
assoc_symbol( int code, list b ){
return assoc( (union object[]){ {.Symbol = {SYMBOL, code, "", 0}} }, b );
}
static list allocation_list = NULL;
static object
new_( object prototype ){
object record = calloc( 2, sizeof *record );
if( record ){
record[0] = (union object){ .Header = { 0, allocation_list } };
allocation_list = record;
record[1] = *prototype;
}
return record + 1;
}
static int next_symbol_code = -2;
symbol
symbol_from_string( string s ){
list ls = allocation_list;
while( ls != NULL && valid( ls + 1 ) ){
if( ls[1].t == SYMBOL
&& strcmp( ls[1].Symbol.printname, s->String.str ) == 0 ){
return ls + 1;
}
ls = ls[0].Header.next;
}
return Symbol_( next_symbol_code--, strdup( s->String.str ), NIL_ );
}
#define PC11PARSER_H
#if ! PC11OBJECT_H
#include "pc11object.h"
#endif
enum parser_symbol_codes {
VALUE = END_OBJECT_SYMBOLS,
OK,
FAIL,
SATISFY_PRED,
EITHER_P,
EITHER_Q,
SEQUENCE_P,
SEQUENCE_Q,
SEQUENCE_OP,
BIND_P,
BIND_OP,
INTO_P,
INTO_ID,
INTO_Q,
ATOM,
PROBE_P,
PROBE_MODE,
SEQ,
ANY,
EPSILON,
MAYBE,
MANY,
END_PARSER_SYMBOLS
};
list parse( parser p, list input );
int is_ok( list result );
int not_ok( list result );
parser succeeds( list result );
parser fails( list errormsg );
parser satisfy( predicate pred );
parser alpha( void );
parser upper( void );
parser lower( void );
parser digit( void );
parser literal( object example );
parser chr( int c );
parser str( char *s );
parser anyof( char *s );
parser noneof( char *s );
parser either( parser p, parser q );
#define ANY(...) reduce( either, PP_NARG(__VA_ARGS__), (object[]){ __VA_ARGS__ } )
parser sequence( parser p, parser q, binoperator op );
parser xthen( parser p, parser q );
parser thenx( parser p, parser q );
parser then( parser p, parser q );
#define SEQ(...) reduce( then, PP_NARG(__VA_ARGS__), (object[]){ __VA_ARGS__ } )
parser forward( void );
parser maybe( parser p );
parser many( parser p );
parser some( parser p );
parser item( void );
parser probe( parser p, int mode ); //print on ok iff mode&1, print not ok iff mode&2
parser bind( parser p, operator op );
parser into( parser p, object id, parser q );
// E->T ('|' T)*
// T->F*
// F->A ('*' | '+' | '?')?
// A->'.' | '('E')' | C
// C->S|L|P
// S->'\' ('.' | '|' | '(' | ')' | '[' | ']' | '/' )
// L->'[' '^'? ']'? [^]]* ']'
// P->Plain char
parser regex( char *re );
// D->N '=' E ';'
// N->name
// E->T ('|' T)*
// T->F*
// F->R | N | '[' E ']' | '{' E '}' | '(' E ')' | '/' regex '/'
// R->'"' [^"]* '"' | "'" [^']* "'"
list ebnf( char *productions, list supplements, list handlers );
#include "pc11parser.h"
#include <ctype.h>
#include <string.h>
list
parse( parser p, list input ){
if( !valid( p ) || !valid( input ) || p->t != PARSER )
return LIST( Symbol( FAIL ), String("parse() validity check failed",0), input );
return p->Parser.f( p->Parser.env, input );
}
static object
success( object v, list input ){
return cons( Symbol( OK ), cons( v, input ) );
}
static object
fail( object v, list input ){
return cons( Symbol( FAIL ), cons( v, input ) );
}
int
is_ok( list result ){
return valid( eq_symbol( OK, first( result ) ) );
}
int
not_ok( list result ){
return ! is_ok( result );
}
parser
succeeds( list result ){
return Parser( result, success );
}
parser
fails( list errormsg ){
return Parser( errormsg, fail );
}
static list
parse_satisfy( object env, list input ){
predicate pred = assoc_symbol( SATISFY_PRED, env );
drop( 1, input );
object item = first( input );
if( ! valid( item ) ) return fail( String( "empty input", 0 ), input );
return valid( apply( pred, item ) )
? success( item, rest( input ) )
: fail( LIST( String( "predicate not satisfied", 0 ), pred, NIL_ ), input );
}
parser
satisfy( predicate pred ){
return Parser( env( NIL_, 1, Symbol(SATISFY_PRED), pred ), parse_satisfy );
}
boolean
always_true( object v, object it ){
return T_;
}
parser item( void ){
return satisfy( Operator( NIL_, always_true ) );
}
static boolean
is_alpha( object v, object it ){
return Boolean( it->t == INT && isalpha( it->Int.i ) );
}
parser
alpha( void ){
return satisfy( Operator( NIL_, is_alpha ) );
}
static boolean
is_upper( object v, object it ){
return Boolean( it->t == INT && isupper( it->Int.i ) );
}
parser
upper( void ){
return satisfy( Operator( NIL_, is_upper ) );
}
static boolean
is_lower( object v, object it ){
return Boolean( it->t == INT && islower( it->Int.i ) );
}
parser
lower( void ){
return satisfy( Operator( NIL_, is_lower ) );
}
static boolean
is_digit( object v, object it ){
return Boolean( it->t == INT && isdigit( it->Int.i ) );
}
parser
digit( void ){
return satisfy( Operator( NIL_, is_digit ) );
}
static boolean
is_literal( object example, object it ){
return eq( example, it );
}
parser
literal( object example ){
return satisfy( Operator( example, is_literal ) );
}
parser
chr( int c ){
return literal( Int( c ) );
}
parser
str( char *s ){
return !*s ? succeeds( NIL_ )
: s[1] ? then( chr( *s ), str( s+1 ) )
: chr( *s );
}
static boolean
is_range( object bounds, object it ){
int lo = first( bounds )->Int.i,
hi = rest( bounds )->Int.i;
return Boolean( it->t == INT && lo <= it->Int.i && it->Int.i <= hi );
}
parser
range( int lo, int hi ){
return satisfy( Operator( cons( Int( lo ), Int( hi ) ), is_range ) );
}
static boolean
is_anyof( object set, object it ){
return Boolean( it->t == INT && strchr( set->String.str, it->Int.i ) != NULL );
}
parser
anyof( char *s ){
return satisfy( Operator( String( s, 0 ), is_anyof ) );
}
static boolean
is_noneof( object set, object it ){
return Boolean( it->t == INT && strchr( set->String.str, it->Int.i ) == NULL );
}
parser
noneof( char *s ){
return satisfy( Operator( String( s, 0 ), is_noneof ) );
}
static object
parse_either( object env, list input ){
parser p = assoc_symbol( EITHER_P, env );
object result = parse( p, input );
if( is_ok( result ) ) return result;
parser q = assoc_symbol( EITHER_Q, env );
return parse( q, input );
}
parser
either( parser p, parser q ){
return Parser( env( NIL_, 2,
Symbol(EITHER_Q), q,
Symbol(EITHER_P), p ),
parse_either );
}
static object
parse_sequence( object env, list input ){
parser p = assoc_symbol( SEQUENCE_P, env );
object p_result = parse( p, input );
if( not_ok( p_result ) ) return p_result;
parser q = assoc_symbol( SEQUENCE_Q, env );
list remainder = rest( rest( p_result ) );
object q_result = parse( q, remainder );
if( not_ok( q_result ) ){
object q_error = first( rest( q_result ) );
object q_remainder = rest( rest( q_result ) );
return fail( LIST( q_error, String( "after", 0), first( rest( p_result ) ), NIL_ ),
q_remainder );
}
binoperator op = assoc_symbol( SEQUENCE_OP, env );
return success( op->Operator.f( first( rest( p_result ) ),
first( rest( q_result ) ) ),
rest( rest( q_result ) ) );
}
parser
sequence( parser p, parser q, binoperator op ){
return Parser( env( NIL_, 3,
Symbol(SEQUENCE_OP), op,
Symbol(SEQUENCE_Q), q,
Symbol(SEQUENCE_P), p ),
parse_sequence );
}
static object
concat( object l, object r ){
if( ! valid( l ) ) return r;
if( r->t == LIST
&& valid( eq_symbol( VALUE, first( first( r ) ) ) )
&& ! valid( rest( r ) )
&& ! valid( rest( first( r ) ) ) )
return l;
switch( l->t ){
case LIST: return cons( first( l ), concat( rest( l ), r ) );
default: return cons( l, r );
}
}
parser
then( parser p, parser q ){
return sequence( p, q, Operator( NIL_, concat ) );
}
static object
left( object l, object r ){
return l;
}
static object
right( object l, object r ){
return r;
}
parser
xthen( parser p, parser q ){
return sequence( p, q, Operator( NIL_, right ) );
}
parser
thenx( parser p, parser q ){
return sequence( p, q, Operator( NIL_, left ) );
}
parser
forward( void ){
parser p = Parser( 0, 0 );
p[-1].Header.forward = 1;
return p;
}
parser
maybe( parser p ){
return either( p, succeeds( NIL_ ) );
}
parser
many( parser p ){
parser q = forward();
*q = *maybe( then( p, q ) );
return q;
}
parser
some( parser p ){
return then( p, many( p ) );
}
static object
parse_bind( object env, list input ){
parser p = assoc_symbol( BIND_P, env );
operator op = assoc_symbol( BIND_OP, env );
object result = parse( p, input );
if( not_ok( result ) ) return result;
object payload = rest( result ),
value = first( payload ),
remainder = rest( payload );
return success( apply( (union object[]){{.Operator={
OPERATOR, append(op->Operator.env, env), op->Operator.f, op->Operator.printname
}}}, value ), remainder );
}
parser
bind( parser p, operator op ){
return Parser( env( NIL_, 2,
Symbol(BIND_P), p,
Symbol(BIND_OP), op ),
parse_bind );
}
static object
parse_into( object v, list input ){
parser p = assoc_symbol( INTO_P, v );
object p_result = parse( p, input );
if( not_ok( p_result ) ) return p_result;
object id = assoc_symbol( INTO_ID, v );
parser q = assoc_symbol( INTO_Q, v );
object q_result = q->Parser.f( env( q->Parser.env, 1,
id, first( rest( p_result ) ) ),
rest( rest( p_result ) ) );
if( not_ok( q_result ) ){
object q_error = first( rest( q_result ) );
object q_remainder = rest( rest( q_result ) );
return fail( LIST( q_error, String( "after", 0), first( rest( p_result ) ), NIL_ ),
q_remainder );
}
return q_result;
}
parser
into( parser p, object id, parser q ){
return Parser( env( NIL_, 3,
Symbol(INTO_P), p,
Symbol(INTO_ID), id,
Symbol(INTO_Q), q ),
parse_into );
}
object
parse_probe( object env, object input ){
parser p = assoc_symbol( PROBE_P, env );
int mode = assoc_symbol( PROBE_MODE, env )->Int.i;
object result = parse( p, input );
if( is_ok( result ) && mode&1 )
print( result ), puts("");
else if( not_ok( result ) && mode&2 )
print_list( result ), puts("");
return result;
}
parser
probe( parser p, int mode ){
return Parser( env( NIL_, 2, Symbol(PROBE_MODE), Int( mode ), Symbol(PROBE_P), p ),
parse_probe );
}
static parser
apply_meta( parser a, object it ){
switch( it->Int.i ){
default: return a;
case '*': return many( a );
case '+': return some( a );
case '?': return maybe( a );
}
}
static parser
on_dot( object v, object it ){
return item();
}
static parser
on_chr( object v, object it ){
return literal( it );
}
static parser
on_meta( object v, object it ){
parser atom = assoc_symbol( ATOM, v );
if( it->t == LIST
&& valid( eq_symbol( VALUE, first( first( it ) ) ) )
&& ! valid( rest( it ) )
&& ! valid( rest( rest( it ) ) ) )
return atom;
return apply_meta( atom, it );
}
static parser
on_class( object v, object it ){
if( first( it )->Int.i == '^' )
return satisfy( Operator( to_string( rest( it ) ), is_noneof ) );
return satisfy( Operator( to_string( it ), is_anyof ) );
}
static parser
on_term( object v, object it ){
if( ! valid( it ) ) return NIL_;
if( it->t == LIST && ! valid( rest( it ) ) ) it = first( it );
if( it->t == PARSER ) return it;
return collapse( then, it );
}
static parser
on_expr( object v, object it ){
if( it->t == LIST && ! valid( rest( it ) ) ) it = first( it );
if( it->t == PARSER ) return it;
return collapse( either, it );
}
#define META "*+?"
#define SPECIAL META ".|()[]/"
static parser
regex_grammar( void ){
parser dot = bind( chr('.'), Operator( NIL_, on_dot ) );
parser meta = anyof( META );
parser escape = xthen( chr('\\'), anyof( SPECIAL "\\" ) );
parser class = xthen( chr('['),
thenx( SEQ( maybe( chr('^') ),
maybe( chr(']') ),
many( noneof( "]" ) ) ),
chr(']') ) );
parser character = ANY( bind( escape, Operator( NIL_, on_chr ) ),
bind( class, Operator( NIL_, on_class ) ),
bind( noneof( SPECIAL ), Operator( NIL_, on_chr ) ) );
parser expr = forward();
{
parser atom = ANY( dot,
xthen( chr('('), thenx( expr, chr(')') ) ),
character );
parser factor = into( atom, Symbol(ATOM),
bind( maybe( meta ),
Operator( NIL_, on_meta ) ) );
parser term = bind( many( factor ),
Operator( NIL_, on_term ) );
*expr = *bind( then( term, many( xthen( chr('|'), term ) ) ),
Operator( NIL_, on_expr ) );
}
return expr;
}
static parser regex_parser;
parser
regex( char *re ){
if( !regex_parser ) regex_parser = regex_grammar();
object result = parse( regex_parser, chars_from_str( re ) );
if( not_ok( result ) ) return result;
return first( rest( result ) );
}
static string
stringify( object env, object input ){
return to_string( input );
}
static symbol
symbolize( object env, object input ){
return symbol_from_string( to_string( input ) );
}
static list
encapsulate( object env, object input ){
return one( input );
}
static parser
make_matcher( object env, object input ){
return str( to_string( input )->String.str );
}
static list
make_sequence( object env, object input ){
if( length( input ) == 0 ) return Symbol( EPSILON );
if( length( input ) < 2 ) return input;
return one( cons( Symbol( SEQ ), input ) );
}
static list
make_any( object env, object input ){
if( length( input ) < 2 ) return input;
return one( cons( Symbol( ANY ), input ) );
}
static list
make_maybe( object env, object input ){
return one( cons( Symbol( MAYBE ), input ) );
}
static list
make_many( object env, object input ){
return one( cons( Symbol( MANY ), input ) );
}
static parser
ebnf_grammar( void ){
if( !regex_parser ) regex_parser = regex_grammar();
parser spaces = many( anyof( " \t\n" ) );
parser defining_symbol = thenx( chr( '=' ), spaces );
parser choice_symbol = thenx( chr( '|' ), spaces );
parser terminating_symbol = thenx( chr( ';' ), spaces );
parser name = some( either( anyof( "-_" ), alpha() ) );
parser identifier = thenx( name, spaces );
parser terminal =
bind(
thenx( either( thenx( xthen( chr( '"'), many( noneof("\"") ) ), chr( '"') ),
thenx( xthen( chr('\''), many( noneof( "'") ) ), chr('\'') ) ),
spaces ),
Operator( NIL_, make_matcher ) );
parser symb = bind( identifier, Operator( NIL_, symbolize ) );
parser nonterminal = symb;
parser expr = forward();
{
parser factor = ANY( terminal,
nonterminal,
bind( xthen( then( chr( '[' ), spaces ),
thenx( expr,
then( chr( ']' ), spaces ) ) ),
Operator( NIL_, make_maybe ) ),
bind( xthen( then( chr( '{' ), spaces ),
thenx( expr,
then( chr( '}' ), spaces ) ) ),
Operator( NIL_, make_many ) ),
bind( xthen( then( chr( '(' ), spaces ),
thenx( expr,
then( chr( ')' ), spaces ) ) ),
Operator( NIL_, encapsulate ) ),
bind( xthen( chr( '/' ),
thenx( regex_parser, chr( '/' ) ) ),
Operator( NIL_, encapsulate ) ) );
parser term = bind( many( factor ), Operator( NIL_, make_sequence ) );
*expr = *bind( then( term, many( xthen( choice_symbol, term ) ) ),
Operator( NIL_, make_any ) );
};
parser definition = bind( then( symb,
xthen( defining_symbol,
thenx( expr, terminating_symbol ) ) ),
Operator( NIL_, encapsulate) );
return some( definition );
}
static list
define_forward( object env, object it ){
if( rest( it )->t == PARSER ) return it;
return cons( first( it ), forward() );
}
static parser
compile_bnf( object env, object it ){
switch( it->t ){
default:
return it;
case SYMBOL: {
object ob = assoc( it, env );
return valid( ob ) ? ob : it;
}
case LIST: {
object f = first( it );
if( valid( eq_symbol( SEQ, f ) ) )
return collapse( then,
map( (union object[]){{.Operator={OPERATOR,env,compile_bnf}}},
rest( it ) ) );
if( valid( eq_symbol( ANY, f ) ) )
return collapse( either,
map( (union object[]){{.Operator={OPERATOR,env,compile_bnf}}},
rest( it ) ) );
if( valid( eq_symbol( MANY, f ) ) )
return many( map( (union object[]){{.Operator={OPERATOR,env,compile_bnf}}},
rest( it ) ) );
if( valid( eq_symbol( MAYBE, f ) ) )
return maybe( map( (union object[]){{.Operator={OPERATOR,env,compile_bnf}}},
rest( it ) ) );
return map( (union object[]){{.Operator={OPERATOR,env,compile_bnf}}},
it );
}
}
}
static list
compile_rhs( object env, object it ){
if( rest( it )->t == PARSER ) return it;
object result = cons( first( it ),
map( (union object[]){{.Operator={OPERATOR,env,compile_bnf}}}, rest( it ) ) );
return result;
}
static list
define_parser( object env, object it ){
object lhs = assoc( first( it ), env );
if( valid( lhs ) && lhs->t == PARSER && lhs->Parser.f == NULL ){
object rhs = rest( it );
if( rhs->t == LIST ) rhs = first( rhs );
*lhs = *rhs;
}
return it;
}
static list
wrap_handler( object env, object it ){
object lhs = assoc( first( it ), env );
if( valid( lhs ) && lhs->t == PARSER ){
object op = rest( it );
parser copy = Parser( 0, 0 );
*copy = *lhs;
*lhs = *bind( copy, op );
}
return it;
}
list
ebnf( char *productions, list supplements, list handlers ){
static parser ebnf_parser;
if( !ebnf_parser ) ebnf_parser = ebnf_grammar();
object result = parse( ebnf_parser, chars_from_str( productions ) );
if( not_ok( result ) ) return result;
object payload = first( rest( result ) );
list defs = append( payload, env( supplements, 1, Symbol(EPSILON), succeeds(NIL_) ) );
list forwards = map( Operator( NIL_, define_forward ), defs );
list parsers = map( Operator( forwards, compile_rhs ), defs );
list final = map( Operator( forwards, define_parser ), parsers );
map( Operator( forwards, wrap_handler ), handlers );
return final;
}
#include "pc11parser.h"
enum test_symbol_codes {
TEST = END_PARSER_SYMBOLS,
DIGIT,
UPPER,
NAME,
NUMBER,
EOL,
SP,
postal_address,
name_part,
street_address,
street_name,
zip_part,
END_TEST_SYMBOLS
};
static int test_basics();
static int test_parsers();
static int test_regex();
static int test_ebnf();
int main( void ){
return test_basics()
|| test_parsers()
|| test_regex()
|| test_ebnf();
}
static int
test_basics(){
puts( __func__ );
list ch = chars_from_str( "abcdef" );
print( ch ), puts(""); // print with dot notation
print_list( ch ), puts(""); // print with list notation
drop( 6, ch ); // force first 6 elements of stream
print( ch ), puts("");
print_list( ch ), puts("");
drop( 7, ch );
print( ch ), puts("");
print_list( ch ), puts("");
puts("");
return 0;
}
static int
test_parsers(){
puts( __func__ );
list ch = chars_from_str( "a b c d 1 2 3 4" );
parser p = succeeds( Int('*') );
print_list( parse( p, ch ) ), puts("");
parser q = fails( String("Do you want a cookie?",0) );
print_list( parse( q, ch ) ), puts("");
parser r = item();
print_list( parse( r, ch ) ), puts("");
parser s = either( alpha(), item() );
print_list( parse( s, ch ) ), puts("");
parser t = literal( Int('a') );
print_list( parse( t, ch ) ), puts("");
puts("");
return 0;
}
static int
test_regex(){
puts( __func__ );
parser a = regex( "." );
print_list( a ), puts("");
print_list( parse( a, chars_from_str( "a" ) ) ), puts("");
print_list( parse( a, chars_from_str( "." ) ) ), puts("");
print_list( parse( a, chars_from_str( "\\." ) ) ), puts("");
puts("");
parser b = regex( "\\." );
print_list( b ), puts("");
print_list( parse( b, chars_from_str( "a" ) ) ), puts("");
print_list( parse( b, chars_from_str( "." ) ) ), puts("");
print_list( parse( b, chars_from_str( "\\." ) ) ), puts("");
puts("");
parser c = regex( "\\\\." );
print_list( c ), puts("");
print_list( parse( c, chars_from_str( "a" ) ) ), puts("");
print_list( parse( c, chars_from_str( "." ) ) ), puts("");
print_list( parse( c, chars_from_str( "\\." ) ) ), puts("");
print_list( parse( c, chars_from_str( "\\a" ) ) ), puts("");
puts("");
parser d = regex( "\\\\\\." );
print_list( d ), puts("");
print_list( parse( d, chars_from_str( "a" ) ) ), puts("");
print_list( parse( d, chars_from_str( "." ) ) ), puts("");
print_list( parse( d, chars_from_str( "\\." ) ) ), puts("");
print_list( parse( d, chars_from_str( "\\a" ) ) ), puts("");
puts("");
parser e = regex( "\\\\|a" );
print_list( e ), puts("");
print_list( parse( e, chars_from_str( "a" ) ) ), puts("");
print_list( parse( e, chars_from_str( "." ) ) ), puts("");
print_list( parse( e, chars_from_str( "\\." ) ) ), puts("");
print_list( parse( e, chars_from_str( "\\a" ) ) ), puts("");
puts("");
parser f = regex( "[abcd]" );
print_list( f ), puts("");
print_list( parse( f, chars_from_str( "a" ) ) ), puts("");
print_list( parse( f, chars_from_str( "." ) ) ), puts("");
puts("");
return 0;
}
static object
stringify( object env, object it ){
return to_string( it );
}
static int
test_ebnf(){
puts( __func__ );
Symbol(postal_address);
Symbol(name_part);
Symbol(street_address);
Symbol(street_name);
Symbol(zip_part);
list parsers = ebnf(
"postal_address = name_part street_address zip_part ;\n"
"name_part = personal_part SP last_name SP opt_suffix_part EOL\n"
" | personal_part SP name_part ;\n"
"personal_part = initial '.' | first_name ;\n"
"street_address = house_num SP street_name opt_apt_num EOL ;\n"
"zip_part = town_name ',' SP state_code SP zip_code EOL ;\n"
"opt_suffix_part = 'Sr.' | 'Jr.' | roman_numeral | ;\n"
"opt_apt_num = [ apt_num ] ;\n"
"apt_num = NUMBER ;\n"
"town_name = NAME ;\n"
"state_code = UPPER UPPER ;\n"
"zip_code = DIGIT DIGIT DIGIT DIGIT DIGIT ;\n"
"initial = 'Mrs' | 'Mr' | 'Ms' | 'M' ;\n"
"roman_numeral = 'I' [ 'V' | 'X' ] { 'I' } ;\n"
"first_name = NAME ;\n"
"last_name = NAME ;\n"
"house_num = NUMBER ;\n"
"street_name = NAME ;\n",
env( NIL_, 6,
Symbol(EOL), chr('\n'),
Symbol(DIGIT), digit(),
Symbol(UPPER), upper(),
Symbol(NUMBER), some( digit() ),
Symbol(NAME), some( alpha() ),
Symbol(SP), many( anyof( " \t\n" ) ) ),
env( NIL_, 2,
Symbol(name_part), Operator( NIL_, stringify ),
Symbol(street_name), Operator( NIL_, stringify ) )
);
print_list( parsers ), puts("\n"); // long output when showing innards
parser start = first( assoc_symbol( postal_address, parsers ) );
print_list( start ), puts("\n");
print_list( parse( start,
chars_from_str( "Mr. luser droog I\n2357 Streetname\nAnytown, ST 00700\n" ) ) ),
puts("");
return 0;
}
Output from the testing code:
$ make clean test
rm *.o
cc -std=c99 -g -Wall -Wpedantic -Wextra -Wno-unused-function -Wno-unused-parameter -Wno-switch -Wno-return-type -Wunused-variable -c -o pc11object.o pc11object.c
cc -std=c99 -g -Wall -Wpedantic -Wextra -Wno-unused-function -Wno-unused-parameter -Wno-switch -Wno-return-type -Wunused-variable -c -o pc11parser.o pc11parser.c
cc -std=c99 -g -Wall -Wpedantic -Wextra -Wno-unused-function -Wno-unused-parameter -Wno-switch -Wno-return-type -Wunused-variable -c -o pc11test.o pc11test.c
cc -std=c99 -g -Wall -Wpedantic -Wextra -Wno-unused-function -Wno-unused-parameter -Wno-switch -Wno-return-type -Wunused-variable -o pc11 pc11object.o pc11parser.o pc11test.o
./pc11
test_basics
...(chars_from_str)
...(chars_from_str)
('a' .('b' .('c' .('d' .('e' .('f' ....(force_chars_from_string) ))))))
('a' 'b' 'c' 'd' 'e' 'f' ...(force_chars_from_string) )
('a' .('b' .('c' .('d' .('e' .('f' .(EOF .() )))))))
('a' 'b' 'c' 'd' 'e' 'f' EOF )
test_parsers
(OK '*' ...(chars_from_str) )
(FAIL "Do you want a cookie?" ...(chars_from_str) )
(OK 'a' ...(force_chars_from_string) )
(OK 'a' ...(force_chars_from_string) )
(OK 'a' ...(force_chars_from_string) )
test_regex
Parser(satisfy, ((SATISFY_PRED .Oper(always_true, () ) ).() ))
(OK 'a' ...(force_chars_from_string) )
(OK '.' ...(force_chars_from_string) )
(OK '\' ...(force_chars_from_string) )
Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, '.' ) ).() ))
(FAIL ("predicate not satisfied" Oper(is_literal, '.' ) ) 'a' ...(force_chars_from_string) )
(OK '.' ...(force_chars_from_string) )
(FAIL ("predicate not satisfied" Oper(is_literal, '.' ) ) '\' ...(force_chars_from_string) )
Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, '\' ) ).() )) ).((SEQUENCE_Q .Parser(satisfy, ((SATISFY_PRED .Oper(always_true, () ) ).() )) ).((SEQUENCE_OP .Oper(concat, () ) ).() ))))
(FAIL ("predicate not satisfied" Oper(is_literal, '\' ) ) 'a' ...(force_chars_from_string) )
(FAIL ("predicate not satisfied" Oper(is_literal, '\' ) ) '.' ...(force_chars_from_string) )
(OK ('\' '.' ) ...(force_chars_from_string) )
(OK ('\' 'a' ) ...(force_chars_from_string) )
Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, '\' ) ).() )) ).((SEQUENCE_Q .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, '.' ) ).() )) ).((SEQUENCE_OP .Oper(concat, () ) ).() ))))
(FAIL ("predicate not satisfied" Oper(is_literal, '\' ) ) 'a' ...(force_chars_from_string) )
(FAIL ("predicate not satisfied" Oper(is_literal, '\' ) ) '.' ...(force_chars_from_string) )
(OK ('\' '.' ) ...(force_chars_from_string) )
(FAIL (("predicate not satisfied" Oper(is_literal, '.' ) ) "after" '\' ) 'a' ...(force_chars_from_string) )
Parser(either, ((EITHER_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, '\' ) ).() )) ).((EITHER_Q .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, 'a' ) ).() )) ).() )))
(OK 'a' ...(force_chars_from_string) )
(FAIL ("predicate not satisfied" Oper(is_literal, 'a' ) ) '.' ...(force_chars_from_string) )
(OK '\' ...(force_chars_from_string) )
(OK '\' ...(force_chars_from_string) )
Parser(satisfy, ((SATISFY_PRED .Oper(is_anyof, "abcd" ) ).() ))
(OK 'a' ...(force_chars_from_string) )
(FAIL ("predicate not satisfied" Oper(is_anyof, "abcd" ) ) '.' ...(force_chars_from_string) )
test_ebnf
((postal_address Parser(sequence, ((SEQUENCE_P .Parser(bind) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(sequence) ).((SEQUENCE_Q .Parser(sequence) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ) (name_part Parser(either, ((EITHER_P .Parser(sequence, ((SEQUENCE_P .Parser(either) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(either) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(sequence) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(either) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(either) ).((SEQUENCE_Q .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, '
' ) ).() )) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((EITHER_Q .Parser(sequence, ((SEQUENCE_P .Parser(either) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(either) ).((SEQUENCE_Q .Parser(bind) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).() ))) ) (personal_part Parser(either, ((EITHER_P .Parser(sequence, ((SEQUENCE_P .Parser(either) ).((SEQUENCE_Q .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, '.' ) ).() )) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((EITHER_Q .Parser(sequence) ).() ))) ) (street_address Parser(sequence, ((SEQUENCE_P .Parser(sequence) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(either) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(bind) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(either) ).((SEQUENCE_Q .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, '
' ) ).() )) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ) (zip_part Parser(sequence, ((SEQUENCE_P .Parser(sequence) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, ',' ) ).() )) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(either) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(sequence) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(either) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(sequence) ).((SEQUENCE_Q .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, '
' ) ).() )) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ) (opt_suffix_part Parser(either, ((EITHER_P .Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, 'S' ) ).() )) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, 'r' ) ).() )) ).((SEQUENCE_Q .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, '.' ) ).() )) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((EITHER_Q .Parser(either, ((EITHER_P .Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, 'J' ) ).() )) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, 'r' ) ).() )) ).((SEQUENCE_Q .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, '.' ) ).() )) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((EITHER_Q .Parser(either, ((EITHER_P .Parser(sequence) ).((EITHER_Q .Parser(succeeds, () ) ).() ))) ).() ))) ).() ))) ) (opt_apt_num Parser(either, ((EITHER_P .(Parser(sequence) .() )).((EITHER_Q .Parser(succeeds, () ) ).() ))) ) (apt_num Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_digit, () ) ).() )) ).((SEQUENCE_Q .Parser(either) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ) (town_name Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_alpha, () ) ).() )) ).((SEQUENCE_Q .Parser(either) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ) (state_code Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_upper, () ) ).() )) ).((SEQUENCE_Q .Parser(satisfy, ((SATISFY_PRED .Oper(is_upper, () ) ).() )) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ) (zip_code Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_digit, () ) ).() )) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_digit, () ) ).() )) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_digit, () ) ).() )) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_digit, () ) ).() )) ).((SEQUENCE_Q .Parser(satisfy, ((SATISFY_PRED .Oper(is_digit, () ) ).() )) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ) (initial Parser(either, ((EITHER_P .Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, 'M' ) ).() )) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, 'r' ) ).() )) ).((SEQUENCE_Q .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, 's' ) ).() )) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((EITHER_Q .Parser(either, ((EITHER_P .Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, 'M' ) ).() )) ).((SEQUENCE_Q .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, 'r' ) ).() )) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((EITHER_Q .Parser(either, ((EITHER_P .Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, 'M' ) ).() )) ).((SEQUENCE_Q .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, 's' ) ).() )) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((EITHER_Q .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, 'M' ) ).() )) ).() ))) ).() ))) ).() ))) ) (roman_numeral Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, 'I' ) ).() )) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(either, ((EITHER_P .(Parser(either, ((EITHER_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, 'V' ) ).() )) ).((EITHER_Q .Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, 'X' ) ).() )) ).() ))) .() )).((EITHER_Q .Parser(succeeds, () ) ).() ))) ).((SEQUENCE_Q .Parser(either) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ) (first_name Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_alpha, () ) ).() )) ).((SEQUENCE_Q .Parser(either) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ) (last_name Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_alpha, () ) ).() )) ).((SEQUENCE_Q .Parser(either) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ) (house_num Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_digit, () ) ).() )) ).((SEQUENCE_Q .Parser(either) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ) (street_name Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_alpha, () ) ).() )) ).((SEQUENCE_Q .Parser(either) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ) (EPSILON Parser(succeeds, () ) ) (SP Parser(either) ) (NAME Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_alpha, () ) ).() )) ).((SEQUENCE_Q .Parser(either) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ) (NUMBER Parser(sequence, ((SEQUENCE_P .Parser(satisfy, ((SATISFY_PRED .Oper(is_digit, () ) ).() )) ).((SEQUENCE_Q .Parser(either) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ) (UPPER Parser(satisfy, ((SATISFY_PRED .Oper(is_upper, () ) ).() )) ) (DIGIT Parser(satisfy, ((SATISFY_PRED .Oper(is_digit, () ) ).() )) ) (EOL Parser(satisfy, ((SATISFY_PRED .Oper(is_literal, '
' ) ).() )) ) )
Parser(sequence, ((SEQUENCE_P .Parser(bind) ).((SEQUENCE_Q .Parser(sequence, ((SEQUENCE_P .Parser(sequence) ).((SEQUENCE_Q .Parser(sequence) ).((SEQUENCE_OP .Oper(concat, () ) ).() )))) ).((SEQUENCE_OP .Oper(concat, () ) ).() ))))
(OK ("Mr. luser droog I
" '2' '3' '5' '7' ' ' "Streetname" '
' 'A' 'n' 'y' 't' 'o' 'w' 'n' ',' ' ' 'S' 'T' ' ' '0' '0' '7' '0' '0' '
' ) ...(force_chars_from_string) )
listdefined? \$\endgroup\$pc11object.h. All of the smorgasbord of types are "subclasses" ofobjectbut different ones are used to convey semantic information to the reader. So alistought to be a pointer to aunion objectwith the tag ==LIST, but the C type system doesn't actually help enforce this, so it's a promise to the reader that the object should be a list object. \$\endgroup\$