La fonction counts est chargée du comptage d'une ligne.
# letseps
=
" \t"
;;
val seps : string = " \t"
# letnl
=
ref
0
;;
val nl : int ref = {contents=0}
# letnw
=
ref
0
;;
val nw : int ref = {contents=0}
# letnc
=
ref
0
;;
val nc : int ref = {contents=0}
La fonction count itère la fonction de comptage d'une ligne sur l'ensemble des lignes d'un fichier.
# letcounts
s
=
let
was_sep
=
ref
true
in
let
n
=
String.length
s
in
for
i
=
0
to
n
-
1
do
let
is_sep
=
String.contains
seps
s
.[
i]
in
if
is_sep
&&
(not
!
was_sep)then
incr
nw
;
was_sep
:=
is_sep
done
;
if
not
!
was_septhen
incr
nw
;
nc
:=
!
nc+
n+
1
;
incr
nl
;;
val counts : string -> unit = <fun>
La fonction principale appelle la fonction de comptage sur le nom de fichier passé en argument et affiche les résultats.
# letcount
f
=
nl
:=
0
;nw
:=
0
;nc
:=
0
;
let
f_in
=
open_in
f
in
try
while
true
do
counts
(input_line
f_in)
done
with
End_of_file
->
close_in
f_in
;;
val count : string -> unit = <fun>
# letprint_count()
=
Printf.printf
"\t%d"
!
nl;
Printf.printf
"\t%d"
!
nw;
Printf.printf
"\t%d\n"
!
nc;;
val print_count : unit -> unit = <fun>
# letmain()
=
try
if
Array.length
Sys.argv
<
2
then
print_string
"wc1: missing file name\n"
else
(
count
Sys.argv
.
(1
);
print_count()
)
with
e
->
Printf.printf
"wc1: %s\n"
(Printexc.to_string
e)
;;
val main : unit -> unit = <fun>
On redéfinit l'affichage en fonction du statut des options.
# letl_opt
=
ref
false
and
w_opt
=
ref
false
and
c_opt
=
ref
false
;;
val l_opt : bool ref = {contents=false}
val w_opt : bool ref = {contents=false}
val c_opt : bool ref = {contents=false}
La ligne de commande est analysée pour mettre à jour le statut des options ainsi que la liste des fichiers à traiter.
# letprint_count
f
=
Printf.printf
"%s:"
f
;
if
!
l_optthen
Printf.printf
"\t%d"
!
nl;
if
!
w_optthen
Printf.printf
"\t%d"
!
nw;
if
!
c_optthen
Printf.printf
"\t%d"
!
nc;
print_newline()
;;
val print_count : string -> unit = <fun>
La fonction principale itère le comptage sur la liste des fichiers.
# letf_list
=
ref
(
[]:
stringlist)
;;
val f_list : string list ref = {contents=[]}
# letread_args
()
=
let
usage_msg
=
"wc2 [-l] [-w] [-w] files..."
in
let
add_f
f
=
f_list
:=
f
::!
f_listin
let
spec_list
=
[
(
"-l"
,
Arg
.
Setl_opt
,
"affichage nombre de lignes"
);
(
"-w"
,
Arg
.
Setw_opt
,
"affichage nombre de mots"
);
(
"-c"
,
Arg
.
Setc_opt
,
"affichage nombre de caractères"
)
]
in
Arg.parse
spec_list
add_f
usage_msg
;;
val read_args : unit -> unit = <fun>
# letmain()
=
try
read_args()
;
List.iter
(fun
f
->
count
f;
print_count
f)
!
f_list
with
e
->
Printf.printf
"wc2: %s\n"
(Printexc.to_string
e)
;;
val main : unit -> unit = <fun>
|
des interprètes de commande Unix.
# letpipe_two_progs
(p1
,
args1)
(p2
,
args2)
=
let
in2
,
out1
=
Unix.pipe()
in
match
Unix.fork()
with
0
->
Unix.close
in2
;
Unix.close
Unix.stdout
;
ignore(Unix.dup
out1)
;
Unix.close
out1
;
Unix.execvp
p1
(Array.of_list
args1)
|
_
->
Unix.close
out1
;
Unix.close
Unix.stdin
;
ignore(Unix.dup
in2)
;
Unix.close
in2
;
Unix.execvp
p2
(Array.of_list
args2)
;;
val pipe_two_progs : string * string list -> string * string list -> unit =
<fun>
# letorthographe
dico
nom
=
let
f
=
open_in
nom
in
try
while
true
do
let
s
=
input_line
f
in
let
ls
=
mots
s
in
List.iter
(Printf.printf
"%s\n"
)(verifie
dico
ls)
done
;
failwith
"cas impossible"
with
End_of_file
->
close_in
f
|
x
->
close_in
f
;
raise
x
;;
val orthographe : arbre_lex -> string -> unit = <fun>
# lettrie
()
=
let
l
=
ref
[]
in
try
while
true
do
l
:=
Sort.list
(
<
)((input_line
stdin)
::!
l)done
with
End_of_file
->
List.iter
(Printf.printf
"%s\n"
)
!
l;;
val trie : unit -> unit = <fun>
# pipe_two_progs(
"orthographe"
,[
""
;Sys.argv.
(1
)]
)(
"tri"
,[]
);;
Pour itérer le pipeline, on définit une fonction récursive dont le premier argument donne le canal d'entrée du premier processus à chaîner.
# letdup_stdin
in_descr
=
if
in_descr
<>
Unix.stdinthen
Unix.dup2
in_descr
Unix.stdin
;
Unix.close
in_descr
;;
val dup_stdin : Unix.file_descr -> unit = <fun>
# letdup_stdout
out_descr
=
if
out_descr
<>
Unix.stdoutthen
Unix.dup2
out_descr
Unix.stdout
;
Unix.close
out_descr
;;
val dup_stdout : Unix.file_descr -> unit = <fun>
# letrec
pipe_n_progs_loop
in_descr
=
function
[
p,
args]
->
dup_stdin
in_descr
;
Unix.execvp
p
(Array.of_list
args)
|
(p
,
args)::ps->
let
in2
,
out1
=
Unix.pipe()
in
(
match
Unix.fork()
with
0
->
Unix.close
in2
;
dup_stdin
in_descr
;
dup_stdout
out1
;
Unix.execvp
p
(Array.of_list
args)
|
_
->
Unix.close
out1
;
pipe_n_progs_loop
in2
ps
)
|
_
->
()
;;
val pipe_n_progs_loop :
Unix.file_descr -> (string * string list) list -> unit = <fun>
# letpipe_n_progs
ps
=
pipe_n_progs_loop
Unix.stdin
ps
;;
val pipe_n_progs : (string * string list) list -> unit = <fun>
# letrmdup
()
=
let
l
=
ref
[]
in
try
while
true
do
let
x
=
input_line
stdin
in
if
not
(List.mem
x
!
l)then
l
:=
x
::!
l
done
with
End_of_file
->
List.iter
(Printf.printf
"%s\n"
)
!
l;;
val rmdup : unit -> unit = <fun>
# pipe_n_progs
[
(
"orthographe"
,[
""
;Sys.argv.
(1
)]
);(
"tri"
,[]
);(
"rmdup"
,[]
)
]
;;
# letresult
=
ref
0
;;
val result : int ref = {contents=0}
# letrec
eras
=
function
[]
->
[]
|
p::q
->
result
:=
p
;
p
::
(eras
(List.filter
(fun
x
->
x
mod
p
<>
0
)q))
;;
val eras : int list -> int list = <fun>
# letsigint_handle
(
_
:
int)
=
Printf.printf
"Current prime number : %d\n"
!
result;
flush
stdout
;;
val sigint_handle : int -> unit = <fun>
# Sys.set_signalSys.sigint
(Sys
.
Signal_handlesigint_handle)
;;
- : unit = ()
$ ocamlc premiers.ml $ premiers 15000 Current prime number : 2539 Current prime number : 8263 2 3 5 7 11 13 17 19 23 29 31 37 41 43 ............