Greetings. Attached is a patch that I'm currently using in Pugs's bundled PGE.pbc, in order to make PGE output properly escaped strings, in a format ready to be used form Haskell FFI.
I'd appreciate comments, and if it's okay to commit it back to the PGE directory. Thanks, /Autrijus/
==== Patch <-> level 1
Source: [No source]
Target: d31e2699-5ff4-0310-a27c-f18f2fbe73fe:/trunk/compilers/pge:8010
(http://svn.perl.org/parrot/trunk)
Log:
* Haskell-compatible dump of matches
=== PGE/Hs.pir
==================================================================
--- PGE/Hs.pir (revision 8010)
+++ PGE/Hs.pir (patch - level 1)
@@ -0,0 +1,130 @@
+=head1 Title
+
+PGE::Hs - Match and display PGE rules as Haskell expressions
+
+=head1 SYNOPSIS
+
+ .sub _main
+ load_bytecode "PGE.pbc"
+ $P0 = find_global "PGE::Hs", "match"
+ $S0 = $P0("Hello\n", "H(.)llo(.)")
+ print $S0 # Just [(0, "Hello\n"), (1, "e"), (5, "\n")]
+ .end
+
+=cut
+
+.namespace [ "PGE::Hs" ]
+
+.sub __onload
+ load_bytecode "library/Data/Escape.imc"
+.end
+
+.sub "match" method
+ .param string x
+ .param string pattern
+ .local pmc rulesub
+ .local pmc match
+ .local pmc p6rule_compile
+ .local string out
+
+ find_global p6rule_compile, "PGE", "p6rule"
+ null rulesub
+
+ rulesub = p6rule_compile(pattern)
+ match = rulesub(x)
+ match_result:
+ unless match goto match_fail
+ out = "Just ["
+ $S0 = match."dump_hs"()
+ concat out, $S0
+ concat out, "]\n"
+ goto end_match
+ match_fail:
+ out = "Nothing\n"
+ goto end_match
+ end_match:
+ .return (out)
+.end
+
+.namespace [ "PGE::Match" ]
+
+.sub "dump_hs" method
+ .local pmc capt
+ .local int spi, spc
+ .local pmc iter
+ .local string escaped
+ .local pmc escape
+ .local string out
+
+ out = ""
+
+ unless argcS < 3 goto start
+ unless argcS < 2 goto start
+ start:
+ escape = find_global "Data::Escape";, "String"
+ $I0 = self
+ unless $I0 goto subpats
+ $S0 = self
+ escaped = escape($S0)
+ $I0 = self."from"()
+ $S0 = $I0
+ concat out, "("
+ concat out, $S0
+ concat out, ", \""
+ concat out, escaped
+ concat out, "\")"
+
+ subpats:
+ $I0 = self
+ capt = getattribute self, "PGE::Match\x0@:capt"
+ isnull capt, subrules
+ spi = 0
+ spc = elements capt
+ subpats_1:
+ unless spi < spc goto subrules
+ $S0 = spi
+ $I0 = defined capt[spi]
+ unless $I0 goto subpats_2
+ $P0 = capt[spi]
+ bsr dumper
+ subpats_2:
+ inc spi
+ goto subpats_1
+
+ subrules:
+ capt = getattribute self, "PGE::Match\x0%:capt"
+ isnull capt, end
+ iter = new Iterator, capt
+ iter = 0
+ subrules_1:
+ unless iter goto end
+ $S0 = shift iter
+ $I0 = defined capt[$S0]
+ unless $I0 goto subrules_1
+ $P0 = capt[$S0]
+ bsr dumper
+ goto subrules_1
+
+ dumper:
+ $I0 = 0
+ $I1 = elements $P0
+ unless $I0 < $I1 goto dumper_1
+ $P1 = getprop "isarray", $P0
+ if $P1 goto dumper_2
+ $P1 = $P0[-1]
+ concat out, ", "
+ $S0 = $P1."dump_hs"()
+ concat out, $S0
+ dumper_1:
+ ret
+ dumper_2:
+ unless $I0 < $I1 goto dumper_1
+ $P1 = $P0[$I0]
+ concat out, ", "
+ $S0 = $P1."dump_hs"()
+ concat out, $S0
+ inc $I0
+ goto dumper_2
+ end:
+ .return (out)
+.end
=== PGE.pir
==================================================================
--- PGE.pir (revision 8010)
+++ PGE.pir (patch - level 1)
@@ -25,9 +25,12 @@
load()
load = find_global "PGE::P6Rule", "__onload"
load()
+ load = find_global "PGE::Hs", "__onload"
+ load()
.end
.include "PGE/TokenHash.pir"
.include "PGE/Exp.pir"
.include "PGE/Match.pir"
.include "PGE/P6Rule.pir"
+.include "PGE/Hs.pir"
==== BEGIN SVK PATCH BLOCK ====
Version: svk 0.994 (freebsd)
eJx9Vftv29YVdlAs3YSkgIetS+e1uFAYwM4kmQ+ZlrXYUzo+JFm25Spp4kaGekle2pwpkuAjtQtt
HR+iHrZsqxvQ7af9qzuUE2wFthkGdS/P+b7vnMtzz5HcF7+rMYOdHXpAMfSg8+VutdrGvnr6BHYU
PyCa4dsutTEwyVtiUtzAtE+o8sDCfQJWH7snxN/ZYQBcuQOLC8B7knLGoWDftjxqa0HW811CKGZQ
rm0MauygxgF0wIDRdojVc23bBzGG5yscWHtZTKppe6SXYcEZUODPUkz5DqAZLlFB8AJCa8vigus9
fuFafk+tGyahNjOnkmO4P3LkMqGNd0L/ZgSXLEI+o+GoygBr2h0LBAU063XvHRPbo9hBkfnfPGzG
s3FnxY5jXvR8cu5rxPRxxg3vOW4Lzm9/aWnpbw+HXyUv/9KSl/4udgX7h8bZXAzvCctD4ZPdMBcK
4cdXQli6apwNxbAGyxdyuDcRoweJEOVCqftDM3ySSDgW/FDsHvj/kKI1EcshM5K61534cSr9cSoV
o3Z8KIYsPCOhNG7Fh3K8HgoRI9it8Nf7ycMwUwxLUvJQCnNJI/5aTFg5xtFB8nkox00pVAAd1ZPz
SFgsx2BP5eFniTzkEliPpPBbQErhczBegnsqDPVQGF4cpssJGMRhJ6nH583ha2lYk4cno6O00khF
2Mzq8c++iHjxUTNqNtL7e/FvmvGrpDU6FkJr3B4dJ51kJRSj7w5HXWlMd5MVQIdS4slDaSKlv0+k
kXMw/ibcn3woTh4CHzi1w18J0UUkRX+GlEIxpuWhnx1j0pr8XJi40uSn6e4waEzO5TEdydPfQoBK
c+Km9fQjOXwedlIqhJBx+nHyxfTb1pjeS5/G4tiRp8vAfzBxhVH/RpzmpeRQHj0bwg68IzE5gVUo
XL4SS9nhSCkVC1NuVB+ZAIz2hjXh6vNQvNqrTx80ryry9NNo9/LrkXhVSqTo8avpvUiaLYvhL/dn
bCKkH4rjlcasDXpxY7ayN9sN5csXYgn2p5d++PrqUyF6Kl7n/toE9psPhJSqXxcOrs7Emw/qaa01
W06a40edGRUfzaryzXp7dtS4+dPezG1eP6rffhLJs6B12csibF0dRvC7O70XircufCVp9rZx+5lw
G3zfmN+LxHmhNV+pz17DixTCPLj8RWvox2r6k/ocQTCRMHLq868gOWW+LMz7kXzzXe35/EK6flCf
au35y/hotLx9SrDGoBeGb5JcDu5RtVr3UBHtZQ0DYUtDmuE5Jr5AYENuYBIPYQ/VsXdGTBORc8cl
nmdAR8nlOkf7B+1Oo5PLIfgreYGCen1sWKaNtZ5y4RPV1gjKL+68ouapNo22kW5YWu/EtBVs5gso
3+/A69V8HcjtrlVfLa3BAp75Ncc1LB+hx6gZeD56s0qvFdAqAxCyAY9jYmm53LYa+LlcKeuHnoNV
gt6g41yuZ1vINBQXuxfrAvbxuuip2CElo6/mc6hP/FNbc7CL+8jzQeQEnTvY94lbMm0Vm8jpq4Hi
8D3V7jvQb+yCFUDm26vwf96D7APTrwYWHIx3Yvu2jg3TDnzILF/Ka0Hf6Z16+VXVtlTsF/LHXQsC
7e3b/ikIlVziB66FVgGwBiH5nmMUkOeoBqiTPLRztYOeIc6Dzs5Wq52GR0wdYsG+B+JUhy7lddfu
N1YLqJvv5tdAFAYAxO4aSuCT7jldqxpeAVjBArQm6RPL93rMM8fQCJw80d6AsccqnosMS2WegC64
WuQb1IAlTAq3cGroPkjlENVgqPYzEHBc20F5w8Ouiy/yBUOHT/amCEbGJVQD8quV/3NW3DVp6Nkc
O6jwfJnWsKKzOsOqBBqtpmFe3+I2MdF17v935nLGQPOKinl1Q69UKpzKK+xmRdMrvM5zCr1FiEJt
snetO/3DaPmj9aXhl0v/XArvD7dv76fbWV1m1fjjuluUZFb3JTgDM3hXozBQ/mseiyi0DVqvKFuq
gnXMlxm6QrMKz5QrfHmjXKG5zcVA4/jB0/c3pZhVD/YNxSQoqwpk66if3THigW9xZ4cdUCx7N7Rf
LOZ4tfrSMt4S18PmExh65QHAT2GuuuQtbILA0CiWHqz7bmCdrb+rTddbd04ImCs0Q2f6GscQlt/a
Km7oerlIcwxdxOymWtSZCnwChWxyOvkX2ivcGA==
==== END SVK PATCH BLOCK ====
pgpt2YJZQPe3P.pgp
Description: PGP signature
