ycextra-0.1: csvprim/GenPrimTable.hs

-- A configure-time tool to build annotations for normal
-- Core primitives from the CSV file obtained from the Google
-- Spreadsheet that is maintained by the Yhc Core Team
-- and contains the source of normal primitives annotation.
-- Whether runhugs or runghc runs this program, the `csv'
-- package should be properly installed and visible.

-- CSV record format is (7 fields):
-- [0]:  primitive name
-- [1]: "Y" if this record is usable
-- [2]: primitive description
-- [3]: implementation mandatory ("M") or can be substituted with <primitive name>
-- [4]: arity
-- [5]: strictness (All | [TF]* | "")
-- [6]: type signature

module Main where

import System.Environment
import System.Directory
import System.FilePath
import System.Exit
import System.IO
import Control.Monad
import Data.List
import Text.CSV

main = do
  args <- getArgs
  prog <- getProgName
  cd <- getCurrentDirectory
  when (length args < 3) $ do
    hPutStrLn stderr $ prog ++ ": three arguments needed"
    exitWith (ExitFailure 1)
  let [csv, outf] = map (cd </>) (take 2 args)
      outmod = head (drop 2 args)
  putStrLn $ prog ++ ": converting \n  from: " ++ csv ++ 
                     "\n  to:   " ++ outf ++
                     "\n  as:   " ++ outmod
  csvrecs <- parseCSVFromFile csv >>= return . 
                                      map (take 7) . 
                                      filter usable .
                                      either (\e -> error $ show e) id
  hout <- openFile outf WriteMode
  mapM (hPutStrLn hout) (modHeader outmod)
  hPutStrLn hout "rawPrimAnno :: [[String]]"
  hPutStrLn hout "rawPrimAnno = ["
  let inddef = map (("  " ++) . show) csvrecs
      catdef = concat $ intersperse ",\n" inddef
  hPutStrLn hout $ catdef ++ "]\n"
  hClose hout
  putStrLn $ prog ++ ": done"

-- Autogenerated module header (based on the module name provided)

modHeader md = [
  "-- Raw annotations for Core Normal Primitives (autogenerated, do not edit!!!)"
 ,"module " ++ md ++ "(rawPrimAnno) where\n"]

-- Filter records based on the condition that number of elements in a record
-- is at least 7, and the second element is "Y".

usable :: [Field] -> Bool

usable rec@(_: "Y": _) = length rec >= 7
usable _ = False