/** * Serialized Dryad repositories. * * This module defines the structure of a serialized Dryad repository * and provides strategies to (de)serialize such a serialized repository. */ module dryad/model/classpath imports liblib dryad/jls/binary/Form dryad/model/repository signature constructors /** * Constructor for exported packages. * * @param SimpleName of this package * @param List of subpackages * @param List of top level classes */ Package : String * List(ExportedPackage) * List(ExportedClass) -> ExportedPackage /** * Constructor for exported classes. * * @param SimpleName of this class * @param Location of this class * @param Member classes of this class */ Class : String * Location * List(ExportedClass) -> ExportedClass /** * Constructor for the location of source files. * * @param Path of source file */ Source : String -> Location /** * Constructor for the location of a bytecode .class file. * * @param Path of .class file */ ClassFile : String -> Location /** * Constructor for the location of a class file in a jar. * * @param Path of jar file * @param Path of class file in jar file */ Jar : String * String -> Location strategies /** * Defines the classes in the specified jar file in the Dryad repository. * * @type String -> ? */ define-jar-entries = ?jar; where( xtc-new-ffd => (path, fd) ; <call(|None(), Some(fd), None())> (<xtc-find> "jar", ["tf", jar]) ; <fopen> (path, "r") => stream ; repeat( <fgetchars-line> stream ; private-define-jar-entry(|jar) ) ; try(<fclose> stream) ) /** * Private util for define-jar-entries. Do not invoke directly. * * This strategy does not fail if the specified file does not have * the .class extension. * * @param Jar file of this class file (String). * @type List(Char) -> Class Object */ private-define-jar-entry(|jar) = ?filename ; ( define-bytecode-class(|Jar(jar, <implode-string> filename)) <+ if get-extension => "class" then log(|Error(), "Could not define jar entry in repository.", <implode-string> filename) ; fail else id end ) /** * @type String -> Class Object */ define-bytecode-class-file = ?path ; explode-string ; define-bytecode-class(|ClassFile(path)) /** * Defines the .class file of the specified name and location in the Dryad repository. * * Example names: * org/foo/Bar.class * org/foo/Bar$Fred.class * * @todo Local classes are not supported * @todo Anonymous classes are not supported * @type List(Char) -> Class Object */ define-bytecode-class(|location) = parse-class-pathname => (pkgname, simplename) ; <parse-binary-name> simplename => parts ; <lookup-or-add-package> pkgname => pkg ; <private-classpath-handle-toplevel-class(|pkg)> parts ; set-package(|pkg) ; set-location(|location) /** * Private helpers. These used to be nested functions, but this produced a C * compilation error. */ strategies private-classpath-get-or-add-toplevel-class(|name, pkg) = <get-toplevel-class(|name)> pkg <+ new-bytecode-class(|name) => class ; <add-toplevel-class(|class)> pkg ; !class private-classpath-get-or-add-member-type(|name, declaring-class) = <get-declared-member-type(|name)> declaring-class <+ new-bytecode-class(|name) => class ; <add-declared-member-type(|class)> declaring-class ; <set-declaring-class(|declaring-class)> class ; !class private-classpath-handle-toplevel-class(|pkg) = ?[TopLevel(name) | <id>] ; where(private-classpath-get-or-add-toplevel-class(|name, pkg) => class) ; private-classpath-handle-member-type(|class) private-classpath-handle-member-type(|declaring-class) = if ?[] then !declaring-class else ?[Member(name) | <id>] ; where(private-classpath-get-or-add-member-type(|name, declaring-class) => class) ; private-classpath-handle-member-type(|class) end strategies /** * Imports a serialized Dryad repository by registering a package, its subpackages and * all classes in the Dryad repository. * * The structure of the ExportedPackage input is specified in dryad/model/classpath. * * @type ExportedPackage -> ExportedPackage */ import-repository = let create-package-in(|pkg) = {simplename: ?Package(simplename, _, _) ; fill-package(|<get-or-add-subpackage(|simplename)> pkg) } fill-package(|pkg) = {pkgs, classes: ?Package(_, pkgs, classes) ; <map(create-package-in(|pkg))> pkgs ; <set-toplevel-bytecode-classes(|classes)> pkg } in where(fill-package(|<get-root-package> ())) end /** * Exports the current Dryad repository by constructing an ATerm that represents its content. * The structure of the ExportedPackage result is specified in dryad/model/classpath. * * @type _ -> ExportedPackage */ export-repository = let /** * @type Package Object -> ExportedPackage */ export-package = !Package( <get-simple-name> , <get-subpackages; map(export-package)> , <get-toplevel-classes; filter(export-class)> ) /** * @type Class Object -> ExportedClass */ export-class = !Class(<get-simple-name>, <get-location>, <get-declared-member-types; filter(export-class)>) <+ /** * @todo Some classes have $, but are not inner classes (e.g. CUP$parser$actions). This * is hack to workaround that. Is it wrong to determine of a class from its name? */ if get-location then log(|Error(), "Could not export class", <get-simple-name>); fail else log(|Warning(), "Class has no location", <get-simple-name>); fail end in get-root-package ; export-package end /** * Java related utils */ strategies /** * @type List(Char) -> (List(String), String) */ parse-class-pathname = list-tokenize(?'/' + ?'.') ; split-last2 => (ps, name, ['c', 'l', 'a', 's', 's']) ; !(<map(implode-string)> ps, <implode-string> name) /** * @type List(Char) -> Class parse-java-pathname = list-tokenize(?'/' + ?'.') ; split-last2 => (ps, name, ['j', 'a', 'v', 'a']) ; !Class(<map(implode-string)> ps, <implode-string> name) */ /** * Generic library utils */ strategies split-last2 = at-suffix(?[_, _]; ?[x1, x2]; ![]) ; !(<id>, x1, x2) /** * @param List(Char) -> a */ fgetchars-lines(postlinehook, at-last) = ?stream ; rec x( <fgetchars-line> stream ; ( postlinehook < ![<id> | <x> ()] + <x> () ) <+ at-last ) fgetchars-line = fgetchars-until(?'\n') /** * fails if there is an immediate EOF. */ fgetchars-until(pred) = ?stream ; <fgetc> stream ; rec x( if not(pred) then ![<id> | <fgetc; x> stream] else ![] end )