main :: [sys_message]
main = [Stdout (lay [show (take 15 (run 2 primeprog)),
                     show (take 20 fracprimes)])]

primeprog :: [(num,num)]
primeprog = fromjust (prog ("17/91 78/85 19/51 23/38 29/33 77/29 95/23 77/19 "
                            ++ "1/17 11/13 13/11 15/14 15/2 55/1"))

fracprimes :: [num]
fracprimes = [fromjust k | k<-map fracprime (run 2 primeprog); isjust k]

fracprime :: num->maybe num
fracprime = f 0
            where f 1 1 = Nothing
                  f n 1 = Just n
                  f n x = Nothing, if x mod 2 ~= 0
                  f n x = f (n+1) (x div 2), otherwise

run :: num->[(num,num)]->[num]
run n prog = [n], if ~isjust n'
           = n : run (fromjust n') prog, otherwise
             where n' = step n prog

step :: num->[(num,num)]->maybe num
step x []         = Nothing
step x ((n,d):xs) = Just (x*n div d), if x*n mod d = 0
                  = step x xs, otherwise

maybe * ::= Nothing | Just *

isjust :: maybe *->bool
isjust (Just x) = True
isjust Nothing  = False

fromjust :: maybe *->*
fromjust (Just x) = x

prog :: [char]->maybe [(num, num)]
prog xs = Just [], if trim xs = []
        = Nothing, if ~isjust fp \/ ~isjust rp
        = Just (fr : fromjust rp), otherwise
          where fp = frac xs
                Just (fr, xs') = fp
                rp = prog xs'

frac :: [char]->maybe ((num,num), [char])
frac xs = Nothing, if ~isjust np \/ ~isjust sl \/ ~isjust dp
        = Just ((n, d), xs'''), otherwise
          where np = numb xs
                Just (n, xs') = np
                sl = match '/' (trim xs')
                Just xs'' = sl
                dp = numb xs''
                Just (d, xs''') = dp

numb :: [char]->maybe (num, [char])
numb xs = Nothing, if n=[]
        = Just (numval n, r), otherwise
          where (n, r) = span "0123456789" (trim xs)

match :: *->[*]->maybe [*]
match m []     = Nothing
match m (m:xs) = Just xs
match m (x:xs) = Nothing

span :: [*]->[*]->([*],[*])
span match []     = ([], [])
span match (x:xs) = ([], x:xs), if ~(x $in match)
                  = (x:r, xs'), otherwise
                    where (r, xs') = span match xs

in :: *->[*]->bool
in x [] = False
in x (x:xs) = True
in x (y:xs) = x $in xs

trim :: [char]->[char]
trim [] = []
trim (c:xs) = trim xs, if c='\t' \/ c='\n' \/ c=' '
trim (c:xs) = c:xs