Browse files

[mm] bring rest of SAFE setting over

  • Loading branch information...
1 parent 912935b commit c5ed79f72420a44f4c9b05bf6a326b21cf747e5c @sorear committed Sep 28, 2010
Showing with 507 additions and 552 deletions.
  1. +0 −543 lib/OLD.setting
  2. +498 −4 lib/SAFE.setting
  3. +2 −2 src/CSharpBackend.pm
  4. +5 −2 src/Metamodel.pm
  5. +2 −1 src/Optimizer/Beta.pm
View
543 lib/OLD.setting
@@ -1,543 +0,0 @@
-# vim: ft=perl6
-
-my module SAFE;
-
-# 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
-
-my class Iterator {
- # subclasses must provide .reify, return parcel
-}
-
-my class EMPTY { }
-
-my class List { ... }
-my class Seq { ... }
-my class Array { ... }
-
-sub flat(*@x) { @x }
-
-my class Whatever { }
-
-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 Double (getfield Length
- (unbox 'Variable[]' (@ {self})))))
- } }
-
- method iterator() {
- my class ParcelIterator is Iterator {
- has $.reify;
- }
- ParcelIterator.RAWCREATE("reify", self);
- }
-}
-
-sub infix:<,> is rawcall {
- Q:CgOp { (newrwlistvar (@ (box Parcel (getfield pos (callframe))))) };
-}
-
-sub unitem is rawcall {
- Q:CgOp { (newrwlistvar (@ (pos 0))) }
-}
-
-# Maybe this should be a constant, but constants are currently forced to
-# scalar-nature (TODO)
-sub Nil is rawcall { Q:CgOp { (newrwlistvar (@ (box Parcel (rawnewarr 'Variable')))) } }
-
-my class List is Cool {
- has @!items;
- has @!rest;
- has $!flat;
- method flat() {
- unitem(Q:CgOp { (box Bool (getslot (s flat) (@ {self}))) }
- ?? self !! self.SETUP(True, (&infix:<,>(self.iterator))));
- }
- method list() { unitem(self) }
-
- method clone() { Q:CgOp {
- (letn dys (cast DynObject (@ {self}))
- new (rawnew DynObject (getfield klass (l dys)))
- (rawcall (l new) SetSlot (s flat)
- (rawcall (l dys) GetSlot (s flat)))
- (rawcall (l new) SetSlot (s items) (rawnew VarDeque
- (cast VarDeque (rawcall (l dys) GetSlot (s items)))))
- (rawcall (l new) SetSlot (s rest) (rawnew VarDeque
- (cast VarDeque (rawcall (l dys) GetSlot (s rest)))))
- (newrwlistvar (l new)))
- } }
-
- method SETUP($flat, $parcel) { Q:CgOp {
- (letn new (rawnew DynObject (rawcall (@ {self}) GetMO))
- (rawcall (l new) SetSlot (s flat) (unbox Boolean (@ {$flat.Bool})))
- (rawcall (l new) SetSlot (s rest) (rawnew VarDeque
- (unbox 'Variable[]' (@ {$parcel}))))
- (rawcall (l new) SetSlot (s items) (rawnew VarDeque))
- (newrwlistvar (l new)))
- } }
-
- method Seq() {
- Seq.SETUP(True, (&infix:<,>(self.iterator)));
- }
-
- #| Takes an object and applies whatever semantics the List subclass
- #| needs to apply on stuff out of the iterator stack
- method !elem is rawcall { Q:CgOp { (pos 1) } }
-
- sub has-iterators($self) { Q:CgOp {
- (box Bool (!= (i 0) (rawcall (cast VarDeque (rawcall (cast DynObject (@ {$self})) GetSlot (s rest))) Count)))
- } }
-
- sub count-items($self) { Q:CgOp {
- (box Num (cast Double (rawcall (cast VarDeque (rawcall (cast DynObject (@ {$self})) GetSlot (s items))) Count)))
- } }
-
- sub shift-iterator($self) { Q:CgOp {
- (rawcall (cast VarDeque (rawcall (cast DynObject (@ {$self})) GetSlot (s rest))) Shift)
- } }
-
- sub shift-item($self) { Q:CgOp {
- (rawcall (cast VarDeque (rawcall (cast DynObject (@ {$self})) GetSlot (s items))) Shift)
- } }
-
- method !item-at-pos($ix) { Q:CgOp {
- (getindex (cast Int32 (unbox Double (@ {$ix}))) (cast VarDeque (rawcall (cast DynObject (@ {self})) GetSlot (s items))))
- } }
-
- sub pop-item($self) { Q:CgOp {
- (rawcall (cast VarDeque (rawcall (cast DynObject (@ {$self})) GetSlot (s items))) Pop)
- } }
-
- sub push-iterator is rawcall { Q:CgOp {
- (prog (rawcall (cast VarDeque (rawcall (cast DynObject (@ (pos 0))) GetSlot (s rest))) Push (pos 1)) (null Variable))
- } }
-
- sub push-item is rawcall { Q:CgOp {
- (prog (rawcall (cast VarDeque (rawcall (cast DynObject (@ (pos 0))) GetSlot (s items))) Push (pos 1)) (null Variable))
- } }
-
- method !fill($nr) { Q:CgOp {
- (letn nr (cast Int32 (unbox Double (@ {$nr})))
- items (cast VarDeque (getslot (s items) (@ {self})))
- rest (cast VarDeque (getslot (s rest) (@ {self})))
- flat (cast Boolean (getslot (s flat) (@ {self})))
- v (null Variable)
- ItMo (rawcall (@ {Iterator}) GetMO)
- (whileloop 0 0
- (ternary (< (rawcall (l items) Count) (l nr))
- (!= (rawcall (l rest) Count) (i 0)) (b 0))
- (prog
- (l v (rawcall (l rest) Shift))
- (ternary (ternary (l flat) (getfield islist (l v)) (b 0))
- (rawcall (l rest) Unshift (methodcall (l v) iterator))
- (ternary (rawcall (@ (l v)) Isa (l ItMo))
- (rawcall (l rest) UnshiftN (unbox 'Variable[]'
- (@ (methodcall (l v) reify))))
- (rawcall (l items) Push (methodcall {self} !elem (l v)))))))
- (box Bool (>= (rawcall (l items) Count) (l nr))))
- } }
-
- method Bool() { self!fill(1) }
- method shift() {
- self!fill(1);
- shift-item(self);
- }
-
- 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); count-items(self); }
- 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 push(*@items) {
- push-iterator(self, @items.Seq.eager.iterator)
- }
- method pop() {
- self.eager;
- pop-item(self);
- }
-}
-
-PRE-INIT { Q:CgOp {
- (prog
- (rawsset Kernel.ListMO
- (getfield klass (cast DynObject (@ {List}))))
- (null Variable))
-} }
-
-sub take($p) { # should be \|$p
- Q:CgOp { (rawsccall Kernel.Take (l $p)) }
-}
-
-PRE-INIT {
- Cool.HOW.add-method("grep", anon method grep($sm) {
- my $itp = @(self).clone;
- gather while $itp {
- my $r = $itp.shift;
- take $r if $r ~~ $sm;
- }
- });
- Cool.HOW.add-method("map",
- anon method map($func) {
- my $itp = @(self).clone;
- gather while $itp {
- my $r = $itp.shift;
- take $func($r);
- }
- });
- Cool.HOW.add-method("for",
- anon method for($func) {
- my $itp = @(self).clone;
- while $itp {
- my $r = $itp.shift;
- $func($r);
- }
- });
- Cool.HOW.add-method("say", anon method say() { self.Str.say });
- Cool.HOW.add-method("chars", anon method chars() { self.Str.chars });
- Cool.HOW.add-method("substr",
- anon method substr($x,$y) { self.Str.substr($x,$y) });
-
- Cool.HOW.add-method("at-pos",
- anon method at-pos($i) { self.flat.at-pos($i) });
- Cool.HOW.add-method("elems", anon method elems() { self.flat.elems });
- Cool.HOW.add-method("iterator",
- anon method iterator() { self.flat.iterator });
- Cool.HOW.add-method("join",
- anon method join($sep) { self.flat.join($sep) });
-}
-
-my class CallFrame {
- method caller() { Q:CgOp {
- (letn c (getfield caller (cast Frame (@ (l self))))
- (ternary
- (!= (letvar c) (null Frame))
- (ns (letvar c))
- (l Any)))
- } }
- method outer() { Q:CgOp {
- (letn c (getfield outer (cast Frame (@ (l self))))
- (ternary
- (!= (letvar c) (null Frame))
- (ns (letvar c))
- (l Any)))
- } }
-
- method file() { Q:CgOp { (box Str (rawcall
- (cast Frame (@ (l self))) ExecutingFile)) } }
- method line() { Q:CgOp { (box Num (cast Double (rawcall
- (cast Frame (@ (l self))) ExecutingLine))) } }
-
- method hints($var) { Q:CgOp { (rawcall (cast Frame (@ (l self)))
- LexicalFind (unbox String (@ (l $var)))) } }
-}
-
-PRE-INIT { Q:CgOp { (prog
- [rawsset Kernel.CallFrameMO (getfield klass
- (cast DynObject (@ (l CallFrame))))]
- [null Variable])
-} }
-
-sub caller { Q:CgOp { (ns (getfield caller (getfield caller (callframe)))) } }
-sub callframe { Q:CgOp { (ns (getfield caller (callframe))) } }
-
-sub die($msg) { Q:CgOp { (prog (die (@ (l $msg))) (null Variable)) } }
-# 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 { (prog
- (rawcall (cast DynObject (@ {self})) SetSlot (s items)
- (rawcall (cast DynObject (@ {$inn})) GetSlot (s items)))
- (null Variable))
- };
- unitem(self);
- }
-
- method !extend is rawcall {
- Q:CgOp {
- (letn i (cast VarDeque (getslot (s items) (@ (pos 0))))
- ct (- (cast Int32 (unbox Double (@ (pos 1))))
- (rawcall (l i) Count))
- (ternary (>= (l ct) (int 0)) [prog]
- [die "Autovivification collision"])
- (whileloop 0 0 (!= (l ct) (int 0))
- (prog
- (l ct (- (l ct) (int 1)))
- (rawcall (l i) Push (newrwscalar (@ {Any})))))
- (rawcall (l i) Push (pos 2))
- (null Variable))
- };
- }
-
- method at-pos($ix) {
- self!fill($ix+1)
- ?? self!item-at-pos($ix)
- !! Any!butWHENCE(sub () is rawcall {
- self!extend($ix, Q:CgOp { (pos 0) });
- });
- }
-}
-
-sub postcircumfix:<[ ]> is rawcall {
- my $index ::= Q:CgOp { (pos 1) };
-
- (Q:CgOp { (pos 0) }).defined
- ?? (Q:CgOp { (pos 0) }).at-pos($index)
- !! Any!butWHENCE(sub () is rawcall {
- my $ar := Q:CgOp { (getindex (int 0) (getfield pos
- (getfield outer (callframe)))) };
- $ar.defined && die("Autovivification collision");
- $ar = Array.new;
- $ar!extend($index, Q:CgOp { (pos 0) });
- });
-}
-
-my class Hash {
- has $!value;
- method new() { Q:CgOp { (box Hash (rawnew Dictionary<string,Variable>)) } }
- method !extend is rawcall {
- Q:CgOp {
- (letn d [unbox Dictionary<string,Variable> (@ (pos 0))]
- k [unbox String (@ (methodcall (pos 1) Str))]
- [ternary (rawcall (l d) ContainsKey (l k))
- (die "Autovivification collision")
- (prog)]
- [setindex (l k) (l d) (pos 2)]
- [null Variable])
- };
- }
-
- # TODO: We need something like pir:: notation for this to not suck
- method at-key($key) {
- Q:CgOp {
- (box Bool (rawcall [unbox Dictionary<string,Variable> (@ (l self))]
- ContainsKey [unbox String (@ (methodcall (l $key) Str))]))
- }
- ?? Q:CgOp {
- (getindex [unbox String (@ (methodcall (l $key) Str))]
- [unbox Dictionary<string,Variable> (@ (l self))])
- } !! Any!butWHENCE({ self!extend($key, Q:CgOp { (pos 0) }) });
- }
-}
-
-PRE-INIT {
- Q:CgOp { (prog (rawsset Kernel.ArrayP (@ (l Array)))
- (rawsset Kernel.HashP (@ (l Hash)))
- (null Variable)) };
-
- Any.HOW.add-method("at-pos", anon method at-pos($ix) {
- ($ix == 0) ?? self !! die("Invalid index on non-list")
- });
-}
-
-sub postcircumfix:<{ }> is rawcall {
- my $key ::= Q:CgOp { (pos 1) };
-
- (Q:CgOp { (pos 0) }).defined
- ?? (Q:CgOp { (pos 0) }).at-key($key)
- !! Any!butWHENCE(sub () is rawcall {
- my $ar := Q:CgOp { (getindex (int 0) (getfield pos
- (getfield outer (callframe)))) };
- $ar.defined && die("Autovivification collision");
- $ar = Hash.new;
- $ar!extend($key, Q:CgOp { (pos 0) });
- });
-}
-
-my class GatherIterator is Iterator {
- has $!frame;
- has $!reify;
-
- method reify() {
- my $*nextframe;
- $!reify // ($!reify = (
- Q:CgOp {
- (letn getv (rawsccall Kernel.CoTake (cast Frame
- (@ {$!frame})))
- (box Parcel (ternary (== (@ {EMPTY}) (@ (l getv)))
- (rawnewarr Variable)
- (rawnewarr Variable
- (l getv)
- {GatherIterator.RAWCREATE("frame", $*nextframe, "reify", Any)}))))
- }));
- }
-}
-
-sub _gather($fr) {
- List.SETUP(True, (&infix:<,>(GatherIterator.RAWCREATE("frame", $fr,
- "reify", Any))));
-}
-
-my class Cursor {
- method new($str) { Q:CgOp { (ns (rawnew Cursor
- (@ {self}) (unbox System.String (@ {$str})))) } }
- method pos { Q:CgOp { (box Num (cast Double (getfield pos
- (cast Cursor (@ {self}))))) } }
- method cursor($np) { Q:CgOp { (ns (rawcall
- (cast Cursor (@ {self})) At
- (cast Int32 (unbox Double (@ {$np}))))) } }
- method orig { Q:CgOp {
- (box Str (getfield backing (cast Cursor (@ {self})))) } }
- method ws() { Q:CgOp { (rawcall (cast Cursor (@ {self})) SimpleWS) } }
- method at-key($k) { Q:CgOp {
- (rawcall (cast Cursor (@ {self})) GetKey (unbox String (@ {$k.Str})))
- } }
- method at-pos($i) { self.at-key($i) }
-}
-
-my class Match {
- method at-key($k) { Q:CgOp {
- (rawcall (cast Cursor (@ {self})) GetKey (unbox String (@ {$k.Str})))
- } }
- method at-pos($i) { self.at-key($i) }
- method new($) { die "Match.new NYI" }
- method from { Q:CgOp { (box Num (cast Double (getfield from
- (cast Cursor (@ {self}))))) } }
- method to { Q:CgOp { (box Num (cast Double (getfield pos
- (cast Cursor (@ {self}))))) } }
- method orig { Q:CgOp {
- (box Str (getfield backing (cast Cursor (@ {self})))) } }
- method chars { $.defined ?? $.to - $.from !! 0 }
- method Str { $.defined ?? $.orig.substr($.from, $.chars) !! "" }
-}
-
-PRE-INIT {
- Q:CgOp { (rnull (rawsset RxFrame.MatchMO (rawcall (@ {Match}) GetMO))) };
- ClassHOW.HOW.add-method("add-multiregex",
- anon method add-multiregex($name, $rx) {
- Q:CgOp { (prog
- [rawcall (unbox DynMetaObject (@ (pos 0)))
- AddMultiRegex (unbox String (@ (l $name))) (@ (l $rx))]
- [l True])
- }
- });
-}
-
-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++));
- }
- $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
- }
-}
-
-my class Enum is Cool {
- has $.key;
- has $.value;
-
- method kv() {
- ($.key, $.value);
- }
-
- method pairs() {
- self.flat;
- }
-}
-
-PRE-INIT {
- Q:CgOp {
- (prog
- (rawsset RxFrame.EMPTYP (@ {EMPTY}))
- (rawsset RxFrame.ListMO (getfield klass (cast DynObject (@ {List}))))
- (rawsset RxFrame.GatherIteratorMO (getfield klass
- (cast DynObject (@ {GatherIterator}))))
- (null Variable))
- }
-}
-
-my class Pair is Enum {
-}
-
-sub infix:<< => >>($k, $v) { Pair.RAWCREATE("key", $k, "value", $v) }
-
-sub assignop($fn) {
- anon sub ANON is rawcall {
- Q:CgOp { (pos 0) } = $fn(Q:CgOp { (pos 0) }, Q:CgOp { (pos 1) })
- }
-}
-
-# XXX multi dispatch
-sub next {
- Q:CgOp { (rawsccall Kernel.SearchForHandler (int 1) (null Frame) (int -1) (null String) (null Variable)) }
-}
-sub last {
- Q:CgOp { (rawsccall Kernel.SearchForHandler (int 2) (null Frame) (int -1) (null String) (null Variable)) }
-}
-sub redo {
- Q:CgOp { (rawsccall Kernel.SearchForHandler (int 3) (null Frame) (int -1) (null String) (null Variable)) }
-}
-sub return is rawcall {
- Q:CgOp { (rawsccall Kernel.SearchForHandler (int 4) (null Frame) (int -1) (null String) (pos 0)) }
-}
-
-{YOU_ARE_HERE}
View
502 lib/SAFE.setting
@@ -1,6 +1,7 @@
-# vim: ft=perl6
+# vim: ft=perl6 fdm=marker
my module SAFE;
+# Fundamental types {{{
my class Mu {
# rawcall to avoid putting a rw binding on self... TODO
method defined is rawcall {
@@ -43,6 +44,9 @@ my class Mu {
}
my class Any is Mu {
+ method at-pos($ix) {
+ ($ix == 0) ?? self !! die("Invalid index on non-list")
+ }
method flat() { (self,).flat }
method ACCEPTS($t) { self === $t }
@@ -52,8 +56,39 @@ my class Any is Mu {
}
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) }
+}
+# }}}
+# Scalar types {{{
my class Num is Cool {
has $!value;
method Str () { Q:CgOp {
@@ -121,7 +156,8 @@ my class Bool is EnumType {
# TODO: import
constant True = Q:CgOp { (box Bool (bool 1)) };
constant False = Q:CgOp { (box Bool (bool 0)) };
-
+# }}}
+# Fundamental scalar operators {{{
# taking a slurpy is wrong for this due to flattening. I'm not sure what is
# right, maybe **@foo
sub infix:<~> is rawcall { Q:CgOp {
@@ -220,7 +256,465 @@ sub infix:<===>($l,$r) { Q:CgOp {
} }
sub infix:<~~>($t,$m) { ($m.defined) ?? ($m.ACCEPTS($t)) !! ($t.^does($m)) }
+# }}}
+# 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 is rawcall {
+ Q:CgOp { (newrwlistvar (@ (pos 0))) }
+}
+
+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 Double (getfield Length
+ (unbox 'Variable[]' (@ {self})))))
+ } }
+
+ method iterator() {
+ my class ParcelIterator is Iterator {
+ has $.reify;
+ }
+ ParcelIterator.RAWCREATE("reify", self);
+ }
+}
+
+# Maybe this should be a constant, but constants are currently forced to
+# scalar-nature (TODO)
+sub Nil is rawcall { Q:CgOp { (newrwlistvar (@ (box Parcel (rawnewarr 'Variable')))) } }
+
+my class List is Cool {
+ has @!items;
+ has @!rest;
+ has $!flat;
+ method flat() {
+ unitem(Q:CgOp { (box Bool (getslot (s flat) (@ {self}))) }
+ ?? self !! self.SETUP(True, (&infix:<,>(self.iterator))));
+ }
+ method list() { unitem(self) }
+
+ method clone() { Q:CgOp {
+ (letn dys (cast DynObject (@ {self}))
+ new (rawnew DynObject (getfield klass (l dys)))
+ (rawcall (l new) SetSlot (s flat)
+ (rawcall (l dys) GetSlot (s flat)))
+ (rawcall (l new) SetSlot (s items) (rawnew VarDeque
+ (cast VarDeque (rawcall (l dys) GetSlot (s items)))))
+ (rawcall (l new) SetSlot (s rest) (rawnew VarDeque
+ (cast VarDeque (rawcall (l dys) GetSlot (s rest)))))
+ (newrwlistvar (l new)))
+ } }
+
+ method SETUP($flat, $parcel) { Q:CgOp {
+ (letn new (rawnew DynObject (rawcall (@ {self}) GetMO))
+ (rawcall (l new) SetSlot (s flat) (unbox Boolean (@ {$flat.Bool})))
+ (rawcall (l new) SetSlot (s rest) (rawnew VarDeque
+ (unbox 'Variable[]' (@ {$parcel}))))
+ (rawcall (l new) SetSlot (s items) (rawnew VarDeque))
+ (newrwlistvar (l new)))
+ } }
+
+ method Seq() {
+ Seq.SETUP(True, (&infix:<,>(self.iterator)));
+ }
+
+ #| Takes an object and applies whatever semantics the List subclass
+ #| needs to apply on stuff out of the iterator stack
+ method !elem is rawcall { Q:CgOp { (pos 1) } }
+
+ sub has-iterators($self) { Q:CgOp {
+ (box Bool (!= (i 0) (rawcall (cast VarDeque (rawcall (cast DynObject (@ {$self})) GetSlot (s rest))) Count)))
+ } }
+
+ sub count-items($self) { Q:CgOp {
+ (box Num (cast Double (rawcall (cast VarDeque (rawcall (cast DynObject (@ {$self})) GetSlot (s items))) Count)))
+ } }
+
+ sub shift-iterator($self) { Q:CgOp {
+ (rawcall (cast VarDeque (rawcall (cast DynObject (@ {$self})) GetSlot (s rest))) Shift)
+ } }
+
+ sub shift-item($self) { Q:CgOp {
+ (rawcall (cast VarDeque (rawcall (cast DynObject (@ {$self})) GetSlot (s items))) Shift)
+ } }
+
+ method !item-at-pos($ix) { Q:CgOp {
+ (getindex (cast Int32 (unbox Double (@ {$ix}))) (cast VarDeque (rawcall (cast DynObject (@ {self})) GetSlot (s items))))
+ } }
+
+ sub pop-item($self) { Q:CgOp {
+ (rawcall (cast VarDeque (rawcall (cast DynObject (@ {$self})) GetSlot (s items))) Pop)
+ } }
+
+ sub push-iterator is rawcall { Q:CgOp {
+ (prog (rawcall (cast VarDeque (rawcall (cast DynObject (@ (pos 0))) GetSlot (s rest))) Push (pos 1)) (null Variable))
+ } }
+
+ sub push-item is rawcall { Q:CgOp {
+ (prog (rawcall (cast VarDeque (rawcall (cast DynObject (@ (pos 0))) GetSlot (s items))) Push (pos 1)) (null Variable))
+ } }
+
+ method !fill($nr) { Q:CgOp {
+ (letn nr (cast Int32 (unbox Double (@ {$nr})))
+ items (cast VarDeque (getslot (s items) (@ {self})))
+ rest (cast VarDeque (getslot (s rest) (@ {self})))
+ flat (cast Boolean (getslot (s flat) (@ {self})))
+ v (null Variable)
+ ItMo (rawcall (@ {Iterator}) GetMO)
+ (whileloop 0 0
+ (ternary (< (rawcall (l items) Count) (l nr))
+ (!= (rawcall (l rest) Count) (i 0)) (b 0))
+ (prog
+ (l v (rawcall (l rest) Shift))
+ (ternary (ternary (l flat) (getfield islist (l v)) (b 0))
+ (rawcall (l rest) Unshift (methodcall (l v) iterator))
+ (ternary (rawcall (@ (l v)) Isa (l ItMo))
+ (rawcall (l rest) UnshiftN (unbox 'Variable[]'
+ (@ (methodcall (l v) reify))))
+ (rawcall (l items) Push (methodcall {self} !elem (l v)))))))
+ (box Bool (>= (rawcall (l items) Count) (l nr))))
+ } }
+
+ method Bool() { self!fill(1) }
+ method shift() {
+ self!fill(1);
+ shift-item(self);
+ }
+
+ 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); count-items(self); }
+ 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 push(*@items) {
+ push-iterator(self, @items.Seq.eager.iterator)
+ }
+ method pop() {
+ self.eager;
+ pop-item(self);
+ }
+}
+
+# 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 { (prog
+ (rawcall (cast DynObject (@ {self})) SetSlot (s items)
+ (rawcall (cast DynObject (@ {$inn})) GetSlot (s items)))
+ (null Variable))
+ };
+ unitem(self);
+ }
+
+ method !extend is rawcall {
+ Q:CgOp {
+ (letn i (cast VarDeque (getslot (s items) (@ (pos 0))))
+ ct (- (cast Int32 (unbox Double (@ (pos 1))))
+ (rawcall (l i) Count))
+ (ternary (>= (l ct) (int 0)) [prog]
+ [die "Autovivification collision"])
+ (whileloop 0 0 (!= (l ct) (int 0))
+ (prog
+ (l ct (- (l ct) (int 1)))
+ (rawcall (l i) Push (newrwscalar (@ {Any})))))
+ (rawcall (l i) Push (pos 2))
+ (null Variable))
+ };
+ }
+
+ method at-pos($ix) {
+ self!fill($ix+1)
+ ?? self!item-at-pos($ix)
+ !! Any!butWHENCE(sub () is rawcall {
+ self!extend($ix, Q:CgOp { (pos 0) });
+ });
+ }
+}
+
+my class Hash {
+ has $!value;
+ method new() { Q:CgOp { (box Hash (rawnew Dictionary<string,Variable>)) } }
+ method !extend is rawcall {
+ Q:CgOp {
+ (letn d [unbox Dictionary<string,Variable> (@ (pos 0))]
+ k [unbox String (@ (methodcall (pos 1) Str))]
+ [ternary (rawcall (l d) ContainsKey (l k))
+ (die "Autovivification collision")
+ (prog)]
+ [setindex (l k) (l d) (pos 2)]
+ [null Variable])
+ };
+ }
-sub infix:<,>() {}
+ # TODO: We need something like pir:: notation for this to not suck
+ method at-key($key) {
+ Q:CgOp {
+ (box Bool (rawcall [unbox Dictionary<string,Variable> (@ (l self))]
+ ContainsKey [unbox String (@ (methodcall (l $key) Str))]))
+ }
+ ?? Q:CgOp {
+ (getindex [unbox String (@ (methodcall (l $key) Str))]
+ [unbox Dictionary<string,Variable> (@ (l self))])
+ } !! Any!butWHENCE({ self!extend($key, Q:CgOp { (pos 0) }) });
+ }
+}
+
+my class Enum is Cool {
+ has $.key;
+ has $.value;
+
+ method kv() {
+ ($.key, $.value);
+ }
+
+ method pairs() {
+ self.flat;
+ }
+}
+
+my class Pair is Enum {
+}
+# }}}
+# List utilities {{{
+sub postcircumfix:<[ ]> is rawcall {
+ my $index ::= Q:CgOp { (pos 1) };
+
+ (Q:CgOp { (pos 0) }).defined
+ ?? (Q:CgOp { (pos 0) }).at-pos($index)
+ !! Any!butWHENCE(sub () is rawcall {
+ my $ar := Q:CgOp { (getindex (int 0) (getfield pos
+ (getfield outer (callframe)))) };
+ $ar.defined && die("Autovivification collision");
+ $ar = Array.new;
+ $ar!extend($index, Q:CgOp { (pos 0) });
+ });
+}
+
+sub postcircumfix:<{ }> is rawcall {
+ my $key ::= Q:CgOp { (pos 1) };
+
+ (Q:CgOp { (pos 0) }).defined
+ ?? (Q:CgOp { (pos 0) }).at-key($key)
+ !! Any!butWHENCE(sub () is rawcall {
+ my $ar := Q:CgOp { (getindex (int 0) (getfield pos
+ (getfield outer (callframe)))) };
+ $ar.defined && die("Autovivification collision");
+ $ar = Hash.new;
+ $ar!extend($key, Q:CgOp { (pos 0) });
+ });
+}
+
+my class GatherIterator is Iterator {
+ has $!frame;
+ has $!reify;
+
+ method reify() {
+ my $*nextframe;
+ $!reify // ($!reify = (
+ Q:CgOp {
+ (letn getv (rawsccall Kernel.CoTake (cast Frame
+ (@ {$!frame})))
+ (box Parcel (ternary (== (@ {EMPTY}) (@ (l getv)))
+ (rawnewarr Variable)
+ (rawnewarr Variable
+ (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 { (rawsccall Kernel.Take (l $p)) }
+}
+
+sub infix:<< => >>($k, $v) { Pair.RAWCREATE("key", $k, "value", $v) }
+
+sub infix:<,> is rawcall {
+ Q:CgOp { (newrwlistvar (@ (box Parcel (getfield pos (callframe))))) };
+}
+# }}}
+# Flow inspection and control {{{
+my class CallFrame {
+ method caller() { Q:CgOp {
+ (letn c (getfield caller (cast Frame (@ (l self))))
+ (ternary
+ (!= (letvar c) (null Frame))
+ (ns (letvar c))
+ (l Any)))
+ } }
+ method outer() { Q:CgOp {
+ (letn c (getfield outer (cast Frame (@ (l self))))
+ (ternary
+ (!= (letvar c) (null Frame))
+ (ns (letvar c))
+ (l Any)))
+ } }
+
+ method file() { Q:CgOp { (box Str (rawcall
+ (cast Frame (@ (l self))) ExecutingFile)) } }
+ method line() { Q:CgOp { (box Num (cast Double (rawcall
+ (cast Frame (@ (l self))) ExecutingLine))) } }
+
+ method hints($var) { Q:CgOp { (rawcall (cast Frame (@ (l self)))
+ LexicalFind (unbox String (@ (l $var)))) } }
+}
+
+sub caller { Q:CgOp { (ns (getfield caller (getfield caller (callframe)))) } }
+sub callframe { Q:CgOp { (ns (getfield caller (callframe))) } }
+
+sub die($msg) { Q:CgOp { (prog (die (@ (l $msg))) (null Variable)) } }
+
+# XXX multi dispatch
+sub next {
+ Q:CgOp { (rawsccall Kernel.SearchForHandler (int 1) (null Frame) (int -1) (null String) (null Variable)) }
+}
+sub last {
+ Q:CgOp { (rawsccall Kernel.SearchForHandler (int 2) (null Frame) (int -1) (null String) (null Variable)) }
+}
+sub redo {
+ Q:CgOp { (rawsccall Kernel.SearchForHandler (int 3) (null Frame) (int -1) (null String) (null Variable)) }
+}
+sub return is rawcall {
+ Q:CgOp { (rawsccall Kernel.SearchForHandler (int 4) (null Frame) (int -1) (null String) (pos 0)) }
+}
+
+sub assignop($fn) {
+ anon sub ANON is rawcall {
+ Q:CgOp { (pos 0) } = $fn(Q:CgOp { (pos 0) }, Q:CgOp { (pos 1) })
+ }
+}
+# }}}
+# Regular expression support {{{
+my class Cursor {
+ method new($str) { Q:CgOp { (ns (rawnew Cursor
+ (@ {self}) (unbox System.String (@ {$str})))) } }
+ method pos { Q:CgOp { (box Num (cast Double (getfield pos
+ (cast Cursor (@ {self}))))) } }
+ method cursor($np) { Q:CgOp { (ns (rawcall
+ (cast Cursor (@ {self})) At
+ (cast Int32 (unbox Double (@ {$np}))))) } }
+ method orig { Q:CgOp {
+ (box Str (getfield backing (cast Cursor (@ {self})))) } }
+ method ws() { Q:CgOp { (rawcall (cast Cursor (@ {self})) SimpleWS) } }
+ method at-key($k) { Q:CgOp {
+ (rawcall (cast Cursor (@ {self})) GetKey (unbox String (@ {$k.Str})))
+ } }
+ method at-pos($i) { self.at-key($i) }
+}
+
+my class Match {
+ method at-key($k) { Q:CgOp {
+ (rawcall (cast Cursor (@ {self})) GetKey (unbox String (@ {$k.Str})))
+ } }
+ method at-pos($i) { self.at-key($i) }
+ method new($) { die "Match.new NYI" }
+ method from { Q:CgOp { (box Num (cast Double (getfield from
+ (cast Cursor (@ {self}))))) } }
+ method to { Q:CgOp { (box Num (cast Double (getfield pos
+ (cast Cursor (@ {self}))))) } }
+ method orig { Q:CgOp {
+ (box Str (getfield backing (cast Cursor (@ {self})))) } }
+ method chars { $.defined ?? $.to - $.from !! 0 }
+ method Str { $.defined ?? $.orig.substr($.from, $.chars) !! "" }
+}
+
+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++));
+ }
+ $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}
View
4 src/CSharpBackend.pm
@@ -130,7 +130,7 @@ sub stash2 {
my %loopbacks = (
'MCallFrame', 'Kernel.CallFrameMO',
'MGatherIterator', 'RxFrame.GatherIteratorMO',
- 'MList', 'Kernel.ListMO',
+ 'MList', 'RxFrame.ListMO',
'MMatch', 'RxFrame.MatchMO',
'PAny', 'Kernel.AnyP',
'PArray', 'Kernel.ArrayP',
@@ -222,7 +222,7 @@ sub enter_code {
if ($lx->hash || $lx->list) {
# XXX should be SAFE::
my $imp = $_->find_lex($lx->hash ? 'Hash' : 'Array')->path;
- my $var = $unit->deref($unit->get_stash($$imp)->obj)
+ my $var = $unit->deref($unit->get_stash(@$imp)->obj)
->{peer}{what_var};
$frag = CgOp::methodcall(CgOp::rawsget($var), 'new');
} else {
View
7 src/Metamodel.pm
@@ -600,6 +600,9 @@ sub Unit::begin {
$unit->need_unit($::SETTING_UNIT) if $::SETTING_UNIT;
+ $unit->get_stash('GLOBAL');
+ $unit->get_stash('PROCESS');
+
local @opensubs;
$unit->mainline($self->mainline->begin(once => 1,
top => ($::SETTING_UNIT ? $::SETTING_UNIT->bottom_ref : undef)));
@@ -705,8 +708,6 @@ sub Op::Attribute::begin {
if $opensubs[-1]->augmenting;
$ns = $unit->deref($ns);
$ns->add_attribute($self->name);
- # we don't need create_static_pad here as the generated accessors close
- # over no variables
if ($self->accessor) {
my $nb = Metamodel::StaticSub->new(
unit => $unit,
@@ -718,6 +719,8 @@ sub Op::Attribute::begin {
run_once => 0,
code => Op::GetSlot->new(name => $self->name,
object => Op::CgOp->new(optree => [ pos => 0 ])));
+ $opensubs[-1]->create_static_pad; # for protosub instance
+ $nb->strong_used(1);
$opensubs[-1]->add_my_sub($self->name . '!a', $nb);
$ns->add_method($self->name, $unit->make_ref($nb));
}
View
3 src/Optimizer/Beta.pm
@@ -26,7 +26,8 @@ sub run_optree {
return unless $op->isa('Op::CallSub') && no_named_params($op);
my $inv = $op->invocant;
return unless $inv->isa('Op::SubDef') && $inv->once;
- my $cbody = $body->lexicals->{$inv->var}->body;
+ my $cbody = $body->lexicals->{$inv->var} or return;
+ $cbody = $cbody->body;
return unless is_removable_body($cbody);
beta_optimize($body, $op, $inv, $cbody);

0 comments on commit c5ed79f

Please sign in to comment.