comparing a trivial program between F#, Haskell, and OCaml

LineInfo.fsx

#!/usr/bin/env fsharpi
#light "off"
#nowarn "9" "42" "51" "62";;

open System.IO

// the stream position reported by .NET's IO is useless because the runtime's
// buffering modifies it from under you, i.e. even if you've only read
// 4 bytes, the current position will be reported as (e.g.) 128 if the runtime's
// buffering has resulted in advancing the stream to that point; so, since we
// can't rely on querying the stream position, we have to calculate it
// ourselves.  we assume (!) that one character = one byte.

let usesCRLF (h : StreamReader) =
  let llen = int64 (h.ReadLine().Length) in
  h.DiscardBufferedData();
  h.BaseStream.Position <- llen;
  let c = h.Peek() in
  let res =
    if c = -1 || c = int '\n' then false else begin
      h.DiscardBufferedData();
      h.BaseStream.Position <- llen + 1L;
      let c = h.Peek() in
      c = int '\n'
    end in
  h.DiscardBufferedData();
  h.BaseStream.Position <- 0L;
  res

let linePositions (h : StreamReader) =
  let crlf = if usesCRLF h then 2L else 1L in
  let f (lineno, pos) =
    if lineno = -1 then None else
    let res = (lineno, pos) in
    if h.EndOfStream then Some (res, (-1, pos)) else begin
      let llen = int64 (h.ReadLine().Length) in
      let npos = pos + llen + crlf in
      Some (res, (lineno + 1, npos))
    end in
  Seq.unfold f (1, 0L) |> Seq.toList

let filesLinePositions files =
  let withFile f path = using (File.OpenText path) f in
  let ls = List.map (withFile linePositions) files in
  let fileLs = List.zip files ls in
  Map.ofList fileLs

#if COMPILED
[<EntryPoint>]
let main argv =
#else
let _ =
  let argv = fsi.CommandLineArgs in
#endif
  let argvl = List.tail (Array.toList argv) in
  let files = if argvl = [] then ["/etc/passwd"] else argvl in
  let m = filesLinePositions files in
  printfn "%A" m;
  0

LineInfo.hs

module LineInfo where

import Control.Monad (forM)
import System.Environment (getArgs)
import System.IO
import qualified Data.Map.Strict as Map

linePositions :: Handle -> IO [(Integer, Integer)]
linePositions h = go 1 []
  where
    go lineno acc = do
      pos <- hTell h
      atEOF <- hIsEOF h
      let res = (lineno, pos):acc
      if atEOF then return res else do
        hGetLine h
        go (lineno + 1) res

filesLinePositions :: [FilePath] -> IO (Map.Map FilePath [(Integer, Integer)])
filesLinePositions files = do
    ls <- forM files $ \file -> withFile file ReadMode linePositions
    let fileLs = zip files (map reverse ls)
    return $ Map.fromList fileLs

main :: IO ()
main = do
    files <- getArgs
    m <- filesLinePositions (if null files then ["/etc/passwd"] else files)
    putStrLn $ Map.showTreeWith (curry show) True False m

LineInfo.ml

let using chan disposer action =
  try
    let res = action chan in
    disposer chan;
    res
  with e -> disposer chan; raise e

let soi = string_of_int

let linePositions h =
  let rec go lineno acc =
    let pos = pos_in h in
    let res = (lineno, pos)::acc in
    let at_eof = try
      begin
        ignore (input_line h);
        false
      end
    with End_of_file -> true in
    if at_eof then res else go (lineno + 1) res in
  go 1 []

let filesLinePositions files =
  let withFile f path = using (open_in path) close_in f in
  let ls = List.map (withFile linePositions) files in
  let fileLs = List.combine files ls in
  let tbl = Hashtbl.create 100 in
  List.iter (fun (k, v) -> Hashtbl.add tbl k v) fileLs;
  tbl

let _ =
  let argvl = List.tl (Array.to_list Sys.argv) in
  let files = if argvl = [] then ["/etc/passwd"] else argvl in
  let m = filesLinePositions files in
  let print_stuff x =
    let print_kv (k, v) = print_endline ("  (" ^ soi k ^ ", " ^ soi v ^ ")") in
    Hashtbl.iter (fun file lines ->
      print_endline (file ^ " ->");
      List.iter print_kv (List.rev lines)) x in
  print_stuff m

// alternate imperative implementation of linePositions for f#
open System.IO
open System.Collections.Generic

let linePositionsLoop (h : StreamReader) =
  let mutable lineno = 1 in
  let mutable pos = 0L in
  let positions = ResizeArray() in
  let crlf = if usesCRLF h then 2L else 1L in
  while lineno <> -1 do
    positions.Add ((lineno, pos));
    if h.EndOfStream then lineno <- -1 else begin
      lineno <- lineno + 1;
      pos <- pos + int64 (h.ReadLine().Length) + crlf
    end
  done;
  Seq.toList positions