From 8dcdd2564a69d785cfa0420741ff6c573c4ca6a8 Mon Sep 17 00:00:00 2001 From: Stefan O'Rear Date: Sat, 9 Oct 2010 17:03:15 -0700 Subject: [PATCH] Run strings and syscalls into portability layer --- lib/CORE.setting | 20 ++++++-------------- lib/SAFE.setting | 42 +++++++++++++++--------------------------- src/CLRTypes.pm | 7 +++++-- src/CgOp.pm | 20 ++++++++++++++++++++ 4 files changed, 46 insertions(+), 43 deletions(-) diff --git a/lib/CORE.setting b/lib/CORE.setting index e168a6c1..0614bffb 100644 --- a/lib/CORE.setting +++ b/lib/CORE.setting @@ -2,10 +2,7 @@ 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; @@ -13,22 +10,18 @@ my class IO is Cool { 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})) }; } @@ -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} diff --git a/lib/SAFE.setting b/lib/SAFE.setting index b26b264d..90b43637 100644 --- a/lib/SAFE.setting +++ b/lib/SAFE.setting @@ -19,11 +19,9 @@ 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) @@ -31,12 +29,6 @@ my class Mu { [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})) } } @@ -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}))])) } } @@ -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 { @@ -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)) } } @@ -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)))) @@ -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})))) @@ -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 diff --git a/src/CLRTypes.pm b/src/CLRTypes.pm index c87f43b0..1977ffb8 100644 --- a/src/CLRTypes.pm +++ b/src/CLRTypes.pm @@ -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 @@ -160,8 +161,10 @@ my %tmap = ( 'varhash' => 'Dictionary', '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 { diff --git a/src/CgOp.pm b/src/CgOp.pm index 9ecae670..38fb95da 100644 --- a/src/CgOp.pm +++ b/src/CgOp.pm @@ -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]) } @@ -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', @_) }