Switch branches/tags
Find file
Fetching contributors…
Cannot retrieve contributors at this time
222 lines (177 sloc) 6.49 KB
#! perl
# Copyright (C) 2003-2006, Parrot Foundation.
# Create Kate syntax highlighting XML file for IMCC
# Language: Parrot IMCC
# Maintainer: Andy Bussey <>, Parrot Team
# Last change: 2007 May 22
use strict;
use warnings;
my $parrot = $ARGV[0];
if ( $parrot eq '-h' ) {
print "\n\n", "Create Kate syntax highlighting file for Parrot IMCC.\n",
"Supply the path to your Parrot directory as the only\n",
"argument. The XML file will be written to the standard\n", "output.\n\n";
$parrot =~ s/\/$//;
my @imcc_oplike = qw( .sym .arg prototyped non_prototyped .class
.endclass .param inc dec new defined global clone );
my @imcc_spdirec = qw(.call .result .return .local .const .globalconst
end goto if unless call branch jump jsr ret invoke invokecc throw
rethrow die_hard .emit .eom .sub .end .begin_call
.end_call .pcc_sub .begin_return .end_return .begin_yield
.end_yield .loadlib .namespace .endnamespace .macro .include);
my @pod_start = qw(head[1-6] over back item for begin end pod);
my $pod_start_rx = join '|', @pod_start;
my @imcc_basic_types = qw(int float string pmc);
my $parrot_pmcsh_file = "include/parrot/core_pmcs.h";
my $date = localtime(time);
my $ops_dir = "$parrot/src/ops";
opendir my $PARROT, "$ops_dir" or die "Supply Parrot directory as argument!";
my @ops_files = map { "$ops_dir/$_" } grep /\.ops$/, readdir $PARROT;
closedir $PARROT;
print <<END;
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE language SYSTEM "language.dtd">
<!-- Created automatically by $date -->
<language name="IMCC" version="0.2" kateversion="2.0"
section="Sources" extensions="*.pasm;*.pir" mimetype="">
<list name="special_directives">
my %ops;
for my $dir (@imcc_spdirec) {
$dir =~ s/\.//g;
print " <item>$dir</item>\n";
$ops{$dir} = 1;
print <<END;
<list name="ops">
for my $ops_file (@ops_files) {
open my $OPS, "<", "$ops_file" or die "Can't read $ops_file!";
while (<$OPS>) {
next unless (/^(inline\s+)?op\s+([a-zA-Z]\w*)/);
my $op = $2;
$op =~ s/\.//g;
next if ( $ops{$op} );
print " <item>$op</item>\n";
$ops{$op} = 1;
for my $op (@imcc_oplike) {
$op =~ s/\.//g;
next if ( $ops{$op} );
print " <item>$op</item>\n";
$ops{$op} = 1;
print <<END;
<list name="types">
my %types;
for my $type (@imcc_basic_types) {
$type =~ s/\./\&046;/g;
next if ( $types{$type} );
print " <item>$type</item>\n";
$types{$type} = 1;
open my $TYPES, "<", "$parrot/$parrot_pmcsh_file"
or die "Can't read $parrot/$parrot_pmcsh_file!";
while (<$TYPES>) {
next unless (/^\s+enum_class_(\w+)\,/);
my $type = $1;
$type =~ s/\./\&046;/g;
print " <item>$type</item>\n";
$types{$type} = 1;
close $TYPES;
print <<END;
<context name="default" attribute="Normal Text" lineEndContext="#stay">
<RegExpr attribute="Label" context="#stay" String="[_\\w]+\\:" />
<keyword attribute="Op" context="#stay" String="ops" />
<keyword attribute="Special Directive" context="#stay"
String="special_directives" />
<keyword attribute="Type" context="#stay" String="types" />
<RegExpr attribute="Comment" context="#stay" String="#.*\$" />
<RegExpr attribute="Comment" context="pod"
String="^\\=($pod_start_rx).*" />
<HlCOct attribute="Octal" context="#stay" />
<HlCHex attribute="Hex" context="#stay" />
<Float attribute="Float" context="#stay" />
<Int attribute="Int" context="#stay" />
print <<END;
<RegExpr attribute="Register" context="#stay"
String="[INSP](\\d|[12]\\d|3[01])" />
<RegExpr attribute="TempRegister" context="#stay"
String="\\\$[INSP]\\d+" />
<RegExpr attribute="String" context="string" String="'" />
<RegExpr attribute="String Interp" context="string_interp"
String="&quot;" />
<RegExpr attribute="Identifier" context="#stay"
String="[a-zA-Z_][\\w_]*" />
print <<END;
<context name="pod" attribute="Comment" lineEndContext="#stay">
<LineContinue attribute="Comment" context="#stay" />
<RegExpr attribute="Comment" context="#stay" String="[^\=]*" />
<RegExpr attribute="Comment" context="#pop" String="^\\=cut\\s*\$" />
print <<END;
<context name="string" attribute="String" lineEndContext="#pop">
<RegExpr attribute="String" context="#pop" String="'" />
print <<END;
<context name="string_interp" attribute="String Interp"
<HlCStringChar attribute="SpChar" context="#stay" />
<RegExpr attribute="String Interp" context="#pop" String="&quot;" />
print <<END;
<itemData name="Normal Text" defStyleNum="dsNormal" />
<itemData name="Op" defStyleNum="dsNormal" color="#000080"
selColor="#ffffff" bold="0" italic="0" />
<itemData name="Special Directive" defStyleNum="dsKeyword" />
<itemData name="Type" defStyleNum="dsDataType" />
<itemData name="Comment" defStyleNum="dsComment" />
<itemData name="Octal" defStyleNum="dsBaseN" />
<itemData name="Hex" defStyleNum="dsBaseN" />
<itemData name="Float" defStyleNum="dsFloat" />
<itemData name="Int" defStyleNum="dsDecVal" />
<itemData name="Label" defStyleNum="dsKeyword" />
<itemData name="Register" defStyleNum="dsDecVal" />
<itemData name="TempRegister" defStyleNum="dsDecVal" />
<itemData name="String" defStyleNum="dsString" color="#FF6C6C"
selColor="#FF6C6C" bold="0" italic="0" />
<itemData name="String Interp" defStyleNum="dsString" />
<itemData name="Identifier" defStyleNum="dsDataType" color="#C00000"
selColor="#C00000" bold="0" italic="0" />
<itemData name="SpChar" defStyleNum="dsChar" />
print <<END;
<comment name="singleLine" start="#" />
<keywords casesensitive="1" />
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4: