Вот это работает 2.5 минуты, из которых 40 секунд - зачитывание файла.

bf.c

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

const int infinity = 2147483647;

struct edge_t {
    int v1;
    int v2;
    int cost;
};

int
main(void) {
    int nvertex, nedge;

    scanf("%d %d\n", &nvertex, &nedge);

    int nalledges = nedge + nvertex;
    struct edge_t *edges = malloc(nalledges * sizeof(struct edge_t));

    // read input
    for (int i = 0; i < nedge; i++) {
        scanf("%d %d %d\n", &edges[i].v1, &edges[i].v2, &edges[i].cost);
    }
    // add edges from fake vertex
    for (int i = 0; i < nvertex; i++) {
        int idx = nedge + i;
        edges[idx].v1 = 0;
        edges[idx].v2 = i + 1;
        edges[idx].cost = 0;
    }

    int *c1 = malloc((nvertex + 1) * sizeof(int));
    int *c2 = malloc((nvertex + 1) * sizeof(int));

    c1[0] = 0;
    for (int i = 1; i < nvertex + 1; i++) {
        c1[i] = infinity;
    }

    for (int n = 0; n < nvertex + 2; n++) {
        for (int i = 0; i < nalledges; i++) {
            int target = edges[i].v2;
            int newcost = c1[edges[i].v1];

            if (newcost != infinity) {
                newcost += edges[i].cost;
            }
            if (newcost > c1[target]) {
                newcost = c1[target];
            }
            c1[target] = newcost;
        }
        if (n == nvertex) {
            memcpy(c2, c1, (nvertex + 1) * sizeof(int));
        }
    }
/*
    for (int i = 0; i < nvertex + 1; i++) {
        printf("%d\n", c1[i]);
    }
*/
    if (memcmp(c1, c2, (nvertex + 1) * sizeof(int))) {
        printf("Cycle\n");
    } else {
        int v = c1[0];
        for (int i = 1; i < nvertex + 1; i++) {
            if (c1[i] < v) {
                v = c1[i];
            }
        }
        printf("Shortest path %d\n", v);
    }

    return 0;
}

bf.hs

{-# LANGUAGE BangPatterns #-}
module Main where

import Control.DeepSeq
import Data.Functor
import Data.Vector.Unboxed ((//), (!))
import qualified Data.Vector.Unboxed as V
import qualified Data.Vector.Unboxed.Mutable as VM
import Data.Int
import System.IO
import Control.Monad

--import Debug.Trace

type Vertex = Int
type Dist = Int32
type Edge = (Vertex, Vertex, Dist)
type EdgeVec = V.Vector Edge
type CostVec = VM.IOVector Dist

readEdge :: String -> Edge
readEdge s = let [v1, v2, w] = words s
              in (read v1, read v2, read w)

bfStep :: EdgeVec -> CostVec -> IO ()
bfStep edges v = do
  putStr "."
  V.mapM_ mincost edges
  where
    mincost (s, h, c) = do
      prev <- VM.unsafeRead v h
      new <- cost s c
      if new < prev then VM.unsafeWrite v h new else return ()

    cost w c = do
      precost <- VM.unsafeRead v w
      return $ if precost == maxBound then maxBound else precost + c

mkEdgeVec :: Int -> [String] -> EdgeVec
mkEdgeVec nvert inp = V.unfoldr step (nvert, inp)
    where
    step (n, s:xs) = Just (readEdge s, (n, xs))
    step (0, []) = Nothing
    step (!n, []) = Just ((0, n, 0), (n - 1, []))

main :: IO()
main = do
    header:body <- lines <$> getContents
    let nvert = read $ head $ words header
    let edgelist = mkEdgeVec nvert body

    bfbase <- VM.replicate (nvert + 1) maxBound
    edgelist `deepseq` VM.unsafeWrite bfbase 0 0
    putStrLn "got edgelist"
    hSetBuffering stdout NoBuffering

    replicateM nvert (bfStep edgelist bfbase)
    bfcheck <- VM.clone bfbase
    bfStep edgelist bfcheck

    base <- V.freeze bfbase
    check <- V.freeze bfcheck
    let hasCycle = V.any id $ V.zipWith (/=) base check

    putStrLn $ if hasCycle then "Cycle" else show $ V.minimum base

bf.ml

open Core.Std

type vertex = int
type dist = int
type edge = (vertex * vertex * dist)
type edgeVec = edge array
type costVec = dist array

let maxBound = 2147483647

let readEdge s =
  match String.split ~on:' ' s with
  | [v1; v2; w] -> (Int.of_string v1, Int.of_string v2, Int.of_string w)
  | _ -> assert false

let bfStep edges v =
  eprintf ".%!";
  Array.iter edges ~f:(fun (s,h,c) ->
    let precost = v.(s) in
    if precost <> maxBound then
      let prev = v.(h) in
      let newcost = precost + c in
      if newcost < prev then v.(h) <- newcost
  )

let mkEdgeVec nvert inp =
  let rec go n inp acc =
    match inp with
    | [] ->
      if n = 0 then List.rev acc
      else go (n - 1) [] ((0, n, 0)::acc)
    | (s::xs) ->
      go n xs ((readEdge s)::acc)
  in
  go nvert inp []

let () =
  eprintf "start\n%!";
  let header, body = match In_channel.input_lines stdin with
    | l::ls -> l, ls
    | _ -> assert false
  in
  let nvert = Int.of_string (List.hd_exn (String.split ~on:' ' header)) in
  let edgelist = Array.of_list (mkEdgeVec nvert body) in

  let bfbase = Array.create ~len:(nvert + 1) maxBound in
  bfbase.(0) <- 0;
  eprintf "got edgelist\n%!";

  for i=1 to nvert do bfStep edgelist bfbase done;
  let bfcheck = Array.copy bfbase in
  bfStep edgelist bfcheck;

  let hasCycle =
    Array.fold2_exn bfbase bfcheck
      ~init:false ~f:(fun res a b -> res || a <> b)
  in

  if hasCycle then printf "Cycle\n"
  else let m = Array.fold ~init:maxBound ~f:(fun res a -> min a res) bfbase in
       printf "%d\n" m