@@ -60,8 +60,8 @@ data AtomoVal = AInt Integer | AHash [(String, (Type, AtomoVal))] | AString AtomoVal -- AString == AList of AChars | AVariable String - | AClass [AtomoVal] [AtomoVal] - | AObject [AtomoVal] + | AClass Type [AtomoVal] [AtomoVal] + | AObject Type [AtomoVal] | AAttribute AtomoVal String | ADefine Index AtomoVal | ADefAttr AtomoVal String AtomoVal @@ -170,7 +170,7 @@ pretty (AVariable n) = "<Variable (" ++ n ++ ")>" pretty (ADefine n v) = "<`" ++ show n ++ "': " ++ pretty v ++ ">" pretty (ADefAttr _ _ v) = pretty v pretty (AStatic _ v) = pretty v -pretty (AObject vs) = "Object:\n" ++ (unlines $ map (" - " ++) $ map pretty vs) +pretty (AObject _ vs) = "Object:\n" ++ (unlines $ map (" - " ++) $ map pretty vs) pretty (ACall f a) = "<Call (`" ++ pretty f ++ "') (`" ++ pretty a ++ "')>" pretty s@(AString _) = show $ fromAString s pretty (ABlock es) = intercalate "\n" $ map pretty es @@ -184,10 +184,10 @@ pretty v@(ALambda _ _ _) = "\x03BB " ++ intercalate " " (map prettyPattern $ rev where lambdas (ALambda p v _) acc = lambdas v (p : acc) lambdas _ acc = acc -pretty (AClass ss ms) = "<Class (`" ++ statics ++ "') (`" ++ methods ++ "')>" - where - statics = intercalate "' `" (map (\(AStatic n _) -> n) ss) - methods = intercalate "' `" (map (\(ADefine (Define n) _) -> n) ms) +pretty (AClass n ss ms) = "<Class `" ++ prettyType n ++ "' (`" ++ statics ++ "') (`" ++ methods ++ "')>" + where + statics = intercalate "' `" (map (\(AStatic n _) -> n) ss) + methods = intercalate "' `" (map (\(ADefine (Define n) _) -> n) ms) pretty (AError m) = m pretty (AAtom n) = "@" ++ n pretty (AReceive v) = "<Receive>" @@ -229,6 +229,11 @@ prettyType (Func a b) = "(" ++ prettyType a ++ " -> " ++ prettyType b ++ ")" prettyType (Poly a) = a prettyType (None) = "None" +attribute :: AtomoVal -> AtomoVal -> AtomoVal +attribute f (AVariable n) = AAttribute f n +attribute f (AAttribute (AVariable a) b) = AAttribute (AAttribute f a) b +attribute f x = error ("Cannot morph: " ++ show (f, x)) + lambdify :: [PatternMatch] -> AtomoVal -> AtomoVal lambdify [] b = b lambdify (s:ss) b = ALambda s (lambdify ss b) [] @@ -274,6 +279,7 @@ getType (AValue c as (AConstruct _ cs (AData n ps))) = Type (Name n) (args cs as where args [] [] ps = ps args (c:cs) (a:as) ps = args cs as (swapType ps c (getType a)) +getType (AObject t _) = t getType a = error ("Cannot get type of `" ++ pretty a ++ "'") getData :: AtomoVal -> String Atomo/Internals.hs @@ -593,7 +593,7 @@ aClass :: Parser AtomoVal aClass = do reserved "class" name <- aSimpleType code <- aBlockOf (try aStaticAnnot <|> try aAnnot <|> try aStatic <|> try aMethod) - return $ ADefine (Class name) $ AClass (static code) (public code) + return $ ADefine (Class name) $ AClass name (static code) (public code) <?> "class" -- Static definition @@ -633,11 +633,14 @@ aDefAttr = do object <- aVariable -- Attribute aAttribute :: Parser AtomoVal -aAttribute = do target <- target - dot - attribute <- identifier - return $ ACall (AAttribute target attribute) ANone +aAttribute = do attr <- aAttribute' + return $ ACall attr ANone where + aAttribute' = do target <- target + dot + attr <- try aAttribute' <|> aVariable + return $ attribute target attr + target = try (parens aExpr) <|> try aVariable <|> aNumber @@ -851,8 +854,12 @@ aList = do contents <- brackets $ commaSep aExpr return $ AList contents -- Parse a tuple (immutable list of values of any type) +-- A tuple must contain 2 or more values. aTuple :: Parser AtomoVal -aTuple = do contents <- parens $ commaSep aExpr +aTuple = do contents <- parens $ (do a <- aExpr + symbol "," + bs <- commaSep1 aExpr + return (a:bs)) return $ ATuple contents -- Parse a hash (mutable, named contents of any type) @@ -905,7 +912,9 @@ aCall = do name <- try aAttribute <|> aVariable <|> try (parens aExpr) <|> try (parens aIf) <|> try (parens aInfix) <|> try (parens aCall) + <|> try (parens aExpr) <|> try aVariable + <|> aLambda <|> aAtom <|> aList <|> aHash Atomo/Parser.hs @@ -39,12 +39,12 @@ apply e (ATypeFunc n f) a = do (AInstance _ _ (ABlock fs)) <- getDef e (Instance Nothing -> throwError $ Unknown $ "Instance does not declare function `" ++ f ++ "'" where t = getData a -apply e (AClass _ cs) a = case getAVal cs (Define "new") of - Nothing -> return object - Just v -> do new <- apply e v object - apply e new a - where - object = AObject cs +apply e (AClass n _ cs) a = case getAVal cs (Define "new") of + Nothing -> return object + Just v -> do new <- apply e v object + apply e new a + where + object = AObject n cs apply e (ALambda p c bs) a = case c of (ALambda p' c' bs') -> return $ ALambda p' c' $ ((p, a) : (bs ++ bs')) (AValue n as c) -> do env <- bind @@ -99,7 +99,7 @@ eval e (ADefine n v) = case v of eval e (ADefAttr n@(AVariable o) a v) = do ev <- eval e n val <- eval e v case ev of - (AObject object) -> mutateVal e (Define o) (AObject (setAVal object (Define a) val)) + (AObject n object) -> mutateVal e (Define o) (AObject n (setAVal object (Define a) val)) _ -> throwError $ Unknown $ "Variable `" ++ o ++ "' does not refer to an object." eval e (ACall t@(AAttribute o n) a) = do obj <- eval e o fun <- eval e t @@ -126,15 +126,15 @@ eval e (AImport n ts) = do source <- liftIO $ readModule n return ANone eval e (AAttribute t n) = do target <- eval e t case target of - (AObject cs) -> case getAVal cs (Define n) of - Just v -> eval e v - Nothing -> throwError $ Unknown $ "Object does not have attribute `" ++ n ++ "'." + (AObject o cs) -> case getAVal cs (Define n) of + Just v -> eval e v + Nothing -> throwError $ Unknown $ "Object of class `" ++ prettyType o ++ "' does not have attribute `" ++ n ++ "'." (AModule as) -> case getAVal as (Define n) of Just v -> eval e v Nothing -> throwError $ Unknown $ "Module does not have value `" ++ n ++ "'." - (AClass ss _) -> case getAVal ss (Define n) of - Just v -> eval e v - Nothing -> throwError $ Unknown $ "Class does not have static method `" ++ n ++ "'." + (AClass c ss _) -> case getAVal ss (Define n) of + Just v -> eval e v + Nothing -> throwError $ Unknown $ "Class `" ++ prettyType c ++ "' does not have static method `" ++ n ++ "'." _ -> do classes <- getClasses e (getType target) if null classes then error ("Could not find class `" ++ prettyType (getType target) ++ "'") @@ -143,9 +143,9 @@ eval e (AAttribute t n) = do target <- eval e t findMethod clss n where findMethod [] n = throwError $ Unknown $ "Class does not have attribute `" ++ n ++ "'." - findMethod ((AClass _ cs):clss) n = case getAVal cs (Define n) of - Just v -> eval e v - Nothing -> findMethod clss n + findMethod ((AClass _ _ cs):clss) n = case getAVal cs (Define n) of + Just v -> eval e v + Nothing -> findMethod clss n eval e (ASpawn c) = do pid <- liftIO $ forkIO (runIOThrows (eval e c) >> return ()) chan <- liftIO newChan defineVal e (Process pid) (AProcess pid chan) Main.hs example.at 3c4cf0ff7bca3670946a8a8c3ec42baf7126540d Alex Suraci i.am@toogeneric.com http://github.com/vito/atomo/commit/7a82af6ad8830e9c9c32e7dad3d896911dbd667e 7a82af6ad8830e9c9c32e7dad3d896911dbd667e 2009-05-26T08:40:09-07:00 2009-05-26T08:40:09-07:00 * Classes and objects carry around their name (type) and use that for getType on an object. * Removed example.at. * Tuples must contain two or more values. * Allow lambdas and parenthesized expressions in function call arguments. * Added handling for chaining attributes, like foo.bar.baz 0071ab203740d21c7f34ee479079ee2c62e23b93 Alex Suraci i.am@toogeneric.com