regex-dna ATS program | Computer Language Benchmarks Game

performance measurements

Each table row shows performance measurements for this ATS program with a particular command-line input value N.

N	CPU secs	Elapsed secs	Memory KB	Code B	≈ CPU Load
50,000	0.27	0.28	332	2482	0% 4% 4% 96%
500,000	2.75	2.76	10,504	2482	0% 3% 0% 100%
5,000,000	27.61	27.62	165,256	2482	0% 0% 0% 100%

Read the ↓ make, command line, and program output logs to see how this program was run.

Read regex-dna benchmark to see what this program should do.

notes

ATS/Anairiats version 0.2.8

regex-dna ATS program source code

(*
** The Computer Language Benchmarks Game
** http://benchmarksgame.alioth.debian.org/
** contributed by Hongwei Xi 
**
** regex-dna benchmark using PCRE
**
** compilation command:
**   atscc -O3 -fomit-frame-pointer -o regex-dna2 regex-dna2.dats -lpcre
*)

(* ****** ****** *)

%{^
#include <pcre.h>
%}

(* ****** ****** *)

staload _(*anonymous*) = "prelude/DATS/array.dats"

(* ****** ****** *)

viewdef bytes_v (n:int, l:addr) = bytes n @ l

(* ****** ****** *)

%{^
ATSinline()
ats_ptr_type
malloc_atm (ats_int_type n) { return malloc (n) ; }

ATSinline()
ats_void_type free_atm (ats_ptr_type p) { free (p) ; return ; }
%}

extern fun malloc_atm {n:nat}
  (n: int n): [l:addr] @(bytes_v (n, l) | ptr l) = "malloc_atm"
extern fun free_atm {n:nat} {l:addr}
  (pf: bytes_v (n, l) | p: ptr l): void = "free_atm"

(* ****** ****** *)

viewdef block_v (sz:int, l:addr) = bytes_v (sz, l)
dataviewtype blocklst (int) =
  | {n:nat} {sz:nat} {l:addr} blocklst_cons (n+1) of
      (block_v (sz, l) | int sz, ptr l, blocklst n)
  | blocklst_nil (0)
viewtypedef blocklst = [n:nat] blocklst (n)

(* ****** ****** *)

extern typedef "blocklst_cons_pstruct" =
  blocklst_cons_pstruct (void | int, ptr, blocklst)

(* ****** ****** *)

extern fun fread_stdin_block {sz:nat} {l:addr}
  (pf: !block_v (sz, l) | sz: int sz, p: ptr l): natLte sz
  = "fread_stdin_block"

%{$

ats_int_type
fread_stdin_block (
  ats_int_type sz0, ats_ptr_type p0
) {
  char *p ; int nread, sz ;
  p = p0; sz = sz0 ;
  while (sz > 0) {
    nread = fread (p, 1, sz, stdin) ;
    if (nread > 0) { p += nread ; sz -= nread ; continue ; }
    if (feof (stdin)) break ;
  }
  return (sz0 - sz) ;
} /* end of [fread_stdin_block] */

%} // end of [%{$]

(* ****** ****** *)

fn fread_stdin_blocklst {sz:nat}
  (sz: int sz, tot: &int): blocklst = let
  fun loop {tot: addr} (
      pf_tot: !int @ tot |
      sz: int sz, p_tot: ptr tot, res: &blocklst? >> blocklst
    ) : void = let
    val (pf | p) = malloc_atm (sz)
    val n = fread_stdin_block (pf | sz, p); val () = !p_tot := !p_tot + n
    val () = (res := blocklst_cons {0} (pf | sz, p, ?))
    val+ blocklst_cons (_ | _, _, !res1) = res
  in
    if n < sz then begin
      !res1 := blocklst_nil (); fold@ res
    end else begin
      loop (pf_tot | sz, p_tot, !res1); fold@ res
    end // end of [if]
  end // end of [loop]
  var res: blocklst; val () = loop (view@ tot | sz, &tot, res)
in
  res
end // end of [fread_stdin_blocklst]

(* ****** ****** *)

extern fun blocklst_concat_and_free
  {n:nat} (n: int n, blks: blocklst): [l:addr] @(bytes_v (n, l) | ptr l)
  = "blocklst_concat_and_free"

%{$

ats_ptr_type
blocklst_concat_and_free
  (ats_int_type tot, ats_ptr_type blks) {
  char *res0, *res, *p_blk ;
  int lft, sz ; blocklst_cons_pstruct blks_nxt ;

  lft = tot ; res0 = res = malloc_atm (tot) ;

  while (blks) {
    sz = ((blocklst_cons_pstruct)blks)->atslab_0 ;
    p_blk = ((blocklst_cons_pstruct)blks)->atslab_1 ;
    if (sz < lft) {
      memcpy (res, p_blk, sz) ;
    } else {
      memcpy (res, p_blk, lft) ; lft = 0 ; break ;
    }
    res += sz ; lft -= sz ;
    blks_nxt = ((blocklst_cons_pstruct)blks)->atslab_2 ;
    free_atm (p_blk) ; ATS_FREE (blks) ;
    blks = blks_nxt ;
  }
  return res0 ;
}

%} // end of [{%$]

(* ****** ****** *)

%{$

ats_int_type
count_pattern_match
  (ats_int_type nsrc, ats_ptr_type src, ats_ptr_type pat) {
  int count ;
  pcre *re; pcre_extra *re_ex ; const char *re_e ;
  int err, re_eo, m[3], pos ;

  re = pcre_compile
    ((char*)pat, PCRE_CASELESS, &re_e, &re_eo, NULL) ;
  if (!re) exit (1) ;
  re_ex = pcre_study (re, 0, &re_e);  

  for (count = 0, pos = 0 ; ; ) {
    err = pcre_exec (re, re_ex, (char*)src, nsrc, pos, 0, m, 3) ;
    if (err < 0) break ; count += 1 ; pos = m[1] ;
  }
  return count ;
} /* end of [count_pattern_match] */

%} // end of [%{$]

(* ****** ****** *)

extern fun count_pattern_match {n:nat} {l:addr}
  (pf: !bytes_v (n, l) | n: int n, p: ptr l, pat: string): int
  = "count_pattern_match"

(* ****** ****** *)

#define variants_length 9
val variants = array_make_arrsz {string} $arrsz(
  "agggtaaa|tttaccct"
, "[cgt]gggtaaa|tttaccc[acg]"
, "a[act]ggtaaa|tttacc[agt]t"
, "ag[act]gtaaa|tttac[agt]ct"
, "agg[act]taaa|ttta[agt]cct"
, "aggg[acg]aaa|ttt[cgt]ccct"
, "agggt[cgt]aa|tt[acg]accct"
, "agggta[cgt]a|t[acg]taccct"
, "agggtaa[cgt]|[acg]ttaccct"
) // end of [variants]

fun count_loop {i:nat} {n:nat} {l:addr}
  (pf: !bytes_v (n, l) | n: int n, p: ptr l, i: int i): void =
  if i < variants_length then let
    val pat = variants[i]
    val cnt = count_pattern_match (pf | n, p, pat)
    val () = (print pat ; print ' '; print cnt ; print_newline ())
  in
    count_loop (pf | n, p, i + 1)
  end // end of [if]

(* ****** ****** *)

datatype seglst (int) =
  | {n:nat} seglst_cons (n+1) of (int(*beg*), int(*len*), seglst n)
  | seglst_nil (0)
typedef seglst0 = seglst 0
typedef seglst = [n:nat] seglst (n)

extern typedef "seglst_cons_pstruct" =
  seglst_cons_pstruct (int, int, seglst)

extern fun seglst_cons_make
  (beg: int, len: int): seglst_cons_pstruct (int, int, seglst0?)
  = "seglst_cons_make"

implement seglst_cons_make (beg, len) = seglst_cons {0} (beg, len, ?)

extern typedef "int_ptr_type" = @(void | int, ptr)

(* ****** ****** *)

%{$

ats_void_type subst_copy (
  char *dst, char *src, int nsrc, seglst_cons_pstruct sgs, char *sub, int nsub
) {
  int ofs, beg, len ; seglst_cons_pstruct sgs_nxt ;
  for (ofs = 0 ; ; ) {
    if (!sgs) break ;
    beg = sgs->atslab_0 ; len = beg - ofs ;
    memcpy (dst, src, len) ; dst += len ; src += len ; ofs = beg ;
    len = sgs->atslab_1 ;
    memcpy (dst, sub, nsub) ; dst += nsub ; src += len ; ofs += len ;
    sgs_nxt = sgs->atslab_2 ; ATS_FREE (sgs); sgs = sgs_nxt ;
  }
  len = nsrc - ofs ;  memcpy (dst, src, len) ; return ;
} /* end of [subst_copy] */

int_ptr_type subst_pattern_string
  (ats_int_type nsrc, ats_ptr_type src, ats_ptr_type pat, ats_ptr_type sub) {
  char *dst ; int ndst, nsub ; int beg, len, nxt ;
  pcre *re; pcre_extra *re_ex ; const char *re_e ;
  int err, re_eo, m[3], pos ;
  seglst_cons_pstruct sgs0, sgs, *sgs_ptr ;
  int_ptr_type ans ;

  ndst = nsrc ; nsub = strlen ((char*)sub) ;
  re = pcre_compile
    ((char*)pat, PCRE_CASELESS, &re_e, &re_eo, NULL) ;
  if (!re) exit (1) ;
  re_ex = pcre_study (re, 0, &re_e);  
  for (pos = 0, sgs_ptr = &sgs0 ; ; ) {
    err = pcre_exec (re, re_ex, (char*)src, nsrc, pos, 0, m, 3) ;
    if (err >= 0) {
      beg = m[0] ; pos = m[1] ;
      len = pos - beg ; ndst -= len ; ndst += nsub ;
      sgs = (seglst_cons_pstruct)seglst_cons_make (beg, len) ;
      *sgs_ptr = sgs ; sgs_ptr = (seglst_cons_pstruct*)&(sgs->atslab_2) ;
    } else {
     *sgs_ptr = (seglst_cons_pstruct)0 ; break ;
    }
  } // end of [for]
  dst = malloc_atm (ndst) ;
  ans.atslab_1 = ndst ; ans.atslab_2 = dst ;
  subst_copy (dst, src, nsrc, sgs0, sub, nsub) ;
  return ans ;
} /* end of [subst_pattern_string] */

%} // end of [%{$]

extern
fun subst_pattern_string
  {n:nat} {l:addr} (
  pf: !bytes_v (n, l) | n: int n, p: ptr l, pat: string, sub: string
) : [n:nat] [l:addr] @(bytes_v (n, l) | int n, ptr l) = "subst_pattern_string"
// end of [subst_pattern_string]

(* ****** ****** *)

#define subst_length 22
val subst = array_make_arrsz {string} $arrsz(
  "B", "(c|g|t)"
, "D", "(a|g|t)"
, "H", "(a|c|t)"
, "K", "(g|t)"
, "M", "(a|c)"
, "N", "(a|c|g|t)"
, "R", "(a|g)"
, "S", "(c|g)"
, "V", "(a|c|g)"
, "W", "(a|t)"
, "Y", "(c|t)"
) // end of [subst]

(* ****** ****** *)

fun subst_loop {i:nat} {n:nat} {l:addr}
  (pf: bytes_v (n, l) | n: int n, p: ptr l, i: int i): int =
  if i < subst_length - 1 then let
    val pat = subst[i]; val sub = subst[i+1]
    val (pf1 | n1, p1) = subst_pattern_string (pf | n, p, pat, sub)
    val () = free_atm (pf | p)
  in
    subst_loop (pf1 | n1, p1, i + 2)
  end else begin
    let val () = free_atm (pf | p) in n end
  end // end of [if]

(* ****** ****** *)

#define BLOCKSIZE 0x10000 // 0x4000000

implement main () = let
  var n0: int = 0
  val blks = fread_stdin_blocklst (BLOCKSIZE, n0)
  val n0 = int1_of_int (n0); val () = assert (n0 >= 0)
  val (pf_bytes | p0) = blocklst_concat_and_free (n0, blks)
  val (pf1_bytes | n1, p1) =
    subst_pattern_string (pf_bytes | n0, p0, ">.*|\n", "")
  val () = free_atm (pf_bytes | p0)
  val () = count_loop (pf1_bytes | n1, p1, 0)
  val n_last = subst_loop (pf1_bytes | n1, p1, 0)
in
  printf ("\n%i\n%i\n%i\n", @(n0, n1, n_last))
end // end of [main]

(* ****** ****** *)

(* end of [regex-dna2.dats] *)

make, command-line, and program output logs

Wed, 23 Jan 2013 07:16:44 GMT

MAKE:
/usr/local/src/ats-lang-anairiats-0.2.9/bin/atscc -pthread -D_GNU_SOURCE -D_ATS_MULTITHREAD -pipe -Wall -O3 -fomit-frame-pointer -march=native  regexdna.dats -o regexdna.ats_run -lpcre
/usr/local/src/ats-lang-anairiats-0.2.9/bin/atsopt --output regexdna_dats.c --dynamic regexdna.dats
In file included from regexdna_dats.c:19:0:
/usr/local/src/ats-lang-anairiats-0.2.9/prelude/CATS/basics.cats: In function ‘atspre_fprint_newline’:
/usr/local/src/ats-lang-anairiats-0.2.9/prelude/CATS/basics.cats:271:11: warning: variable ‘n2’ set but not used [-Wunused-but-set-variable]
/usr/local/src/ats-lang-anairiats-0.2.9/prelude/CATS/basics.cats:271:7: warning: variable ‘n1’ set but not used [-Wunused-but-set-variable]
regexdna_dats.c: In function ‘fread_stdin_blocklst_0’:
regexdna_dats.c:231:1: warning: label ‘__ats_lab_fread_stdin_blocklst_0’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘array_get_elt_at__intsz_01355_ats_ptr_type’:
regexdna_dats.c:249:1: warning: label ‘__ats_lab_array_get_elt_at__intsz_01355_ats_ptr_type’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘seglst_cons_make’:
regexdna_dats.c:302:1: warning: label ‘__ats_lab_seglst_cons_make’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘mainats’:
regexdna_dats.c:374:1: warning: label ‘__ats_lab_mainats’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘subst_pattern_string’:
regexdna_dats.c:579:46: warning: unused variable ‘nxt’ [-Wunused-variable]
In file included from regexdna_dats.c:29:0:
regexdna_dats.c: At top level:
/usr/local/src/ats-lang-anairiats-0.2.9/prelude/CATS/pointer.cats:52:14: warning: ‘atspre_null_ptr’ defined but not used [-Wunused-variable]
In file included from regexdna_dats.c:30:0:
/usr/local/src/ats-lang-anairiats-0.2.9/prelude/CATS/printf.cats:57:1: warning: ‘atspre_fprintf_err’ defined but not used [-Wunused-function]
/usr/local/src/ats-lang-anairiats-0.2.9/prelude/CATS/printf.cats:69:1: warning: ‘atspre_fprintf_exn’ defined but not used [-Wunused-function]
/usr/local/src/ats-lang-anairiats-0.2.9/prelude/CATS/printf.cats:105:1: warning: ‘atspre_prerrf_exn’ defined but not used [-Wunused-function]
In file included from regexdna_dats.c:33:0:
/usr/local/src/ats-lang-anairiats-0.2.9/prelude/CATS/string.cats:351:14: warning: ‘atspre_stropt_none’ defined but not used [-Wunused-variable]
gcc -I/usr/local/src/ats-lang-anairiats-0.2.9/ -I/usr/local/src/ats-lang-anairiats-0.2.9/ccomp/runtime/ -L/usr/local/src/ats-lang-anairiats-0.2.9/ccomp/lib/ /usr/local/src/ats-lang-anairiats-0.2.9/ccomp/runtime/ats_prelude.c -pthread -D_GNU_SOURCE -D_ATS_MULTITHREAD -pipe -Wall -O3 -fomit-frame-pointer -march=native regexdna_dats.c -o regexdna.ats_run -lpcre -lats_mt -lats 
rm regexdna.dats
2.59s to complete and log all make actions

COMMAND LINE:
./regexdna.ats_run 0 < regexdna-input5000000.txt

PROGRAM OUTPUT:
agggtaaa|tttaccct 356
[cgt]gggtaaa|tttaccc[acg] 1250
a[act]ggtaaa|tttacc[agt]t 4252
ag[act]gtaaa|tttac[agt]ct 2894
agg[act]taaa|ttta[agt]cct 5435
aggg[acg]aaa|ttt[cgt]ccct 1537
agggt[cgt]aa|tt[acg]accct 1431
agggta[cgt]a|t[acg]taccct 1608
agggtaa[cgt]|[acg]ttaccct 2178

50833411
50000000
66800214

Home Conclusions License Play

Ubuntu : Intel® Q6600® one coreComputer Language Benchmarks Game [[ Play ]]

performance measurements

notes

regex-dna ATS program source code

make, command-line, and program output logs

Ubuntu : Intel® Q6600® one core
Computer Language Benchmarks Game [[ Play ]]