OpItem.hs revision 42c01284bba8d7c8d995c8dfb96ace57d28ed1bc
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederModule : $Header$
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederCopyright : (c) Christian Maeder, Uni Bremen 2002-2004
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederMaintainer : maeder@tzi.de
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederStability : provisional
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederPortability : portable
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder parse OP-ITEM and "op/ops OP-ITEM ; ... ; OP-ITEM"
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder parse PRED-ITEM and "op/ops PRED-ITEM ; ... ; PRED-ITEM"
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder from 25 March 2001
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder C.2.1 Basic Specifications with Subsorts
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maedermodule CASL.OpItem (opItem, predItem) where
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder-- stupid cast
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederargDecl :: [String] -> AParser st ARG_DECL
75067b1beba1380cde707c30e7fc050d86f6927fKarl LucargDecl = fmap (\(Var_decl vs s ps) -> Arg_decl vs s ps) . varDecl
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl LucpredHead :: [String] -> AParser st PRED_HEAD
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder do o <- wrapAnnos oParenT
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder (vs, ps) <- argDecl ks `separatedBy` anSemi
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder p <- addAnnos >> cParenT
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder return $ Pred_head vs $ catPos (o:ps++[p])
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederopHead :: [String] -> AParser st OP_HEAD
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder do Pred_head vs ps <- predHead ks
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder (b, s, qs) <- opSort ks
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder return $ Op_head (if b then Partial else Total) vs s
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder (ps `appRange` tokPos c `appRange` qs)
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederopAttr :: AParsable f => [String] -> AParser st (OP_ATTR f, Token)
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederopAttr ks = do p <- asKey assocS
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder return (Assoc_op_attr, p)
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl Luc do p <- asKey commS
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl Luc return (Comm_op_attr, p)
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder do p <- asKey idemS
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder return (Idem_op_attr, p)
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder do p <- asKey unitS
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder return (Unit_op_attr t, p)
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederisConstant :: OP_TYPE -> Bool
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederisConstant(Op_type _ [] _ _) = True
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederisConstant _ = False
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaedertoHead :: Range -> OP_TYPE -> OP_HEAD
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaedertoHead (Range c) (Op_type k [] s ps) = Op_head k [] s (Range c `appRange` ps)
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaedertoHead _ _ = error "toHead got non-empty argument type"
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederopItem :: AParsable f => [String] -> AParser st (OP_ITEM f)
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder do (os, cs) <- parseId ks `separatedBy` anComma
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder if isSingle os then
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder do c <- anColon
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder t <- opType ks
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder if isConstant t then
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder opBody ks (head os) (toHead (tokPos c) t)
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder <|> opAttrs ks os t [c] -- this always succeeds
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder else opAttrs ks os t [c]
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder do h <- opHead ks
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder opBody ks (head os) h
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder do c <- anColon
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder t <- opType ks
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder opAttrs ks os t (cs++[c])
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederopBody :: AParsable f => [String] -> OP_NAME -> OP_HEAD
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder -> AParser st (OP_ITEM f)
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederopBody ks o h =
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder do e <- equalT
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder return $ Op_defn o h (Annoted t nullRange a []) $ tokPos e
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederopAttrs :: AParsable f => [String] -> [OP_NAME] -> OP_TYPE -> [Token]
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder -> AParser st (OP_ITEM f)
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl LucopAttrs ks os t c =
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl Luc do q <- anComma
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl Luc (as, cs) <- opAttr ks `separatedBy` anComma
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl Luc let ps = Range (sort (catPosAux (c ++ map snd as ++ (q:cs))))
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl Luc return (Op_decl os t (map fst as) ps)
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl Luc <|> return (Op_decl os t [] (catPos c))
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl Luc-- overlap "o:t" DEF-or DECL "o:t=e" or "o:t, assoc"
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl Luc-- ----------------------------------------------------------------------
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl Luc-- predicates
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl Luc-- ----------------------------------------------------------------------
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl LucpredItem :: AParsable f => [String] -> AParser st (PRED_ITEM f)
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl LucpredItem ks =
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl Luc do (ps, cs) <- parseId ks `separatedBy` anComma
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl Luc if isSingle ps then
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl Luc predBody ks (head ps) (Pred_head [] nullRange)
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl Luc do h <- predHead ks
7b1111ca3b126f71cce47e60ce4b56e6f92422e9Karl Luc predBody ks (head ps) h
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder predTypeCont ks ps cs
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder else predTypeCont ks ps cs
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederpredBody :: AParsable f => [String] -> PRED_NAME -> PRED_HEAD
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder -> AParser st (PRED_ITEM f)
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederpredBody ks p h =
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder do e <- asKey equivS
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder f <- formula ks
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder return $ Pred_defn p h (Annoted f nullRange a []) $ tokPos e
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederpredTypeCont :: [String] -> [PRED_NAME] -> [Token] -> AParser st (PRED_ITEM f)
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian MaederpredTypeCont ks ps cs =
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder do c <- colonT
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder t <- predType ks
5096f518ac5380a0834a09b22a8b38fabe247bf5Christian Maeder return $ Pred_decl ps t $ catPos (cs++[c])