maxPrime = 6 [0] = 0 i = 1 while < i maxPrime do [i] = i i = + i 1 end i = 2 while < i maxPrime do if [i] then j = * i 2 while < j maxPrime do [j] = 0 j = + j i end end i = + i 1 end

no precompilation; #use Grammar::Tracer; grammar Shanish-grammar { rule TOP { <.ws> <stmts> } rule stmts { <expr>+ } rule expr { <ifExpr> | <whileExpr> | <opExpr> | <storeSet> | <storeGet> | <value> | <var> } rule ifExpr { 'if' <stmts> 'then' <stmts> [ 'else' <stmts> ]? 'end' } rule whileExpr { 'while' <stmts> 'do' <stmts> 'end' } rule storeSet { [ '[' <stmts> ']' | <var> ] '=' <expr> } rule storeGet { '[' <stmts> ']' | <var> } my @keywords = < if then else while do end >; token var { :i <!before @keywords> <[_a..z]> \w* } my @ops = << <= >= == - + * / < > >>; token op { @ops } rule opExpr { <op> <expr> <expr> } token value { '-'? <[0..9]>+ } }

no precompilation; unit class Shanish-toP6; use Grammar::ToAST; has %!store; method TOP ($/) { hang #`[[[ put %!store ]]] } #method stmts ($/) { hang } #method expr ($/) { hang } #method ifExpr ($/) { hang #`[[[ p6 "if &cake() \{\n &cake(:piece(1)) } else \{\n &cake(:piece(2)) }\n" ]]] } #method whileExpr ($/) { hang #`[[[ p6 "while &cake() \{\n &cake(:piece(1)) }\n" ]]] } #method storeSet ($/) # { hang #`[[[ make '%!store{\'' ~ ($<var> // '[\'~' ~ $<stmts>.made ~ '~\']') ~ "'} = " ~ expr-made($<expr>) ]]] } #method storeGet ($/) # { hang #`[[[ make '%!store{\'' ~ ($<var> // '[\'~' ~ $<stmts>.made ~ '~\']') ~ "'}" ]]] } #method opExpr ($/) { hang #`[[[ make expr-made($<expr>[0]) ~ " $<op> " ~ expr-made($<expr>[1]) ]]] } #method value ($/) { hang #`[[[ make ~ $/ ]]] }

no precompilation; unit module Grammar::ToAST; our proto cst2ast (|) is export { say 'cst2ast proto'; {*} } multi cst2ast (Match $_ where *.ast) { say '.ast'; .ast } # if arg is capture, with `.ast`, then return it multi cst2ast (Match $_ where *.list) { say '.list'; .&hashcheck: 0; .&cst2ast for .list } # else `cst2ast` of numbered captures if any multi cst2ast (Match $_ where *.hash) { say '.hash'; .&hashcheck: 1; cst2ast .hash.pairs[0].value } # else `cst2ast` of first named capture value multi cst2ast (Match $_) { say 'Match'; $_ } # else return capture as is multi cst2ast (@_) { say '@_'; .&cst2ast for @_ } # if NOT a single capture, then `cst2ast` args sub hashcheck ($_, $element-count) { # expecting either 0 or 1 hash elements return if .hash == $element-count; note "cst2ast ignoring hash pairs(s):\n", .hash.pairs[$element-count..*].join: "\n" } our proto hung (|) is export { say 'hung proto'; {*} } # Multi that will match for a *quantified* sub-capture `$<foo>` (eg sub-rule was `<foo>*` or `<foo>+`, NOT `<foo>` or `<foo>?`). multi hung (List $captures where *.all ~~ Match) { say '.all'; .&hung for $captures } # Multis that will match for a *non* quantified sub-capture `$<foo>` (i.e. sub-rule was eg `<foo>`, NOT eg `<foo>*`). multi hung (Match $_ where .ast) { say '.ast'; .ast } # if .ast already generated then use that multi hung (Match $_ where .list) { say '.list'; .&hung for .list } # elsif positional captures then use them multi hung (Match $_ where .hash) { say '.hash'; .hash.pairs[0].value } # elsif named captures then use the first value multi hung (Match $_) { say '$_'; $_ } # else use cst (concrete syntax tree capture) sub msg ($msg) { warn "hung $msg" } our proto hang (|) is export { say 'hang proto'; {*} } multi hang () { CALLERS::<$/> .make: hung CALLERS::<$/> } # if nullary `hang` then write caller's `hung` to its `.ast` multi hang ($ast) { CALLERS::<$/> .make: $ast } # elsif unary `hang` then write passed arg to caller's `.ast` multi hang (*@hung) { CALLERS::<$/> .make: do .&hung for @hung } # otherwise write list of `hung` of each passed arg to caller's `.ast` proto wrap { * } multi wrap () { :wrap }