Sunday, June 04, 2006

un md5sum encore un peu plus compact... toujours en OCaml

open String module I=Int32 module J=Int64 let n,v,(<),(=),($),(&),(|/),(&*),(@),
(++),(>*),w,m,l,(%)=I.lognot,Sys.argv,I.shift_left,I.shift_right_logical,I.add,I
.logand,I.logor,J.logand,I.logxor,J.add,J.shift_right_logical,sub,Array.make,
Array.length,List.iter let(><)i x=(ilet s=create 8in let a,b=J.
to_int32(n>*32),J.to_int32 n in s.[4]<-c(255l&a);s.[5]<-c(a=8&255l);s.[6]<-c(a=
16&255l);s.[7]<-c(a=24&255l);s.[0]<-c(255l&b);s.[1]<-c(b=8&255l);s.[2]<-c(b=16&
255l);s.[3]<-c(b=24&255l);s),(fun s->let a,b,c,d=f s.[0],(f s.[1])<8,(f s.[2])<
16,(f s.[3])<24in a|/b|/c|/d)let u s=let x=m 16 0l in for i=0to 15do x.(i)<-f(w
s(i*4)4)done;x and t=let t=m 64 0l in for i=0to l t-1do t.(i)<-J.to_int32(J.
of_float(ldexp(abs_float(sin(float_of_int(i+1))))32))done;t and g x=let l=J.
to_int((J.sub 960L(511L&*x))&*511L)in let l=if not(l<>0)then 512else l in let s=
make((l+1)/8)'\000'in s.[0]<-'\128';s^(r x)let rec i()=j:=(!j+1)mod 64;!j and j=
ref(-1)and h xb a b c d=j:=-1;let aa,bb,cc,dd= !a,!b,!c,!d in let rec x()=p:=(!p
+1)mod 4;match!p with 0->a,b,c,d|3->b,c,d,a|2->c,d,a,b|_->d,a,b,c and p=ref 0and
o()=p:= -1in(o();let k=ref(-1)in let m()=incr k;!k in let f s=let(a,b,c,d),k=x()
,m()in a:= !b$(!a$((!b& !c)|/((n!b)& !d))$xb.(k)$t.(i())>(%)(Printf.printf"%02lx")[a<24=24;a=8<
24=24;a=16<24=24;a=24<24=24])l;Printf.printf" %s\n"f let z f=let a,b,c,d=ref 
0x67452301l,ref 0xefcdab89l,ref 0x98badcfel,ref 0x10325476l in let ic,bf=open_in
f,create 64in let rec e ea=match input ic bf 0 64with 0->h(u(g ea))a b c d|64->h
(u bf)a b c d;e(ea++512L)|l->let ea=ea++(J.of_int(8*l))in let s=(w bf 0 l)^(g ea
)in let sl=length s in if sl>64 then(h(u(w s 0 64))a b c d;h(u(w s 64(sl-64)))a
b c d)else h(u s)a b c d in e 0L;p[!a;!b;!c;!d]f;;for i=1to l v-1do z v.(i)done