"--make-latex-doc"
-> putStr (gen_latex_doc p_o_specs)
+
+ _ -> error "Should not happen, known_args out of sync?"
)
known_args :: [String]
hdr (PrimOpSpec { name = n }) = wrapOp n ++ ","
hdr (PseudoOpSpec { name = n }) = wrapOp n ++ ","
hdr (PrimTypeSpec { ty = TyApp n _ }) = wrapTy n ++ ","
+ hdr (PrimTypeSpec {}) = error "Illegal type spec"
ent (Section {}) = ""
ent o@(PrimOpSpec {}) = spec o
PrimOpSpec { name = n, ty = t } -> wrapOp n ++ " :: " ++ pty t
PseudoOpSpec { name = n, ty = t } -> wrapOp n ++ " :: " ++ pty t
PrimTypeSpec { ty = t } -> "data " ++ pty t
+ Section { } -> ""
comm = case (desc o) of
[] -> ""
case lookup_attrib opt_name opts of
Just (OptionTrue _) -> if_true
Just (OptionFalse _) -> if_false
+ Just (OptionString _ _) -> error "String value for boolean option"
Nothing -> ""
mk_strictness opts =
case lookup_attrib "strictness" opts of
Just (OptionString _ s) -> s -- for now
+ Just _ -> error "Boolean value for strictness"
Nothing -> ""
mk_usage opts =
case lookup_attrib "usage" opts of
Just (OptionString _ s) -> s -- for now
+ Just _ -> error "Boolean value for usage"
Nothing -> ""
zencode cs =
-> case ty i of
TyF t1 (TyF _ _)
-> "mkCompare " ++ sl_name i ++ ppType t1
+ _ -> error "Type error in comparison op"
Monadic
-> case ty i of
TyF t1 _
-> "mkMonadic " ++ sl_name i ++ ppType t1
+ _ -> error "Type error in monadic op"
Dyadic
-> case ty i of
TyF t1 (TyF _ _)
-> "mkDyadic " ++ sl_name i ++ ppType t1
+ _ -> error "Type error in dyadic op"
GenPrimOp
-> let (argTys, resTy) = flatTys (ty i)
tvs = nub (tvsIn (ty i))
++ listify (map ppTyVar tvs) ++ " "
++ listify (map ppType argTys) ++ " "
++ "(" ++ ppType resTy ++ ")"
-
+
sl_name :: Entry -> String
sl_name i = "FSLIT(\"" ++ name i ++ "\") "
ppTyVar "c" = "gammaTyVar"
ppTyVar "s" = "deltaTyVar"
ppTyVar "o" = "openAlphaTyVar"
+ppTyVar _ = error "Unknown type var"
ppType :: Ty -> String
ppType (TyApp "Bool" []) = "boolTy"
------------------------------------------------------------------
alts :: [Parser a] -> Parser a
+alts [] = pzero
alts [p1] = try p1
alts (p1:p2:ps) = (try p1) <|> alts (p2:ps)