runtime/parrot/library/PGE/Hs.pir

   1 =head1 Title
   2
   3 PGE::Hs - Match and display PGE rules as Haskell expressions
   4
   5 =head1 SYNOPSIS
   6
   7 (You need to run C<make PGE-Hs.pbc> in F<compilers/pge> first.)
   8
   9     .sub _main
  10         load_bytecode "PGE.pbc"
  11         load_bytecode "PGE/Hs.pir"
  12         $P0 = find_global "PGE::Hs", "match"
  13         $S0 = $P0("Hello", "(...)*$")
  14         print $S0   # PGE_Match 2 5 [PGE_Array [PGE_Match 2 5 [] []]] []
  15     .end
  16
  17 =head1 DESCRIPTION
  18
  19 The Haskell-side data structure is defined thus:
  20
  21     data MatchPGE
  22         = PGE_Match Int Int [MatchPGE] [(String, MatchPGE)]
  23         | PGE_Array [MatchPGE]
  24         | PGE_String String
  25         | PGE_Fail
  26         deriving (Show, Eq, Ord, Read)
  27
  28 This F<PGE-Hs.pbc> is built separately (not by default).  The reason is
  29 because it's intended to be bundled with Pugs, so as to make Pugs usable
  30 with vanilla Parrot from 0.2.0 on, using either an external F<parrot>
  31 executable, or a linked F<libparrot>.
  32
  33 In external F<parrot> mode, Parrot's include path looks into the
  34 F<.pbc> files inside the library tree first, then look into the current
  35 directory, F<.>.  Hence this file includes, rather than loads, the
  36 F<PGE.pbc> library, because if Pugs is shipped with its own copy
  37 of F<PGE.pbc>, Parrot would ignore that file and prefer to load
  38 the one in the Parrot tree instead.
  39
  40 Granted, it is possible to pass in Pugs's own library path into an
  41 environment variable (maybe C<PARROT_LIBS>?), but as this was not in
  42 the 0.3.0 release, I (audreyt) decided to take the easy route. :-)
  43
  44 =head1 CAVEATS
  45
  46 This is an initial sketch.  The dump format may change, and the
  47 whole thing may be taken out or refactored away at any moment.
  48
  49 =cut
  50
  51 .namespace [ "PGE::Hs" ]
  52
  53 .const string PGE_FAIL = "PGE_Fail"
  54 .const string PGE_SUB_POS = "@!list"
  55 .const string PGE_SUB_NAMED = "%!hash"
  56
  57 .sub "__onload" :load
  58     .local pmc load
  59     load_bytecode "Data/Escape.pir"
  60     $P0 = get_class 'PGE::Match'
  61 .end
  62
  63 .sub "add_rule"
  64     .param string name
  65     .param string pattern
  66     .param pmc adverbs :slurpy :named
  67     .local pmc p6rule_compile, rulesub
  68
  69     p6rule_compile = compreg 'PGE::Perl6Regex'
  70     null rulesub
  71
  72     # adverbs['grammar'] = 'PGE::Grammar'
  73     # adverbs['name'] = name
  74     rulesub = p6rule_compile(pattern, adverbs :named :flat)
  75
  76     $I0 = exists adverbs["grammar"]
  77     if $I0 goto done
  78     $P0 = get_class "PGE::Grammar"
  79     if null $P0 goto done
  80     addmethod $P0, name, rulesub
  81
  82   done:
  83     .return (name)
  84 .end
  85
  86 .sub "match"
  87     .param string x
  88     .param string pattern
  89     .param pmc adverbs :slurpy :named
  90     .local string out, tmps
  91     .local pmc rulesub
  92     .local pmc match
  93     .local pmc p6rule_compile
  94     .local pmc capt
  95
  96     p6rule_compile = compreg 'PGE::Perl6Regex'
  97     null rulesub
  98
  99     push_eh match_error
 100     rulesub = p6rule_compile(pattern, adverbs :named :flat)
 101     match = rulesub(x, 'grammar' => 'PGE::Grammar')
 102
 103   match_result:
 104     unless match goto match_fail
 105     tmps = match."dump_hs"()
 106     out .= tmps
 107     goto end_match
 108
 109   match_fail:
 110     out = PGE_FAIL
 111     goto end_match
 112
 113   match_error:
 114     get_results "0, 0", match, out
 115
 116   end_match:
 117     out .= "\n"
 118
 119     .return (out)
 120 .end
 121
 122 .sub unescape
 123     .param string str
 124     .local string ret, tmp
 125     .local int i, j
 126
 127     ret = ""
 128     j = length str
 129     if j == 0 goto END
 130     i = 0
 131
 132 LOOP:
 133     tmp = str[i]
 134     inc i
 135     if i >= j goto FIN
 136
 137     eq tmp, "\\", ESC
 138     concat ret, tmp
 139     goto LOOP
 140
 141 ESC:
 142     tmp = str[i]
 143     inc i
 144     eq tmp, "n", LF
 145     concat ret, tmp
 146     goto UNESC
 147 LF:
 148     concat ret, "\n"
 149 UNESC:
 150     if i >= j goto END
 151     goto LOOP
 152
 153 FIN:
 154     concat ret, tmp
 155 END:
 156     .return(ret)
 157 .end
 158
 159 .namespace [ "PGE::Match" ]
 160
 161 .sub "dump_hs" :method
 162     .local string out
 163     .local int spi, spc
 164     .local int ari, arc
 165     .local int tmpi, cond
 166     .local string tmps, key
 167     .local pmc capt, iter, subelm, elm, escape
 168
 169     out = ""
 170     escape = find_global "Data::Escape", "String"
 171
 172   start:
 173     out .= "PGE_Match "
 174     tmpi = self."from"()
 175     tmps = tmpi
 176     out .= tmps
 177     out .= " "
 178     tmpi = self."to"()
 179     tmps = tmpi
 180     out .= tmps
 181     out .= " ["
 182
 183   subpats:
 184     capt = getattribute self, PGE_SUB_POS
 185     if_null capt, subrules
 186     spi = 0
 187     spc = elements capt
 188     goto subpats_body
 189   subpats_loop:
 190     unless spi < spc goto subrules
 191     out .= ", "
 192   subpats_body:
 193     cond = defined capt[spi]
 194     unless cond goto subpats_fail
 195     elm = capt[spi]
 196     bsr dumper
 197     inc spi
 198     goto subpats_loop
 199   subpats_fail:
 200     out .= PGE_FAIL
 201     inc spi
 202     goto subpats_loop
 203
 204   subrules:
 205     out .= "] ["
 206     capt = self.'hash'()
 207     if_null capt, end
 208     iter = new 'Iterator', capt
 209     iter = 0
 210     unless iter goto end
 211   subrules_body:
 212     key = shift iter
 213     cond = defined capt[key]
 214     unless cond goto subrules_fail
 215     elm = capt[key]
 216     out .= '("'
 217     tmps = escape(key)
 218     out .= tmps
 219     out .= '", '
 220     bsr dumper
 221     out .= ")"
 222     unless iter goto end
 223     out .= ", "
 224     goto subrules_body
 225   subrules_fail:
 226     out .= PGE_FAIL
 227     key = shift iter
 228     unless iter goto end
 229     goto subrules_body
 230
 231   dumper:
 232     $I0 = does elm, "array"
 233     if $I0 goto dumper_array
 234     $I0 = can elm, "dump_hs"
 235     unless $I0 goto dumper_string
 236     tmps = elm."dump_hs"()
 237     out .= tmps
 238     ret
 239   dumper_string:
 240     tmps = escape(elm)
 241     out .= 'PGE_String "'
 242     out .= tmps
 243     out .= '"'
 244     ret
 245   dumper_fail:
 246     out .= PGE_FAIL
 247     ret
 248   dumper_done:
 249     out .= "]"
 250     ret
 251   dumper_array:
 252     ari = 0
 253     arc = elements elm
 254     out .= "PGE_Array ["
 255     unless ari < arc goto dumper_done
 256     goto dumper_array_body
 257   dumper_array_loop:
 258     unless ari < arc goto dumper_done
 259     out .= ", "
 260   dumper_array_body:
 261     subelm = elm[ari]
 262     tmps = subelm."dump_hs"()
 263     out .= tmps
 264     inc ari
 265     goto dumper_array_loop
 266
 267   end:
 268     out .= "]"
 269     .return (out)
 270 .end
 271
 272 # Local Variables:
 273 #   mode: pir
 274 #   fill-column: 100
 275 # End:
 276 # vim: expandtab shiftwidth=4 ft=pir: