Changeset 2497

Show
Ignore:
Timestamp:
04/29/05 23:42:50 (4 years ago)
Author:
theorbtwo
svk:copy_cache_prev:
4052
Message:

We have haddockability! (There's not yet a makefile rule for it -- I still
need to figure out the best options for it. In the meantime, try find src
-name \*.hs|perl -pe 's/hs$/hpp/'|xargs make && haddock find src -name \*.hpp)

Files:
12 modified

Legend:

Unmodified
Added
Removed

  • Makefile.PL

    r2465 r2497  
    4242    'src/Pugs/Config.hs', 'blib6', 
    4343    'test.log', 
    44     map {("$_/*.hi", "$_/*.o*")} @srcdirs 
     44    map {("$_/*.hpp", "$_/*.hi", "$_/*.o*")} @srcdirs 
    4545); 
    4646 
    … …  
    120120 
    121121%.hpp : %.hs @prereqs 
    122         $ghc $threaded $ghc_flags -E \$< -o \$@ 
    123         \$(PERL) -i -pe 's/^#.*//' \$@ 
    124  
    125 %.html : %.hpp 
    126         haddock -vD  \$< 
     122        $ghc $threaded $ghc_flags -DHADDOCK -E \$< -o \$@ 
     123        \$(PERLRUN) util/munge_haddock.pl \$@ 
    127124 
    128125profiled :: src/Pugs/Config.hs @srcfiles $version_h @prereqs 

  • src/IMC.hs

    r2236 r2497  
    1 {-# OPTIONS_GHC -fglasgow-exts -fth #-} 
     1{-# OPTIONS_GHC -fglasgow-exts -fth -cpp #-} 
    22 
    33{- 
    … …  
    1919-- import IMC.Lexer 
    2020 
     21#ifndef HADDOCK 
    2122run = $( imcX prog ) 
     23#endif 
    2224 
    2325{- 

  • src/IMC/AST.hs

    r2134 r2497  
    1 {-# OPTIONS_GHC -fglasgow-exts -fth #-} 
     1{-# OPTIONS_GHC -fglasgow-exts -fth -cpp #-} 
    22 
    33module IMC.AST where 
    … …  
    1313instance Value String 
    1414 
     15#ifndef HADDOCK 
    1516data Term a where 
    1617    TStr     :: String -> Term String 
    1718    TOp1     :: (Show a, Value a) => Op -> Term a -> Term Statement 
    1819    TSub     :: SubName  -> [Term Statement] -> Term Sub 
     20#else 
     21data Term = TStr str termstr | TOp1 op term termstatement | TSub subname arrtermstatement termsub 
     22#endif 
    1923 
    2024compile :: ExpQ -> ExpQ 
     25#ifndef HADDOCK 
    2126compile str = [| putStrLn $ "Hello, " ++ $str ++ "!" |] 
     27#endif 
    2228 
    2329-- Haskell Equivalent of a BEGIN block! 
    … …  
    3844 
    3945imcCompile :: Term a -> ExpQ 
     46#ifndef HADDOCK 
    4047imcCompile (TStr a) = [| return a |] 
    4148imcCompile (TOp1 "print" (TStr str)) = [| putStrLn str |] 
    4249imcCompile (TSub _ stmts) = let foo = map imcCompile stmts in 
    4350    [| sequence_ $(listE foo) |] 
    44  
     51#endif 

  • src/IMC/Compile.hs

    r2134 r2497  
    1 {-# OPTIONS_GHC -fglasgow-exts -fth #-} 
     1{-# OPTIONS_GHC -fglasgow-exts -fth -cpp #-} 
    22 
    33module IMC.Compile where 
    … …  
    8989-- run :: Term a -> IO (Term a) 
    9090-- run program = $( compile [| program |] ) 
     91#ifndef HADDOCK 
    9192foo program = $( compile [| program |] ) 
     93#endif 
    9294 
    9395 

  • src/Pugs/AST.hs

    r2490 r2497  
    2121import qualified Data.Map       as Map 
    2222 
    23 #include "Types/Array.hs" 
    24 #include "Types/Handle.hs" 
    25 #include "Types/Hash.hs" 
    26 #include "Types/Scalar.hs" 
    27 #include "Types/Code.hs" 
    28 #include "Types/Thunk.hs" 
    29 #include "Types/Rule.hs" 
    30 #include "Types/Pair.hs" 
    31 #include "Types/Object.hs" 
     23{- include "Types/Array.hs" -} 
     24{- include "Types/Handle.hs" -} 
     25{- include "Types/Hash.hs" -} 
     26{- include "Types/Scalar.hs" -} 
     27{- include "Types/Code.hs" -} 
     28{- include "Types/Thunk.hs" -} 
     29{- include "Types/Rule.hs" -} 
     30{- include "Types/Pair.hs" -} 
     31{- include "Types/Object.hs" -} 
    3232 
    3333type Ident = String 
    … …  
    514514    } 
    515515 
     516#ifndef HADDOCK 
    516517mkSub = MkCode 
    517518    { isMulti = False 
    … …  
    526527    , subBody = emptyExp 
    527528    } 
     529#endif 
    528530 
    529531instance Ord VComplex where 
    … …  
    10571059    return $ f (av :: VArray) 
    10581060 
     1061#ifndef HADDOCK 
    10591062data (Typeable v) => IVar v where 
    10601063    IScalar :: ScalarClass a => a -> IVar VScalar 
    … …  
    10861089    vCast v = MkOpaque v 
    10871090    castV (MkOpaque x) = castV x 
     1091#endif 
    10881092 
    10891093readIVar :: IVar v -> Eval v 
    … …  
    11001104refType (MkRef x) = object_iType x 
    11011105 
     1106#ifndef HADDOCK 
    11021107instance Eq VRef where 
    11031108    (==) = const $ const False 
    … …  
    11151120instance (Typeable a) => Show (IVar a) where 
    11161121    show v = show (MkRef v) 
     1122#endif 
    11171123 
    11181124scalarRef x = MkRef (IScalar x) 
    … …  
    11491155retConstError val = retError "Can't modify constant item" val 
    11501156 
     1157#ifndef HADDOCK 
    11511158type IArray  = TVar [IVar VScalar] 
    11521159type IArraySlice = [IVar VScalar] 
    … …  
    11821189    typeOf1 (IThunk  x) = typeOf x 
    11831190    typeOf1 (IPair   x) = typeOf x 
    1184  
     1191#endif 
     1192 

  • src/Pugs/Compile/Haskell.hs

    r2462 r2497  
    1616 
    1717genGHC :: Eval Val 
     18#ifndef HADDOCK 
    1819genGHC = do 
    1920    exp <- asks envBody 
    … …  
    3132        , TH.pprint str 
    3233        ] 
     34#endif 
    3335 
     36#ifndef HADDOCK 
    3437compile (Stmts stmt rest) = [| do 
    3538        $(argC) 
    … …  
    5861compile Noop = [| return () |] 
    5962compile exp = internalError ("Unrecognized construct: " ++ show exp) 
     63#endif 
    6064 
    6165#endif 

  • src/Pugs/Eval.hs

    r2487 r2497  
    1 {-# OPTIONS_GHC -fglasgow-exts #-} 
     1{-# OPTIONS_GHC -fglasgow-exts -cpp #-} 
    22{-# OPTIONS_GHC -#include "UnicodeC.h" #-} 
    33 
    … …  
    377377        val     <- evalExp valExp 
    378378        retVal $ castV (key, val) 
     379#ifndef HADDOCK 
    379380    "*" | [Syn syn [exp]] <- unwrap exps -- * cancels out [] and {} 
    380381        , syn == "\\{}" || syn == "\\[]" 
    381382        -> enterEvalContext cxtSlurpyAny exp 
     383#endif 
    382384    "*" -> do -- first stab at an implementation 
    383385        let [exp] = exps 
    … …  
    509511        modVal  <- readVar "$?MODULE" 
    510512        mod     <- fromVal modVal 
     513#ifndef HADDOCK 
    511514        let file = (`concatMap` mod) $ \v -> case v of 
    512515            { '-' -> "__"; _ | isAlphaNum v -> [v] ; _ -> "_" } 
     516#endif 
    513517        op1 "require_haskell" (VStr $ file ++ ".o") 
    514518        retEmpty 

  • src/Pugs/External/Haskell.hs

    r2441 r2497  
    6868 
    6969externalizeHaskell :: String -> String -> IO String 
     70#ifndef HADDOCK 
    7071externalizeHaskell mod code = do 
    7172    let names = map snd exports 
    … …  
    9293        ParseOk (HsModule _ _ _ _ decls) -> decls 
    9394        ParseFailed _ err -> error err 
     95#endif 
    9496 
    9597wrap :: String -> IO Dec 
     98#ifndef HADDOCK 
    9699wrap fun = do 
    97100    [quoted] <- runQ [d| 
    … …  
    101104        |] 
    102105    return $ munge quoted ("extern__" ++ fun) 
     106#endif 
    103107 
    104108munge (ValD _ x y) name = ValD (VarP (mkName name)) x y 

  • src/Pugs/Help.hs

    r2135 r2497  
    1010-} 
    1111 
    12 #define PUGS_VERSION "6" 
    13 #define PUGS_DATE "" 
    14 #include "pugs_config.h" 
    15 #include "pugs_version.h" 
     12{- define PUGS_VERSION "6" -} 
     13{- define PUGS_DATE "" -} 
     14{- include "pugs_config.h" -} 
     15{- include "pugs_version.h" -} 
    1616 
    1717module Pugs.Help (printInteractiveHelp, printCommandLineHelp, 

  • src/Pugs/Parser.hs

    r2476 r2497  
    1 {-# OPTIONS_GHC -fglasgow-exts #-} 
     1{-# OPTIONS_GHC -fglasgow-exts -cpp #-} 
    22{-# OPTIONS_GHC -#include "UnicodeC.h" #-} 
    33 
    … …  
    939939                  <|> do 
    940940    sigil   <- oneOf "$@%&" 
    941     -- ^ placeholder, * global, ? magical, . member, : private member 
     941    --^ \^ placeholder, \* global, \? magical, \. member, \: private member 
    942942    caret   <- option "" $ choice $ map string $ words " ^ * ? . : " 
    943943    names   <- many1 wordAny `sepBy1` (try $ string "::") 
    … …  
    10531053 
    10541054qInterpolator :: QFlags -> RuleParser Exp 
     1055#ifndef HADDOCK 
    10551056qInterpolator flags = choice [ 
    10561057        closure, 
    … …  
    10991100                    else True -- $ followed by anything else is interpolated 
    11001101            where second = head $ tail var 
     1102#endif 
    11011103 
    11021104qLiteral = do -- This should include q:anything// as well as '' "" <> 

  • src/Pugs/Run.hs

    r2486 r2497  
    7373    errSV   <- newScalar (VStr "") 
    7474    defSV   <- newScalar undef 
    75 #if defined(PUGS_HAVE_HSPLUGINS) 
     75{- if defined(PUGS_HAVE_HSPLUGINS) -} 
    7676    hspluginsSV <- newScalar (VInt 1) 
    77 #else 
     77{- else -} 
    7878    hspluginsSV <- newScalar (VInt 0) 
    79 #endif 
     79{- endif -} 
    8080    let subExit = \x -> case x of 
    8181            [x] -> op1 "exit" x 

  • src/Pugs/Shell.hs

    r2440 r2497  
    8080#else 
    8181addHistory _ = return () 
    82 #endif  
     82#endif 
    8383