Changeset 3948

Timestamp:

05/27/05 04:03:10 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

5515

Message:

* method.t all pass!

Location:

src

Files:

• Pugs/Run/Perl5.hs (modified) (4 diffs)
• perl5/perl5.c (modified) (1 diff)
• perl5/pugsembed.c (modified) (1 diff)
• perl5/pugsembed.h (modified) (1 diff)

src/Pugs/Run/Perl5.hs

@@ -18 +18 @@
 
 foreign export ccall "pugs_Apply"
-    pugs_apply :: PugsVal -> PugsVal -> Ptr PugsVal -> IO PugsVal
+    pugs_apply :: PugsVal -> PugsVal -> Ptr PugsVal -> IO PerlSV
 
 foreign export ccall "pugs_ValToSv"
@@ -60 +60 @@
     mkVal val
 
-pugs_apply :: PugsVal -> PugsVal -> Ptr PugsVal -> IO PugsVal
+pugs_apply :: PugsVal -> PugsVal -> Ptr PugsVal -> IO PerlSV
 pugs_apply subPtr invPtr argsPtr = do
     -- print "DEREF #0"
@@ -66 +66 @@
     -- print "DEREF #1"
     sub     <- deVal subPtr
-    -- print "DEREF #2"
+    -- print ("DEREF #2", sub)
     inv     <- deValMaybe invPtr
     -- print ("DEREF #3", inv)
@@ -75 +75 @@
             _           -> Val sub
     val <- runEvalIO env $ evalExp (App subExp (fmap Val inv) (map Val args))
-    mkVal val
+    case val of
+        PerlSV sv   -> return sv
+        VStr str    -> vstrToSV str
+        VBool bool  -> vintToSV (fromEnum bool)
+        VInt int    -> vintToSV int
+        VRat rat    -> vnumToSV rat
+        VNum num    -> vnumToSV num
+        _           -> mkValRef val
 
 deVal :: PugsVal -> IO Val

src/perl5/perl5.c

@@ -44 +44 @@
 
     /* fprintf(stderr, "back to pugs\n"); */
-    ret = pugs_ValToSv(pugs_Apply (val, inv, stack));
+    ret = pugs_Apply(val, inv, stack);
     free (stack);
 
-    ST(0) = ret;
+    sv_setsv(ST(0), ret);
     
     XSRETURN(1);

src/perl5/pugsembed.c

@@ -23 +23 @@
     isa[0] = pugs_PvToVal("Code");
     isa[1] = NULL;
-    if (pugs_ValToIv(pugs_Apply(pugs_PvToVal("&isa"), val, isa))) {
+    if (SvTRUE(pugs_Apply(pugs_PvToVal("&isa"), val, isa))) {
         if (__init) {
             stack[0] = sv;
             stack[1] = NULL;
-            fprintf (stderr, "isa code\n");
+            /* fprintf (stderr, "isa code\n"); */
             sv = perl5_apply(newSVpv("code", 0), newSVpv("pugs::guts", 0), stack, NULL, G_SCALAR);
         }

src/perl5/pugsembed.h

@@ -8 +8 @@
 
 extern Val *pugs_Eval ( char *code );
-extern Val *pugs_Apply ( Val *sub, Val *inv, Val **args );
+extern SV *pugs_Apply ( Val *sub, Val *inv, Val **args );
 
 extern Val *pugs_IvToVal ( IV iv );