HsPerl5 (empty) → 0.0.1

raw patch · 8 files changed

+300/−0 lines, 8 filesdep +basesetup-changed

Dependencies added: base

Files

• HsPerl5.cabal +18/−0
• LICENSE +18/−0
• README +7/−0
• Setup.lhs +3/−0
• configure +20/−0
• p5embed.c +150/−0
• src/Language/Perl5.hs +78/−0
• test.hs +6/−0

@@ -0,0 +1,18 @@+name:               HsPerl5+version:            0.0.1+copyright:          2008 Audrey Tang+license:            BSD3+license-file:       LICENSE+author:             Audrey Tang <audreyt@audreyt.org>+maintainer:         Audrey Tang <audreyt@audreyt.org>+synopsis:           Haskell interface to embedded Perl 5 interpreter+description:        Haskell interface to embedded Perl 5 interpreter+stability:          experimental+build-type:         Simple+extensions:         ForeignFunctionInterface+exposed-modules:    Language.Perl5+build-depends:      base+extra-source-files: README test.hs configure+hs-source-dirs:     src+category:           Language+c-sources:          p5embed.c

@@ -0,0 +1,18 @@+Copyright 2008 by Audrey Tang++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to+deal in the Software without restriction, including without limitation the+rights to use, copy, modify, merge, publish, distribute, sublicense, and/or+sell copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:+  +The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.+   +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL+THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,7 @@+This module provides a Haskell interface to embedded Perl 5 interpreter.++Documentation and functionality is scarce at the moment; see test.hs for+some basic usage examples.++Eventually the entirety of Pugs.Embed.Perl5 and Pugs.Run.Perl5 will be+carried into this module.

@@ -0,0 +1,3 @@+#!/usr/bin/env runghc+> import Distribution.Simple+> main = defaultMainWithHooks autoconfUserHooks

@@ -0,0 +1,20 @@+#!/bin/sh -e++/usr/bin/perl << CONFIGURE++use ExtUtils::Embed;++my @ccoptions   = (split(/\s+/, ccflags()), split(/\s+/, ccdlflags()));+my @includedirs = split(/\s+/, perl_inc());+my @ldoptions   = split(/\s+/, ldopts());+s/^-I// for @includedirs;++open INFO, ">HsPerl5.buildinfo" or die "Cannot write build info";+print INFO "cc-options: @ccoptions\n";+print INFO "ld-options: @ldoptions\n";+print INFO "include-dirs: @includedirs\n";+close INFO;++xsinit();++CONFIGURE

@@ -0,0 +1,150 @@+#include "p5embed.h"+#include <XSUB.h>+#include "perlxsi.c"++/* define to enable pugsembed debug messages */+#define PERL5_EMBED_DEBUG 0++#if PERL5_EMBED_DEBUG+#define oRZ ""+#define hate Perl_croak(aTHX_ "hate software")+#else+#define oRZ "#"+#define hate+#endif++/* Workaround for mapstart: the only op which needs a different ppaddr */+#undef Perl_pp_mapstart+#define Perl_pp_mapstart Perl_pp_grepstart+#undef OP_MAPSTART+#define OP_MAPSTART OP_GREPSTART++static PerlInterpreter *my_perl;+int _P5EMBED_INIT = 0;++SV *+perl5_sv_undef ()+{+    return(&PL_sv_undef);+}++PerlInterpreter *+perl5_init ( int argc, char **argv )+{+    int exitstatus;+    int i;++#ifdef PERL_GPROF_MONCONTROL+    PERL_GPROF_MONCONTROL(0);+#endif++#if (defined(USE_5005THREADS) || defined(USE_ITHREADS)) && defined(HAS_PTHREAD_ATFORK)+    /* XXX Ideally, this should really be happening in perl_alloc() or+     * perl_construct() to keep libperl.a transparently fork()-safe.+     * It is currently done here only because Apache/mod_perl have+     * problems due to lack of a call to cancel pthread_atfork()+     * handlers when shared objects that contain the handlers may+     * be dlclose()d.  This forces applications that embed perl to+     * call PTHREAD_ATFORK() explicitly, but if and only if it hasn't+     * been called at least once before in the current process.+     * --GSAR 2001-07-20 */+    PTHREAD_ATFORK(Perl_atfork_lock,+                   Perl_atfork_unlock,+                   Perl_atfork_unlock);+#endif++    if (!PL_do_undump) {+        my_perl = perl_alloc();+        if (!my_perl)+            exit(1);+        perl_construct( my_perl );+        PL_perl_destruct_level = 0;+    }+#ifdef PERL_EXIT_DESTRUCT_END+    PL_exit_flags |= PERL_EXIT_DESTRUCT_END;+#endif /* PERL_EXIT_DESTRUCT_END */+#ifdef PERL_EXIT_EXPECTED+    PL_exit_flags |= PERL_EXIT_EXPECTED;+#endif /* PERL_EXIT_EXPECTED */++#if (defined(CSH) && defined(PL_cshname))+    if (!PL_cshlen)+      PL_cshlen = strlen(PL_cshname);+#endif++    exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);++    if (exitstatus == 0)+        exitstatus = perl_run( my_perl );++    _P5EMBED_INIT = 1;++    /*+    newXS((char*) "pugs::guts::invoke", _pugs_guts_invoke, (char*)__FILE__);+    newXS((char*) "pugs::guts::eval_apply", _pugs_guts_eval_apply, (char*)__FILE__);+    */++#if PERL5_EMBED_DEBUG+    fprintf(stderr, "(%s)", pugs_guts_code);+#endif+    /*+    eval_pv(pugs_guts_code, TRUE);+    */++    if (SvTRUE(ERRSV)) {+        STRLEN n_a;+        printf("Error init perl: %s\n", SvPV(ERRSV,n_a));+        exit(1);+    }+    return my_perl;+}++SV *+perl5_eval(char *code, int cxt)+{+    dSP;+    SV* sv;++    ENTER;+    SAVETMPS;++    sv = newSVpv(code, 0);+#ifdef SvUTF8_on+    SvUTF8_on(sv);+#endif+    eval_sv(sv, cxt);+    SvREFCNT_dec(sv);++    SPAGAIN;+    sv = POPs;+    SvREFCNT_inc(sv);+    PUTBACK;++    if (SvTRUE(ERRSV)) {+        STRLEN n_a;+        fprintf(stderr, "Error eval perl5: \"%s\"\n*** %s\n", code, SvPV(ERRSV,n_a));+    }++    FREETMPS;+    LEAVE;++    return sv;+}++char *+perl5_SvPV ( SV *sv )+{+    char *rv;+    rv = SvPV_nolen(sv);+    return rv;+}++SV *+perl5_newSVpvn ( char * pv, int len )+{+    SV *sv = newSVpvn(pv, len);+#ifdef SvUTF8_on+    SvUTF8_on(sv);+#endif+    return(sv);+}

@@ -0,0 +1,78 @@+{-# LANGUAGE ForeignFunctionInterface, TypeSynonymInstances, ScopedTypeVariables #-}+{-# INCLUDE "p5embed.h" #-}++module Language.Perl5+    ( Context(..)+    , ToSV(..)+    , FromSV(..)+    , withPerl5+    , eval+    ) where+import Foreign+import Foreign.C.Types+import Foreign.C.String+import Control.Exception (bracket)++data Context = Void | Item | List++enumContext :: (Num a) => Context -> a+enumContext Void = 128+enumContext Item = 0+enumContext List = 1++type Interpreter = Ptr ()+type SV = Ptr ()++-- | Run a computation within the context of a Perl 5 interpreter. +withPerl5 :: IO a -> IO a+withPerl5 f = do+    withCString "-e" $ \prog -> withCString "" $ \cstr -> do+        withArray [prog, prog, cstr] $ \argv -> do+            bracket (perl5_init 3 argv) (\interp -> do+                perl_destruct interp+                perl_free interp) (const f)++-- | Evaluate a snippet of Perl 5 code.+eval :: forall a. FromSV a => String -> IO a+eval str = withCString str $ \cstr -> do+    sv <- perl5_eval cstr (enumContext $ contextOf (undefined :: a))+    fromSV sv++-- | Data types that can be casted into a Perl 5 value (SV).+class ToSV a where+    toSV :: a -> IO SV++-- | Data types that can be casted from a Perl 5 value (SV).+class FromSV a where+    fromSV :: SV -> IO a+    contextOf :: a -> Context+    contextOf _ = Item++instance ToSV () where+    toSV _ = perl5_sv_undef+instance FromSV () where+    fromSV x = seq x (return ())+    contextOf _ = Void++instance ToSV String where+    toSV str = withCStringLen str $ \(cstr, len) -> do+        perl5_newSVpvn cstr (toEnum len)+instance FromSV String where+    fromSV sv = do+        cstr <- perl5_SvPV sv+        peekCString cstr++foreign import ccall "perl5_init"+    perl5_init :: CInt -> Ptr CString -> IO Interpreter+foreign import ccall "perl5_sv_undef"+    perl5_sv_undef :: IO SV+foreign import ccall "perl5_eval"+    perl5_eval :: CString -> CInt -> IO SV+foreign import ccall "perl5_newSVpvn"+    perl5_newSVpvn :: CString -> CInt -> IO SV+foreign import ccall "perl5_SvPV"+    perl5_SvPV :: SV -> IO CString+foreign import ccall "perl_destruct"+    perl_destruct :: Interpreter -> IO CInt+foreign import ccall "perl_free"+    perl_free :: Interpreter -> IO ()

@@ -0,0 +1,6 @@+import Language.Perl5++main :: IO ()+main = withPerl5 $ do+    putStrLn =<< eval "qq[1..1]"+    eval "print qq[ok 1\n]"