SAFE.setting

# vim: ft=perl6 fdm=marker
my module SAFE;

# Fundamental types {{{
my class Mu {
    method defined() {
        Q:CgOp { (box Bool (obj_is_defined (@ {self}))) }
    }
    method head() { @(self).head }
    method Bool() { self.defined }
    method Str() {
        my $tn := Q:CgOp { (box Str (obj_typename (@ {self}))) };
        if self.defined {
            $tn ~ "()<instance>"
        } else {
            $tn ~ "()"
        }
    }
    method dump() { self.defined ?? "Unknown{self.Str}" !! "undef" }
    method item() { self }
    method so() { self.Bool }
    method not() { ! self.Bool }
    method RAWCREATE(\|$vars) { Q:CgOp {
        (letn ar  (unbox fvarlist (@ {$vars}))
              max (fvarlist_length (l ar))
              i   (int 1)
              obj (obj_newblank (obj_llhow (@ (fvarlist_item (i 0) (l ar)))))
          [whileloop 0 0 (< (l i) (l max)) (prog
              [setslot
                (unbox str (@ (fvarlist_item (l i) (l ar)))) (l obj)
                (nsw (@ (fvarlist_item (+ (l i) (int 1)) (l ar))))]
              [l i (+ (l i) (int 2))])]
          [ns (l obj)])
    } }
    method CREATE() { Q:CgOp { (default_new (@ (l self))) } }
    method new() { Q:CgOp { (default_new (@ {self})) } }
}

my class Any is Mu {
    method at-pos($ix) {
        ($ix == 0) ?? self !! die("Invalid index on non-list")
    }
    method flat() { (self,).flat }

    method sort($cmp = &infix:<leg>) { self.list.sort($cmp) }

    method ACCEPTS($t) { self === $t }
    method !butWHENCE($cr) {
        Q:CgOp { (newgeneralvar (bool 1) (bool 0) (@ {$cr}) (@ {self})) }
    }
}

my class Cool {
    method grep($sm) {
        my $itp = @(self).clone;
        gather while $itp {
            my $r = $itp.shift;
            take $r if $r ~~ $sm;
        }
    }
    method map($func) {
        my $itp = @(self).clone;
        gather while $itp {
            my $r = $itp.shift;
            take $func($r);
        }
    }
    method for($func) {
        my $itp = @(self).clone;
        while $itp {
            my $r = $itp.shift;
            $func($r);
        }
    }

    method say() { self.Str.say }
    method chars() { self.Str.chars }
    method substr($x,$y) { self.Str.substr($x,$y) }

    method at-pos($i) { self.flat.at-pos($i) }
    method elems() { self.flat.elems }
    method iterator() { self.flat.iterator }
    method join($sep) { self.flat.join($sep) }
}

my class Capture {
    has $!positionals;
    has $!named;

    method Capture () { self }
    method list () { @( Q:CgOp { (box Parcel (getslot positionals fvarlist
        (@ {self}))) } ) }
    method hash () { unitem( Q:CgOp { (box Hash (getslot named varhash
        (@ {self}))) } // {} ) }
}
# }}}
# Scalar types {{{
my class Num is Cool {
    has $!value;
    method Str () { Q:CgOp {
        (box Str (num_to_string (unbox num (@ {self}))))
    } }
    method Bool() { Q:CgOp {
        (box Bool (compare != (double 0) (unbox num (@ {self}))))
    } }
    method Numeric() { self }
    method ACCEPTS($t) { self == $t }
    method dump() { self.Str }
}

my class Str is Cool {
    has $!value;
    method Str () { self }
    method ACCEPTS($t) { self eq $t }
    method Bool () { self ne "" }
    method chars() { Q:CgOp {
        (box Num (cast num (str_length (unbox str (@ (l self))))))
    } }
    method say() { Q:CgOp {
        (prog [say (unbox str (@ {self}))]
              [box Bool (bool 1)]
        )
    } }
    method substr($from, $len) { Q:CgOp {
        (box Str (str_substring [unbox str (@ {self})]
                    [cast int (unbox num (@ {$from}))]
                    [cast int (unbox num (@ {$len}))]))
    } }
    method dump() { '"' ~ self ~ '"' }
}

my class Scalar {
    has $!value;
}

my class Sub {
    has $!outer;
    has $!info;

    # Should be for Block, not Sub
    method ACCEPTS($t) { (self)($t) }
}

my class ClassHOW {
    has $!value;
    method isa($obj, $type) { Q:CgOp {
        (box Bool (obj_isa (@ {$obj}) (obj_llhow (@ {$type}))))
    } }
    method does($obj, $role) { self.isa($obj, $role) } #no roles yet
}

my class EnumType is Cool { }
my class Bool is EnumType {
    has $!value;
    method Str() { self ?? "Bool::True" !! "Bool::False" }
    method Bool() { self }
    method ACCEPTS($) { self }
    method Numeric() { self ?? 1 !! 0 }
    our constant True  = Q:CgOp { (box Bool (bool 1)) };
    our constant False = Q:CgOp { (box Bool (bool 0)) };
}
# TODO: import
constant True  = Q:CgOp { (box Bool (bool 1)) };
constant False = Q:CgOp { (box Bool (bool 0)) };
# }}}
# Fundamental scalar operators {{{
sub infix:<~>(\|$bits) { Q:CgOp {
    (letn buf (strbuf_new)
          i   (int 0)
          ar  (unbox fvarlist (@ {$bits}))
          max (fvarlist_length (l ar))
      [whileloop 0 0 (< (l i) (l max)) (prog
          [strbuf_append (l buf)
            (unbox str (@ (methodcall (fvarlist_item (l i) (l ar)) Str)))]
          [l i (+ (l i) (int 1))])]
      [box Str (strbuf_seal (l buf))])
} }

sub infix:<+>($l,$r) { Q:CgOp {
    (box Num (+ (unbox num (@ {$l})) (unbox num (@ {$r}))))
} }

sub infix:<->($l,$r) { Q:CgOp {
    (box Num (- (unbox num (@ {$l})) (unbox num (@ {$r}))))
} }

sub infix:<*>($l,$r) { Q:CgOp {
    (box Num (* (unbox num (@ {$l})) (unbox num (@ {$r}))))
} }

sub infix:</>($l,$r) { Q:CgOp {
    (box Num (/ (unbox num (@ {$l})) (unbox num (@ {$r}))))
} }

sub infix:<< < >>($l,$r) { Q:CgOp {
    (box Bool (< (unbox num (@ {$l})) (unbox num (@ {$r}))))
} }

sub infix:<< > >>($l,$r) { Q:CgOp {
    (box Bool (> (unbox num (@ {$l})) (unbox num (@ {$r}))))
} }

sub infix:<< <= >>($l,$r) { Q:CgOp {
    (box Bool (<= (unbox num (@ {$l})) (unbox num (@ {$r}))))
} }

sub infix:<< >= >>($l,$r) { Q:CgOp {
    (box Bool (>= (unbox num (@ {$l})) (unbox num (@ {$r}))))
} }

sub infix:<< == >>($l,$r) { Q:CgOp {
    (box Bool (== (unbox num (@ {$l})) (unbox num (@ {$r}))))
} }

sub infix:<< != >>($l,$r) { Q:CgOp {
    (box Bool (!= (unbox num (@ {$l})) (unbox num (@ {$r}))))
} }

sub warn($str) { Q:CgOp {
    (prog [note (unbox str (@ {$str.Str}))]
          [box Bool (bool 1)]
    )
} }

sub say(*@obj) { @obj.join('').say }
sub note(*@text) { Q:CgOp { (rnull (note (unbox str (@ {@text.join('').Str})))) } }

sub exit($status = 0) { Q:CgOp {
    (rnull [exit (cast int (unbox num (@ {$status})))])
} }

sub infix:<=>(\$a, \$b) { Q:CgOp { (prog [assign {$a} {$b}] {$a}) } }

sub chars($str) { $str.chars }
sub substr($str, $start, $len = $str.chars - $start) {
    $str.substr($start, $len)
}

sub item($x) { $x }

sub prefix:<not>($x) { $x.not }
sub defined($x) { $x.defined }

# Buglet in STD: standard infix operators look custom inside the setting, and
# forget their precedence.
sub prefix:<-->($v is rw) { $v = ($v - 1); $v }
sub prefix:<++>($v is rw) { $v = ($v + 1); $v }
sub postfix:<-->($v is rw) { my $old = $v; $v = ($v - 1); $old }
sub postfix:<++>($v is rw) { my $old = $v; $v = ($v + 1); $old }

sub prefix:<~>($v) { $v.Str } # should be Stringy
sub prefix:<?>($v) { $v.Bool }
sub prefix:<->($v) { 0 - $v }
sub prefix:<+>($x) { $x.Numeric }

sub prefix:<!>($v) { $v ?? False !! True }

sub infix:<x>($str, $ct) {
    my $i = +$ct;
    my $j = ''; # XXX use strbuf
    while $i >= 1 {
        $i--;
        $j ~= $str;
    }
    $j;
}

sub infix:<leg>($s1, $s2) {
    Q:CgOp { (box Num (cast num (strcmp (unbox str (@ {$s1.Str})) (unbox str (@ {$s2.Str}))))) }
}

sub infix:<ge>($s1, $s2) { ($s1 leg $s2) >= 0 }
sub infix:<gt>($s1, $s2) { ($s1 leg $s2) > 0  }
sub infix:<le>($s1, $s2) { ($s1 leg $s2) <= 0 }
sub infix:<lt>($s1, $s2) { ($s1 leg $s2) < 0  }

sub infix:<eq>($l,$r) { Q:CgOp {
    (box Bool (compare == (unbox str (@ {$l.Str}))
      (unbox str (@ {$r.Str}))))
} }
sub infix:<ne>($l,$r) { Q:CgOp {
    (box Bool (compare != (unbox str (@ {$l.Str}))
      (unbox str (@ {$r.Str}))))
} }
# this one is horribly wrong and only handles the ref eq case.
sub infix:<===>($l,$r) { Q:CgOp {
    (box Bool (compare == (@ {$l}) (@ {$r})))
} }

sub _param_role_inst(\|$t) {
    Q:CgOp { (instrole (unbox fvarlist (@ {$t}))) }
}

sub infix:<but>($obj, $role) { Q:CgOp {
    (ns (stab_what (role_apply (obj_llhow (@ {$obj})) (obj_llhow (@ {$role})))))
} }

sub infix:<~~>($t,$m) { ($m.defined) ?? ($m.ACCEPTS($t)) !! ($t.^does($m)) }
# }}}
# Flow inspection and control {{{
my class CallFrame {
    method caller() { Q:CgOp {
        (letn c (frame_caller (cast frame (@ {self})))
          (ternary
            (!= (letvar c) (null frame))
            (ns (letvar c))
            {Any}))
    } }

    method file() { Q:CgOp { (box Str (frame_file
        (cast frame (@ (l self))))) } }
    method line() { Q:CgOp { (box Num (cast num (frame_line
        (cast frame (@ (l self)))))) } }

    method hints($var) { Q:CgOp { (frame_hint (cast frame (@ (l self)))
        (unbox str (@ (l $var)))) } }
}

sub caller() { Q:CgOp { (ns (frame_caller (frame_caller (callframe)))) } }
sub callframe() { Q:CgOp { (ns (frame_caller (callframe))) } }

sub die($msg) { Q:CgOp { (die (@ {$msg})) } }

# XXX multi dispatch
sub next() {
    Q:CgOp { (control 1 (null frame) (int -1) (null str) (null var)) }
}
sub last() {
    Q:CgOp { (control 2 (null frame) (int -1) (null str) (null var)) }
}
sub redo() {
    Q:CgOp { (control 3 (null frame) (int -1) (null str) (null var)) }
}
sub return(\$obj) is return-pass {
    Q:CgOp { (control 4 (null frame) (int -1) (null str) {$obj}) }
}
sub nextsame() {
    Q:CgOp { (control 9 (null frame) (int -1) (null str) (null obj)) }
}

sub assignop($fn) {
    anon sub _assign(\$lhs, \$rhs) {
        $lhs = $fn($lhs, $rhs)
    }
}

sub notop(&fn) { -> \$x, \$y { !(fn($x,$y)) } }

# }}}
# Aggregate types {{{
# Parcel: immutable list of boxes which have no context - may flatten, may
# autovivify, don't rebind or push/shift/etc
# List: mutable list of boxes without much context.  accessing off end returns
# undefined.  lazy.
# Seq: mutable list of boxes which are taken to be read-only scalars. The .Seq
# coercion makes the elements of a List read-only and maybe fetches them too.
# Array: mutable list of read-write scalar boxes

sub unitem(\$a) { Q:CgOp { (newrwlistvar (@ {$a})) } }

my class Iterator {
    # subclasses must provide .reify, return parcel
}

sub flat(*@x) { @x }

my class Whatever { }

my class EMPTY { }

my class List { ... }
my class Seq { ... }
my class Array { ... }

my class Parcel is Cool {
    has $!value;
    # $!value -> Variable[]

    method flat() { List.SETUP(True, self) }
    method list() { List.SETUP(False, self) }

    method elems() { Q:CgOp {
        (box Num (cast num (fvarlist_length (unbox fvarlist (@ {self})))))
    } }

    method Capture () {
        Q:CgOp {
            (letn n (obj_newblank (obj_llhow (@ {Capture})))
              (setslot positionals (l n) (unbox fvarlist (@ {self})))
              (ns (l n)))
        }
    }

    method LISTSTORE(*@in) {
        my @values = @in;

        # TODO: proper (sized) handling of sub-parcels
        Q:CgOp {
            (rnull
              (letn i    (i 0)
                    tgts (unbox fvarlist (@ {self}))
                    ntgt (fvarlist_length (l tgts))
                    tgt  (null var)
                (whileloop 0 0 (< (l i) (l ntgt))
                  (prog
                    (l tgt (fvarlist_item (l i) (l tgts)))
                    (l i (+ (l i) (i 1)))
                    (ternary (var_islist (l tgt))
                      (prog
                        (sink (methodcall (l tgt) LISTSTORE {@values.clone}))
                        (sink {@values = ()}))
                      (assign (l tgt) {@values ?? @values.shift !! Any}))))))
        };

        @in;
    }

    method iterator() {
        my class ParcelIterator is Iterator {
            has $.reify;
        }
        ParcelIterator.RAWCREATE("reify", self);
    }
}

constant Nil = Q:CgOp { (newrwlistvar (@ (box Parcel (fvarlist_new)))) };

my class List is Cool {
    has @!items;
    has @!rest;
    has $!flat;
    method flat() {
        unitem(Q:CgOp { (box Bool (getslot flat bool (@ {self}))) }
            ?? self !! self.SETUP(True, (&infix:<,>(self.iterator))));
    }
    method list() { unitem(self) }

    method clone() { Q:CgOp {
        (letn selfo (@ {self})
              new (obj_newblank (obj_llhow (l selfo)))
          (setslot flat (l new) (getslot flat bool (l selfo)))
          (setslot items (l new) (vvarlist_clone
              (getslot items vvarlist (l selfo))))
          (setslot rest (l new) (vvarlist_clone
              (getslot rest vvarlist (l selfo))))
          (newrwlistvar (l new)))
    } }

    method SETUP($flat, $parcel) { Q:CgOp {
        (letn new (obj_newblank (obj_llhow (@ {self})))
          (setslot flat (l new) (unbox bool (@ {$flat.Bool})))
          (setslot rest (l new) (vvarlist_from_fvarlist
              (unbox fvarlist (@ {$parcel}))))
          (setslot items (l new) (vvarlist_new_empty))
          (newrwlistvar (l new)))
    } }

    method Seq() {
        Seq.SETUP(True, (&infix:<,>(self.iterator)));
    }

    method Capture () {
        Q:CgOp {
            (letn n (obj_newblank (obj_llhow (@ {Capture})))
              (setslot positionals (l n) (vvarlist_to_fvarlist
                  (getslot items vvarlist (@ {self.eager}))))
              (ns (l n)))
        }
    }

    method dump() { '[' ~ self.map(*.dump).join(', ') ~ ']' }

    #| Takes an object and applies whatever semantics the List subclass
    #| needs to apply on stuff out of the iterator stack
    method _elem(\$x) { $x }

    method !count-items() { Q:CgOp {
        (box Num (cast num (vvarlist_count (getslot items vvarlist (@ {self})))))
    } }

    method !shift-item() { Q:CgOp {
        (vvarlist_shift (getslot items vvarlist (@ {self})))
    } }

    method !item-at-pos($ix) { Q:CgOp {
        (vvarlist_item (cast int (unbox num (@ {$ix}))) (getslot items vvarlist (@ {self})))
    } }

    method !pop-item() { Q:CgOp {
        (vvarlist_pop (getslot items vvarlist (@ {self})))
    } }

    method !push-iterator(\$x) { Q:CgOp {
        (rnull (vvarlist_push (getslot rest vvarlist (@ {self})) {$x}))
    } }

    method !push-item(\$x) { Q:CgOp {
        (rnull (vvarlist_push (getslot items vvarlist (@ {self})) {$x}))
    } }

    method !unshift-item(\$x) { Q:CgOp {
        (rnull (vvarlist_unshift (getslot items vvarlist (@ {self})) {$x}))
    } }

    method !fill($nr) { Q:CgOp {
        (letn  nr    (cast int (unbox num (@ {$nr})))
               items (getslot items vvarlist (@ {self}))
               rest  (getslot rest vvarlist (@ {self}))
               flat  (getslot flat bool (@ {self}))
               v     (null var)
               ItMo  (obj_llhow (@ {Iterator}))
          (whileloop 0 0
            (ternary (< (vvarlist_count (l items)) (l nr))
              (!= (vvarlist_count (l rest)) (i 0)) (b 0))
            (prog
              (l v (vvarlist_shift (l rest)))
              (ternary (ternary (l flat) (var_islist (l v)) (b 0))
                (vvarlist_unshift (l rest) (methodcall (l v) iterator))
                (ternary (obj_isa (@ (l v)) (l ItMo))
                  (vvarlist_unshiftn (l rest) (unbox fvarlist
                      (@ (methodcall (l v) reify))))
                  (vvarlist_push (l items) (methodcall {self} _elem (l v)))))))
          (box Bool (>= (vvarlist_count (l items)) (l nr))))
    } }

    method Bool() { self!fill(1) }
    method shift() {
        self!fill(1);
        self!shift-item;
    }

    method eager() {
        self!fill(1_000_000_000);
        self;
    }

    method head { self!fill(1) ?? self!item-at-pos(0) !! Any }

    method elems() { self!fill(1000_000_000); self!count-items; }
    method Numeric () { self.elems }

    method at-pos($i) {
        self!fill($i + 1);
        self!item-at-pos($i);
    }

    method iterator() {
        my class ListIterator is Iterator {
            has $!list;
            has $!reify;
            method reify() {
                $!reify // ($!reify = (
                    $!list ??
                        ($!list.shift, ListIterator.RAWCREATE("list", $!list,
                            "reify", Any)) !!
                        &infix:<,>()));
            }
        }
        my $itp = self.clone;
        ListIterator.RAWCREATE("list", $itp, "reify", Any);
    }

    method join($sep) {
        my $t;
        for self.flat -> $x {
            $t = ($t.defined ?? ($t ~ ($sep ~ $x)) !! $x);
        }
        $t // '';
    }

    method Str() { self.join(" ") }

    method sort($cmp = &infix:<leg>) {
        my $l = self.list.eager;
        Q:CgOp {
            (letn n (obj_newblank (obj_llhow (@ {List})))
              (setslot flat (l n) (bool 1))
              (setslot items (l n) (vvarlist_sort (@ {$cmp})
                  (getslot items vvarlist (@ {$l}))))
              (setslot rest (l n) (vvarlist_new_empty))
              (newrwlistvar (l n)))
        }
    }

    method push(*@items) {
        self!push-iterator(@items.Seq.eager.iterator)
    }
    method pop() {
        self.eager;
        self!pop-item;
    }

    method unshift(*@a) {
        for reverse(@a) -> $v { self!unshift-item($v) }
    }
}

# exactly like List, but flattens, and with "is copy" semantics on stuff
my class Seq is List {
    method _elem($x) { my $y = $x; $y }
    method Seq { self }
}

my class Array is List {
    method new() {
        Array.SETUP(True, &infix:<,>())
    }

    method LISTSTORE(*@in) {
        # fetch everything NOW in case self is mentioned
        my $inn := @in.Seq.eager;

        Q:CgOp { (rnull
            (setslot items (@ {self}) (getslot items vvarlist (@ {$inn}))))
        };
        unitem(self);
    }

    method !extend($ix, \$var) {
        Q:CgOp {
            (letn i (getslot items vvarlist (@ {self}))
                  ct (- (cast int (unbox num (@ {$ix})))
                        (vvarlist_count (l i)))
              (ternary (>= (l ct) (int 0)) [prog]
                [sink [die "Autovivification collision"]])
              (whileloop 0 0 (!= (l ct) (int 0))
                (prog
                  (l ct (- (l ct) (int 1)))
                  (vvarlist_push (l i) (newrwscalar (@ {Any})))))
              (vvarlist_push (l i) {$var})
              (null var))
        };
    }

    method at-pos($ix) {
        self!List::fill($ix+1)
            ?? self!List::item-at-pos($ix)
            !! Any!Any::butWHENCE(sub (\$var) { self!extend($ix, $var); });
    }
}

my class Hash {
    has $!value;
    method new() { unitem(Q:CgOp { (box Hash (varhash_new)) }) }
    method !extend($key, \$var) {
        Q:CgOp {
            (letn d [unbox varhash (@ {self})]
                  k [unbox str (@ {$key.Str})]
              [ternary (varhash_contains_key (l d) (l k))
                (sink (die "Autovivification collision"))
                (prog)]
              [varhash_setindex (l k) (l d) {$var}]
              [null var])
        };
    }

    method Capture () {
        Q:CgOp {
            (letn n (obj_newblank (obj_llhow (@ {Capture})))
              (setslot positionals (l n) (fvarlist_new))
              (setslot named (l n) (varhash_dup
                  (unbox varhash (@ {self}))))
              (ns (l n)))
        }
    }

    method keys() {
        Q:CgOp {
            (letn n (obj_newblank (obj_llhow (@ {List})))
              (setslot flat (l n) (bool 1))
              (setslot items (l n) (varhash_keys (unbox varhash (@ {self}))))
              (setslot rest (l n) (vvarlist_new_empty))
              (newrwlistvar (l n)))
        }
    }

    method values() {
        gather { for self.keys -> $k { take self.at-key($k) } }
    }

    method list() {
        gather { for self.keys -> $k { take ($k => self.at-key($k)) } }
    }

    method Bool () { self.list.Bool }

    method kv() {
        gather { for self.keys -> $k { take $k; take self.at-key($k) } }
    }

    method invert() {
        my %new;
        for self.keys -> $k { %new{self{$k}} = $k }
        %new
    }

    method LISTSTORE(*@in) {
        my @r := @in.Seq.eager;

        Q:CgOp { (rnull (varhash_clear (unbox varhash (@ {self})))) };

        for @r -> $p { self.{$p.key} = $p.value }

        unitem(self);
    }

    method exists-key($str) {
        Q:CgOp { (box Bool (varhash_contains_key (unbox varhash (@ {self})) (unbox str (@ {$str.Str})))) }
    }

    method delete-key($str) {
        Q:CgOp {
            (letn r   (unbox varhash (@ {self}))
                  k   (unbox str (@ {$str.Str}))
                  old (ternary (varhash_contains_key (l r) (l k))
                               (varhash_getindex (l k) (l r))
                               {Any})
              (varhash_delete_key (l r) (l k))
              (l old))
        };
    }

    method iterator () { self.list.iterator }
    method dump () { '{' ~ self.list.map(*.dump).join(', ') ~ '}' }

    # TODO: We need something like pir:: notation for this to not suck
    method at-key($key) {
        Q:CgOp {
            (box Bool (varhash_contains_key [unbox varhash (@ {self})]
                [unbox str (@ {$key.Str})]))
        }
            ?? Q:CgOp {
                (varhash_getindex [unbox str (@ {$key.Str})]
                  [unbox varhash (@ {self})])
            } !! Any!Any::butWHENCE(sub (\$var) {
                self!extend($key, $var)
            });
    }
}

my class Enum is Cool {
    has $.key;
    has $.value;

    method Capture () {
        Q:CgOp {
            (letn n (obj_newblank (obj_llhow (@ {Capture})))
                  d (varhash_new)
              (setslot positionals (l n) (fvarlist_new))
              (setslot named (l n) (l d))
              (varhash_setindex (unbox str (@ {$!key.Str}))
                (l d) {$!value})
              (ns (l n)))
        }
    }

    method kv() {
        ($.key, $.value);
    }

    method dump() { self.key.dump ~ ' => ' ~ self.value.dump }

    method pairs() {
        self.flat;
    }
}

my class Pair is Enum {
}
# }}}
# List utilities {{{
sub postcircumfix:<[ ]>(\$container, $index) { # TODO: is rwtrans
    $container.defined
        ?? $container.at-pos($index)
        !! Any!Any::butWHENCE(sub (\$var) {
            $container.defined && die("Autovivification collision");
            $container = Array.new;
            $container!Array::extend($index, $var);
        });
}

sub postcircumfix:<{ }>(\$container, $key, :$exists, :$delete) {
    $exists ?? ($container.defined ?? $container.exists-key($key) !! False) !!
    $delete ?? ($container.defined ?? $container.delete-key($key) !! Any) !!
    $container.defined
        ?? $container.at-key($key)
        !! Any!Any::butWHENCE(sub (\$var) {
            $container.defined && die("Autovivification collision");
            $container = Hash.new;
            $container!Hash::extend($key, $var);
        });
}

my class GatherIterator is Iterator {
    has $!frame;
    has $!reify;

    method reify() {
        my $*nextframe;
        $!reify // ($!reify = (
            Q:CgOp {
                (letn getv (cotake (cast frame (@ {$!frame})))
                  (box Parcel (ternary (== (@ {EMPTY}) (@ (l getv)))
                    (fvarlist_new)
                    (fvarlist_new
                      (l getv)
                      {GatherIterator.RAWCREATE("frame", $*nextframe, "reify", Any)}))))
            }));
    }
}

sub _gather($fr) {
    List.SETUP(True, (&infix:<,>(GatherIterator.RAWCREATE("frame", $fr,
        "reify", Any))));
}

sub take($p) { # should be \|$p
    Q:CgOp { (take (l $p)) }
}

sub infix:<< => >>($k, $v) { Pair.RAWCREATE("key", $k, "value", $v) }

sub reverse(*@arr) {
    my @acc;
    while @arr { @acc.push(@arr.pop) }
    @acc;
}

sub push(@arr, *@stuff) { @arr.push(@stuff) }
sub unshift(@arr, *@stuff) { @arr.unshift(@stuff) }
sub pop(@arr) { @arr.pop }
sub shift(@arr) { @arr.shift }
sub join($tween, *@stuff) { @stuff.join($tween) }

sub invert(%h) { %h.invert }
sub keys(%h) { %h.keys }
sub values(%h) { %h.values }

sub grep($filter, *@items) { @items.grep($filter) }
sub map($callback, *@items) { @items.map($callback) }

sub sort(*@bits) { @bits.sort }

sub _array_constructor(\$parcel) { my $r := (anon @new = $parcel);  $r }
sub _hash_constructor(\$parcel)  { my $r := (anon %hash = $parcel); $r }

sub infix:<,>(\|$t) { Q:CgOp { (newrwlistvar (@ {$t})) }; }
# }}}
# Regular expression support {{{
my class Cursor {
    method suppose($rx) {
        my $*IN_SUPPOSE = True;
        my $*FATALS = 0;
        my @*WORRIES;
        my %*WORRIES;
        my $*HIGHWATER = -1;
        my $*HIGHEXPECT = {};
        try {
            my @ret := $rx(self);
            if (@ret) { return @( &infix:<,>(self) ) }
        };
        return ();
    }
    method O (*%hash) {
        Q:CgOp { (cursor_O (cast cursor (@ {self}))
                           (unbox varhash (@ {%hash}))) }
    }
    method list () { @( self.Capture ) }
    method flat () { @( self.Capture ) }
    method iterator () { self.flat.iterator }
    method hash () { %( self.Capture ) }
    method Capture () { Q:CgOp {
        (letn cap (obj_newblank (obj_llhow (@ {Capture})))
          (cursor_unpackcaps (cast cursor (@ {self})) (l cap))
          (newscalar (l cap)))
    } }
    method new($str) { Q:CgOp { (ns (cursor_start
        (@ {self}) (unbox str (@ {$str})))) } }
    method pos() { Q:CgOp { (box Num (cast num (cursor_pos
        (cast cursor (@ {self}))))) } }
    method to() { Q:CgOp { (box Num (cast num (cursor_pos
        (cast cursor (@ {self}))))) } }
    method cursor($np) { Q:CgOp { (ns (cursor_butpos
        (cast cursor (@ {self}))
          (cast int (unbox num (@ {$np}))))) } }
    method orig() { Q:CgOp {
        (box Str (cursor_backing (cast cursor (@ {self})))) } }
    method ws() { Q:CgOp { (cursor_dows (cast cursor (@ {self}))) } }
    method at-key($k) { Q:CgOp {
        (cursor_item (cast cursor (@ {self})) (unbox str (@ {$k.Str})))
    } }
    method at-pos($i) { self.at-key($i) }
    token alpha { <+INTERNAL::alpha> }
}

my class Match {
    method list () { @( self.Capture ) }
    method hash () { %( self.Capture ) }
    method flat () { @( self.Capture ) }
    method iterator () { self.flat.iterator }
    method Capture () { Q:CgOp {
        (letn cap (obj_newblank (obj_llhow (@ {Capture})))
          (cursor_unpackcaps (cast cursor (@ {self})) (l cap))
          (newscalar (l cap)))
    } }
    method at-key($k) { Q:CgOp {
        (cursor_item (cast cursor (@ {self})) (unbox str (@ {$k.Str})))
    } }
    method at-pos($i) { self.at-key($i) }
    method new($) { die "Match.new NYI" }
    method from() { Q:CgOp { (box Num (cast num (cursor_from
        (cast cursor (@ {self}))))) } }
    method to() { Q:CgOp { (box Num (cast num (cursor_pos
        (cast cursor (@ {self}))))) } }
    method pos() { self.to }
    method orig() { Q:CgOp {
        (box Str (cursor_backing (cast cursor (@ {self})))) } }
    method chars() { $.defined ?? $.to - $.from !! 0 }
    method Str() { $.defined ?? $.orig.substr($.from, $.chars) !! "" }
    method dump() {
        "#<match from({ self.from }) to({ self.to }) text({ self }) pos({ @(self).dump }) named({ %(self).dump })>"
    }
    method synthetic(:$cursor!, :$method!, :@captures!, :$from!, :$to!) {
        my $m = Q:CgOp {
            (newscalar (cursor_synthetic
                (cast cursor (@ {$cursor})) (unbox str (@ {$method.Str}))
                (cast int (unbox num (@ {$from})))
                (cast int (unbox num (@ {$to})))))
        };
        # this is wrong.  I need a better way to pass lists into primitives.
        for @captures -> $pair {
            Q:CgOp { (rnull
                (cursor_synthcap (cast cursor (@ {$m}))
                  (unbox str (@ {$pair.key.Str})) (@ {$pair.value}))) };
        }
        $m
    }
}

my class Regex is Sub {
    method ACCEPTS($str) {
        my $i = 0;
        my $mat;
        my $C = Cursor.new($str);
        while !$mat && ($i <= $str.chars) {
            $mat = (self)($C.cursor($i++));
        }
        unitem($mat.head);
    }
}

my class Grammar is Cursor {
    method parse($text) {
        my @results := self.new($text).TOP\
            .grep({ $_.to == $text.chars });
        @results ?? @results.shift !! Any; # TODO List.at-pos
    }
}
# }}}

{YOU_ARE_HERE}