Форум программистов [Powered by Invision Power Board]

Код


function sum(a) {
    return function(b) {
        return a+b
    }
}

sum(1)(3) //=> 4

Код


var foo = {
    "bar": 42
}

Код


function Foo(bar) {
    this.bar = bar;
}

var foo = new Foo(42)
foo.bar //=> 42

Код


(defun foo (a)
 (lambda (b) (+ a b)))

Код


(defmacro cond (&rest body)
 (labels ((cond-req-fnc (body)
           (if (car body)
            `(if ,(caar body) ,(cadar body) ,(cond-req-fnc (cdr body))))))
  (cond-req-fnc body)))

Код


let (^-^) f a = f a

type Parser<'a> = Parser of (string ->('a * string) list)

let extract(Parser(f)) = f

type ParserMonad() =
    member b.Bind(p,f) = Parser ^-^ fun cs ->
                                            let r = extract(p) cs
                                            let r' = List.map (fun (a,cs') -> extract(f a) cs') r
                                            List.concat r'
    member b.Return x = Parser ^-^ fun cs -> [x,cs]
    member b.ReturnFrom v = v
    member b.Zero() = Parser ^-^ fun cs -> []


let (++) p q = Parser ^-^ fun cs -> List.append (extract p cs) (extract q cs)
let (+++) p q = Parser ^-^ fun cs -> match (extract(p ++ q) cs) with
                                      | [] -> []
                                      | x::xs -> [x]

let parser = ParserMonad()

let item = Parser ^-^ fun cs -> match cs with
                                | "" -> []
                                | cs -> [cs.[0], cs.Substring(1)]
                            
let sat p = parser { let! c = item
                     if p c then
                       return c }
                      
let char c = sat ^-^ fun s -> c = s
                                            
let rec stringp s = match s with
                    | "" -> parser { return [] }
                    | xs -> parser { let! c = char xs.[0]
                                     let! cs = stringp (xs.Substring(1))
                                     return c::cs }
                                                          
let rec many1 p = parser { let! x = p
                           let! xs = many p
                           return (x::xs) }
and many p = (many1 p) +++ parser { return [] }

and chain p op =
    let rec rest a = parser { let! f = op
                              let! b = p
                              return! rest(f a b) } +++ parser { return a }
    parser { let! a = p
             return! rest a }
           
let space = many ( sat (fun s -> System.Char.IsWhiteSpace s) )

let token p = parser { let! a = p
                       let! _ = space
                       return a }

let symb cs = token (stringp cs)

let apply p = extract (parser { let! _ = space
                                let! r = p
                                return r })

open System
#nowarn "40"
do
    while true do
        Console.ReadLine() |> fun x ->
            let logOp = parser { let! _ = symb "AND"
                                 return (&&) } +++ parser { let! _ = symb "OR"
                                                            return (||) }
            let digit = parser { let! x = token (sat (fun ch -> Char.IsDigit(ch)))
                                 return ( x = '1' ) }
            let rec expr = chain term logOp
            and term = factor +++ parser { let! _ = symb "NOT"
                                           let! ex = expr
                                           return (not ex) }
            and factor = digit +++ parser { let! _ = symb "("
                                            let! ex = expr
                                            let! _ = symb ")"
                                            return ex }
            let parse s = match apply expr s with
                            | [] -> failwith "failed to parse"
                            | (ret, _)::xs -> ret
            Console.WriteLine (parse x)

Код


let f a = fun b -> a + b

Код


package qxp;
use strict;

sub H($){pack'H*',$_[0]}
sub by{map{[splice@_,1,$_[0]]}!($#_%$_[0])..$#_/$_[0]}
sub is($){$_ eq$_[0]}
sub cat{join'',@_}
sub list{@_}
sub wa{wantarray?@_:cat@_}
sub yuki(&@){shift->();@_}
sub fopen(;$){open my$z,$_[0]||$_;$z}{my %file;
sub file($){readline($file{$_[0]}||=fopen$_[0])}}
sub slurp(;$){wa map{yuki{close$_}<$_>}fopen$_[0]}
#sub spew($;$){sub{map{print $_ $_[1];close$_}fopen$_[0]}->($_[0],$#_?$_[1]:$_)}
sub spew($;$){open my$z,">$_[0]";print $z $#_?$_[1]:$_;close $z}
sub table{map{chomp;[split/\t/]}@_}
sub trim{map{s/^\s+|\s+$//g}@_?@_:$_}
sub count{my%z;$z{$_}++for@_;\%z}
sub uniq{keys%{count@_}}
sub copy{wa local@_=@_}
sub find(&@){no strict 'refs';local(*{(caller).'::a'})=\(my$a=$_[1]);&{$_[0]}||($a=$_)for(@_[2..$#_]);$a}
sub first(&@){$_[0]->()&&return$_ for@_[1..$#_]}
sub min{find{$a<$_}@_}
sub max{find{$a>$_}@_}
sub section{map{$_->[$_[0]]}@_[1..$#_]}
*#=sub{map$#$_,@_};
sub zip{map section($_,@_),0..max &#(@_)}
sub char{substr$#_?shift:$_,$_[0],1}
sub via(&$){local $_=$_[1];$_[0]->()}

*\=sub{map[section($_,@_)],0..max &#(@_)};

{my%ops;*?=sub{ref$_[-1]?map&?($_[0],@$_),&\(@_[1..$#_]):wa do{my@z=$_[1];@z=$ops{$_[0]}->($_,@z)for@_[2..$#_];@z}};
{no strict 'refs';(*$_,$ops{$_})=eval"sub{&?('$_',\@_)},sub{wa(\@_[1..\$#_]) $_ \$_[0]}" for qw'** =~ !~ * / % x + - . << >> < > <= >= lt gt le ge == != <=> eq ne cmp & | ^ && || .. ... = , => and or xor'}}
my%refs=(''=>'_',map{$_=>lc substr $_,0,1}qw{SCALAR ARRAY HASH CODE REF GLOB LVALUE});
sub refs{wa map{$refs{ref $_}||'o'}@_}
sub _{cat map{
  is '' ? $_:
  is 'a' ? @{$_[0]}:
  ()
}refs@_}

sub wday{(int(365.25*($_[2]-($_[1]<3)))+int(30.6*(1+$_[1]+12*($_[1]<3)))+$_[0]-621050)%7+1}
sub leap{$_[0]%4?0:$_[0]%100?1:$_[0]%400?0:1}
sub days{(31,(28+leap $_[1]),(31,30,31,30,31)x2)[$_[0]-1]}
sub cal{by 7,((undef)x(wday(1,@_)-1),1..days @_)}

sub all{@_==grep$_,@_}
sub one{1==grep$_,@_}
sub none{!grep$_,@_}
sub any{!&none}

sub import{no strict 'refs';*{caller(0)."::$_"}=${"$_[0]::"}{$_} for grep !/^(BEGIN|__ANON__|a|import)$/, keys%{"$_[0]::"}}

Код


package L2;

use strict;
use qxp;

sub kludges{cat map{(join': ',@$_)."\n"}by 2,@_}

sub tree2(&$@){
  wa map{
    {
      ARRAY=>sub{$_[0]->(1,$_[1],$_[2],cat tree2($_[0],$_[1]+1,@{$_[3]}))},
      ''=>sub{$_[0]->(0,@_[1..3])}
    }->{ref($_->[1])}->(@_[0,1],@$_)
  }by 2,@_[2..$#_]
}

sub templator(&@){
  my($s,%s,%x)=shift;
  my$x=join'|',map{$x{$_->[0]}=quotemeta$_->[1];$s{$_->[0]}=$_->[2];quotemeta$_->[0]}by 3,@_;
  sub{wa map{s;((??{$x}))(.*?)(??{$x{$1}});$s{$1}($2,$_[1]);eg;$_}$s->($_[0])}
}

sub subst{
  my%s=@_;
  my$s=join'|',map quotemeta,keys%s;
  sub{wa map{s/($s)/$s{$1}/eg;$_}copy @_}
}



# 2do: move to module
sub import{no strict 'refs';*{caller(0)."::$_"}=${"$_[0]::"}{$_} for grep !/^(BEGIN|__ANON__|a|import)$/, keys%{"$_[0]::"}}

666;

Цитата(newbee @ 2.9.2011, 06:05

)

gcc, ты продемонстрировал киллер фичу перла - writeonly?

Цитата(newbee @ 1.9.2011, 11:14)

CLOS, MOP, dynamic and lexical variables, return multiple values, conditions and restarts,..

Цитата(newbee @ 2.9.2011, 07:05)

gcc, ты продемонстрировал киллер фичу перла - writeonly? smile

Цитата(gcc @ 14.9.2011, 13:50

)

я тут почти все понимаю