Migrated source code from Simantics SVN

[simantics/platform.git] / bundles / org.simantics.scl.osgi / scl / Reflection.scl

diff --git a/bundles/org.simantics.scl.osgi/scl/Reflection.scl b/bundles/org.simantics.scl.osgi/scl/Reflection.scl
new file mode 100644 (file)
index 0000000..f75f292
--- /dev/null
+++ b/bundles/org.simantics.scl.osgi/scl/Reflection.scl
@@ -0,0 +1,116 @@
+import "String"\r
+import "StringBuilder" as StringBuilder\r
+import "IterN"\r
+\r
+@private\r
+importJava "org.simantics.scl.compiler.errors.Failable" where\r
+    data Failable a\r
+    \r
+    @JavaName getResult\r
+    resultOfFailable :: Failable a -> Maybe a\r
+\r
+@private\r
+importJava "org.simantics.scl.compiler.module.ImportDeclaration" where\r
+    data ImportDeclaration\r
+\r
+    @JavaName moduleName\r
+    moduleNameOfImportDeclaration :: ImportDeclaration -> String\r
+    @JavaName localName\r
+    localNameOfImportDeclaration :: ImportDeclaration -> Maybe String\r
+    @JavaName getSpecString\r
+    importSpecOfImportDeclaration :: ImportDeclaration -> String\r
+\r
+@private    \r
+importJava "org.simantics.scl.compiler.module.Module" where\r
+    data Module    \r
+    @JavaName getDependencies\r
+    dependenciesOf :: Module -> [ImportDeclaration]\r
+\r
+@private\r
+importJava "org.simantics.scl.compiler.elaboration.modules.SCLValue" where\r
+    data Value\r
+    @JavaName getName\r
+    nameOfValue :: Value -> Name\r
+    @JavaName getType\r
+    typeOfValue :: Value -> Type\r
+\r
+@private\r
+importJava "org.simantics.scl.compiler.common.names.Name" where\r
+    data Name\r
+    @JavaName name\r
+    nameOfName :: Name -> String\r
+    @JavaName module\r
+    moduleOfName :: Name -> String\r
+\r
+@private\r
+importJava "org.simantics.scl.compiler.module.repository.ModuleRepository" where\r
+    data ModuleRepository\r
+    \r
+    @JavaName getModule\r
+    findModule :: ModuleRepository -> String -> <Proc> Failable Module\r
+    \r
+    @JavaName getValueRef\r
+    findValueRef :: ModuleRepository -> String -> <Proc> Value\r
+    \r
+    @JavaName getValue\r
+    findValue :: ModuleRepository -> String -> <Proc> a\r
+    \r
+    @JavaName getSourceRepository\r
+    sourceRepositoryOf :: ModuleRepository -> ModuleSourceRepository\r
+\r
+@private\r
+importJava "org.simantics.scl.compiler.source.repository.ModuleSourceRepository" where\r
+    data ModuleSourceRepository\r
+    \r
+@private\r
+importJava "org.simantics.scl.compiler.module.repository.ModuleRepositories" where\r
+    allValues :: ModuleRepository -> <Proc> [Value]\r
+    allValuesMatching :: ModuleRepository -> String -> <Proc> [Value]\r
+    \r
+@private    \r
+importJava "org.simantics.scl.compiler.source.repository.SourceRepositories" where\r
+    @JavaName getModuleNames\r
+    moduleNames :: ModuleSourceRepository -> <Proc> [String]\r
+\r
+@private\r
+importJava "org.simantics.scl.osgi.SCLOsgi" where\r
+    @JavaName MODULE_REPOSITORY\r
+    ModuleRepository :: ModuleRepository\r
+\r
+@private\r
+printTable :: [[String]] -> <Proc> ()\r
+printTable [] = ()\r
+printTable rows = iter printRow rows \r
+  where\r
+    columnCount = maximum (map length rows)\r
+    columnWidth i = maximum (map ithColumnWidth rows)\r
+      where\r
+        ithColumnWidth cols | length cols <= i = 0\r
+                            | otherwise = length (cols!i) \r
+    columnWidths = mapN columnWidth columnCount\r
+    printColumn i sb col = foldlN (\sb _ -> sb << " ") (sb << col) (columnWidths!i + 1 - length col)\r
+    printRow row = print $ StringBuilder.toString $ foldlI printColumn StringBuilder.new row \r
+\r
+searchValue :: String -> <Proc> ()\r
+searchValue pattern = printTable $ sort $ map tableRow $ allValuesMatching ModuleRepository pattern\r
+  where\r
+    tableRow value = [\r
+        moduleOfName $ nameOfValue value,\r
+        nameOfName $ nameOfValue value,\r
+        ":: " + (show $ removeForAll $ typeOfValue value)]\r
+\r
+moduleDependencyGraph :: <Proc> [(String, [(String, Maybe String, String)])]\r
+moduleDependencyGraph = mapMaybe\r
+    (\moduleName -> catch \r
+        (match resultOfFailable $ findModule ModuleRepository moduleName with\r
+            Just module -> Just (moduleName, findDependencies module)\r
+            Nothing -> Nothing\r
+        ) \r
+        $ \(_ :: Exception) -> Nothing\r
+    ) \r
+    (moduleNames $ sourceRepositoryOf ModuleRepository)\r
+  where\r
+    mapImportDeclaration decl = (moduleNameOfImportDeclaration decl,\r
+                                 localNameOfImportDeclaration decl,\r
+                                 importSpecOfImportDeclaration decl)\r
+    findDependencies module = map mapImportDeclaration (dependenciesOf module)
\ No newline at end of file