diff --git a/spec/ExpectationsCompilerSpec.hs b/spec/ExpectationsCompilerSpec.hs index 0a1d3758d..fe6fc760e 100644 --- a/spec/ExpectationsCompilerSpec.hs +++ b/spec/ExpectationsCompilerSpec.hs @@ -137,6 +137,7 @@ spec = do run (hs "f a b = g") "f" "Uses:g" `shouldBe` True run (hs "x = (*y) 10") "x" "Uses:y" `shouldBe` True run (hs "x = (*z) 10") "x" "Uses:y" `shouldBe` False + run (hs "x = f { g = h }") "x" "Uses:f" `shouldBe` True run (java "class Foo{ void a(){ let = b(); } }") "a" "Uses:b" `shouldBe` True run (java "class Foo{ void a(){ let = c(); } }") "a" "Uses:b" `shouldBe` False run (java "class Foo{ void a(){ try{ b(); } } }") "a" "Uses:b" `shouldBe` True diff --git a/spec/GenericSpec.hs b/spec/GenericSpec.hs index 93ef2ea20..9d18b3ed9 100644 --- a/spec/GenericSpec.hs +++ b/spec/GenericSpec.hs @@ -170,6 +170,11 @@ spec = do it "is False if there is no usage" $ do uses (named "m") (EntryPoint "main" (Reference "f")) `shouldBe` False + it "works with RecordUpdate" $ do + uses (named "f") (RecordUpdate (Reference "f") [("g", Reference "h")]) `shouldBe` True + uses (named "h") (RecordUpdate (Reference "f") [("g", Reference "h")]) `shouldBe` True + uses (named "g") (RecordUpdate (Reference "f") [("g", Reference "h")]) `shouldBe` False + describe "delegates'" $ do it "is True when used with a scope" $ do decontextualize (contextualized (scoped "main") (delegates' anyone)) ( diff --git a/spec/HaskellSpec.hs b/spec/HaskellSpec.hs index 5211b99df..16f8af837 100644 --- a/spec/HaskellSpec.hs +++ b/spec/HaskellSpec.hs @@ -64,3 +64,6 @@ spec = do it "parses chars as MuChars" $ do hs "x = 'a'" `shouldBe` Variable "x" (MuChar 'a') + + it "parses record syntax update" $ do + hs "f = someData { someField = someValue, someOtherField = someOtherValue }" `shouldBe` Variable "f" (RecordUpdate (Reference "someData") [("someField", Reference "someValue"), ("someOtherField", Reference "someOtherValue")]) diff --git a/src/Language/Mulang/Ast.hs b/src/Language/Mulang/Ast.hs index d649f6364..da82e9521 100644 --- a/src/Language/Mulang/Ast.hs +++ b/src/Language/Mulang/Ast.hs @@ -96,6 +96,9 @@ data Expression | Record Identifier -- ^ Imperative / Functional programming struct declaration. -- Only the record name is parsed + | RecordUpdate Expression [(Identifier, Expression)] + -- ^ Functional programming side-effect-less record update. For example: + -- a Haskell update such as someData { someField = someValue, someOtherField = someOtherValue } | TypeSignature Identifier Type -- ^ Generic type signature for a computation, -- composed by a name and its type @@ -133,7 +136,7 @@ data Expression | Rule Identifier [Pattern] [Expression] -- ^ Logic programming declaration of a fact, composed by the rue name, rule arguments, and rule body | Fact Identifier [Pattern] - -- ^ Logic programming declaration of a fact , composed by the fact name and fact arguments + -- ^ Logic programming declaration of a fact, composed by the fact name and fact arguments | Exist Identifier [Pattern] -- ^ Logic programming existential cuantification / consult | Not Expression diff --git a/src/Language/Mulang/Generator.hs b/src/Language/Mulang/Generator.hs index 2e2836e56..e95e6932c 100644 --- a/src/Language/Mulang/Generator.hs +++ b/src/Language/Mulang/Generator.hs @@ -79,6 +79,7 @@ expressions expr = expr : concatMap expressions (subExpressions expr) subExpressions (Send e1 e2 es) = e1 : e2 : es subExpressions (Switch e1 list e2) = e1 : concatMap (\(x,y) -> [x,y]) list ++ [e2] subExpressions (Try t cs f) = t : map snd cs ++ [f] + subExpressions (RecordUpdate e ups) = e : map snd ups -- subExpressions (ExpressionAndExpressionsList e es _) = e : es subExpressions (SingleEquationsList eqs _) = equationsExpressions eqs diff --git a/src/Language/Mulang/Parsers/Haskell.hs b/src/Language/Mulang/Parsers/Haskell.hs index 6df7f0ef5..6a3cb104e 100644 --- a/src/Language/Mulang/Parsers/Haskell.hs +++ b/src/Language/Mulang/Parsers/Haskell.hs @@ -94,8 +94,11 @@ mu (HsModule _ _ _ _ decls) = compact (concatMap muDecls decls) muExp (HsListComp exp stmts) = For (map muStmt stmts) (Yield (muExp exp)) muExp (HsDo stmts) | (HsQualifier exp) <- last stmts = For (map muStmt stmts) (Yield (muExp exp)) muExp (HsExpTypeSig _ exp (HsQualType cs t)) = TypeCast (muExp exp) (muType t cs) + muExp (HsRecUpdate record updates) = RecordUpdate (muExp record) $ map muFieldUpdate updates muExp e = debug e + muFieldUpdate (HsFieldUpdate field value) = (muQName field, muExp value) + muLit (HsCharPrim v) = MuChar v muLit (HsStringPrim v) = MuString v muLit (HsChar v) = MuChar v diff --git a/src/Language/Mulang/Transform/Normalizer.hs b/src/Language/Mulang/Transform/Normalizer.hs index daa61a080..f7ba29782 100644 --- a/src/Language/Mulang/Transform/Normalizer.hs +++ b/src/Language/Mulang/Transform/Normalizer.hs @@ -71,6 +71,7 @@ normalize ops (Rule n args es) = Rule n args (mapNormalize normalize ops (Send r e es) = Send (normalize ops r) (normalize ops e) (mapNormalize ops es) normalize ops (Switch v cs d) = Switch (normalize ops v) (normalizeSwitchCases ops cs) (normalize ops d) normalize ops (Try t cs f) = Try (normalize ops t) (normalizeTryCases ops cs) (normalize ops f) +normalize ops (RecordUpdate r ups) = RecordUpdate (normalize ops r) (normalizeRecordUpdates ops ups) -- normalize _ (SinglePatternsList ps c) = c ps normalize _ c@(Terminal) = c @@ -118,8 +119,9 @@ normalizeReturn _ e | isImplicitReturn e = Return e normalizeReturn _ (Sequence es) | Just (i, l) <- unwind es, isImplicitReturn l = Sequence $ i ++ [Return l] normalizeReturn _ e = e -normalizeTryCases ops = map (\(p, e) -> (p, normalize ops e)) -normalizeSwitchCases ops = map (\(e1, e2) -> (normalize ops e1, normalize ops e2)) +normalizeRecordUpdates ops = map (\(i, e) -> (i, normalize ops e)) +normalizeTryCases ops = map (\(p, e) -> (p, normalize ops e)) +normalizeSwitchCases ops = map (\(e1, e2) -> (normalize ops e1, normalize ops e2)) isImplicitReturn :: Expression -> Bool isImplicitReturn (Reference _) = True diff --git a/src/Language/Mulang/Transform/Renamer.hs b/src/Language/Mulang/Transform/Renamer.hs index bd9e15fd5..7a2682c77 100644 --- a/src/Language/Mulang/Transform/Renamer.hs +++ b/src/Language/Mulang/Transform/Renamer.hs @@ -36,6 +36,7 @@ renameState (Match e1 eqs) = do { e1' <- renameState e1; eqs' <- renameEqua renameState (Send r e es) = do { (r':e':es') <- mapM renameState (r:e:es); return $ Send r' e' es' } renameState (Switch v cs d) = do { v' <- renameState v; cs' <- renameSwitchCases cs; d' <- renameState d; return $ Switch v' cs' d' } renameState (Try t cs f) = do { t' <- renameState t; cs' <- renameTryCases cs; f' <- renameState f; return $ Try t' cs' f' } +renameState (RecordUpdate r us) = do { r' <- renameState r; us' <- renameRecordUpdates us; return $ RecordUpdate r' us' } renameState a@(Assert _ _) = return a renameState r@(Rule _ _ _) = return r -- @@ -48,8 +49,9 @@ renameState (TwoExpressions e1 e2 c) = do { e1' <- renameState e1; renameState e@(SinglePatternsList _ _) = return e renameState e@Terminal = return e -renameTryCases = mapM (\(p, e) -> do { e' <- renameState e; return (p, e') }) -renameSwitchCases = mapM (\(e1, e2) -> do { e1' <- renameState e1; e2' <- renameState e2; return (e1', e2') }) +renameRecordUpdates = mapM (\(i, e) -> do { e' <- renameState e; return (i, e') }) +renameTryCases = mapM (\(p, e) -> do { e' <- renameState e; return (p, e') }) +renameSwitchCases = mapM (\(e1, e2) -> do { e1' <- renameState e1; e2' <- renameState e2; return (e1', e2') }) renameStatement :: Statement -> RenameState Statement renameStatement (Generator p e) = do { p' <- renameParameter p; e' <- renameState e; return $ Generator p' e' } diff --git a/src/Language/Mulang/Transform/Replacer.hs b/src/Language/Mulang/Transform/Replacer.hs index ecbcbf0de..e3097fa27 100644 --- a/src/Language/Mulang/Transform/Replacer.hs +++ b/src/Language/Mulang/Transform/Replacer.hs @@ -22,6 +22,7 @@ replace i o (Rule n args es) = Rule n args (mapReplace i o replace i o (Send r e es) = Send (replace i o r) (replace i o e) (mapReplace i o es) replace i o (Switch v cs d) = Switch (replace i o v) (replaceSwitchCases i o cs) (replace i o d) replace i o (Try t cs f) = Try (replace i o t) (replaceTryCases i o cs) (replace i o f) +replace i o (RecordUpdate r ups) = RecordUpdate (replace i o r) (replaceRecordUpdates i o ups) -- replace _ _ (SinglePatternsList ps c) = c ps replace _ _ c@(Terminal) = c @@ -39,8 +40,9 @@ replaceEquation :: Inspection -> Expression -> Equation -> Equation replaceEquation i o = mapEquation f f where f = replace i o -replaceTryCases i o = map (\(p, e) -> (p, replace i o e)) -replaceSwitchCases i o = map (\(e1, e2) -> (replace i o e1, replace i o e2)) +replaceRecordUpdates i o = map (\(id, e) -> (id, replace i o e)) +replaceTryCases i o = map (\(p, e) -> (p, replace i o e)) +replaceSwitchCases i o = map (\(e1, e2) -> (replace i o e1, replace i o e2)) localReplace :: Replacer localReplace i o (Sequence es) = Sequence (map (localReplace i o) es)