basis/alien/libraries/finder/macosx/macosx.factor

   1 ! Copyright (C) 2013 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors alien.c-types alien.libraries.finder
   5 alien.syntax arrays assocs combinators environment io.files
   6 io.files.info io.pathnames kernel make math.order namespaces
   7 sequences splitting system system-info ;
   8
   9 IN: alien.libraries.finder.macosx
  10
  11 <PRIVATE
  12
  13 TUPLE: framework-info location name shortname version suffix ;
  14
  15 : make-framework-info ( filename -- info/f )
  16     [ framework-info new ] dip
  17     "/" split dup [ ".framework" tail? ] find drop [
  18         cut [
  19             [ "/" join ] bi@ [ >>location ] [ >>name ] bi*
  20         ] keep [
  21             rest dup ?first "Versions" = [
  22                 rest dup empty? [
  23                     unclip swap [ >>version ] dip
  24                 ] unless
  25             ] when ?first "_" split1 [ >>shortname ] [ >>suffix ] bi*
  26         ] unless-empty
  27     ] [ drop ] if* dup shortname>> empty? [ drop f ] when ;
  28
  29 CONSTANT: default-framework-fallback {
  30     "~/Library/Frameworks"
  31     "/Library/Frameworks"
  32     "/Network/Library/Frameworks"
  33     "/System/Library/Frameworks"
  34 }
  35
  36 CONSTANT: default-library-fallback {
  37     "~/lib"
  38     "/usr/local/lib"
  39     "/lib"
  40     "/usr/lib"
  41 }
  42
  43 SYMBOL: dyld-environment
  44
  45 : dyld-env ( name -- seq )
  46     dyld-environment get [ at ] [ os-env ] if* ;
  47
  48 : dyld-paths ( name -- seq )
  49     dyld-env [ ":" split ] [ f ] if* ;
  50
  51 : paths% ( name seq -- )
  52     [ prepend-path , ] with each ;
  53
  54 : dyld-override-search ( name -- seq )
  55     [
  56         dup make-framework-info [
  57             name>> "DYLD_FRAMEWORK_PATH" dyld-paths paths%
  58         ] when*
  59
  60         file-name "DYLD_LIBRARY_PATH" dyld-paths paths%
  61     ] { } make ;
  62
  63 SYMBOL: dyld-executable-path
  64
  65 : dyld-executable-path-search ( name -- seq )
  66     "@executable_path/" ?head dyld-executable-path get and [
  67         dyld-executable-path get prepend-path
  68     ] [
  69         drop f
  70     ] if ;
  71
  72 :: dyld-default-search ( name -- seq )
  73     name make-framework-info :> framework
  74     name file-name :> basename
  75     "DYLD_FALLBACK_FRAMEWORK_PATH" dyld-paths :> fallback-framework-path
  76     "DYLD_FALLBACK_LIBRARY_PATH" dyld-paths :> fallback-library-path
  77     [
  78         name ,
  79
  80         framework [
  81             name>> fallback-framework-path paths%
  82         ] when*
  83
  84         basename fallback-library-path paths%
  85
  86         framework fallback-framework-path empty? and [
  87             framework name>> default-framework-fallback paths%
  88         ] when
  89
  90         fallback-library-path empty? [
  91             basename default-library-fallback paths%
  92         ] when
  93     ] { } make ;
  94
  95 : dyld-image-suffix-search ( seq -- str )
  96     "DYLD_IMAGE_SUFFIX" dyld-env [
  97         swap [
  98             [
  99                 [
 100                     ".dylib" ?tail [ prepend ] dip
 101                     [ ".dylib" append ] when ,
 102                 ] [
 103                     ,
 104                 ] bi
 105             ] with each
 106         ] { } make
 107     ] when* ;
 108
 109 : dyld-search-paths ( name -- paths )
 110     [ dyld-override-search ]
 111     [ dyld-executable-path-search ]
 112     [ dyld-default-search ] tri 3append
 113     dyld-image-suffix-search ;
 114
 115 FUNCTION: bool _dyld_shared_cache_contains_path ( c-string name )
 116
 117 : use-dyld-shared-cache? ( -- ? )
 118     os-version { 11 0 0 } after=? ;
 119
 120 PRIVATE>
 121
 122 : dyld-find ( name -- path/f )
 123     dyld-search-paths [
 124         {
 125             { [ dup file-exists? ] [ file-info regular-file? ] }
 126             { [ use-dyld-shared-cache? ] [ _dyld_shared_cache_contains_path ] }
 127             [ drop f ]
 128         } cond
 129     ] find [ nip ] when* ;
 130
 131 : framework-find ( name -- path )
 132     dup dyld-find [ nip ] [
 133         ".framework" over subseq-start [
 134             dupd head
 135         ] [
 136             [ ".framework" append ] keep
 137         ] if* file-name append-path dyld-find
 138     ] if* ;
 139
 140 M: macosx find-library*
 141     [ "lib" ".dylib" surround ]
 142     [ ".dylib" append ]
 143     [ ".framework/" over 3append ] tri 3array
 144     [ dyld-find ] map-find drop ;