cvs commit: hugs98/src GreenCard.h connect.h hugs.c input.c parser.y static.c

[Alastair Reid]

reid        2000/12/13 01:36:05 PST

  Modified files:
    src                  GreenCard.h connect.h hugs.c input.c 
                         parser.y static.c 
  Log:
  Final commit in the series.
  
  Added +G flag to options in hugs.c.
  Lexer, parser and static checker additions.
  
  Note that foreign export (static) is not implemented.
  My problem was how to handle the following:
  
    plus x y = x + y
    foreign export "plusInt"   plus :: Int -> Int -> Int
    foreign export "plusFloat" plus :: Float -> Float -> Float
  
  What I want to do is to define:
  
    __plusInt :: Int -> Int -> Int
    __plusInt = plus
  
    __plusFloat :: Float -> Float -> Float
    __plusFloat = plus
  
  then invoke the typechecker which will insert dictionaries, check that
  the instances make sense, etc.  And now I can foreign export each
  individual instance with no bother at all.
  
  One problem is that ffi declarations are processed fairly early in the
  checking process - it's a bad time to go invoking the typechecker.
  Another problem is that I'm not entirely sure how to actually do the
  above.  I think it should be like checking the bindings in an instance
  declaration but I don't quite grok that code.
  
  [This is a subtly disguised plea for help from Mark, Jeff or someone
  else who feels happy in the typechecker.  (I'm assuming someone
  suitably qualified is on the commit mailing list.)]
  
  Anyway, enough about what if can't do.  Here's what it can do:
  
  1) Copy the following files into Test.hs and test.c
  2) hugs +G Test.hs
     This generates Test.c
  3) cc -shared Test.c test.c -o Test.so
     This generates Test.so
  4) hugs Test.hs
     This loads Test.hs and Test.so
  5) test (+) 1 1
     This should print 2!
  
  I know it's a lot of work just to add two numbers... but there's a
  certain satisfaction in knowing that the addition was done in C isn't
  there?
  
  ----------------------------------------------------------------
  -- Start of Haskell part of test file Test.hs
  ----------------------------------------------------------------
  -- Doesn't support:
  -- o foreign export static
  -- o Int64, Word64, Int32, Word32, Int16, Word16, Int8, Word8
  -- o The named C types HsChar, HsInt16, etc
  
  module Test where
  
  foreign import x :: Int -> Char -> IO Addr
  foreign import z :: Int -> Int -> Int
  foreign import dynamic x' :: Addr -> (Int -> Char -> IO Addr)
  
  -- foreign export static isn't implemented (typechecking problems)
  -- foreign export y :: Int -> Char -> IO Float
  -- y _ _ = return 1.0
  
  foreign export dynamic toC :: (Int -> Int -> Int) -> IO Addr
  
  -- You can use either of these definitions - both work
  -- foreign import "fromC" fromC :: Addr -> (Int -> Int -> Int)
  fromC = fromfromC fromC_addr
  
  foreign import dynamic fromfromC :: Addr -> (Addr -> (Int -> Int -> Int))
  foreign label "fromC" fromC_addr :: Addr
  
  test f x y = do{ f' <- toC f; print (fromC f' x y) }
  
  ----------------------------------------------------------------
  -- Start of Haskell part of test file Test.hs
  ----------------------------------------------------------------
  
  /****************************************************************
   * Start of C part of test file test.c
   ****************************************************************/
  extern void* y(int a, char b);
  
  void* x(int a, char b) {
    //    return y(a,b);
  }
  
  int z(int a, int b) { return a+b; }
  
  void* from_dyn(void* (*f)(int i, char c),int i, char c) {
      return (*f)(i,c);
  }
  
  void* fromC(void* (*f)(int a, int b),int a, int b) {
      return (*f)(a,b);
  }
  /****************************************************************
   * Start of C part of test file test.c
   ****************************************************************/
  
  Revision  Changes    Path
  1.4       +12 -5     hugs98/src/GreenCard.h
  1.14      +9 -2      hugs98/src/connect.h
  1.26      +8 -3      hugs98/src/hugs.c
  1.16      +29 -2     hugs98/src/input.c
  1.11      +44 -4     hugs98/src/parser.y
  1.26      +357 -2    hugs98/src/static.c