src/jparse1.pl

#!/usr/bin/env perl
# jparse1 -- the nsc parser, second stage of the nscc pipeline. owns:
# the nsc grammar, precedence climbing for expressions, and error
# recovery at statement boundaries (a bad statement is reported and
# skipped to the next ';' or '}' -- one error per line of noise, not a
# cascade of "expected ..." garbage after the first mistake). output
# format .cst.j1 is the indented s-expression tree from jcplib::tree:
# one node opener per line, leaf nodes inlined on their parent's
# opener line, closers glued to the end of the last line they close.
# every STATEMENT node carries an at=L:C atom (source position); pure
# expressions don't (j2..j4 report the enclosing statement's position
# for expression-level errors, and positions die at this stage anyway
# once every syntax error has been reported).
#
# the cst node vocabulary, complete:
#   (unit toplevel...)
#   (func NAME ret=T [linkage=global] (params (param NAME T [const=1])...) (body stmt...))
#   (fdecl NAME ret=T [linkage=global] (params ...))
#   (gvar NAME T [linkage=global] [const=1] (init EXPR|(initlist ...))?)
#   (struct NAME (field NAME T)...)   (typedef NAME T)   (enum NAME (enumval NAME [E])...)
#   (block stmt...)  (decl NAME T [const=1] (init ...)?)  (assign OP LVALUE EXPR)
#   (stmt EXPR)  (if C THEN (else ELSE)?)  (while C BODY)
#   (switch E (case VAL stmt...)* (default stmt...)?)
#   (ret EXPR)?  (break)  (continue)
#   (binop OP A B)  (unop OP A)  (addr A)  (deref A)
#   (member EXPR FIELD)  (index BASE IDX)  (initlist E...)
#   (preinc L) (postinc L) (predec L) (postdec L)  (call NAME ARG...)
#   (icall CALLEE ARG...)
#   (cast T E)  (cond C T E)  (sizeof T)  (sizeof E)
#   (intlit N)  (charlit N)  (strlit "...")  (var NAME)
#
# a parameter list is explicit: () is an error, zero params is written
# (void). a type position accepts a builtin type keyword, struct NAME,
# or an IDENT (a typedef/enum name -- left raw here; jscope2 resolves
# aliases, and reinterprets an (IDENT) cast as grouping when the name
# is no type). i8 a[N] declares a fixed-size array; the type atom is
# [N]T. -> is sugar for (*p).f. name(args) is (call NAME ...) whether
# NAME turns out to be a function or a ptr variable (jscope2 decides);
# any other expr(args) is (icall EXPR ...), an indirect call through a
# ptr. const qualifies decls/params/gvars,
# never functions. unsigned exists only to be rejected with a pointer
# to u8/u16/u32/u64.
#
# this stage's own mini pipeline: in -- preproc -- proc -- out, where
# preproc is the token-line deserialization (jlex0's .toks.j0 format)
# and proc is the parse proper.
use v5.16;
use strict;
use warnings FATAL => 'all';
use FindBin;
use lib "$FindBin::Bin";
use jcplib::util qw(stage_err);
use jcplib::tree qw(write_tree mk);
 
my $RAW = do { local $/; <STDIN>; };
 
my %TYPES = map { $_ => 1 } qw(I8 I16 I32 I64 U8 U16 U32 U64 PTR VOID);
my %TYPE_TXT = (I8 => 'i8', I16 => 'i16', I32 => 'i32', I64 => 'i64',
	U8 => 'u8', U16 => 'u16', U32 => 'u32', U64 => 'u64',
	PTR => 'ptr', VOID => 'void');
my %ASSIGNOPS = map { $_ => 1 } qw(ASSIGN PLUSEQ MINUSEQ STAREQ SLASHEQ PERCENTEQ LSHIFTEQ RSHIFTEQ AMPEQ PIPEEQ CARETEQ);
my %ASSIGN_TXT = (ASSIGN => '=', PLUSEQ => '+=', MINUSEQ => '-=', STAREQ => '*=', SLASHEQ => '/=',
	PERCENTEQ => '%=', LSHIFTEQ => '<<=', RSHIFTEQ => '>>=', AMPEQ => '&=', PIPEEQ => '|=', CARETEQ => '^=');
my %BINOP_PREC = ('OROR' => 1, 'ANDAND' => 2, 'PIPE' => 3, 'CARET' => 4, 'AMP' => 5,
	'EQ' => 6, 'NE' => 6, 'LT' => 7, 'LE' => 7, 'GT' => 7, 'GE' => 7,
	'LSHIFT' => 8, 'RSHIFT' => 8, 'PLUS' => 9, 'MINUS' => 9, 'STAR' => 10, 'SLASH' => 10, 'PERCENT' => 10);
my %BINOP_TXT = (OROR => '||', ANDAND => '&&', PIPE => '|', CARET => '^', AMP => '&',
	EQ => '==', NE => '!=', LT => '<', LE => '<=', GT => '>', GE => '>=',
	LSHIFT => '<<', RSHIFT => '>>', PLUS => '+', MINUS => '-', STAR => '*', SLASH => '/', PERCENT => '%');
my %UNOP_TXT = (MINUS => '-', TILDE => '~', BANG => '!');
 
my $TOKS;    # parsed token arrayref
my $I;       # cursor into it
my $FILE = $ENV{NSCC_FILE} || 'input';
 
sub tok_lncol {
	my ($t) = @_;
	return $t->{l} . ':' . $t->{c};
}
 
sub parse_err {
	my ($t, $msg) = @_;
	stage_err("jparse1: $FILE:" . tok_lncol($t) . ": $msg");
}
 
sub peek { return $TOKS->[$I]; }
sub peek2 { return $TOKS->[$I + 1]; }
 
sub next_tok {
	my $t = $TOKS->[$I];
	$I++ if $t && $t->{t} ne 'EOF';
	return $t;
}
 
sub expect {
	my ($type, $what) = @_;
	my $t = peek();
	parse_err($t, "expected $what, got " . ($t->{t} eq 'EOF' ? 'end of file' : "'$t->{v}'")) unless $t && $t->{t} eq $type;
	return next_tok();
}
 
sub is_type_tok {
	my ($t) = @_;
	return $t && exists $TYPE_TXT{$t->{t}};
}
 
# a type may begin with a builtin type keyword, the struct keyword, or
# an IDENT (a typedef/enum name -- jscope2 resolves which; an IDENT
# that turns out not to name a type is handled there too).
sub tok_starts_type {
	my ($t) = @_;
	return $t && (is_type_tok($t) || $t->{t} eq 'STRUCT' || $t->{t} eq 'IDENT');
}
 
# parse a type, returning its text atom: a builtin name, a typedef/enum
# name left raw for jscope2, or struct.NAME for the struct keyword.
sub parse_type {
	my $t = peek();
	if(is_type_tok($t)) { return $TYPE_TXT{next_tok()->{t}}; }
	if($t->{t} eq 'STRUCT') {
		next_tok();
		my $name = expect('IDENT', 'a struct name');
		return "struct.$name->{v}";
	}
	if($t->{t} eq 'IDENT') { return next_tok()->{v}; }
	parse_err($t, 'expected a type');
}
 
# { e, e, ... } -- a struct/array initializer list (only legal right
# after a decl's '='; jtype3 checks the count and the element types).
sub parse_initlist {
	expect('LBRACE', "'{'");
	my @els;
	if(peek()->{t} ne 'RBRACE') {
		push @els, parse_expr();
		while(peek()->{t} eq 'COMMA') { next_tok(); push @els, parse_expr(); }
	}
	expect('RBRACE', "'}'");
	return mk('initlist', [], \@els);
}
 
# decode a char/string literal's escapes (\n \t \r \0 \\ \' \" and
# \xNN); the surrounding quotes are kept on the text. hex escapes
# decode first, so the simple-escape pass below only ever sees a \x
# with malformed digits (an error).
sub decode_esc {
	my ($s, $t) = @_;
	my $body = substr($s, 1, -1);
	$body =~ s{\\x([0-9A-Fa-f]{2})}{chr(hex($1))}ge;
	$body =~ s{\\(.)}{
		$1 eq 'n' ? "\n" : $1 eq 't' ? "\t" : $1 eq 'r' ? "\r" : $1 eq '0' ? "\0"
		: $1 eq '\\' ? '\\' : $1 eq "'" ? "'" : $1 eq '"' ? '"'
		: (parse_err($t, "unknown escape \\$1"));
	}ge;
	return substr($s, 0, 1) . $body . substr($s, -1);
}
 
sub at_of {
	my ($t) = @_;
	return 'at=' . tok_lncol($t);
}
 
 
sub parse_block {
	my $open = expect('LBRACE', "'{'");
	my @stmts;
	while(1) {
		my $t = peek();
		parse_err($t, 'unexpected end of file in block') unless $t;
		last if $t->{t} eq 'RBRACE';
		last if $t->{t} eq 'EOF';
		push @stmts, parse_stmt();
	}
	expect('RBRACE', "'}'");
	return mk('block', [at_of($open)], \@stmts);
}
 
sub parse_stmt {
	my $t = peek();
	if($t->{t} eq 'LBRACE') { return parse_block(); }
 
	if($t->{t} eq 'UNSIGNED') {
		parse_err($t, "unsigned types are spelled u8/u16/u32/u64");
	}
	if($t->{t} eq 'INCLUDE') {
		parse_err($t, 'malformed include directive -- expected exactly: include "path.nsh"; alone on its own line');
	}
 
	# a statement is a declaration when it starts with const, with a
	# builtin type keyword or struct, or with an IDENT followed by
	# another IDENT (typedef name + variable name) -- anything else
	# IDENT-led (x = ..., x[i] = ..., x++;) is an expression.
	my $is_decl = 0;
	if($t->{t} eq 'CONST') { $is_decl = 1; }
	elsif(is_type_tok($t) || $t->{t} eq 'STRUCT') { $is_decl = 1; }
	elsif($t->{t} eq 'IDENT' && peek2() && peek2()->{t} eq 'IDENT') { $is_decl = 1; }
 
	if($is_decl) {
		my $const = '';
		if($t->{t} eq 'CONST') { $const = 'const=1'; next_tok(); $t = peek(); }
		my $ty = parse_type();
		my $name = expect('IDENT', 'an identifier');
		if(peek()->{t} eq 'LBRACKET') {
			# i32 a[N] -- a fixed-size array; the type atom is [N]T.
			next_tok();
			my $n = expect('INTLIT', 'an array size');
			parse_err($n, 'array size must be a positive decimal') unless $n->{v} =~ /^[1-9][0-9]*$/;
			expect('RBRACKET', "']'");
			$ty = "[$n->{v}]$ty";
		}
		if(peek()->{t} eq 'ASSIGN') {
			next_tok();
			my $init;
			if(peek()->{t} eq 'LBRACE') {
				$init = parse_initlist();
			}
			else {
				$init = parse_expr();
			}
			expect('SEMI', "';'");
			return mk('decl', [$name->{v}, $ty, $const, at_of($t)], [mk('init', [], [$init])]);
		}
		expect('SEMI', "';'");
		return mk('decl', [$name->{v}, $ty, $const, at_of($t)], []);
	}
 
	if($t->{t} eq 'IF') {
		next_tok();
		expect('LPAREN', "'('");
		my $c = parse_expr();
		expect('RPAREN', "')'");
		my $then = parse_stmt();
		my @kids = ($c, $then);
		if(peek()->{t} eq 'ELSE') {
			next_tok();
			push @kids, mk('else', [], [parse_stmt()]);
		}
		return mk('if', [at_of($t)], \@kids);
	}
 
	if($t->{t} eq 'WHILE') {
		next_tok();
		expect('LPAREN', "'('");
		my $c = parse_expr();
		expect('RPAREN', "')'");
		my $body = parse_stmt();
		return mk('while', [at_of($t)], [$c, $body]);
	}
 
	if($t->{t} eq 'SWITCH') {
		next_tok();
		expect('LPAREN', "'('");
		my $e = parse_expr();
		expect('RPAREN', "')'");
		expect('LBRACE', "'{'");
		my @kids = ($e);
		my $seen_default = 0;
		while(1) {
			my $c = peek();
			parse_err($c, 'unexpected end of file in switch') unless $c;
			last if $c->{t} eq 'RBRACE' || $c->{t} eq 'EOF';
			if($c->{t} eq 'CASE') {
				next_tok();
				my $val = parse_unary();
				expect('COLON', "':'");
				my @stmts;
				while(1) {
					my $s = peek();
					last if $s->{t} eq 'CASE' || $s->{t} eq 'DEFAULT' || $s->{t} eq 'RBRACE' || $s->{t} eq 'EOF';
					push @stmts, parse_stmt();
				}
				push @kids, mk('case', [], [$val, @stmts]);
				next;
			}
			if($c->{t} eq 'DEFAULT') {
				parse_err($c, 'duplicate default in switch') if $seen_default;
				$seen_default = 1;
				next_tok();
				expect('COLON', "':'");
				my @stmts;
				while(1) {
					my $s = peek();
					last if $s->{t} eq 'CASE' || $s->{t} eq 'DEFAULT' || $s->{t} eq 'RBRACE' || $s->{t} eq 'EOF';
					push @stmts, parse_stmt();
				}
				push @kids, mk('default', [], \@stmts);
				next;
			}
			parse_err($c, "expected 'case', 'default' or '}', got '$c->{v}'");
		}
		expect('RBRACE', "'}'");
		return mk('switch', [at_of($t)], \@kids);
	}
 
	if($t->{t} eq 'RETURN') {
		next_tok();
		my $at = at_of($t);
		if(peek()->{t} eq 'SEMI') { next_tok(); return mk('ret', [$at], []); }
		my $e = parse_expr();
		expect('SEMI', "';'");
		return mk('ret', [$at], [$e]);
	}
 
	if($t->{t} eq 'BREAK' || $t->{t} eq 'CONTINUE') {
		my $op = lc($t->{t});
		next_tok();
		expect('SEMI', "';'");
		return mk($op, [at_of($t)], []);
	}
 
	if($t->{t} eq 'SEMI') {
		# a bare ';' is a no-op statement: skipped entirely, no node.
		next_tok();
		return mk('block', [at_of($t)], []);
	}
 
	# anything else: an expression statement (assignment, call, ++ ...).
	my $e = parse_expr();
	expect('SEMI', "';'");
	return mk('stmt', [at_of($t)], [$e]);
}
 
 
sub parse_expr { return parse_assign(); }
 
sub parse_assign {
	my $lhs = parse_ternary();
	if(exists $ASSIGNOPS{peek()->{t}}) {
		my $op = next_tok();
		my $rhs = parse_assign();
		return mk('assign', [$ASSIGN_TXT{$op->{t}}], [$lhs, $rhs]);
	}
	return $lhs;
}
 
sub parse_ternary {
	my $c = parse_binary(1);
	if(peek()->{t} eq 'QUES') {
		next_tok();
		my $t = parse_expr();
		expect('COLON', "':'");
		my $e = parse_assign();
		return mk('cond', [], [$c, $t, $e]);
	}
	return $c;
}
 
sub parse_binary {
	my ($minprec) = @_;
	my $lhs = parse_unary();
	while(exists $BINOP_PREC{peek()->{t}} && $BINOP_PREC{peek()->{t}} >= $minprec) {
		my $op = next_tok();
		my $rhs = parse_binary($BINOP_PREC{$op->{t}} + 1);
		$lhs = mk('binop', [$BINOP_TXT{$op->{t}}], [$lhs, $rhs]);
	}
	return $lhs;
}
 
sub parse_unary {
	my $t = peek();
	if(exists $UNOP_TXT{$t->{t}}) {
		next_tok();
		my $e = parse_unary();
		return mk('unop', [$UNOP_TXT{$t->{t}}], [$e]);
	}
	if($t->{t} eq 'AMP') { next_tok(); return mk('addr', [], [parse_unary()]); }
	if($t->{t} eq 'STAR') { next_tok(); return mk('deref', [], [parse_unary()]); }
	if($t->{t} eq 'INC') { next_tok(); return mk('preinc', [], [parse_unary()]); }
	if($t->{t} eq 'DEC') { next_tok(); return mk('predec', [], [parse_unary()]); }
	return parse_postfix();
}
 
sub parse_postfix {
	my $e = parse_primary();
	while(1) {
		my $t = peek();
		if($t->{t} eq 'LPAREN') {
			next_tok();
			my @args;
			if(peek()->{t} ne 'RPAREN') {
				push @args, parse_assign();
				while(peek()->{t} eq 'COMMA') { next_tok(); push @args, parse_assign(); }
			}
			expect('RPAREN', "')'");
			# a bare-name callee is (call NAME ARG...): jscope2 decides
			# whether NAME is a function (a static call, the common
			# case) or a ptr variable (an indirect call). any other
			# callee expression is (icall CALLEE ARG...) -- always an
			# indirect call through a ptr value, checked by jtype3.
			# there is no (*fp)(args) form: *fp is an 8-byte load.
			if($e->{op} eq 'var') {
				$e = mk('call', [$e->{atoms}[0]], \@args);
			}
			else {
				$e = mk('icall', [], [$e, @args]);
			}
			next;
		}
		if($t->{t} eq 'DOT') {
			next_tok();
			my $n = expect('IDENT', 'a field name');
			$e = mk('member', [$n->{v}], [$e]);
			next;
		}
		if($t->{t} eq 'ARROW') {
			next_tok();
			my $n = expect('IDENT', 'a field name');
			$e = mk('member', [$n->{v}], [mk('deref', [], [$e])]);
			next;
		}
		if($t->{t} eq 'LBRACKET') {
			next_tok();
			my $i = parse_expr();
			expect('RBRACKET', "']'");
			$e = mk('index', [], [$e, $i]);
			next;
		}
		if($t->{t} eq 'INC') { next_tok(); $e = mk('postinc', [], [$e]); next; }
		if($t->{t} eq 'DEC') { next_tok(); $e = mk('postdec', [], [$e]); next; }
		last;
	}
	return $e;
}
 
sub parse_primary {
	my $t = peek();
	parse_err($t, 'expected an expression') unless $t;
 
	if($t->{t} eq 'INTLIT') {
		next_tok();
		return mk('intlit', [$t->{v}], []);
	}
	if($t->{t} eq 'CHARLIT') {
		next_tok();
		my $s = decode_esc($t->{v}, $t);
		return mk('charlit', [ord(substr($s, 1, 1))], []);
	}
	if($t->{t} eq 'STRLIT') {
		next_tok();
		return mk('strlit', [decode_esc($t->{v}, $t)], []);
	}
	if($t->{t} eq 'IDENT') {
		next_tok();
		return mk('var', [$t->{v}], []);
	}
	if($t->{t} eq 'SIZEOF') {
		next_tok();
		expect('LPAREN', "'('");
		# sizeof(type) is an atom-carrying node; sizeof(expr) is a
		# kid-carrying node. jtype3 folds both (compile-time
		# constant) and rejects sizeof(void).
		if(tok_starts_type(peek())) {
			my $ty = parse_type();
			expect('RPAREN', "')'");
			return mk('sizeof', [$ty], []);
		}
		my $e = parse_expr();
		expect('RPAREN', "')'");
		return mk('sizeof', [], [$e]);
	}
	if($t->{t} eq 'UNSIGNED') {
		parse_err($t, "unsigned types are spelled u8/u16/u32/u64");
	}
	if($t->{t} eq 'INCLUDE') {
		parse_err($t, 'malformed include directive -- expected exactly: include "path.nsh"; alone on its own line');
	}
	if($t->{t} eq 'LPAREN') {
		# (type)expr is a cast; (expr) is grouping. when the next
		# token after '(' could start a type (builtin, struct, or an
		# IDENT -- a typedef name), it parses as a cast and jscope2
		# reinterprets the IDENT case as grouping when the name turns
		# out not to be a type.
		if(tok_starts_type(peek2()) && $TOKS->[$I + 1] && $TOKS->[$I + 2] && $TOKS->[$I + 2]->{t} eq 'RPAREN') {
			next_tok();
			my $ty = parse_type();
			next_tok();  # RPAREN
			return mk('cast', [$ty], [parse_unary()]);
		}
		next_tok();
		my $e = parse_expr();
		expect('RPAREN', "')'");
		return $e;
	}
	parse_err($t, "unexpected token '$t->{v}'");
}
 
 
sub parse_params {
	my @params;
	my $lparen = expect('LPAREN', "'('");
	# nsc is explicit about zero params: () is an error, (void) is
	# the one way to say "no parameters".
	parse_err($lparen, 'empty parameter list: write (void)') if peek()->{t} eq 'RPAREN';
	if(peek()->{t} eq 'VOID' && $TOKS->[$I + 1]->{t} eq 'RPAREN') {
		next_tok();
		expect('RPAREN', "')'");
		return mk('params', [], []);
	}
	while(1) {
		my $t = peek();
		parse_err($t, 'expected a parameter type') unless tok_starts_type($t) || $t->{t} eq 'CONST';
		parse_err($t, 'void must stand alone: write (void)') if $t->{t} eq 'VOID';
		my $const = '';
		if($t->{t} eq 'CONST') { $const = 'const=1'; next_tok(); }
		my $ty = parse_type();
		# extern-style decls may leave a parameter unnamed
		# (i32 fwd(i32);) -- '_' is the placeholder; a function
		# DEFINITION rejects it (parse_toplevel checks once it
		# knows a body follows).
		my $name = '_';
		my $nametok;
		if(peek()->{t} eq 'IDENT') { $nametok = next_tok(); $name = $nametok->{v}; }
		# nsc has no array values, so an array parameter is an error
		# (pass &a[0] instead) -- spelled out, not a bare parse stop.
		parse_err($nametok // peek(), 'array parameters are not allowed: pass &a[0]') if peek()->{t} eq 'LBRACKET';
		push @params, mk('param', [$name, $ty, $const], []);
		last unless peek()->{t} eq 'COMMA';
		next_tok();
	}
	expect('RPAREN', "')'");
	return mk('params', [], \@params);
}
 
sub parse_toplevel {
	my $t = peek();
	# struct declarations: STRUCT IDENT { ... }; -- a struct-TYPED
	# decl (func or var) is STRUCT IDENT IDENT/( instead, and falls
	# through to the generic path below (parse_type knows struct).
	if($t->{t} eq 'STRUCT' && $TOKS->[$I + 1] && $TOKS->[$I + 1]->{t} eq 'IDENT' && $TOKS->[$I + 2] && $TOKS->[$I + 2]->{t} eq 'LBRACE') {
		next_tok();
		my $name = expect('IDENT', 'a struct name');
		expect('LBRACE', "'{'");
		my @fields;
		while(peek()->{t} ne 'RBRACE') {
			my $ft = peek();
			parse_err($ft, 'const struct fields are not supported') if $ft->{t} eq 'CONST';
			parse_err($ft, 'expected a field type') unless tok_starts_type($ft);
			my $fty = parse_type();
			my $fname = expect('IDENT', 'a field name');
			expect('SEMI', "';'");
			push @fields, mk('field', [$fname->{v}, $fty], []);
		}
		expect('RBRACE', "'}'");
		expect('SEMI', "';'");
		return mk('struct', [$name->{v}, at_of($t)], \@fields);
	}
	if($t->{t} eq 'TYPEDEF') {
		next_tok();
		my $ty = parse_type();
		my $name = expect('IDENT', 'a typedef name');
		expect('SEMI', "';'");
		return mk('typedef', [$name->{v}, $ty, at_of($t)], []);
	}
	if($t->{t} eq 'ENUM') {
		next_tok();
		my $name = expect('IDENT', 'an enum name');
		expect('LBRACE', "'{'");
		my @vals;
		while(peek()->{t} ne 'RBRACE') {
			my $vn = expect('IDENT', 'an enumerator name');
			my $v;
			if(peek()->{t} eq 'ASSIGN') { next_tok(); $v = parse_expr(); }
			push @vals, mk('enumval', [$vn->{v}], [$v ? ($v) : ()]);
			last unless peek()->{t} eq 'COMMA';
			next_tok();
		}
		expect('RBRACE', "'}'");
		expect('SEMI', "';'");
		return mk('enum', [$name->{v}, at_of($t)], \@vals);
	}
	if($t->{t} eq 'UNSIGNED') {
		parse_err($t, "unsigned types are spelled u8/u16/u32/u64");
	}
	if($t->{t} eq 'INCLUDE') {
		parse_err($t, 'malformed include directive -- expected exactly: include "path.nsh"; alone on its own line');
	}
	my $linkage = '';
	if($t->{t} eq 'GLOBAL') { $linkage = 'linkage=global'; next_tok(); $t = peek(); }
	my $const = '';
	if($t->{t} eq 'CONST') { $const = 'const=1'; next_tok(); $t = peek(); }
	parse_err($t, 'expected a type at toplevel') unless tok_starts_type($t);
	my $ty = parse_type();
	my $name = expect('IDENT', 'a name');
	my $at = at_of($t);
 
	if(peek()->{t} eq 'LBRACKET') {
		# i32 a[N] -- a fixed-size global array; the type atom is
		# [N]T.
		next_tok();
		my $n = expect('INTLIT', 'an array size');
		parse_err($n, 'array size must be a positive decimal') unless $n->{v} =~ /^[1-9][0-9]*$/;
		expect('RBRACKET', "']'");
		$ty = "[$n->{v}]$ty";
	}
 
	if(peek()->{t} eq 'LPAREN') {
		parse_err($name, 'const cannot qualify a function') if $const;
		my $params = parse_params();
		if(peek()->{t} eq 'LBRACE') {
			for my $p (@{$params->{kids}}) {
				parse_err($name, "parameter '_' needs a name in a function definition") if $p->{atoms}[0] eq '_';
			}
			my $body = mk('body', [], [parse_block()]);
			return mk('func', [$name->{v}, "ret=$ty", grep { length } ($linkage), $at], [$params, $body]);
		}
		expect('SEMI', "';'");
		return mk('fdecl', [$name->{v}, "ret=$ty", grep { length } ($linkage), $at], [$params]);
	}
 
	my $init;
	if(peek()->{t} eq 'ASSIGN') {
		next_tok();
		if(peek()->{t} eq 'LBRACE') {
			$init = parse_initlist();
		}
		else {
			$init = parse_expr();
		}
	}
	expect('SEMI', "';'");
	return mk('gvar', [$name->{v}, $ty, grep { length } ($linkage, $const), $at], [$init ? mk('init', [], [$init]) : ()]);
}
 
# deserialize jlex0's .toks.j0: "TOK TEXT L:C" per line; STRLIT and
# CHARLIT lexemes arrive \xHH-escaped (they may contain spaces) and are
# unescaped back to their source text before parse.
sub preproc {
	my ($text) = @_;
	my @toks;
	for my $line (split /\n/, $text) {
		next unless $line =~ /\S/;
		my ($t, $v, $pos) = split / /, $line, 3;
		stage_err("jparse1: bad token line: $line") unless defined $pos;
		my ($l, $c) = split /:/, $pos, 2;
		$v =~ s/\\x([0-9A-Fa-f]{2})/chr(hex($1))/ge if $t eq 'STRLIT' || $t eq 'CHARLIT';
		push @toks, {t => $t, v => $v, l => $l, c => $c};
	}
	stage_err('jparse1: empty token stream') unless @toks;
	return \@toks;
}
 
sub proc {
	my ($toks) = @_;
	$TOKS = $toks;
	$I = 0;
	my @top;
	while(peek()->{t} ne 'EOF') { push @top, parse_toplevel(); }
	my $unit = mk('unit', [], \@top);
	return write_tree($unit);
}
 
print proc(preproc($RAW));