X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=utils%2Fgenprimopcode%2FMain.hs;h=14f08346be833127dd764184cc5aa39047e9c15a;hp=3d7c83f34fae1375111b711ddca5eeb787e7d24b;hb=b2524b3960999fffdb3767900f58825903f6560f;hpb=28cb2d6d40264796fb84da1f352490fd2b8eb27f diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index 3d7c83f..14f0834 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -8,10 +8,10 @@ module Main where import Parser import Syntax -import Char -import List -import System ( getArgs ) -import Maybe ( catMaybes ) +import Data.Char +import Data.List +import Data.Maybe ( catMaybes ) +import System.Environment ( getArgs ) main :: IO () main = getArgs >>= \args -> @@ -46,13 +46,13 @@ main = getArgs >>= \args -> "commutable" "commutableOp" p_o_specs) - "--needs-wrapper" + "--code-size" -> putStr (gen_switch_from_attribs - "needs_wrapper" - "primOpNeedsWrapper" p_o_specs) + "code_size" + "primOpCodeSize" p_o_specs) - "--can-fail" - -> putStr (gen_switch_from_attribs + "--can-fail" + -> putStr (gen_switch_from_attribs "can_fail" "primOpCanFail" p_o_specs) @@ -91,7 +91,7 @@ known_args "--has-side-effects", "--out-of-line", "--commutable", - "--needs-wrapper", + "--code-size", "--can-fail", "--strictness", "--primop-primop-info", @@ -141,6 +141,7 @@ gen_hs_source (Info defaults entries) = where opt (OptionFalse n) = n ++ " = False" opt (OptionTrue n) = n ++ " = True" opt (OptionString n v) = n ++ " = { " ++ v ++ "}" + opt (OptionInteger n v) = n ++ " = " ++ show v hdr s@(Section {}) = sec s hdr (PrimOpSpec { name = n }) = wrapOp n ++ "," @@ -409,7 +410,8 @@ gen_latex_doc (Info defaults entries) Just (OptionTrue _) -> if_true Just (OptionFalse _) -> if_false Just (OptionString _ _) -> error "String value for boolean option" - Nothing -> "" + Just (OptionInteger _ _) -> error "Integer value for boolean option" + Nothing -> "" mk_strictness o = case lookup_attrib "strictness" o of @@ -550,6 +552,7 @@ gen_switch_from_attribs attrib_name fn_name (Info defaults entries) getAltRhs (OptionFalse _) = "False" getAltRhs (OptionTrue _) = "True" + getAltRhs (OptionInteger _ i) = show i getAltRhs (OptionString _ s) = s mkAlt po