CljPerl

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

	- Add bin/cljp into Makefile.PL.
	- Some bug fixes.
0.08  Mon May 06 12:28:00 2013 
	- Add perlobj-type and object-id. 
0.09  Mon May 06 14:33:00 2013
	- Refine error report.
	- Set key of map with nil to delete key. 
0.10  TBD
	- Add exception throw/catch.
	- Add cond form.
	- Add coroutine support.

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)

	------------------

	> bin/cljp t.clp

## Install

	cpan install CljPerl

## Lisp <-> Perl

lib/CljPerl/Evaler.pm  view on Meta::CPAN

                  "."=>1,
                  "->"=>1,
                  "eq"=>1,
                  "ne"=>1,
		  "and"=>1,
		  "or"=>1,
                  "equal"=>1,
                  "require"=>1,
		  "read"=>1,
	          "println"=>1, 
                  "coro"=>1,
                  "coro-suspend"=>1,
                  "coro-sleep"=>1,
                  "coro-yield"=>1,
                  "coro-resume"=>1,
                  "coro-wake"=>1,
                  "coro-join"=>1,
                  "coro-current"=>1,
                  "coro-main"=>1,
                  "xml-name"=>1,
                  "trace-vars"=>1};

  our $empty_list = CljPerl::Seq->new("list");
  our $true = CljPerl::Atom->new("bool", "true");
  our $false = CljPerl::Atom->new("bool", "false");
  our $nil = CljPerl::Atom->new("nil", "nil");

  sub bind {
    my $self = shift;

lib/CljPerl/Evaler.pm  view on Meta::CPAN

    } elsif($fn eq "perl->clj") {
      $ast->error("perl->clj expects 1 argument") if $size != 2;
      my $o = $self->_eval($ast->second());
      $ast->error("perl->clj expects perlobject as argument but got " . $o->type()) if $o->type() ne "perlobject";
      return &perl2clj($o->value());
    # (println obj)
    } elsif($fn eq "println") {
      $ast->error("println expects 1 argument") if $size != 2;
      print CljPerl::Printer::to_string($self->_eval($ast->second())) . "\n";
      return $nil;
    } elsif($fn eq "coro") {
      $ast->error("coro expects 1 argument") if $size != 2;
      my $b = $self->_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 = CljPerl::Evaler->new();
        my $fc = CljPerl::Seq->new("list");
        $fc->append($b);
        $evaler->_eval($fc);
      };
      $coro->ready();
      return CljPerl::Atom->new("coroutine", $coro);
    } elsif($fn eq "coro-suspend") {
      $ast->error("coro-suspend expects 1 argument") if $size != 2;                              
      my $coro = $self->_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;
    } elsif($fn eq "coro-sleep") {
      $ast->error("coro-sleep expects 0 argument") if $size != 1;                              
      $Coro::current->suspend();
      cede;
      return CljPerl::Atom->new("coroutine", $Coro::current);
    } elsif($fn eq "coro-yield") {
      $ast->error("coro-yield expects 0 argument") if $size != 1;                              
      cede;
      return CljPerl::Atom->new("coroutine", $Coro::current);
    } elsif($fn eq "coro-resume") {
      $ast->error("coro-resume expects 1 argument") if $size != 2;                              
      my $coro = $self->_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;                                                                              
    } elsif($fn eq "coro-wake") {
      $ast->error("coro-wake expects 1 argument") if $size != 2;                              
      my $coro = $self->_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;
    } elsif($fn eq "join-coro") {
      $ast->error("join-coro expects 1 argument") if $size != 2;                              
      my $coro = $self->_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;
    } elsif($fn eq "coro-current") {
      $ast->error("coro-current expects 0 argument") if $size != 1;                             
      return CljPerl::Atom->new("coroutine", $Coro::current);                                                                                                                                        
    } elsif($fn eq "coro-main") {
      $ast->error("coro-main expects 0 argument") if $size != 1;                              
      return CljPerl::Atom->new("coroutine", $Coro::main);                             
    } elsif($fn eq "trace-vars") {
      $ast->error("trace-vars expects 0 argument") if $size != 1;
      $self->trace_vars();
      return $nil;
    };
  
    return $ast;
  }

  sub perlfunc_call {

lib/CljPerl/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

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

(cond
  [true (println "a")]
  [else (println "b")])

(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)