klapaucius

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

const int infinity = 2147483647;

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

klapaucius

$wbfStep :: EdgeVec -> CostVec -> Vector Dist
$wbfStep =
  \ (w :: EdgeVec) (w1 :: CostVec) ->
    let { Vector ipv ipv1 ipv2 ~ _ <- w1 `cast` ... } in
    let { V_3 ipv3 ipv4 ipv5 ipv6 ~ _ <- w `cast` ... } in
    let { Vector rb _ rb2 ~ _ <- ipv4 `cast` ... } in
    let { Vector rb3 _ rb5 ~ _ <- ipv5 `cast` ... } in
    let { Vector rb6 _ rb8 ~ _ <- ipv6 `cast` ... } in
    runSTRep
      (\ (@ s) (s :: State# s) ->

klapaucius

{-# LANGUAGE TypeFamilies, DataKinds, GADTs, NoMonomorphismRestriction #-}

-- http://typesandkinds.wordpress.com/2012/11/26/variable-arity-zipwith/

module Main where

import Prelude hiding (map, zipWith, zipWith3)
import Control.Applicative hiding (liftA, liftA2, liftA3)
import Control.Monad hiding (liftM, liftM2, liftM3)

klapaucius

Prelude> :set -XDataKinds
Prelude> :set -XKindSignatures
Prelude> :set -XScopedTypeVariables
Prelude> import Data.Fixed
Prelude Data.Fixed> import GHC.TypeLits
Prelude Data.Fixed GHC.TypeLits> 
data E (a :: Nat)

Prelude Data.Fixed GHC.TypeLits> 
instance SingI a => HasResolution (E a) where resolution _ = 10 ^ fromSing (sing :: Sing a)

klapaucius

{-# LANGUAGE FlexibleInstances #-}
import Control.Applicative

newtype J a = J { runJ :: a }

instance (Applicative f, Num n) => Num (J(f n)) where
    (+) = (J .) . liftA2 (+) `on` runJ
    (-) = (J .) . liftA2 (-) `on` runJ
    (*) = (J .) . liftA2 (*) `on` runJ
    abs = J . fmap abs . runJ

klapaucius

module Parsers =
    let inline konst a b = a //const зарезервировано

    type Parser<'s, 't> = 's -> ('t * 's) option  
        
    let inline uncons l = match l with x::xs -> Some(x,xs) | [] -> None

    let inline unit a xs = Some (a, xs)
    let inline (<*>) pf px inp = 
        match pf inp with 

klapaucius

> import GHC.HeapView
> 
let evLength n l = do
    ht <- buildHeapTree n (asBox $ l)
    let cnt (HeapTree _ (ConsClosure {ptrArgs = [hd,tl]})) = 1 + cnt tl
        cnt _ = 0
    return $ cnt ht
> let l = [1..]
> l !! 10
11

klapaucius

Prelude> let foo ys | (xs:_) <- reverse ys = case xs of xs' | (x:_) <- reverse xs' -> x
Prelude> foo [[1..3],[4..7],[8..10]]
10

Prelude> let foo' (reverse -> (reverse -> x:_):_) = x
Prelude> foo' [[1..3],[4..7],[8..10]]
10

klapaucius

Детская болезнь "эмелизны" в хаскелизме.

Приближается, пожалуй, самое значительное нововведение в хаскеле, со времен FC и превращения хаскеля из ML++ в недоΩmega: модули. Весь этот тектонический сдвиг, правда, остается незамеченным. Даже в Release notes об этом не упомянуто. Есть, только упоминание в руководстве пользователя Также, описания новой системы модулей можно найти на странице Backpack, но установить что из этого уже имплементировано можно только опытным путем.

Представление о ML-модулях можно составить из диссертации Дрейера (pdf)

klapaucius

{-# LANGUAGE RankNTypes, TypeInType, TypeApplications, OverloadedLabels,
  ScopedTypeVariables, TypeOperators, GADTs, FlexibleInstances, FlexibleContexts,
  TypeFamilies, UndecidableInstances #-}

import Data.Kind (Type)
import Data.Proxy (Proxy(..))
import GHC.Generics
import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)
import Control.Lens
import Data.Generics.Product.Fields (field')