Language-LispPerl

 view release on metacpan or  search on metacpan

OLD_README.md  view on Meta::CPAN

	(.CljPerl print "Hi\n")
	
	(. print "Guy\n")

	(defmulti mf type)
	(defmethod mf "string" [a] (println "string"))
	(defmethod mf "keyword" [a] (println "keyword"))
	(mf "test")
	(mf :test)

	(def c (coroutine
	  (println "b")
	  (coro-sleep)
	  (println "d")))

	(println "a")
	(coro-resume c)
	(println "c")
	(coro-resume c)


	(def a (actor
	  (println "a")
	  (actor-send (actor-receive) "exit")
	  (println "b")))

	(actor-send a (actor-self))
	(println (actor-receive "exit")

lib/Language/LispPerl/Role/BuiltIns/Coro.pm  view on Meta::CPAN

$Language::LispPerl::Role::BuiltIns::Coro::VERSION = '0.007';
use Moose::Role;

use Coro;

use Language::LispPerl::Atom;
use Language::LispPerl::Seq;

=head1 NAME

Language::LispPerl::Role::BuiltIns::Coro - A role with coro primitives for the BuiltIns objects.

=head1 SYNOPSIS

   my $lisp = Language::LispPerl::Evaler->new();

   $lisp->builtins()->apply_role('Language::LispPerl::Role::BuiltIns::Coro');

   .. lisp now implements the coro functions.

=head2 FUNCTIONS

To be documented. Look at the source code for now..

=cut

my $_CORO_FUNCTIONS = {

    # Coro stuff
    "coro"         => \&_impl_coro,
    "coro-suspend" => \&_impl_coro_suspend,
    "coro-sleep"   => \&_impl_coro_sleep,
    "coro-yield"   => \&_impl_coro_yield,
    "coro-resume"  => \&_impl_coro_resume,
    "coro-wake"    => \&_impl_coro_wake,
    "coro-join"    => \&_impl_coro_join,
    "coro-current" => \&_impl_coro_current,
    "coro-main"    => \&_impl_coro_main,
};

around 'has_function' => sub {
    my ( $orig, $self, $fname, @rest ) = @_;

    if ( my $f = $_CORO_FUNCTIONS->{$fname} ) {
        return $f;
    }
    return $self->$orig( $fname, @rest );
};

sub _impl_coro {
    my ( $self, $ast, $symbol ) = @_;
    $ast->error("coro expects 1 argument") if $ast->size() != 2;
    my $b = $self->evaler()->_eval( $ast->second() );
    $ast->error( "core expects a function as argument but got " . $b->type() )
      if $b->type() ne "function";
    my $coro = new Coro sub {
        my $evaler = $self->evaler()->new_instance();
        my $fc     = Language::LispPerl::Seq->new({ type => "list" });
        $fc->append($b);
        $evaler->_eval($fc);
    };
    $coro->ready();
    return Language::LispPerl::Atom->new({type =>  "coroutine", value =>  $coro });
}

sub _impl_coro_suspend {
    my ( $self, $ast, $symbol ) = @_;
    $ast->error("coro-suspend expects 1 argument") if $ast->size() != 2;
    my $coro = $self->evaler()->_eval( $ast->second() );
    $ast->error( "coro-suspend expects a coroutine as argument but got "
          . $coro->type() )
      if $coro->type() ne "coroutine";
    $coro->value()->suspend();
    return $coro;
}

sub _impl_coro_sleep {
    my ( $self, $ast ) = @_;
    $ast->error("coro-sleep expects 0 argument") if $ast->size != 1;
    $Coro::current->suspend();
    cede();
    return Language::LispPerl::Atom->new({ type => "coroutine", value => $Coro::current });
}

sub _impl_coro_yield {
    my ( $self, $ast ) = @_;
    $ast->error("coro-yield expects 0 argument") if $ast->size() != 1;
    cede;
    return Language::LispPerl::Atom->new({ type => "coroutine", value => $Coro::current });
}

sub _impl_coro_resume {
    my ( $self, $ast ) = @_;
    $ast->error("coro-resume expects 1 argument") if $ast->size() != 2;
    my $coro = $self->evaler()->_eval( $ast->second() );
    $ast->error(
        "coro-resume expects a coroutine as argument but got " . $coro->type() )
      if $coro->type() ne "coroutine";
    $coro->value()->resume();
    $coro->value()->cede_to();
    return $coro;
}

sub _impl_coro_wake {
    my ( $self, $ast ) = @_;
    $ast->error("coro-wake expects 1 argument") if $ast->size() != 2;
    my $coro = $self->evaler()->_eval( $ast->second() );
    $ast->error(
        "coro-wake expects a coroutine as argument but got " . $coro->type() )
      if $coro->type() ne "coroutine";
    $coro->value()->resume();
    return $coro;
}

sub _impl_coro_join {
    my ( $self, $ast ) = @_;
    $ast->error("join-coro expects 1 argument") if $ast->size() != 2;
    my $coro = $self->evaler()->_eval( $ast->second() );
    $ast->error(
        "join-coro expects a coroutine as argument but got " . $coro->type() )
      if $coro->type() ne "coroutine";
    $coro->value()->join();
    return $coro;
}

sub _impl_coro_current {
    my ( $self, $ast ) = @_;
    $ast->error("coro-current expects 0 argument") if $ast->size() != 1;
    return Language::LispPerl::Atom->new({ type => "coroutine", value => $Coro::current });
}

sub _impl_coro_main {
    my ( $self, $ast ) = @_;
    $ast->error("coro-main expects 0 argument") if $ast->size() != 1;
    return Language::LispPerl::Atom->new({ type => "coroutine", value => $Coro::main });
}

1;

share/lisp/core.clp  view on Meta::CPAN

        `(if ~k
           ~v
           ~i)))
    `()
    (reverse pairs)))

; env
(defn env [n]
  (. get_env n))

; coroutine

(defmacro coroutine [ & body]
  `(coro (fn [] ~@body)))

t/basic_syntax.clp  view on Meta::CPAN

((fn []
 (catch
  ((fn []
     (throw aaa "bbb")))
  (fn [e]
    (println e)))))

(println (env "PATH"))

(def c0 (coroutine
  (println "a")
  (coro-sleep)
  (println (coro-current))
  (println (coro-main))
  (println "d")))

(println "b")
(coro-resume c0)
(println "c")
(println (coro-current))
(coro-resume c0)