diff --git a/Elixir.hs b/Elixir.hs index 23eaf81..1c3f2ff 100644 --- a/Elixir.hs +++ b/Elixir.hs @@ -229,12 +229,9 @@ value g (Except i es) = unlines (map (\(k,v) -> "Map.put(" ++ reference g i ++ " value g (Case ms) = "cond do\n" ++ intercalate "\n" (map (caseMatch g) ms) ++ "\nend\n" -- Others, not specified -value _ (Str s) = show s value g (Range n1 n2) = value g n1 ++ ".." ++ value g n2 -value _ (Boolean b) = if b then "true" else "false" value g (Ref i) = reference g i value g (Tuple as) = "{" ++ intercalate ", " (map (value g) as) ++ "}" -value _ (Num d) = show d value g (Neg a) = "-" ++ value' g a value g (Add a b) = value' g a ++ " + " ++ value' g b value g (Sub a b) = value' g a ++ " - " ++ value' g b @@ -242,17 +239,22 @@ value g (Mul a b) = value' g a ++ " * " ++ value' g b value g (Div a b) = value' g a ++ " / " ++ value' g b value g (Mod a b) = "rem(" ++ value' g a ++ ", " ++ value' g b ++ ")" value g (Domain v) = "Map.keys(" ++ value g v ++ ")" +value _ (Lit l) = lit l value _ v = error("Missing value case: " ++ show v) -value' _ (Num d) = show d +value' _ (Lit (Num d)) = show d value' g (Ref i) = reference g i value' g e = "(" ++ value g e ++ ")" +lit (Str s) = show s +lit (Num d) = show d +lit (Boolean b) = if b then "true" else "false" + caseMatch g (Match p v) = predicate g p ++ " -> " ++ value g v caseMatch g (DefaultMatch v) = "true -> " ++ value g v -mapping g ((Key i), v) = snake i ++ ": " ++ value g v +mapping g ((Key i), v) = show i ++ ": " ++ value g v mapping g ((All i a), v) = let ig = (i, "param"):g in value g a ++ " |> Enum.map(fn (" ++ i ++ ") -> {" ++ i ++ ", " ++ value ig v ++ "} end)" -- (VAL-*) diff --git a/Head.hs b/Head.hs index 84af6df..e9c9a39 100644 --- a/Head.hs +++ b/Head.hs @@ -21,7 +21,9 @@ data Definition = ActionDefinition Identifier [Parameter] Documentation Action | Comment String deriving(Show, Eq) -data Key = Key Identifier | All Identifier Value deriving(Show, Eq) +data Lit = Str String | Boolean Bool | Num Integer | FullSet String deriving(Show, Eq) + +data Key = Key Lit | All Identifier Value deriving(Show, Eq) data CaseMatch = Match Value Value | DefaultMatch Value deriving(Show, Eq) @@ -56,19 +58,18 @@ data Value = Equality Value Value | FunSet Value Value | FunGen Identifier Value Value | SetTimes Value Value + | SetIn Value Value + | SetMinus Value Value | Union Value Value | Filtered Identifier Value Value | Cardinality Value | Record [(Key, Value)] + | RecordSet [(Key, Value)] | Except Identifier [(Value, Value)] | Case [CaseMatch] | Domain Value - | Str String - | Boolean Bool - | FullSet String | Index Value Value | Range Value Value - | Num Integer | Ref String | Neg Value | Add Value Value @@ -76,4 +77,5 @@ data Value = Equality Value Value | Mul Value Value | Div Value Value | Mod Value Value + | Lit Lit deriving (Show, Eq) diff --git a/Helpers.hs b/Helpers.hs index aea06b9..4e7d9aa 100644 --- a/Helpers.hs +++ b/Helpers.hs @@ -71,7 +71,7 @@ mapMerge (m:ms) = "Map.merge(\n " ++ m ++ ",\n" ++ ident (mapMerge ms) ++ ")\n" preassignment as = (head as) == '(' || take 2 as == "if" || dropWhile (/= ':') as == [] || take 4 as == "Enum" || take 3 as == "Map" || take 4 as == "List" -interpolate (Str i) = "#{inspect " ++ i ++ "}" +interpolate (Lit (Str i)) = "#{inspect " ++ i ++ "}" interpolate (Ref i) = "#{inspect " ++ i ++ "}" interpolate i = show i diff --git a/JSONParser.hs b/JSONParser.hs index 63c0e54..4d5bd87 100644 --- a/JSONParser.hs +++ b/JSONParser.hs @@ -10,6 +10,7 @@ import Data.List import GHC.Generics import qualified Data.ByteString.Lazy as B import Control.Applicative +import Control.Arrow type Kind = String @@ -89,6 +90,7 @@ convertBody :: Kind -> String -> Expression -> Either String H.Definition convertBody k i e = case k of "OperEx" -> Right (H.Comment "A") "TlaOperDecl" -> convertExpression e >>= \x -> Right (H.ActionDefinition i [] [] x) + "TlaAssumeDecl" -> Right (H.Comment (show e)) _ -> Left ("Unknown body kind " ++ show k) @@ -99,6 +101,7 @@ primed (OperEx o [a]) = case o of identifier :: Expression -> Either String H.Identifier identifier (NameEx i) = Right i +identifier e = Left ("Expected name expression when looking for identifier, got: " ++ show e) manyIdentifiers :: Expression -> Either String [H.Identifier] manyIdentifiers (NameEx i) = Right [i] @@ -106,10 +109,10 @@ manyIdentifiers (OperEx o as) = case o of "TUPLE" -> mapM identifier as _ -> Left ("Not tuple operator: " ++ o) -identifierFromString :: Expression -> Either String H.Identifier -identifierFromString (ValEx (TlaStr s)) = Right s +-- identifierFromString :: Expression -> Either String H.Identifier +-- identifierFromString (ValEx (TlaStr s)) = Right s -val :: TlaValue -> H.Value +val :: TlaValue -> H.Lit val (TlaStr s) = H.Str s val (TlaBool b) = H.Boolean b val (TlaInt n) = H.Num n @@ -119,98 +122,102 @@ splits :: [a] -> [(a, a)] splits [a, b] = [(a, b)] splits (a:b:ts) = (a,b):splits ts -valueOperators :: [String] -valueOperators = ["TUPLE", "MINUS", "PLUS", "EXCEPT", "DOMAIN", "RECORD"] - -valuePrefixes :: [String] -valuePrefixes = ["FUN_", "SET_", "INT_"] - convertValue :: Expression -> Either String H.Value convertValue (NameEx i) = Right(H.Ref i) -convertValue (ValEx v) = Right(val v) -convertValue (OperEx o as) = case o of - "FUN_SET" -> case as of - [a1, a2] -> liftA2 H.FunSet (convertValue a1) (convertValue a2) - "FUN_APP" -> case as of - [a1, a2] -> liftA2 H.Index (convertValue a1) (convertValue a2) - "FUN_CTOR" -> case as of - [a1, a2, a3] -> liftA3 H.FunGen (identifier a1) (convertValue a2) (convertValue a3) - "SET_TIMES" -> case as of - [a1, a2] -> liftA2 H.SetTimes (convertValue a1) (convertValue a2) - "SET_ENUM" -> case as of - vs -> fmap H.Set (mapM convertValue vs) - "INT_RANGE" -> case as of - [a1, a2] -> liftA2 H.Range (convertValue a1) (convertValue a2) - "TUPLE" -> case as of - vs -> fmap H.Tuple (mapM convertValue vs) - "RECORD" -> case as of - vs -> fmap H.Record (convertRecordValues vs) - "MINUS" -> case as of - [a1, a2] -> liftA2 H.Sub (convertValue a1) (convertValue a2) - "PLUS" -> case as of - [a1, a2] -> liftA2 H.Add (convertValue a1) (convertValue a2) - "EXCEPT" -> case as of - (e:es) -> liftA2 H.Except (identifier e) (fmap splits (mapM convertValue es)) - "DOMAIN" -> case as of - [a1] -> fmap H.Domain (convertValue a1) - "NE" -> case as of - [x1, x2] -> liftA2 H.Inequality (convertValue x1) (convertValue x2) - "EQ" -> case as of - [x1, x2] -> liftA2 H.Equality (convertValue x1) (convertValue x2) - "GT" -> case as of - [x1, x2] -> liftA2 H.Gt (convertValue x1) (convertValue x2) - "GE" -> case as of - [x1, x2] -> liftA2 H.Gte (convertValue x1) (convertValue x2) - "EXISTS3" -> case as of - [a1, a2, a3] -> liftA3 H.PExists (identifier a1) (convertValue a2) (convertValue a3) - "FORALL3" -> case as of - [a1, a2, a3] -> liftA3 H.PForAll (identifier a1) (convertValue a2) (convertValue a3) - "AND" -> case as of - es -> fmap H.And (mapM convertValue es) - "OR" -> case as of - es -> fmap H.Or (mapM convertValue es) - "NOT" -> case as of - [a] -> fmap H.Not (convertValue a) - "IF_THEN_ELSE" -> case as of - [a1, a2, a3] -> liftA3 H.If (convertValue a1) (convertValue a2) (convertValue a3) - "OPER_APP" -> case as of - (e:es) -> liftA2 H.ConditionCall (identifier e) (mapM convertValue es) - op -> Left ("Unknown value operator " ++ op) +convertValue (ValEx v) = Right(H.Lit (val v)) +convertValue (OperEx o as) = let r = case o of + "FUN_SET" -> case as of + [a1, a2] -> liftA2 H.FunSet (convertValue a1) (convertValue a2) + "FUN_APP" -> case as of + [a1, a2] -> liftA2 H.Index (convertValue a1) (convertValue a2) + "FUN_CTOR" -> case as of + [a1, a2, a3] -> liftA3 H.FunGen (identifier a2) (convertValue a3) (convertValue a1) + "SET_TIMES" -> case as of + [a1, a2] -> liftA2 H.SetTimes (convertValue a1) (convertValue a2) + "SET_ENUM" -> case as of + vs -> fmap H.Set (mapM convertValue vs) + "SET_IN" -> case as of + [a1, a2] -> liftA2 H.SetIn (convertValue a1) (convertValue a2) + "SET_MINUS" -> case as of + [a1, a2] -> liftA2 H.SetMinus (convertValue a1) (convertValue a2) + "SET_FILTER" -> case as of + [a1, a2, a3] -> liftA3 H.Filtered (identifier a1) (convertValue a2) (convertValue a3) + "INT_RANGE" -> case as of + [a1, a2] -> liftA2 H.Range (convertValue a1) (convertValue a2) + "TUPLE" -> case as of + vs -> fmap H.Tuple (mapM convertValue vs) + "RECORD" -> case as of + vs -> fmap H.Record (convertRecordValues vs) + "RECORD_SET" -> case as of + vs -> fmap H.RecordSet (convertRecordValues vs) + "MINUS" -> case as of + [a1, a2] -> liftA2 H.Sub (convertValue a1) (convertValue a2) + "PLUS" -> case as of + [a1, a2] -> liftA2 H.Add (convertValue a1) (convertValue a2) + "EXCEPT" -> case as of + (e:es) -> liftA2 H.Except (identifier e) (fmap splits (mapM convertValue es)) + "DOMAIN" -> case as of + [a1] -> fmap H.Domain (convertValue a1) + "NE" -> case as of + [x1, x2] -> liftA2 H.Inequality (convertValue x1) (convertValue x2) + "EQ" -> case as of + [x1, x2] -> liftA2 H.Equality (convertValue x1) (convertValue x2) + "GT" -> case as of + [x1, x2] -> liftA2 H.Gt (convertValue x1) (convertValue x2) + "GE" -> case as of + [x1, x2] -> liftA2 H.Gte (convertValue x1) (convertValue x2) + "LE" -> case as of + [x1, x2] -> liftA2 H.Lte (convertValue x1) (convertValue x2) + "EXISTS3" -> case as of + [a1, a2, a3] -> liftA3 H.PExists (identifier a1) (convertValue a2) (convertValue a3) + "FORALL3" -> case as of + [a1, a2, a3] -> liftA3 H.PForAll (identifier a1) (convertValue a2) (convertValue a3) + "AND" -> case as of + es -> fmap H.And (mapM convertValue es) + "OR" -> case as of + es -> fmap H.Or (mapM convertValue es) + "NOT" -> case as of + [a] -> fmap H.Not (convertValue a) + "IF_THEN_ELSE" -> case as of + [a1, a2, a3] -> liftA3 H.If (convertValue a1) (convertValue a2) (convertValue a3) + "OPER_APP" -> case as of + (e:es) -> liftA2 H.ConditionCall (identifier e) (mapM convertValue es) + op -> Left ("Unknown value operator " ++ op) + in left (\s -> s ++ "\nwhen converting " ++ show (OperEx o as)) r convertValue (LetInEx ds b) = liftA2 H.Let (mapM convertDefinitions ds) (convertValue b) -- convertValue e = Left ("Unexpected expression while converting value: " ++ show e) convertAction :: Expression -> Either String H.Action -convertAction (OperEx o as) = case o of - "EXISTS3" -> case as of - [a1, a2, a3] -> liftA3 H.Exists (identifier a1) (convertValue a2) (convertExpression a3) - "FORALL3" -> case as of - [a1, a2, a3] -> liftA3 H.ForAll (identifier a1) (convertValue a2) (convertExpression a3) - "UNCHANGED" -> case as of - [a] -> liftA H.Unchanged (manyIdentifiers a) - "AND" -> case as of - es -> fmap H.ActionAnd (mapM convertExpression es) - "EQ" -> case as of - [a1, a2] -> liftA2 H.Primed (primed a1) (convertValue a2) - op -> Left("Unknown action operator " ++ op) +convertAction (OperEx o as) = let r = case o of + "EXISTS3" -> case as of + [a1, a2, a3] -> liftA3 H.Exists (identifier a1) (convertValue a2) (convertExpression a3) + "FORALL3" -> case as of + [a1, a2, a3] -> liftA3 H.ForAll (identifier a1) (convertValue a2) (convertExpression a3) + "UNCHANGED" -> case as of + [a] -> liftA H.Unchanged (manyIdentifiers a) + "AND" -> case as of + es -> fmap H.ActionAnd (mapM convertExpression es) + "EQ" -> case as of + [a1, a2] -> liftA2 H.Primed (primed a1) (convertValue a2) + op -> Left("Unknown action operator " ++ op ++ " with args " ++ show as) + in left (\s -> s ++ "\nwhen converting " ++ show (OperEx o as)) r convertExpression :: Expression -> Either String H.Action -convertExpression (OperEx o as) = if isPredicate (OperEx o as) then convertValue (OperEx o as) >>= \x -> Right(H.Condition x) else convertAction (OperEx o as) +convertExpression (OperEx o as) = if isPredicate (OperEx o as) then (convertValue (OperEx o as) >>= \x -> Right(H.Condition x)) else convertAction (OperEx o as) convertExpression (ValEx v) = convertValue (ValEx v) >>= \cv -> Right(H.Condition cv) actionOperators :: [String] actionOperators = ["PRIME", "UNCHANGED"] - isPredicate :: Expression -> Bool -isPredicate (OperEx o as) = if o `elem` actionOperators then False else all isPredicate as +isPredicate (OperEx o as) = o `notElem` actionOperators && all isPredicate as isPredicate _ = True convertRecordValues :: [Expression] -> Either String [(H.Key, H.Value)] convertRecordValues [] = Right [] -convertRecordValues (k:v:vs) = do k <- identifierFromString k - e <- convertValue v - rs <- convertRecordValues vs - return ((H.Key k, e):rs) +convertRecordValues (ValEx l:v:vs) = do e <- convertValue v + rs <- convertRecordValues vs + return ((H.Key (val l), e):rs) parseJson :: FilePath -> IO (Either String (H.Module, [H.Definition])) parseJson file = do content <- B.readFile file diff --git a/Math.hs b/Math.hs index c462bf4..040ea08 100644 --- a/Math.hs +++ b/Math.hs @@ -54,4 +54,4 @@ number = do digits <- P.many1 P.digit let n = foldl (\x d -> 10*x + toInteger (digitToInt d)) 0 digits ws - return (Num n) + return (Lit (Num n)) diff --git a/Parser.hs b/Parser.hs index add2558..c0c2d38 100644 --- a/Parser.hs +++ b/Parser.hs @@ -282,7 +282,7 @@ mapping = do try $ do ws ws v <- value ws - return (Key i, v) + return (Key (Str i), v) primed = do try $ do i <- identifier char '\'' @@ -376,6 +376,6 @@ record = do try $ do char '[' ws return (Except i [(Ref k, v)]) -literal = do try $ do {char '\"'; cs <- many1 (noneOf reserved); char '\"'; ws; return (Str cs)} +literal = do try $ do {char '\"'; cs <- many1 (noneOf reserved); char '\"'; ws; return (Lit (Str cs))} arithmeticExpression = Math.build