* Implement warn($), exit(), and the "..." term.

sorear · Jul 20, 2010 · 6fd3e0b · 6fd3e0b
1 parent 90ad541
commit 6fd3e0b
Show file tree

Hide file tree

Showing 3 changed files with 29 additions and 0 deletions.
diff --git a/CodeGen.pm b/CodeGen.pm
@@ -50,6 +50,8 @@ use 5.010;
         'Kernel.NewRWScalar'   => [m => 'Variable'],
         'Kernel.NewRWListVar'  => [m => 'Variable'],
         'Console.WriteLine'    => [m => 'Void'],
+        'Console.Error.WriteLine'    => [m => 'Void'],
+        'Environment.Exit'     => [m => 'Void'],
         'String.Concat'        => [m => 'String'],
         'Kernel.SubMO'         => [f => 'DynMetaObject'],
         'Kernel.ScalarMO'      => [f => 'DynMetaObject'],

diff --git a/Op.pm b/Op.pm
@@ -187,6 +187,20 @@ use CgOp;
     extends 'Op';
 
     has kind => (isa => 'Str', is => 'ro', required => 1);
+
+    sub code {
+        my ($self, $cg, $body) = @_;
+
+        CgOp::prog(
+            CgOp::subcall(
+                CgOp::fetch(CgOp::scopedlex("&warn")),
+                CgOp::string_var(">>>Stub code executed<<<")
+            ),
+            CgOp::subcall(
+                CgOp::fetch(CgOp::scopedlex("&exit")),
+            ),
+        );
+    }
 }
 
 {

diff --git a/setting b/setting
@@ -263,13 +263,26 @@ sub infix:<< != >>($l,$r) { Q:CgOp {
                           (unbox Double (fetch (scopedlex $r)))))
 } }
 
+sub warn($str) { Q:CgOp {
+    (prog [rawscall Console.Error.WriteLine
+            (unbox String (fetch (methodcall (scopedlex $str) Str))])
+          [box Bool (bool 1)]
+    )
+} }
+
 sub say($str) { Q:CgOp {
     (prog [rawscall Console.WriteLine
             (unbox String (fetch (methodcall (scopedlex $str) Str))])
           [box Bool (bool 1)]
     )
 } }
 
+sub exit() { Q:CgOp {
+    (prog [rawscall Environment.Exit (int 0) ]
+          [null Variable]
+    )
+} }
+
 sub infix:<=> { Q:CgOp { (prog [assign (pos 0) (pos 1)] (pos 0)) } }
 
 # Buglet in STD: standard infix operators look custom inside the setting, and