Skip to content
This repository
branch: vms-platform-s…
Fetching contributors…

Cannot retrieve contributors at this time

file 221 lines (177 sloc) 6.65 kb
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 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221
#! perl

# Copyright (C) 2003-2006, Parrot Foundation.

# Create Kate syntax highlighting XML file for IMCC
# Language: Parrot IMCC
# Maintainer: Andy Bussey <andybussey@yahoo.co.uk>, Parrot Team
# Last change: 2007 May 22

use strict;
use warnings;

my $parrot = $ARGV[0];

if ( $parrot eq '-h' ) {
    print "kate_syntax.pl\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";
    exit;
}

$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 kate_syntax.pl $date -->

<language name="IMCC" version="0.2" kateversion="2.0"
section="Sources" extensions="*.pasm;*.pir" mimetype="">

<highlighting>

<list name="special_directives">
END

my %ops;
for my $dir (@imcc_spdirec) {
    $dir =~ s/\.//g;
    print " <item>$dir</item>\n";
    $ops{$dir} = 1;
}

print <<END;
</list>

<list name="ops">
END

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>

<list name="types">
END

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;
</list>

<contexts>

<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" />
END

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_]*" />
</context>

END

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*\$" />
</context>

END

print <<END;
<context name="string" attribute="String" lineEndContext="#pop">
<RegExpr attribute="String" context="#pop" String="'" />
</context>

END

print <<END;
<context name="string_interp" attribute="String Interp"
lineEndContext="#pop">
<HlCStringChar attribute="SpChar" context="#stay" />
<RegExpr attribute="String Interp" context="#pop" String="&quot;" />
</context>

</contexts>

END

print <<END;
<itemDatas>
<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" />
</itemDatas>

</highlighting>

END

print <<END;
<general>

<comments>
<comment name="singleLine" start="#" />
</comments>

<keywords casesensitive="1" />

</general>

</language>

END

# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
Something went wrong with that request. Please try again.