Skip to content
This repository
branch: master
Matthew B. Mirman
file 104 lines (78 sloc) 1.868 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
{-# LANGUAGE
RankNTypes,
TemplateHaskell,
NoMonomorphismRestriction
#-}

-----------------------------------------------------------------------------
-- |
-- Module : Main
-- Author : Matthew Mirman ( mmirman@andrew.cmu.edu )
-- Stability : experimental
-- Portability : portable
-- Description : An example module for Control.Monad.Imperative
--
-- Some exampes of use.
-----------------------------------------------------------------------------
module Main where

import Control.Monad.Imperative
  
swap(r1,r2) = function $ do
{
    z <- new auto;
    z =: r1;
    r1 =: r2;
    r2 =: z;
    return' r1;
};

imperativeId(r1) = function $ do
{
  return' r1;
};

type NumLit = forall r a . Num a => V TyVal r a

deferer() = function $ do
{
  a <- new 0;
  b <- new 2;
  
  defer' a;
  
  defer' $ do {
    io $ putStrLn "hi1";
    io $ putStrLn "hi2";
  };
  
  defer' $ do {
    imperativeId(a);
    io $ putStrLn "hi3";
    return' b;
  };
  
  return' a;
}

print' v = do
  v' <- val v
  io $ print v'

factorial :: (Show r, Num r, Ord r) => () -> MIO i b r
factorial() = function $ do
{
    a <- new 0;
    n <- new 1;
    
    a =: (0 :: NumLit);
    
    for' ( a =: Lit 1 , a <. Lit 11 , a +=: Lit 1 ) $ do
    {
      
        b <- new 0;
        b =: a;
        
        defer' $ do {
           print' b;
        };
        
        n *=: a;
        if' ( a <. Lit 5)
            continue';
        
        if' ( a >. Lit 2)
            break';
        
        return' a;
        
    };
    
    a =: imperativeId(a);
    
    swap( (&)n , (&)a);
    
    return' a;
};

main = do
  t <- runImperative $ deferer()
  putStrLn $ "Defer: " ++ show t
  
  j <- runImperative $ factorial()
  putStrLn $ "Factorial: " ++ show j
Something went wrong with that request. Please try again.