Send Beginners mailing list submissions to
        beginners@haskell.org

To subscribe or unsubscribe via the World Wide Web, visit
        http://www.haskell.org/mailman/listinfo/beginners
or, via email, send a message with subject or body 'help' to
        beginners-requ...@haskell.org

You can reach the person managing the list at
        beginners-ow...@haskell.org

When replying, please edit your Subject line so it is more specific
than "Re: Contents of Beginners digest..."


Today's Topics:

   1.  gtk2hs, inputAdd and forked process (Johann Giwer)
   2.  Is complete decoupling and abstraction possible  in Haskell?
      (Tomer Libal)
   3.  Re: Is complete decoupling and abstraction       possible in
      Haskell? (Tomer Libal)
   4.  Re: Is complete decoupling and abstraction       possible in
      Haskell? (Tomer Libal)
   5.  MULTICONF-09 final call for papers (John Edward)


----------------------------------------------------------------------

Message: 1
Date: Thu, 15 Jan 2009 23:26:25 +0100
From: Johann Giwer <johanngi...@web.de>
Subject: [Haskell-beginners] gtk2hs, inputAdd and forked process
To: The Haskell-Beginners Mailing List <beginners@haskell.org>
Message-ID: <20090115222622.ga24...@zitrone>
Content-Type: text/plain; charset=us-ascii

Some times ago I wrote a frontend for mpg123 using python and gtk2. Now
I'm trying to do the same in haskell, but my attempt failed in a very
early stage. 

I like to start a subprocess and read its output via 'inputAdd'. The
(simplified) code looks like this:

module Main (Main.main) where
import System.IO.UTF8 hiding (putStr, putStrLn, print)
import qualified Control.Exception as E
import System.Glib.MainLoop
import System.Environment
import System.Posix.Process
import System.Posix.IO
import System.Posix.Types
import Graphics.UI.Gtk


main :: IO ()
main = do
    name <- getProgName
    argv <- getArgs
    case argv of
        [file] -> play file
        _      -> putStrLn $ "Usage: " ++ name ++ " MP3 FILE"

play :: FilePath -> IO ()
play file = do
    initGUI
    (r0,w0) <- createPipe
    (r1,w1) <- createPipe
    pid <- forkProcess $ do
        closeFd w0
        closeFd r1
        dupTo r0 stdInput
        dupTo w1 stdOutput
        executeFile "mpg123" True ["--output", "alsa", "--remote"] Nothing
    closeFd w1
    closeFd r0

    window <- windowNew
    onDestroy window mainQuit
    button <- buttonNew
    set button [ buttonLabel := "Play" ]
    onClicked button $ do
        w <- fdToHandle w0
        E.handle ( \e -> print e ) $ do
            hPutStrLn w ( "L " ++ file )
        return ()
    set window [ containerChild := button ]
    widgetShowAll window

    inputAdd (fromIntegral r1) [ IOIn,IOPri ] priorityHigh ( readData r1 ) 

    mainGUI

readData :: Fd -> IO Bool
readData h = do
    E.handle ( \e ->  print e >> return True ) $ do
        (s,_) <- fdRead h 1
        putStr s 
        return False

When loading the file in ghci, I get half a second of sound and a couple of
status message lines. Compiled with ghc, this program gives absolute no output
(So threading seams to be the problem?). 

In a next step, I wrapped every IO action in the main process in a call
of 'forkIO' and used MVars for the file name and descriptors, but that
doesn't help. 

Does anybody have experience with 'inputAdd' and forked processes?

Thanks in advance

-Johann




------------------------------

Message: 2
Date: Fri, 16 Jan 2009 13:35:35 +0100
From: Tomer Libal <shaoli...@gmail.com>
Subject: [Haskell-beginners] Is complete decoupling and abstraction
        possible        in Haskell?
To: beginners@haskell.org
Message-ID:
        <ac706fd70901160435o35362b2fp4beee48c8193a...@mail.gmail.com>
Content-Type: text/plain; charset="iso-8859-1"

Hi,

I must add that although in general Theorem provers are very performance
oriented, we are not interested in performance in our prover as it is used
mainly for testing different refinements and extensions. Therefore, we
consider haskell as well (as c++).

Also, is there a big reference project, implemented in Haskell, that
exhibits some of the OO concepts like decoupling, modulation and
abstraction? I understand functional programming has other core values like
ease of programming and easy validation of correctness but is it also
suitable for large structured projects worked on by many programmers (using
decoupling for example)?

I have read the previous thread about Monads with great interest. The
abstration ideas contained in Wadler's papers gave me hope that there is a
way to do a full decoupling and abstraction in Haskell, but I have no idea
how.
I am interested in building a completely generic resolution theorem prover
that all of its parts can be implemented separately. In fact, we already
have this prover programmed in c++ but I would be glad if I can reprogram it
in Haskell for further extensions of the different parts.

The idea of the resolution prover is to get a set of clauses in clasual
logic and to try and refute them by using resolution.

Some of the parts that need to be decoupled are:
- Refinements which are datastructures that return the pair (or more) of
clauses each time that need to be processed. They are chosen according to
some heuristic, i.e. smallest clauses, etc. Each Refinement instance should
be able to return the next pair to be processed according to its inner state
and heuristics.
- Resolvers that process two clauses and tries to unify a specific literal
in each. The abstraction here deals with each resolver processing in a
different way. Some do factorization and some modulation and each one of
this processes have several kinds that should be decoupled as well (i.e.
modulator that works by a brute force BFS or
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 
http://www.haskell.org/pipermail/beginners/attachments/20090116/15ad9255/attachment-0001.htm

------------------------------

Message: 3
Date: Fri, 16 Jan 2009 13:36:38 +0100
From: Tomer Libal <shaoli...@gmail.com>
Subject: [Haskell-beginners] Re: Is complete decoupling and
        abstraction     possible in Haskell?
To: beginners@haskell.org
Message-ID:
        <ac706fd70901160436s1bdaee54rcb9ee89994827...@mail.gmail.com>
Content-Type: text/plain; charset="iso-8859-1"

I am deeply sorry, the message was sent by mistake before I have finished
it..
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 
http://www.haskell.org/pipermail/beginners/attachments/20090116/198c6324/attachment-0001.htm

------------------------------

Message: 4
Date: Fri, 16 Jan 2009 13:52:31 +0100
From: Tomer Libal <shaoli...@gmail.com>
Subject: [Haskell-beginners] Re: Is complete decoupling and
        abstraction     possible in Haskell?
To: beginners@haskell.org
Message-ID:
        <ac706fd70901160452u10d54bbavb9fe8a34acb0f...@mail.gmail.com>
Content-Type: text/plain; charset="iso-8859-1"

Hi,

I have read the previous thread about Monads with great interest. The
abstration ideas contained in Wadler's papers gave me hope that there is a
way to do a full decoupling and abstraction in Haskell, but I have no idea
how.
I am interested in building a completely generic resolution theorem prover
that all of its parts can be implemented separately. In fact, we already
have this prover programmed in c++ but I would be glad if I can reprogram it
in Haskell for further extensions of the different parts.

The idea of the resolution prover is to get a set of clauses in clasual
logic and to try and refute them by using resolution.

Some of the parts that need to be decoupled are:
- Refinements which are datastructures that return the pair (or more) of
clauses each time that need to be processed. They are chosen according to
some heuristic, i.e. smallest clauses, etc. Each Refinement instance should
be able to return the next pair to be processed according to its inner state
and heuristics.
- Resolvers that process two clauses and tries to unify a specific literal
in each. The abstraction here deals with each resolver processing in a
different way. Some do factorization and some modulation and each one of
this processes have several kinds that should be decoupled as well (i.e.
modulator that works by a brute force BFS or in a smarter way).
- Post processors that are applied to all successfull resolvents and perform
manipulation on the Refinements states, like adding new clauses (called also
resolvents), forward subsumption, deletion of tautologies, etc.)

As an example for abstraction in the Refinement state, we have in the c++
version an interactive refinement that gets as argument another refinement
and deals with obtaining commands from the user:
- do x steps in automatic mode i.e. execute the inner refinement for x
steps.
- tries to unifies two clauses on all positions, etc.

Also the user interface module should be deoupled as it can be a simple
command like or a GUI.

My naive approach was to create a class for each abstract part of the prover
and the different instances will implement the specific implementations.

My main question is if it is feasible to achieve in Haskell and even if it
is Feasible, if such decoupling should be attempted in Haskell in the first
place or that other languages are more suitable. I guess my main question is
if projects prgrammed by several programmers with a complete decoupling
between them can be done in Haskell.

I must add that although in general Theorem provers are very performance
oriented, we are not interested in performance in our prover as it is used
mainly for testing different refinements and extensions. Therefore, we
consider haskell as well (as c++).

Also, is there a big reference project, implemented in Haskell, that
exhibits some of the OO concepts like decoupling, modulation and
abstraction? I understand functional programming has other core values like
ease of programming and easy validation of correctness but is it also
suitable for large structured projects worked on by many programmers (using
decoupling for example)?

to give an example for the main function (many parts are missing):

class Refinement a where
getClauses :: Maybe (Clause, Clause)

loop  timeout refinement =
  let
    clauses = getClauses refinement
    timedout = isTimeout t
  in
    if timedout then Timedout t else
      case clauses of
        Nothing -> Exahusted
        Just (c1, c2) -> let
          resolvents = unifyOnAllLiterals c1 c2 -- list of all resolvents
        in
          if emptyClauseIsContained resolvents
             then Success unifier -- unifer is the global unifier
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 
http://www.haskell.org/pipermail/beginners/attachments/20090116/b90c26fe/attachment-0001.htm

------------------------------

Message: 5
Date: Fri, 16 Jan 2009 05:59:13 -0800 (PST)
From: John Edward <jeedw...@yahoo.com>
Subject: [Haskell-beginners] MULTICONF-09 final call for papers
To: beginners@haskell.org
Message-ID: <90105.78966...@web45901.mail.sp1.yahoo.com>
Content-Type: text/plain; charset="iso-8859-1"


MULTICONF-09 final call for papers
 
The 2009 Multi Conference in Computer Science, Information Technology and 
Control systems and Computational Science and Computer Engineering 
(MULTICONF-09) (website: http://www.PromoteResearch.org) will be held during 
July 13-16 2009 in Orlando, FL, USA. We invite draft paper submissions. The 
event consists of the following conferences:
·         International Conference on Artificial Intelligence and Pattern 
Recognition (AIPR-09) 
·         International Conference on Automation, Robotics and Control Systems 
(ARCS-09)
·         International Conference on Bioinformatics, Computational Biology, 
Genomics and Chemoinformatics (BCBGC-09)
·         International Conference on Enterprise Information Systems and Web 
Technologies (EISWT-09)
·         International Conference on High Performance Computing, Networking 
and Communication Systems (HPCNCS-09) 
·         International Conference on Information Security and Privacy (ISP-09)
·         International Conference on Recent Advances in Information Technology 
and Applications (RAITA-09)
·         International Conference on Software Engineering Theory and Practice 
(SETP-09) 
·         International Conference on Theory and Applications of Computational 
Science (TACS-09)
·         International Conference on Theoretical and Mathematical Foundations 
of Computer Science (TMFCS-09)
 
The website http://www.PromoteResearch.org  contains more details.
 
Sincerely
John Edward
Publicity committee
 
 


      
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 
http://www.haskell.org/pipermail/beginners/attachments/20090116/b49284b4/attachment.htm

------------------------------

_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://www.haskell.org/mailman/listinfo/beginners


End of Beginners Digest, Vol 7, Issue 13
****************************************

Reply via email to