Skip to content

Commit

Permalink
Run strings and syscalls into portability layer
Browse files Browse the repository at this point in the history
  • Loading branch information
@sorear
sorear committed Oct 10, 2010
1 parent e151b74 commit 8dcdd25
Show file tree
Hide file tree
Showing 4 changed files with 46 additions and 43 deletions.
20 changes: 6 additions & 14 deletions lib/CORE.setting
View file
Expand Up @@ -2,33 +2,26 @@

my module CORE;

sub slurp($path) {
Q:CgOp { (box Str (rawscall System.IO.File.ReadAllText
(unbox str (@ {$path})))) }
}
sub slurp($path) { Q:CgOp { (box Str (slurp (unbox str (@ {$path})))) } }
my class IO is Cool {
has $!value;
}
my class TextReader is IO {
method get() {
Q:CgOp { (box Str (rawcall (unbox clr:System.IO.TextReader (@ {self}))
ReadLine:m,System.String)) };
Q:CgOp { (box Str (treader_getline (unbox treader (@ {self})))) }
}

method slurp() {
Q:CgOp { (box Str (rawcall (unbox clr:System.IO.TextReader (@ {self}))
ReadToEnd:m,System.String)) };
Q:CgOp { (box Str (treader_slurp (unbox treader (@ {self})))) }
}
method getc() {
Q:CgOp {
(letn chi (rawcall (unbox clr:System.IO.TextReader (@ {self}))
Read:m,System.Int32)
(letn chi (treader_getc (unbox treader (@ {self})))
(ternary (>= (l chi) (int 0))
(box Str (rawnew str
(cast clr:System.Char (l chi)) (int 1)))
(box Str (str_chr (l chi)))
{Str}))
};
}
Expand All @@ -38,7 +31,6 @@ my class TextReader is IO {
}
}

$PROCESS::IN ::= Q:CgOp { (box TextReader (rawsget
System.Console.In:f,System.IO.TextReader)) };
$PROCESS::IN ::= Q:CgOp { (box TextReader (treader_stdin)) };
{YOU_ARE_HERE}
42 changes: 15 additions & 27 deletions lib/SAFE.setting
View file
Expand Up @@ -19,24 +19,16 @@ my class Mu {
method so() { self.Bool }
method not() { ! self.Bool }
method RAWCREATE is rawcall { Q:CgOp {
(withtypes i int max int obj clr:DynObject
[l max (getfield Length (getfield pos (callframe)))]
[l i (int 1)]
[l obj (rawnew clr:DynObject (getfield mo (cast clr:DynObject
(@ (pos 0)))))]
(letn max (poscount)
i (int 1)
obj (obj_newblank (obj_llhow (@ (pos 0))))
[whileloop 0 0 (< (l i) (l max)) (prog
[setslot
(unbox str (@ (pos (l i)))) (l obj)
(nsw (@ (pos (+ (l i) (int 1)))))]
[l i (+ (l i) (int 2))])]
[ns (l obj)])
} }
method bless($obj) { Q:CgOp {
(prog
[setfield mo (cast clr:DynObject (@ {$obj}))
(getfield mo (cast clr:DynObject (@ {self})))]
{$obj})
} }
method CREATE() { Q:CgOp {
(rawscall Kernel.DefaultNew (@ (l self))) } }
method new() { Q:CgOp { (rawscall Kernel.DefaultNew (@ {self})) } }
Expand Down Expand Up @@ -108,13 +100,12 @@ my class Str is Cool {
(box Num (cast num (str_length (unbox str (@ (l self))))))
} }
method say() { Q:CgOp {
(prog [rawscall Console.WriteLine
(unbox str (@ {self}))]
(prog [say (unbox str (@ {self}))]
[box Bool (bool 1)]
)
} }
method substr($from, $len) { Q:CgOp {
(box Str (rawcall [unbox str (@ {self})] Substring
(box Str (str_substring [unbox str (@ {self})]
[cast int (unbox num (@ {$from}))]
[cast int (unbox num (@ {$len}))]))
} }
Expand Down Expand Up @@ -158,14 +149,14 @@ constant False = Q:CgOp { (box Bool (bool 0)) };
# 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 {
(letn buf (rawnew clr:System.Text.StringBuilder)
(letn buf (strbuf_new)
i (int 0)
max (getfield Length (getfield pos (callframe)))
max (poscount)
[whileloop 0 0 (< (l i) (l max)) (prog
[rawcall (l buf) Append
[strbuf_append (l buf)
(unbox str (@ (methodcall (pos (l i)) Str)))]
[l i (+ (l i) (int 1))])]
[box Str (rawcall (l buf) ToString)])
[box Str (strbuf_seal (l buf))])
} }
sub infix:<+>($l,$r) { Q:CgOp {
Expand Down Expand Up @@ -209,18 +200,15 @@ sub infix:<< != >>($l,$r) { Q:CgOp {
} }
sub warn($str) { Q:CgOp {
(prog [rawscall Console.Error.WriteLine
(unbox str (@ {$str.Str}))]
(prog [note (unbox str (@ {$str.Str}))]
[box Bool (bool 1)]
)
} }
sub say($obj) { ($obj ~~ Cool) ?? $obj.say !! $obj.Str.say }
sub exit() { Q:CgOp {
(prog [rawscall System.Environment.Exit (int 0) ]
[null var]
)
sub exit($status = 0) { Q:CgOp {
(rnull [exit (cast int (unbox num (@ {$status})))])
} }
sub infix:<=> is rawcall { Q:CgOp { (prog [assign (pos 0) (pos 1)] (pos 0)) } }
Expand Down Expand Up @@ -316,7 +304,7 @@ my class List is Cool {
method clone() { Q:CgOp {
(letn selfo (@ {self})
new (rawnew clr:DynObject (obj_llhow (l selfo)))
new (obj_newblank (obj_llhow (l selfo)))
(setslot flat (l new) (getslot flat bool (l selfo)))
(setslot items (l new) (rawnew vvarlist
(getslot items vvarlist (l selfo))))
Expand All @@ -326,7 +314,7 @@ my class List is Cool {
} }
method SETUP($flat, $parcel) { Q:CgOp {
(letn new (rawnew clr:DynObject (obj_llhow (@ {self})))
(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}))))
Expand Down Expand Up @@ -378,7 +366,7 @@ my class List is Cool {
(!= (vvarlist_count (l rest)) (i 0)) (b 0))
(prog
(l v (vvarlist_shift (l rest)))
(ternary (ternary (l flat) (getfield islist (l v)) (b 0))
(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
Expand Down
7 changes: 5 additions & 2 deletions src/CLRTypes.pm
View file
Expand Up @@ -150,6 +150,7 @@ my %typedata = (
my %tmap = (
# a simple string, like string or $S32. May support nulls
'str' => 'String',
'strbuf' => 'System.Text.StringBuilder',
# a reference to a container + usage flags
'var' => 'Variable',
# a reference to a single Perl 6 object, decontainerized
Expand All @@ -160,8 +161,10 @@ my %tmap = (
'varhash' => 'Dictionary<string,Variable>',
'fvarlist' => 'Variable[]',
'vvarlist' => 'VarDeque',
# XXX does this leak too much information about the metamodel?
'class' => 'DynMetaObject',
'stab' => 'DynMetaObject',
# portable IO is hard, we let CgOp fake it for now?
'treader' => 'System.IO.TextReader',
'twriter' => 'System.IO.TextWriter',
);

sub _generic_infer {
Expand Down
20 changes: 20 additions & 0 deletions src/CgOp.pm
View file
Expand Up @@ -140,6 +140,9 @@ use warnings;
sub obj_llhow { getfield('mo', $_[0]) }
sub obj_isa { rawcall($_[0], 'Isa', $_[1]) }
sub obj_does { rawcall($_[0], 'Does', $_[1]) }
sub obj_newblank { rawnew('clr:DynObject', $_[0]) }

sub var_islist { getfield('islist', $_[0]) }

sub llhow_name { getfield('name', $_[0]) }

Expand All @@ -149,9 +152,26 @@ use warnings;
sub varhash_new { rawnew('varhash') }

sub newgeneralvar { rawnew('clr:SimpleVariable', $_[0], $_[1], rawsget('Kernel.AnyMO'), $_[2], $_[3]) }
sub poscount { getfield('Length', getfield('pos', callframe())) }

sub num_to_string { rawcall($_[0], 'ToString') }
sub str_length { getfield('Length', $_[0]) }
sub str_substring { rawcall($_[0], 'Substring', $_[1], $_[2]) }
sub str_chr { rawnew('str', cast('clr:System.Char', $_[0]), CgOp::int(1)) }

sub strbuf_new { rawnew('strbuf') }
sub strbuf_append { rawcall($_[0], 'Append', $_[1]) }
sub strbuf_seal { rawcall($_[0], 'ToString') }

sub say { rawscall('Console.WriteLine', $_[0]) }
sub note { rawscall('Console.Error.WriteLine', $_[0]) }
sub exit { rawscall('System.Environment.Exit', $_[0]) }
sub slurp { rawscall('System.IO.File.ReadAllText', $_[0]) }

sub treader_getc { rawcall($_[0], 'Read:m,Int32') }
sub treader_slurp { rawcall($_[0], 'ReadToEnd:m,String') }
sub treader_getline { rawcall($_[0], 'ReadLine:m,String') }
sub treader_stdin { rawsget('System.Console.In:f,System.IO.TextReader') }

sub fvarlist_length { getfield('Length', $_[0]) }
sub fvarlist_new { rawnewarr('var', @_) }
Expand Down

0 comments on commit 8dcdd25

Please sign in to comment.