Ordona Haskello

Antaŭludo.hs

{-# LANGUAGE FlexibleInstances, UndecidableInstances, Rank2Types #-}
module Antaŭludo ((+), (=<<), (>>=), ($), (<$>), (<), module Antaŭludo, module Prelude.Unicode)

where

import Control.Monad.ST -- ST → SF
import Control.Monad.Loops
import System.Environment
import Data.STRef
import Prelude.Unicode -- de base-unicode-symbols

type SF = ST -- State Thread → Statusa Fadeno
type SFRef = STRef
type Ĉenan = String
type Ĉenon = String
type Enelon = IO
type Liston = []
type Listan = []
type Bul = Bool

class Show s ⇒ Montrigeblan s where
  montrigu ∷ s → String

instance Show s ⇒ Montrigeblan s where
  montrigu = show

class Read s ⇒ Legeblan s where
  legu ∷ String → s

instance Read s ⇒ Legeblan s where
  legu = read

ruliguSF ∷ ∀ a. (∀ s. SF s a) → a
ruliguSF = runST

novaSFRef ∷ ∀ a s. a → SF s (SFRef s a)
novaSFRef = newSTRef -- Ref = Reference → Referencon
leguSFRef ∷ ∀ s a. SFRef s a → SF s a
leguSFRef = readSTRef
skribuSFRef ∷ ∀ s a. SFRef s a → a → SF s ()
skribuSFRef = writeSTRef
ŝanĝuSFRef' ∷ ∀ s a. SFRef s a → (a → a) → SF s ()
ŝanĝuSFRef' = modifySTRef'

dumM_ ∷ (Monad m) ⇒ m Bul → m () → m ()
dumM_ = whileM_ -- M = Monad → Monado

videbligu ∷ Montrigeblan s ⇒ s → Enelon ()
videbligu = print

trovuOperandojn ∷ Enelon (Listan Ĉenan)
trovuOperandojn = getArgs

malsukcesu ∷ Ĉenon → a
malsukcesu = error

fib.hs

{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude #-}
module Main
where

import Antaŭludo

fib ∷ ℤ → ℤ
fib n = ruliguSF $ do
  a ← novaSFRef 0
  b ← novaSFRef 1
  kalkulon ← novaSFRef 1
  dumM_ ((< n) <$> leguSFRef kalkulon) $ do
    aMalnova ← leguSFRef a
    skribuSFRef a =<< leguSFRef b
    ŝanĝuSFRef' b (+ aMalnova)
    ŝanĝuSFRef' kalkulon (+ 1)
  leguSFRef b

ruligu ∷ Liston Ĉenan → Enelon ()
ruligu [n] = videbligu $ fib (legu n)
ruligu _ = malsukcesu "Mi deziras unu numeron n, kaj mi aldonos la n-an fibonaĉan numeron"
   
main ∷ Enelon ()
main = trovuOperandojn >>= ruligu