Parser Combinators are the amazingly elegant way to write parsers that has evolved over on the functional programming side of the world, but have been less available or accessible for imperative languages. I have attempted somewhat to bridge this gap by stealing copying as many ideas from FP as were needed to make these combinators in C.
I've written an overview of Parser Combinators and presentations of the basic lisp-like object system and the higher order functions which supplement the basic objects. Of course wikipedia has a nice article on the topic, and my code mostly follows the excellent paper by Hutton and Meijer which is also a good introduction.
This code is the result of 16 (or so) re-writes of the code in my previous question. I anticipate at least one more re-write to add more features like checking the offside rule both for parsing syntaxes lke Python which use this rule, or just checking that indentation in C code is reasonable.
A few remarks about the code overall: I'm trying the "McIllroy convention" which places header guards around the #include lines rather than inside the included files. The object type is a pointer to a union. Most of the .c files have a (name-mangled) main() function which does some simple tests; somewhere along the continuum between real unit testing and not testing.
I'm looking for review of the "weird stuff" if possible. Particularly the handling of suspensions, which represent values to be lazily evaluated. But of course anything weird or suspicious is fair game.
ppnarg.h
Written by Laurent Deniau for the C Object System. I have extended the maximum number of arguments a little. This macro supports the variadic combinators PLUS and SEQ which combine many subparsers together. It lets you pass a count of the variadic arguments into the function that processes them.
/* * 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 pc9obj.h
Public interface to the basic objects. All the constructors for various types of objects and lists. Especially, chars_from_string which produces a lazy list of characters. The symbol-typed objects are constructed with a unique numeric identifer and a print string. These unique ids are generated by declaring the names in an enum. The odd name SYM1 is used to start the next enum in the next layer to add more symbols keeping all ids unique.
#define PC9OBJ_H #include <stdlib.h> #include <stdio.h> #define POINTER_TO * typedef union uobject POINTER_TO object; typedef object list; typedef object parser; typedef object oper; typedef oper predicate; typedef object boolean; typedef object fSuspension( object ); typedef list fParser( object, list ); typedef object fOperator( object, object ); typedef boolean fPredicate( object, object ); typedef object fBinOper( object, object ); enum object_symbols { T, F, X, A, B, SYM1 }; object T_, NIL_; int valid( object a ); object Int( int i ); list one( object a ); list cons( object a, object b ); object Suspension( object v, fSuspension *f ); parser Parser( object v, fParser *f ); oper Operator( object v, fOperator *f ); object String( char *s, int disposable ); object Symbol_( int sym, char *pname ); #define Symbol(n) Symbol_( n, #n ) object Void( void *v ); void add_global_root( object a ); int garbage_collect( object local_roots ); object x_( list a ); object xs_( list a ); list take( int n, list o ); list drop( int n, list o ); list chars_from_string( char *v ); list chars_from_file( FILE *v ); object string_from_chars( list o ); void print( object o ); void print_list( list a ); void print_flat( list a ); void print_data( list a ); #define PRINT_WRAPPER(_, __, ___) printf( "%s: %s %s= ", __func__, #__, ___ ), _( __ ), puts("") #define PRINT(__) PRINT_WRAPPER( print_list, __, "" ) #define PRINT_FLAT(__) PRINT_WRAPPER( print_flat, __, "flat" ) #define PRINT_DATA(__) PRINT_WRAPPER( print_data, __, "data" ) pc9objpriv.h
Private interface to the basic objects. Objects are represented as a pointer to a tagged union. The at_ function forces execution of suspensions, but externally this action must be performed by calling take or drop.
#define PC9OBJPRIV_H #ifndef PC9OBJ_H #include "pc9obj.h" #endif typedef enum object_tag { INVALID, INTEGER, LIST, SUSPENSION, PARSER, OPERATOR, SYMBOL, STRING, VOID, } tag; union uobject { tag t; struct { tag t; int i; } Int; struct { tag t; object a, b; } List; struct { tag t; object v; fSuspension *f; } Suspension; struct { tag t; object v; fParser *f; } Parser; struct { tag t; object v; fOperator *f; } Operator; struct { tag t; int symbol; char *pname; object data; } Symbol; struct { tag t; char *string; int disposable; } String; struct { tag t; object next; } Header; struct { tag t; void *v; } Void; }; object new_( object a ); #define OBJECT(...) new_( (union uobject[]){{ __VA_ARGS__ }} ) object at_( object a ); object fill_string( char **s, list o ); int obj_main( void ); pc9obj.c
Implementation of basic objects. Objects are allocated as two structs side by side with the hidden left object used as an allocation record. The allocation records form a singly linked list which is traversed during a sweep of the garbage collector. x_ and xs_ are the famous lisp car and cdr functions, but I like the haskell naming convention so I used those; but x is too useful as a local variable name so they got underscores appended.
#include <stdio.h> #include "pc9objpriv.h" static void mark_objects( list a ); static int sweep_objects( list *po ); object T_ = (union uobject[]){{ .Symbol = { SYMBOL, T, "T" } }}, NIL_ = (union uobject[]){{ .t = INVALID }}; static list global_roots = NULL; static list allocation_list = NULL; object new_( object a ){ object p = calloc( 2, sizeof *p ); return p ? p[0] = (union uobject){ .Header = { 0, allocation_list } }, allocation_list = p, p[1] = *a, &p[1] : 0; } int valid( object a ){ switch( a ? a->t : 0 ){ default: return 0; case INTEGER: case LIST: case SUSPENSION: case PARSER: case OPERATOR: case SYMBOL: case STRING: return 1; } } object Int( int i ){ return OBJECT( .Int = { INTEGER, i } ); } list one( object a ){ return cons( a, NIL_ ); } list cons( object a, object b ){ return OBJECT( .List = { LIST, a, b } ); } object Suspension( object v, fSuspension *f ){ return OBJECT( .Suspension = { SUSPENSION, v, f } ); } parser Parser( object v, fParser *f ){ return OBJECT( .Parser = { PARSER, v, f } ); } oper Operator( object v, fOperator *f ){ return OBJECT( .Operator = { OPERATOR, v, f } ); } object String( char *s, int disposable ){ return OBJECT( .String = { STRING, s, disposable } ); } object Symbol_( int sym, char *pname ){ return OBJECT( .Symbol = { SYMBOL, sym, pname } ); } object Void( void *v ){ return OBJECT( .Void = { VOID, v } ); } void add_global_root( object a ){ global_roots = cons( a, global_roots ); } int garbage_collect( object local_roots ){ mark_objects( local_roots ); mark_objects( global_roots ); return sweep_objects( &allocation_list ); } static tag * mark( object a ){ return &a[-1].Header.t; } static void mark_objects( list a ){ if( !valid(a) || *mark( a ) ) return; *mark( a ) = 1; switch( a->t ){ case LIST: mark_objects( a->List.a ); mark_objects( a->List.b ); break; case PARSER: mark_objects( a->Parser.v ); break; case OPERATOR: mark_objects( a->Operator.v ); break; case SYMBOL: mark_objects( a->Symbol.data ); break; case SUSPENSION: mark_objects( a->Suspension.v ); break; } } static int sweep_objects( list *po ){ int count = 0; while( *po ) if( (*po)->t ){ (*po)->t = 0; po = &(*po)->Header.next; } else { object z = *po; *po = (*po)->Header.next; if( z[1].t == STRING && z[1].String.disposable ) free( z[1].String.string ); free( z ); ++count; } return count; } object at_( object a ){ return valid( a ) && a->t == SUSPENSION ? at_( a->Suspension.f( a->Suspension.v ) ) : a; } object px_( object v ){ list a = v; *a = *at_( a ); return x_( a ); } object x_( list a ){ return valid( a ) ? a->t == LIST ? a->List.a : a->t == SUSPENSION ? Suspension( a, px_ ) : NIL_ : NIL_; } object pxs_( object v ){ list a = v; *a = *at_( a ); return xs_( a ); } object xs_( list a ){ return valid( a ) ? a->t == LIST ? a->List.b : a->t == SUSPENSION ? Suspension( a, pxs_ ) : NIL_ : NIL_; } list take( int n, list o ){ if( n == 0 ) return NIL_; *o = *at_( o ); return valid( o ) ? cons( x_( o ), take( n-1, xs_( o ) ) ) : NIL_; } list drop( int n, list o ){ if( n == 0 ) return o; *o = *at_( o ); return valid( o ) ? drop( n-1, xs_( o ) ) : NIL_; } list pchars_from_string( object v ){ char *p = v->String.string; return *p ? cons( Int( *p ), Suspension( String( p+1, 0 ), pchars_from_string ) ) : Symbol(EOF); } list chars_from_string( char *p ){ return p ? Suspension( String( p, 0 ), pchars_from_string ) : NIL_; } list pchars_from_file( object v ){ FILE *f = v->Void.v; int c = fgetc( f ); return c != EOF ? cons( Int( c ), Suspension( v, pchars_from_file ) ) : Symbol(EOF); } list chars_from_file( FILE *f ){ return f ? Suspension( Void( f ), pchars_from_file ) : NIL_; } static int count_ints( list o ){ return !o ? 0 : o->t == SUSPENSION ? *o = *at_( o ), count_ints( o ) : o->t == INTEGER ? 1 : o->t == LIST ? count_ints( o->List.a ) + count_ints( o->List.b ) : 0; } object fill_string( char **s, list o ){ return !o ? NULL : o->t == INTEGER ? *(*s)++ = o->Int.i, NULL : o->t == LIST ? fill_string( s, o->List.a ), fill_string( s, o->List.b ) : NULL; } object string_from_chars( list o ){ char *s = calloc( count_ints( o ) + 1, 1 ); object z = String( s, 1 ); return fill_string( &s, o ), z; } void print( object o ){ if( !o ){ printf( "() " ); return; } switch( o->t ){ case INTEGER: printf( "%d ", o->Int.i ); break; case LIST: printf( "(" ); print( o->List.a ); print( o->List.b ); printf( ") " ); break; case SUSPENSION: printf( "... " ); break; case PARSER: printf( "Parser " ); break; case OPERATOR: printf( "Oper " ); break; case STRING: printf( "\"%s\"", o->String.string ); break; case SYMBOL: printf( "%s ", o->Symbol.pname ); break; case INVALID: printf( "_ " ); break; default: printf( "INVALID " ); break; } } void print_listn( list a ){ switch( a ? a->t : 0 ){ default: print( a ); return; case LIST: print_list( x_( a ) ), print_listn( xs_( a ) ); return; } } void print_list( list a ){ switch( a ? a->t : 0 ){ default: print( a ); return; case LIST: printf( "(" ), print_list( x_( a ) ), print_listn( xs_( a ) ), printf( ")" ); return; } } void print_flat( list a ){ if( !a ) return; if( a->t != LIST ){ print( a ); return; } print_flat( a->List.a ); print_flat( a->List.b ); } void print_data( list a ){ if( !a ) return; switch( a->t ){ case LIST: print_data( a->List.a), print_data( a->List.b ); break; case STRING: printf( "%s", a->String.string ); break; case SYMBOL: print_data( a->Symbol.data ); break; } } int test_basics(){ list ch = chars_from_string( "abcdef" ); PRINT( ch ); PRINT( Int( garbage_collect( ch ) ) ); PRINT( take( 1, ch ) ); PRINT( Int( garbage_collect( ch ) ) ); PRINT( x_( ch ) ); PRINT( Int( garbage_collect( ch ) ) ); PRINT( x_( xs_( ch ) ) ); PRINT( Int( garbage_collect( ch ) ) ); PRINT( take( 1, x_( xs_( ch ) ) ) ); PRINT( Int( garbage_collect( ch ) ) ); PRINT( take( 5, ch ) ); PRINT( Int( garbage_collect( ch ) ) ); PRINT( ch ); PRINT( Int( garbage_collect( ch ) ) ); PRINT( take( 6, ch ) ); PRINT( Int( garbage_collect( ch ) ) ); PRINT( take( 1, ch ) ); PRINT( Int( garbage_collect( ch ) ) ); PRINT( take( 2, ch ) ); PRINT( Int( garbage_collect( ch ) ) ); PRINT( take( 2, ch ) ); PRINT( Int( garbage_collect( ch ) ) ); PRINT( take( 2, ch ) ); PRINT( Int( garbage_collect( ch ) ) ); PRINT( take( 2, ch ) ); PRINT( Int( garbage_collect( ch ) ) ); return 0; } int obj_main(){ return test_basics(); } pc9fp.h
Interface to the "functional programming" functions. These have all been tweaked to deal nicely (?) with suspensions and force only enough execution to make progress on a computation.
#define PC9FP_H #ifndef PC9OBJ_H #include "pc9obj.h" #endif boolean eq( object a, object b ); list env( list tail, int n, ... ); object assoc( object a, list b ); list copy( list a ); list append( list a, list b ); object apply( oper f, object o ); list map( oper f, list o ); list join( list o ); object collapse( fBinOper *f, list o ); object reduce( fBinOper *f, int n, object *po ); pc9fp.c
Implementation of the "functional programming" functions.
#include <stdarg.h> #include <string.h> #include "pc9fp.h" #include "pc9objpriv.h" boolean eq( object a, object b ){ return ( !valid( a ) && !valid( b ) ? 1 : !valid( a ) || !valid( b ) ? 0 : a->t != b->t ? 0 : a->t == SYMBOL ? a->Symbol.symbol == b->Symbol.symbol : !memcmp( a, b, sizeof *a ) ? 1 : 0 ) ? T_ : NIL_; } list copy( list a ){ return !valid( a ) ? NIL_ : a->t == LIST ? cons( copy( x_( a ) ), copy( xs_( a ) ) ) : a; } 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 a, list b ){ return !valid( b ) ? NIL_ : valid( eq( a, x_( x_( b ) ) ) ) ? xs_( x_( b ) ) : assoc( a, xs_( b ) ); } static list pappend( object v ){ list a = assoc( Symbol(A), v ); list b = assoc( Symbol(B), v ); *a = *at_( a ); return append( a, b ); } list append( list a, list b ){ return !valid( a ) ? b : a->t == SUSPENSION ? Suspension( env( 0, 2, Symbol(A), a, Symbol(B), b ), pappend ) : cons( x_( a ), append( xs_( a ), b ) ); } static object papply( object v ){ oper f = assoc( Symbol(F), v ); object o = assoc( Symbol(X), v ); *o = *at_( o ); return valid( o ) ? f->Operator.f( f->Operator.v, o ) : NIL_; } object apply( oper f, object o ){ return f->t == OPERATOR ? valid( o ) ? o->t == SUSPENSION ? Suspension( env( 0, 2, Symbol(F), f, Symbol(X), o ), papply ) : f->Operator.f( f->Operator.v, o ) : f->Operator.f( f->Operator.v, o ) // for using( maybe(), ... ) : NIL_; //return f->t == OPERATOR ? f->Operator.f( f->Operator.v, o ) : NIL_; } static list pmap( object v ){ oper f = assoc( Symbol(F), v ); list o = assoc( Symbol(X), v ); *o = *at_( o ); return valid( o ) ? cons( apply( f, x_( o ) ), map( f, xs_( o ) ) ) : NIL_; } list map( oper f, list o ){ return valid( o ) ? o->t == SUSPENSION ? Suspension( env( 0, 2, Symbol(F), f, Symbol(X), o ), pmap ) : cons( apply( f, x_( o ) ), Suspension( env( 0, 2, Symbol(F), f, Symbol(X), xs_( o ) ), pmap ) ) : NIL_; //return valid( o ) ? cons( apply( f, x_( o ) ), map( f, xs_( o ) ) ) : NIL_; } static list pjoin( object v ){ list o = assoc( Symbol(X), v ); *o = *at_( o ); return append( x_( take( 1, o ) ), join( xs_( o ) ) ); } list join( list o ){ return valid( o ) ? o->t == SUSPENSION ? Suspension( env( 0, 1, Symbol(X), o ), pjoin ) : append( x_( o ), Suspension( env( 0, 1, Symbol(X), xs_( o ) ), pjoin ) ) : NIL_; //return valid( o ) ? append( x_( o ), join( xs_( o ) ) ) : NIL_; } static object do_collapse( fBinOper *f, object a, object b ){ return valid( b ) ? f( a, b ) : a; } object collapse( fBinOper *f, list o ){ return valid( o ) ? o->t == LIST ? do_collapse( f, collapse( f, x_( o ) ), collapse( f, xs_( o ) ) ) : o : NIL_; } object reduce( fBinOper *f, int n, object *po ){ return n==1 ? *po : f( *po, reduce( f, n-1, po+1 ) ); } pc9par.h
Interface to the Parser Combinators. Constructing parsers for single characters alphadigitsat or combining parsers together seqplus. Construct a parser using a regex.
#define PC9PAR_H #ifndef PC9FP_H #include "pc9fp.h" #endif #include "ppnarg.h" enum parser_symbols { VALUE = SYM1, PRED, P, PP, NN, Q, R, FF, XX, AA, ID, USE, ATOM, SYM2 }; list parse( parser p, list input ); parser result( object a ); parser zero( void ); parser item( void ); parser bind( parser p, oper f ); parser plus( parser p, parser q ); #define PLUS(...) reduce( plus, PP_NARG(__VA_ARGS__), (object[]){ __VA_ARGS__ } ) parser sat( predicate pred ); parser alpha( void ); parser digit( void ); parser lit( object a ); parser chr( int c ); parser str( char *s ); parser anyof( char *s ); parser noneof( char *s ); parser seq( parser p, parser q ); #define SEQ(...) reduce( seq, PP_NARG(__VA_ARGS__), (object[]){ __VA_ARGS__ } ) parser xthen( parser p, parser q ); parser thenx( parser p, parser q ); parser into( parser p, object id, parser q ); parser maybe( parser p ); parser forward( void ); parser many( parser p ); parser some( parser p ); parser trim( parser p ); parser using( parser p, fOperator *f ); parser regex( char *re ); int par_main( void ); pc9par.c
Implementation of the Parser Combinators. Includes 3 "internal DSL" examples with the regex() function, and pprintf() and pscanf() functions.
#include <ctype.h> #include <stdarg.h> #include <string.h> #include "pc9par.h" #include "pc9objpriv.h" list parse( parser p, list input ){ return valid( p ) && p->t == PARSER && valid( input ) ? p->Parser.f( p->Parser.v, input ) : NIL_; } static list presult( object v, list input ){ return one( cons( assoc( Symbol(VALUE), v ), input ) ); } parser result( object a ){ return Parser( env( 0, 1, Symbol(VALUE), a ), presult ); } static list pzero( object v, list input ){ return NIL_; } parser zero( void ){ return Parser( 0, pzero ); } static list pitem( object v, list input ){ drop( 1, input ); return valid( input ) ? one( cons( x_( input ), xs_( input ) ) ) : NIL_; //return valid( input ) ? one( cons( x_( take( 1, input ) ), xs_( input ) ) ) : NIL_; //strict //return valid( input ) ? one( cons( x_( input ), xs_( input ) ) ) : NIL_; //lazy } parser item( void ){ return Parser( 0, pitem ); } static list pbind( object v, list input ){ parser p = assoc( Symbol(P), v ); oper f = assoc( Symbol(FF), v ); list r = parse( p, input ); return valid( r ) ? join( map( Operator( valid( f->Operator.v ) ? append( copy( f->Operator.v ), v ) : v, f->Operator.f ), r ) ) : NIL_; } parser bind( parser p, oper f ){ return Parser( env( 0, 2, Symbol(P), p, Symbol(FF), f ), pbind ); } static list bplus( object v ){ list r = assoc( Symbol(R), v ); object qq = assoc( Symbol(Q), v ); *r = *at_( r ); return valid( r ) ? append( r, qq ) : qq; } static list cplus( object v ){ parser q = assoc( Symbol(Q), v ); list input = assoc( Symbol(X), v ); return parse( q, input ); } static list pplus( object v, list input ){ parser p = assoc( Symbol(P), v ); parser q = assoc( Symbol(Q), v ); list r = parse( p, input ); object qq = Suspension( env( 0, 2, Symbol(Q), q, Symbol(X), input ), cplus ); return valid( r ) ? r->t == SUSPENSION ? Suspension( env( 0, 2, Symbol(R), r, Symbol(Q), qq ), bplus ) : append( r, qq ) : qq; } parser plus( parser p, parser q ){ if( !q ) return p; return Parser( env( 0, 2, Symbol(P), p, Symbol(Q), q ), pplus ); } static list psat( object v, list input ){ predicate pred = assoc( Symbol(PRED), v ); object r = apply( pred, x_( input ) ); return valid( r ) ? one( cons( x_( input ), xs_( input ) ) ) : NIL_; } parser sat( predicate pred ){ return bind( item(), Operator( env( 0, 1, Symbol(PRED), pred ), psat ) ); } static boolean palpha( object v, object o ){ return isalpha( o->Int.i ) ? T_ : NIL_; } parser alpha( void ){ return sat( Operator( 0, palpha ) ); } static boolean pdigit( object v, object o ){ return isdigit( o->Int.i ) ? T_ : NIL_; } parser digit( void ){ return sat( Operator( 0, pdigit ) ); } static boolean plit( object v, object o ){ object a = assoc( Symbol(X), v ); return eq( a, o ); } parser lit( object a ){ return sat( Operator( env( 0, 1, Symbol(X), a ), plit ) ); } parser chr( int c ){ return lit( Int( c ) ); } parser str( char *s ){ return *s ? seq( chr( *s ), str( s+1 ) ) : result(0); } parser anyof( char *s ){ return *s ? plus( chr( *s ), anyof( s+1 ) ) : zero(); } static list pnone( object v, list input ){ parser p = assoc( Symbol(NN), v ); object r = parse( p, input ); *r = *at_( r ); return valid( r ) ? NIL_ : pitem( 0, input ); } parser noneof( char *s ){ return Parser( env( 0, 1, Symbol(NN), anyof( s ) ), pnone ); } static list pprepend( object v, list o ){ object a = assoc( Symbol(AA), v ); return valid( a ) ? cons( cons( a, x_( o ) ), xs_( o ) ) : o; } static list prepend( list a, list b ){ return map( Operator( env( 0, 1, Symbol(AA), a ), pprepend ), b ); } static list pseq( object v, list output ){ parser q = assoc( Symbol(Q), v ); return prepend( x_( output ), parse( q, xs_( output ) ) ); } parser seq( parser p, parser q ){ if( !q ) return p; return bind( p, Operator( env( 0, 1, Symbol(Q), q ), pseq ) ); } static list pxthen( object v, list o ){ return one( cons( xs_( x_( o ) ), xs_( o ) ) ); } parser xthen( parser p, parser q ){ return bind( seq( p, q ), Operator( 0, pxthen ) ); } static list pthenx( object v, list o ){ return one( cons( x_( x_( o ) ), xs_( o ) ) ); } parser thenx( parser p, parser q ){ return bind( seq( p, q ), Operator( 0, pthenx ) ); } static list pinto( object v, list o ){ object id = assoc( Symbol(ID), v ); parser q = assoc( Symbol(Q), v ); return parse( Parser( env( q->Parser.v, 1, id, x_( o ) ), q->Parser.f ), xs_( o ) ); } parser into( parser p, object id, parser q ){ return bind( p, Operator( env( 0, 2, Symbol(ID), id, Symbol(Q), q ), pinto ) ); } parser maybe( parser p ){ return plus( p, result(0) ); } parser forward( void ){ return Parser( 0, 0 ); } parser many( parser p ){ parser q = forward(); parser r = maybe( seq( p, q ) ); *q = *r; return r; } parser some( parser p ){ return seq( p, many( p ) ); } static list ptrim( object v, list input ){ parser p = assoc( Symbol(PP), v ); list r = parse( p, input ); return valid( r ) ? one( x_( take( 1, r ) ) ) : r; } parser trim( parser p ){ return Parser( env( 0, 1, Symbol(PP), p ), ptrim ); } static list pusing( object v, list o ){ oper f = assoc( Symbol(USE), v ); return one( cons( apply( f, x_( o ) ), xs_( o ) ) ); } parser using( parser p, fOperator *f ){ return bind( p, Operator( env( 0, 1, Symbol(USE), Operator( 0, f ) ), pusing ) ); } static parser do_meta( parser a, object o ){ switch( o->Int.i ){ case '*': return many( a ); break; case '+': return some( a ); break; case '?': return maybe( a ); break; } return a; } static parser on_meta( object v, object o ){ parser atom = assoc( Symbol(ATOM), v ); return valid( o ) ? do_meta( atom, o ) : atom; } static parser on_dot( object v, object o ){ return item(); } static parser on_chr( object v, object o ){ return lit( o ); } static parser on_term( object v, object o ){ return collapse( seq, o ); } static parser on_expr( object v, object o ){ return collapse( plus, o ); } #define META "*+?" #define SPECIAL META ".|()" parser regex( char *re ){ static parser p; if( !p ){ parser dot = using( chr('.'), on_dot ); parser meta = anyof( META ); parser escape = xthen( chr('\\'), anyof( SPECIAL "\\" ) ); parser chr_ = using( plus( escape, noneof( SPECIAL ) ), on_chr ); parser expr_ = forward(); parser atom = PLUS( dot, xthen( chr('('), thenx( expr_, chr(')') ) ), chr_ ); parser factor = into( atom, Symbol(ATOM), using( maybe( meta ), on_meta ) ); parser term = using( some( factor ), on_term ); parser expr = using( seq( term, many( xthen( chr('|'), term ) ) ), on_expr ); *expr_ = *expr; p = trim( expr ); add_global_root( p ); } list r = parse( p, chars_from_string( re ) ); return valid( r ) ? ( x_( x_( r ) ) ) : r; } parser vusing( parser p, object v, fOperator *f ){ return bind( p, Operator( env( 0, 1, Symbol(USE), Operator( v, f ) ), pusing ) ); } object sum( object a, object b ){ return Int( a->Int.i + b->Int.i ); } boolean nz( object v, object o ){ return o->Int.i ? T_ : NIL_; } static object p_char( object v, list o ){ va_list *p = (void *)v; return putchar(va_arg( *p, int )), Int(1); } static object p_string( object v, list o ){ va_list *p = (void *)v; char *s = va_arg( *p, char* ); return fputs( s, stdout ), Int(strlen( s )); } static object p_lit( object v, list o ){ return putchar( o->Int.i ), Int(1); } static object on_fmt( object v, list o ){ return collapse( sum, o ); } int pprintf( char const *fmt, ... ){ if( !fmt ) return 0; static va_list v; va_start( v, fmt ); static parser p; if( !p ){ parser directive = PLUS( using( chr('%'), p_lit ), vusing( chr('c'), (void *)&v, p_char ), vusing( chr('s'), (void *)&v, p_string ) ); parser term = PLUS( xthen( chr('%'), directive ), using( sat( Operator( 0, nz ) ), p_lit ) ); parser format = many( term ); p = using( format, on_fmt ); add_global_root( p ); } object r = parse( p, chars_from_string( (char*)fmt ) ); drop( 1, r ); va_end( v ); return x_( x_( r ) )->Int.i; } static object convert_char( object v, list o ){ va_list *p = (void *)v; char *cp = va_arg( *p, char* ); *cp = o->Int.i; return Int(1); } static object convert_string( object v, list o ){ va_list *p = (void *)v; char *sp = va_arg( *p, char* ); fill_string( &sp, o ); return Int(1); } static parser on_char( object v, list o ){ return vusing( item(), v, convert_char ); } static parser on_string( object v, list o ){ return vusing( xthen( many( anyof( " \t\n" ) ), many( noneof( " \t\n" ) ) ), v, convert_string ); } static object r_zero( object v, list o ){ return Int(0); } static parser pass( parser p ){ return using( p, r_zero ); } static parser on_space( object v, list o ){ return valid( o ) ? pass( many( anyof( " \t\n" ) ) ) : o; } static parser on_percent( object v, list o ){ return pass( chr('%') ); } static parser on_lit( object v, list o ){ return pass( lit( o ) ); } static object sum_up( object v, list o ){ return collapse( sum, o ); } static parser on_terms( object v, list o ){ return using( collapse( seq, o ), sum_up ); } int pscanf( char const *fmt, ... ){ if( !fmt ) return 0; static va_list v; va_start( v, fmt ); static parser p; if( !p ){ parser space = using( many( anyof( " \t\n" ) ), on_space ); parser directive = PLUS( using( chr('%'), on_percent ), vusing( chr('c'), (void *)&v, on_char ), vusing( chr('s'), (void *)&v, on_string ) ); parser term = PLUS( xthen( chr('%'), directive ), using( sat( Operator( 0, nz ) ), on_lit ) ); parser format = many( seq( space, term ) ); p = using( format, on_terms ); add_global_root( p ); } list fp = parse( p, chars_from_string( (char*)fmt ) ); drop( 1, fp ); parser f = x_( x_( fp ) ); if( !valid( f ) ) return 0; list r = parse( f, chars_from_file( stdin ) ); drop( 1, r ); va_end( v ); return valid( r ) ? x_( x_( r ) )->Int.i : 0; } int test_pscanf(){ char c; PRINT( Int( pscanf( "" ) ) ); PRINT( Int( pscanf( "abc" ) ) ); PRINT( Int( pscanf( " %c", &c ) ) ); PRINT( string_from_chars( Int( c ) ) ); char buf[100]; PRINT( Int( pscanf( "%s", buf ) ) ); PRINT( String( buf, 0 ) ); return 0; } int test_pprintf(){ PRINT( Int( pprintf( "%% abc %c %s\n", 'x', "123" ) ) ); return 0; } int test_regex(){ parser a; PRINT( a = regex( "\\." ) ); PRINT( parse( a, chars_from_string( "a" ) ) ); PRINT( parse( a, chars_from_string( "." ) ) ); PRINT( parse( a, chars_from_string( "\\." ) ) ); parser b; PRINT( b = regex( "\\\\\\." ) ); PRINT( parse( b, chars_from_string( "\\." ) ) ); PRINT( take( 3, parse( b, chars_from_string( "\\." ) ) ) ); parser r; PRINT( r = regex( "a?b+(c).|def" ) ); PRINT( parse( r, chars_from_string( "abc" ) ) ); PRINT( parse( r, chars_from_string( "abbcc" ) ) ); PRINT( Int( garbage_collect( r ) ) ); list s; PRINT( s = parse( r, chars_from_string( "def" ) ) ); PRINT( take( 3, s ) ); PRINT( parse( r, chars_from_string( "deff" ) ) ); PRINT( parse( r, chars_from_string( "adef" ) ) ); PRINT( parse( r, chars_from_string( "bcdef" ) ) ); PRINT( Int( garbage_collect( cons( r, s ) ) ) ); parser t; PRINT( t = regex( "ac|bd" ) ); PRINT( parse( t, chars_from_string( "ac" ) ) ); PRINT( take( 1, parse( t, chars_from_string( "bd" ) ) ) ); PRINT( Int( garbage_collect( t ) ) ); parser u; PRINT( u = regex( "ab|cd|ef" ) ); PRINT( parse( u, chars_from_string( "ab" ) ) ); PRINT( parse( u, chars_from_string( "cd" ) ) ); PRINT( take( 1, parse( u, chars_from_string( "cd" ) ) ) ); PRINT( parse( u, chars_from_string( "ef" ) ) ); PRINT( take( 1, parse( u, chars_from_string( "ef" ) ) ) ); PRINT( Int( garbage_collect( u ) ) ); parser v; PRINT( v = regex( "ab+(c).|def" ) ); PRINT( parse( v, chars_from_string( "def" ) ) ); PRINT( take( 2, parse( v, chars_from_string( "def" ) ) ) ); parser w; PRINT( w = regex( "a?b|c" ) ); PRINT( parse( w, chars_from_string( "a" ) ) ); PRINT( parse( w, chars_from_string( "b" ) ) ); PRINT( take( 3, parse( w, chars_from_string( "c" ) ) ) ); PRINT( Int( garbage_collect( w ) ) ); return 0; } int test_env(){ object e = env( 0, 2, Symbol(F), Int(2), Symbol(X), Int(4) ); PRINT( e ); PRINT( assoc( Symbol(F), e ) ); PRINT( assoc( Symbol(X), e ) ); return 0; } object b( object v, object o ){ return one( cons( Int( - x_( o )->Int.i ), xs_( o ) ) ); } int test_parsers(){ list ch = chars_from_string( "a b c 1 2 3 d e f 4 5 6" ); { parser p = result( Int(42) ); PRINT( parse( p, ch ) ); PRINT( Int( garbage_collect( ch ) ) ); } { parser q = zero(); PRINT( parse( q, ch ) ); PRINT( Int( garbage_collect( ch ) ) ); } { parser r = item(); PRINT( r ); PRINT( parse( r, ch ) ); PRINT( x_( parse( r, ch ) ) ); PRINT( take( 1, x_( parse( r, ch ) ) ) ); PRINT( x_( take( 1, x_( parse( r, ch ) ) ) ) ); PRINT( take( 1, x_( take( 1, x_( parse( r, ch ) ) ) ) ) ); PRINT( parse( bind( r, Operator( 0, b ) ), ch ) ); PRINT( Int( garbage_collect( cons( ch, r ) ) ) ); } { parser s = plus( item(), alpha() ); PRINT( s ); PRINT( parse( s, ch ) ); PRINT( take( 2, parse( s, ch ) ) ); PRINT( Int( garbage_collect( ch ) ) ); } { parser t = lit( Int( 'a' ) ); PRINT( parse( t, ch ) ); parser u = str( "a b c" ); PRINT( parse( u, ch ) ); PRINT( Int( garbage_collect( cons( ch, cons( t, u ) ) ) ) ); } return 0; } int par_main(){ return obj_main(), test_env(), test_parsers(), test_regex(), test_pprintf(), test_pscanf(), 0; } pc9tok.h
Interface to the example tokenizer for circa 1975 pre-K&R C. Perhaps too much macro stuff? All the keywords and operators and punctuation which can be matched as exact strings are defined in an X-macro table which associates each string with an identifier. The identifiers are all defined in the enum for use with the symbol typed objects.
#define PC9TOK_H #ifndef PC9PAR_H #include "pc9par.h" #endif #define Each_Symbolic(_) \ _("int", k_int) _("char", k_char) _("float", k_float) _("double", k_double) _("struct", k_struct) \ _("auto", k_auto) _("extern", k_extern) _("register", k_register) _("static", k_static) \ _("goto", k_goto) _("return", k_return) _("sizeof", k_sizeof) \ _("break", k_break) _("continue", k_continue) \ _("if", k_if) _("else", k_else) \ _("for", k_for) _("do", k_do) _("while", k_while) \ _("switch", k_switch) _("case", k_case) _("default", k_default) \ /*_("entry", k_entry)*/ \ _("*", o_star) _("++", o_plusplus) _("+", o_plus) _(".", o_dot) \ _("->", o_arrow) _("--", o_minusminus) _("-", o_minus) _("!=", o_ne) _("!", o_bang) _("~", o_tilde) \ _("&&", o_ampamp) _("&", o_amp) _("==", o_equalequal) _("=", o_equal) \ _("^", o_caret) _("||", o_pipepipe) _("|", o_pipe) \ _("/", o_slant) _("%", o_percent) \ _("<<", o_ltlt) _("<=", o_le) _("<", o_lt) _(">>", o_gtgt) _(">=", o_ge) _(">", o_gt) \ _("=+", o_eplus) _("=-", o_eminus) _("=*", o_estar) _("=/", o_eslant) _("=%", o_epercent) \ _("=>>", o_egtgt) _("=<<", o_eltlt) _("=&", o_eamp) _("=^", o_ecaret) _("=|", o_epipe) \ _("(", lparen) _(")", rparen) _(",", comma) _(";", semi) _(":", colon) _("?", quest) \ _("{", lbrace) _("}", rbrace) _("[", lbrack) _("]", rbrack) \ //End Symbolic #define Enum_name(x,y) y , enum token_symbols { t_id = SYM2, c_int, c_float, c_char, c_string, Each_Symbolic( Enum_name ) SYM3 }; list tokens_from_chars( object v ); int tok_main( void ); pc9tok.c
Implementation of the tokenizer for pre-K&R C. All of the identifiers from the table in the header file are converted into parsers which match the associated string and yield the symbol as output. The next layer can easily match against these symbols. The symbol type object also has an extra data pointer to hold extra stuff. The token functions pack the actual input string and any preliminary whitespace in this pointer in the symbol object. So this data isn't lost, but it's hidden from the parser layer which just deals with token symbols.
#include "pc9tok.h" #include "pc9objpriv.h" static object on_spaces( object v, list o ){ return string_from_chars( o ); } static object on_integer( object v, list o ){ return cons( Symbol(c_int), string_from_chars( o ) ); } static object on_floating( object v, list o ){ return cons( Symbol(c_float), string_from_chars( o ) ); } static object on_character( object v, list o ){ return cons( Symbol(c_char), string_from_chars( o ) ); } static object on_string( object v, list o ){ return cons( Symbol(c_string), string_from_chars( o ) ); } static object on_identifier( object s, list o ){ return cons( Symbol(t_id), string_from_chars( o ) ); } #define On_Symbolic(a,b) \ static object on_##b( object v, list o ){ return cons( Symbol(b), string_from_chars( o ) ); } Each_Symbolic( On_Symbolic ) static parser token_parser( void ){ parser space = using( many( anyof( " \t\n" ) ), on_spaces ); parser alpha_ = plus( alpha(), chr('_') ); parser integer = using( some( digit() ), on_integer ); parser floating = using( SEQ( plus( SEQ( some( digit() ), chr('.'), many( digit() ) ), seq( chr('.'), some( digit() ) ) ), maybe( SEQ( anyof("eE"), maybe( anyof("+-") ), some( digit() ) ) ) ), on_floating ); parser escape = seq( chr('\\'), plus( seq( digit(), maybe( seq( digit(), maybe( digit() ) ) ) ), anyof( "'\"bnrt\\" ) ) ); parser char_ = plus( escape, noneof( "'\n" ) ); parser schar_ = plus( escape, noneof( "\"\n" ) ); parser character = using( SEQ( chr('\''), char_, chr('\'') ), on_character ); parser string = using( SEQ( chr('"'), many( schar_ ), chr('"') ), on_string ); parser constant = PLUS( floating, integer, character, string ); # define Handle_Symbolic(a,b) using( str( a ), on_##b ), parser symbolic = PLUS( Each_Symbolic( Handle_Symbolic ) zero() ); parser identifier = using( seq( alpha_, many( plus( alpha_, digit() ) ) ), on_identifier ); return seq( space, PLUS( constant, symbolic, identifier ) ); } static object on_token( object v, list o ){ object space = x_( o ); object symbol = x_( xs_( o ) ); object string = xs_( xs_( o ) ); return symbol->Symbol.data = cons( space, string ), symbol; return cons( symbol, cons( space, string ) ); } list ptokens_from_chars( object s ){ if( !valid( s ) ) return Symbol(EOF); static parser p; if( !p ){ p = using( token_parser(), on_token ); add_global_root( p ); } list r = parse( p, s ); take( 1, r ); r = x_( r ); return cons( x_( r ), Suspension( xs_( r ), ptokens_from_chars ) ); } list tokens_from_chars( object s ){ return valid( s ) ? Suspension( s, ptokens_from_chars ) : Symbol(EOF); } int test_tokens(){ list tokens = tokens_from_chars( chars_from_string( "'x' auto \"abc\" 12 ;*++'\\42' '\\n' 123 if" ) ); PRINT( tokens ); PRINT( take( 1, tokens ) ); PRINT( take( 2, tokens ) ); PRINT( drop( 1, tokens ) ); PRINT( take( 2, drop( 1, tokens ) ) ); drop( 7, tokens ); PRINT( tokens ); PRINT( Int( garbage_collect( tokens ) ) ); return 0; } int tok_main(){ return par_main(), test_tokens(), 0; } pc9syn.h
Interface to the Syntax Analyzer for pre-K&R C. Pretty simple this time, just extending the symbol ids and declaring the main parser function.
#define PC9SYN_H #ifndef PC9TOK_H #include "pc9tok.h" #endif enum syntax_analysis_symbols { func_def = SYM3, data_def, SYM4 }; list tree_from_tokens( object s ); pc9syn.c
Implementation of the Syntax Analyzer for pre-K&R C. All of the symbols from the tokenizer are converted into parsers which match those symbols and are named with an extra underscore appended. So c_float is an enum, Symbol(c_float) is a symbol object, and c_float_ (with extra underscore) is a parser which matches that token symbol. So all the names in here with underscores, like comma_semi_k_if_, are parsers which match against the tokens coming from the input list.
#include "pc9syn.h" #include "pc9objpriv.h" #define Extra_Symbols(_) \ _(t_id) _(c_int) _(c_float) _(c_char) _(c_string) #define Parser_for_symbolic_(a,b) parser b##_ = lit( Symbol(b) ); #define Parser_for_symbol_(b) parser b##_ = lit( Symbol(b) ); static object on_func_def( object v, list o ){ object s = Symbol(func_def); return s->Symbol.data = o, s; return cons( Symbol(func_def), o ); } static object on_data_def( object v, list o ){ object s = Symbol(data_def); return s->Symbol.data = o, s; } parser parser_for_grammar( void ){ Each_Symbolic( Parser_for_symbolic_ ) Extra_Symbols( Parser_for_symbol_ ) parser identifier = t_id_; parser asgnop = PLUS( o_equal_, o_eplus_, o_eminus_, o_estar_, o_eslant_, o_epercent_, o_egtgt_, o_eltlt_, o_eamp_, o_ecaret_, o_epipe_ ); parser constant = PLUS( c_int_, c_float_, c_char_, c_string_ ); parser lvalue = forward(); parser expression = forward(); *lvalue = *PLUS( identifier, seq( o_star_, expression ), //SEQ( primary, o_arrow_, identifier ), // introduces a left-recursion indirectly SEQ( lparen_, lvalue, rparen_ ) ); parser expression_list = seq( expression, many( seq( comma_, expression ) ) ); parser primary = seq( PLUS( identifier, constant, SEQ( lparen_, expression, rparen_ ), SEQ( lvalue, o_dot_, identifier ) ), maybe( PLUS( SEQ( lparen_, expression_list, rparen_ ), SEQ( lbrack_, expression, rbrack_ ), seq( o_arrow_, identifier ) ) ) ); *expression = *seq( PLUS( primary, seq( o_star_, expression ), seq( o_amp_, expression ), seq( o_minus_, expression ), seq( o_bang_, expression ), seq( o_tilde_, expression ), seq( o_plusplus_, lvalue ), seq( o_minusminus_, lvalue ), seq( lvalue, o_plusplus_ ), seq( lvalue, o_minusminus_ ), seq( k_sizeof_, expression ), SEQ( lvalue, asgnop, expression ) ), maybe( PLUS( seq( PLUS( o_star_, o_slant_, o_percent_ ), expression ), seq( PLUS( o_plus_, o_minus_ ), expression ), seq( PLUS( o_ltlt_, o_gtgt_ ), expression ), seq( PLUS( o_lt_, o_le_, o_gt_, o_ge_ ), expression ), seq( PLUS( o_equalequal_, o_ne_ ), expression ), seq( o_amp_, expression ), seq( o_caret_, expression ), seq( o_pipe_, expression ), seq( o_ampamp_, expression ), seq( o_pipepipe_, expression ), SEQ( quest_, expression, colon_, expression ), seq( comma_, expression ) ) ) ); parser constant_expression = expression; parser statement = forward(); parser statement_list = many( statement ); *statement = *PLUS( seq( expression, semi_ ), SEQ( lbrace_, statement_list, rbrace_ ), SEQ( k_if_, lparen_, expression, rparen_, statement ), SEQ( k_if_, lparen_, expression, rparen_, statement, k_else_, statement ), SEQ( k_do_, statement, k_while_, lparen_, expression, rparen_, semi_ ), SEQ( k_while_, lparen_, expression, rparen_, statement ), SEQ( k_for_, lparen_, maybe( expression ), semi_, maybe( expression ), semi_, maybe( expression ), rparen_, statement ), SEQ( k_switch_, lparen_, expression, rparen_, statement ), SEQ( k_case_, constant_expression, colon_, statement ), SEQ( k_default_, colon_, statement ), seq( k_break_, semi_ ), seq( k_continue_, semi_ ), seq( k_return_, semi_ ), SEQ( k_return_, expression, semi_ ), SEQ( k_goto_, expression, semi_ ), SEQ( identifier, colon_, statement ), semi_ ); parser constant_expression_list = seq( constant_expression, many( seq( comma_, constant_expression ) ) ); parser initializer = plus( constant, constant_expression_list ); parser type_specifier = forward(); parser declarator_list = forward(); parser type_declaration = SEQ( type_specifier, declarator_list, semi_ ); parser type_decl_list = some( type_declaration ); parser sc_specifier = PLUS( k_auto_, k_static_, k_extern_, k_register_ ); *type_specifier = *PLUS( k_int_, k_char_, k_float_, k_double_, SEQ( k_struct_, lbrace_, type_decl_list, rbrace_ ), SEQ( k_struct_, identifier, lbrace_, type_decl_list, rbrace_ ), SEQ( k_struct_, identifier ) ); parser declarator = forward(); *declarator = *seq( PLUS( identifier, seq( o_star_, declarator ), SEQ( lparen_, declarator, rparen_ ) ), maybe( PLUS( seq( lparen_, rparen_ ), SEQ( lbrack_, constant_expression, rbrack_ ) ) ) ); *declarator_list = *seq( declarator, many( seq( comma_, declarator ) ) ); parser decl_specifiers = PLUS( type_specifier, sc_specifier, seq( type_specifier, sc_specifier ), seq( sc_specifier, type_specifier ) ); parser declaration = seq( decl_specifiers, maybe( declarator_list ) ); parser declaration_list = seq( declaration, many( seq( comma_, declaration ) ) ); parser init_declarator = seq( declarator, maybe( initializer ) ); parser init_declarator_list = seq( init_declarator, many( seq( comma_, init_declarator ) ) ); parser data_def = using( SEQ( maybe( k_extern_ ), maybe( type_specifier ), maybe( init_declarator_list ), semi_ ), on_data_def ); parser parameter_list = maybe( seq( expression, many( seq( comma_, expression ) ) ) ); parser function_declarator = SEQ( declarator, lparen_, parameter_list, rparen_ ); parser function_statement = SEQ( lbrace_, maybe( declaration_list ), many( statement ), rbrace_ ); parser function_body = seq( maybe( type_decl_list ), function_statement ); parser function_def = using( SEQ( maybe( type_specifier ), function_declarator, function_body ), on_func_def ); parser external_def = plus( function_def, data_def ); parser program = some( external_def ); return program; } list tree_from_tokens( object s ){ if( !s ) return NIL_; static parser p; if( !p ){ p = parser_for_grammar(); add_global_root( p ); } return parse( p, s ); } int test_syntax(){ char *source = "\n" "int i,j,k 5;\n" "float d 3.4;\n" "int max(a, b, c)\n" "int a, b, c;\n" "{\n" " int m;\n" " m = (a>b)? a:b;\n" " return(m>c? m:c);\n" "}\n" "main( ) {\n" "\tprintf(\"Hello, world\");\n" "}\n" "\t if( 2 ){\n\t x = 5;\n\t } int auto"; object tokens = tokens_from_chars( chars_from_string( source ) ); add_global_root( tokens ); PRINT( take( 4, tokens ) ); object program = tree_from_tokens( tokens ); PRINT( program ); PRINT( x_( x_( ( drop( 1, program ), program ) ) ) ); PRINT_FLAT( x_( x_( program ) ) ); PRINT_DATA( x_( x_( program ) ) ); PRINT( xs_( x_( program ) ) ); PRINT( Int( garbage_collect( program ) ) ); return 0; } int main(){ return tok_main(), test_syntax(), 0; } The input to the test is for the pscanf() calls which looks for the literal "abc" then a %c then a %s. And test is the first rule, so a simple make command will compile and then run the test rule/script.
CFLAGS= -std=c99 -g -Wall -Wpedantic -Wno-switch -Wreturn-type -Wunused-variable CFLAGS+= $(cflags) test : pc9 echo abc j string | ./$< clean : rm *.o pc9 : pc9obj.o pc9fp.o pc9par.o pc9tok.o pc9syn.o $(CC) $(CFLAGS) -o $@ $^ $(LDLIBS) All told, it's just under 1500 lines.
$ wc -l *[ch] 128 pc9fp.c 19 pc9fp.h 316 pc9obj.c 54 pc9obj.h 24 pc9objpriv.h 529 pc9par.c 48 pc9par.h 208 pc9syn.c 12 pc9syn.h 85 pc9tok.c 38 pc9tok.h 28 ppnarg.h 1489 total Output from simple tests. At the very end, the print_data function is used to recover all the strings hidden inside the token symbols in the syntax tree, reconstructing the source code.
$ make -k cc -std=c99 -g -Wall -Wpedantic -Wno-switch -Wreturn-type -Wunused-variable -c -o pc9obj.o pc9obj.c cc -std=c99 -g -Wall -Wpedantic -Wno-switch -Wreturn-type -Wunused-variable -c -o pc9fp.o pc9fp.c cc -std=c99 -g -Wall -Wpedantic -Wno-switch -Wreturn-type -Wunused-variable -c -o pc9par.o pc9par.c cc -std=c99 -g -Wall -Wpedantic -Wno-switch -Wreturn-type -Wunused-variable -c -o pc9tok.o pc9tok.c cc -std=c99 -g -Wall -Wpedantic -Wno-switch -Wreturn-type -Wunused-variable -c -o pc9syn.o pc9syn.c cc -std=c99 -g -Wall -Wpedantic -Wno-switch -Wreturn-type -Wunused-variable -o pc9 pc9obj.o pc9fp.o pc9par.o pc9tok.o pc9syn.o echo abc j string | ./pc9 test_basics: ch = ... test_basics: Int( garbage_collect( ch ) ) = 0 test_basics: take( 1, ch ) = (97 _ ) test_basics: Int( garbage_collect( ch ) ) = 4 test_basics: x_( ch ) = 97 test_basics: Int( garbage_collect( ch ) ) = 1 test_basics: x_( xs_( ch ) ) = ... test_basics: Int( garbage_collect( ch ) ) = 2 test_basics: take( 1, x_( xs_( ch ) ) ) = (_ _ ) test_basics: Int( garbage_collect( ch ) ) = 5 test_basics: take( 5, ch ) = (97 98 99 100 101 _ ) test_basics: Int( garbage_collect( ch ) ) = 12 test_basics: ch = (97 98 99 100 101 ... ) test_basics: Int( garbage_collect( ch ) ) = 1 test_basics: take( 6, ch ) = (97 98 99 100 101 102 _ ) test_basics: Int( garbage_collect( ch ) ) = 9 test_basics: take( 1, ch ) = (97 _ ) test_basics: Int( garbage_collect( ch ) ) = 2 test_basics: take( 2, ch ) = (97 98 _ ) test_basics: Int( garbage_collect( ch ) ) = 3 test_basics: take( 2, ch ) = (97 98 _ ) test_basics: Int( garbage_collect( ch ) ) = 3 test_basics: take( 2, ch ) = (97 98 _ ) test_basics: Int( garbage_collect( ch ) ) = 3 test_basics: take( 2, ch ) = (97 98 _ ) test_basics: Int( garbage_collect( ch ) ) = 3 test_env: e = ((X 4 )(F 2 )() ) test_env: assoc( Symbol_( F, "F" ), e ) = 2 test_env: assoc( Symbol_( X, "X" ), e ) = 4 test_parsers: parse( p, ch ) = ((42 ... )_ ) test_parsers: Int( garbage_collect( ch ) ) = 33 test_parsers: parse( q, ch ) = _ test_parsers: Int( garbage_collect( ch ) ) = 2 test_parsers: r = Parser test_parsers: parse( r, ch ) = ((97 ... )_ ) test_parsers: x_( parse( r, ch ) ) = (97 ... ) test_parsers: take( 1, x_( parse( r, ch ) ) ) = (97 _ ) test_parsers: x_( take( 1, x_( parse( r, ch ) ) ) ) = 97 test_parsers: take( 1, x_( take( 1, x_( parse( r, ch ) ) ) ) ) = (_ _ ) test_parsers: parse( bind( r, Operator( 0, b ) ), ch ) = ((-97 ... )... ) test_parsers: Int( garbage_collect( cons( ch, r ) ) ) = 46 test_parsers: s = Parser test_parsers: parse( s, ch ) = ((97 ... )... ) test_parsers: take( 2, parse( s, ch ) ) = ((97 ... )(97 ... )_ ) test_parsers: Int( garbage_collect( ch ) ) = 76 test_parsers: parse( t, ch ) = ((97 ... )... ) test_parsers: parse( u, ch ) = (((97 32 98 32 99 () )... )... ) test_parsers: Int( garbage_collect( cons( ch, cons( t, u ) ) ) ) = 372 test_regex: a = regex( "\\." ) = _ test_regex: parse( a, chars_from_string( "a" ) ) = _ test_regex: parse( a, chars_from_string( "." ) ) = _ test_regex: parse( a, chars_from_string( "\\." ) ) = _ test_regex: b = regex( "\\\\\\." ) = _ test_regex: parse( b, chars_from_string( "\\." ) ) = _ test_regex: take( 3, parse( b, chars_from_string( "\\." ) ) ) = _ test_regex: r = regex( "a?b+(c).|def" ) = Parser test_regex: parse( r, chars_from_string( "abc" ) ) = ... test_regex: parse( r, chars_from_string( "abbcc" ) ) = ... test_regex: Int( garbage_collect( r ) ) = 13660 test_regex: s = parse( r, chars_from_string( "def" ) ) = ... test_regex: take( 3, s ) = _ test_regex: parse( r, chars_from_string( "deff" ) ) = ... test_regex: parse( r, chars_from_string( "adef" ) ) = ... test_regex: parse( r, chars_from_string( "bcdef" ) ) = ... test_regex: Int( garbage_collect( cons( r, s ) ) ) = 130 test_regex: t = regex( "ac|bd" ) = _ test_regex: parse( t, chars_from_string( "ac" ) ) = _ test_regex: take( 1, parse( t, chars_from_string( "bd" ) ) ) = _ test_regex: Int( garbage_collect( t ) ) = 5294 test_regex: u = regex( "ab|cd|ef" ) = _ test_regex: parse( u, chars_from_string( "ab" ) ) = _ test_regex: parse( u, chars_from_string( "cd" ) ) = _ test_regex: take( 1, parse( u, chars_from_string( "cd" ) ) ) = _ test_regex: parse( u, chars_from_string( "ef" ) ) = _ test_regex: take( 1, parse( u, chars_from_string( "ef" ) ) ) = _ test_regex: Int( garbage_collect( u ) ) = 7804 test_regex: v = regex( "ab+(c).|def" ) = Parser test_regex: parse( v, chars_from_string( "def" ) ) = _ test_regex: take( 2, parse( v, chars_from_string( "def" ) ) ) = _ test_regex: w = regex( "a?b|c" ) = Parser test_regex: parse( w, chars_from_string( "a" ) ) = ... test_regex: parse( w, chars_from_string( "b" ) ) = ... test_regex: take( 3, parse( w, chars_from_string( "c" ) ) ) = ((() ... )_ ) test_regex: Int( garbage_collect( w ) ) = 13306 test_pprintf: Int( pprintf( "%% abc %c %s\n", 'x', "123" ) ) = % abc x 123 12 test_pscanf: Int( pscanf( "" ) ) = 0 test_pscanf: Int( pscanf( "abc" ) ) = 0 test_pscanf: Int( pscanf( " %c", &c ) ) = 1 test_pscanf: string_from_chars( Int( c ) ) = "j" test_pscanf: Int( pscanf( "%s", buf ) ) = 1 test_pscanf: String( buf, 0 ) = "string" test_tokens: tokens = ... test_tokens: take( 1, tokens ) = (c_char _ ) test_tokens: take( 2, tokens ) = (c_char k_auto _ ) test_tokens: drop( 1, tokens ) = (k_auto ... ) test_tokens: take( 2, drop( 1, tokens ) ) = (k_auto c_string _ ) test_tokens: tokens = (c_char k_auto c_string c_int semi o_star o_plusplus ... ) test_tokens: Int( garbage_collect( tokens ) ) = 28834 test_syntax: take( 4, tokens ) = (k_int t_id comma t_id _ ) test_syntax: program = ... test_syntax: x_( x_( ( drop( 1, program ), program ) ) ) = (data_def data_def func_def func_def () ) test_syntax: x_( x_( program ) ) flat= data_def data_def func_def func_def test_syntax: x_( x_( program ) ) data= int i,j,k 5; float d 3.4; int max(a, b, c) int a, b, c; { int m; m = (a>b)? a:b; return(m>c? m:c); } main( ) { printf("Hello, world"); } test_syntax: xs_( x_( program ) ) = (k_if ... ) test_syntax: Int( garbage_collect( program ) ) = 434910 
CFLAGS += -Wextra?\$\endgroup\$fOperfunctions which don't use the environment parameter. It's a good point that I should have checked this, but I think it doesn't tell me anything interesting.\$\endgroup\$