1###
2# A deliverable for the build system
3###
4::clay::define ::practcl::product {
5
6  method code {section body} {
7    my variable code
8    ::practcl::cputs code($section) $body
9  }
10
11  method Collate_Source CWD {}
12
13  method project-compile-products {} {
14    set result {}
15    noop {
16    set filename [my define get filename]
17    if {$filename ne {}} {
18      ::practcl::debug [self] [self class] [self method] project-compile-products $filename
19      if {[my define exists ofile]} {
20        set ofile [my define get ofile]
21      } else {
22        set ofile [my Ofile $filename]
23        my define set ofile $ofile
24      }
25      lappend result $ofile [list cfile $filename include [my define get include]  extra [my define get extra] external [string is true -strict [my define get external]] object [self]]
26    }
27    }
28    foreach item [my link list subordinate] {
29      lappend result {*}[$item project-compile-products]
30    }
31    return $result
32  }
33
34  method generate-debug {{spaces {}}} {
35    set result {}
36    ::practcl::cputs result "$spaces[list [self] [list class [info object class [self]] filename [my define get filename]] links [my link list]]"
37    foreach item [my link list subordinate] {
38      practcl::cputs result [$item generate-debug "$spaces  "]
39    }
40    return $result
41  }
42
43  method generate-cfile-constant {} {
44    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
45    set result {}
46    my variable code cstruct methods tcltype
47    if {[info exists code(constant)]} {
48      ::practcl::cputs result "/* [my define get filename] CONSTANT */"
49      ::practcl::cputs result $code(constant)
50    }
51    foreach obj [my link list product] {
52      # Exclude products that will generate their own C files
53      if {[$obj define get output_c] ne {}} continue
54      ::practcl::cputs result [$obj generate-cfile-constant]
55    }
56    return $result
57  }
58
59  ###
60  # Populate const static data structures
61  ###
62  method generate-cfile-public-structure {} {
63    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
64    my variable code cstruct methods tcltype
65    set result {}
66    if {[info exists code(struct)]} {
67      ::practcl::cputs result $code(struct)
68    }
69    foreach obj [my link list product] {
70      # Exclude products that will generate their own C files
71      if {[$obj define get output_c] ne {}} continue
72      ::practcl::cputs result [$obj generate-cfile-public-structure]
73    }
74    return $result
75  }
76
77  method generate-cfile-header {} {
78    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
79    my variable code cfunct cstruct methods tcltype tclprocs
80    set result {}
81    if {[info exists code(header)]} {
82      ::practcl::cputs result $code(header)
83    }
84    foreach obj [my link list product] {
85      # Exclude products that will generate their own C files
86      if {[$obj define get output_c] ne {}} continue
87      set dat [$obj generate-cfile-header]
88      if {[string length [string trim $dat]]} {
89        ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-header */"
90        ::practcl::cputs result $dat
91        ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-header */"
92      }
93    }
94    return $result
95  }
96
97  method generate-cfile-global {} {
98    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
99    my variable code cfunct cstruct methods tcltype tclprocs
100    set result {}
101    if {[info exists code(global)]} {
102      ::practcl::cputs result $code(global)
103    }
104    foreach obj [my link list product] {
105      # Exclude products that will generate their own C files
106      if {[$obj define get output_c] ne {}} continue
107      set dat [$obj generate-cfile-global]
108      if {[string length [string trim $dat]]} {
109        ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-global */"
110        ::practcl::cputs result $dat
111        ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-global */"
112      }
113    }
114    return $result
115  }
116
117  method generate-cfile-private-typedef {} {
118    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
119    my variable code cstruct
120    set result {}
121    if {[info exists code(private-typedef)]} {
122      ::practcl::cputs result $code(private-typedef)
123    }
124    if {[info exists cstruct]} {
125      # Add defintion for native c data structures
126      foreach {name info} $cstruct {
127        if {[dict get $info public]==1} continue
128        ::practcl::cputs result "typedef struct $name ${name}\;"
129        if {[dict exists $info aliases]} {
130          foreach n [dict get $info aliases] {
131            ::practcl::cputs result "typedef struct $name ${n}\;"
132          }
133        }
134      }
135    }
136    set result [::practcl::_tagblock $result c [my define get filename]]
137    foreach mod [my link list product] {
138      ::practcl::cputs result [$mod generate-cfile-private-typedef]
139    }
140    return $result
141  }
142
143  method generate-cfile-private-structure {} {
144    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
145    my variable code cstruct
146    set result {}
147    if {[info exists code(private-structure)]} {
148      ::practcl::cputs result $code(private-structure)
149    }
150    if {[info exists cstruct]} {
151      foreach {name info} $cstruct {
152        if {[dict get $info public]==1} continue
153        if {[dict exists $info comment]} {
154          ::practcl::cputs result [dict get $info comment]
155        }
156        ::practcl::cputs result "struct $name \{[dict get $info body]\}\;"
157      }
158    }
159    set result [::practcl::_tagblock $result c [my define get filename]]
160    foreach mod [my link list product] {
161      ::practcl::cputs result [$mod generate-cfile-private-structure]
162    }
163    return $result
164  }
165
166
167  ###
168  # Generate code that provides subroutines called by
169  # Tcl API methods
170  ###
171  method generate-cfile-functions {} {
172    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
173    my variable code cfunct
174    set result {}
175    if {[info exists code(funct)]} {
176      ::practcl::cputs result $code(funct)
177    }
178    if {[info exists cfunct]} {
179      foreach {funcname info} $cfunct {
180        ::practcl::cputs result "/* $funcname */"
181        if {[dict get $info inline] && [dict get $info public]} {
182          ::practcl::cputs result "\ninline [dict get $info header]\{[dict get $info body]\}"
183        } else {
184          ::practcl::cputs result "\n[dict get $info header]\{[dict get $info body]\}"
185        }
186      }
187    }
188    foreach obj [my link list product] {
189      # Exclude products that will generate their own C files
190      if {[$obj define get output_c] ne {}} {
191        continue
192      }
193      ::practcl::cputs result [$obj generate-cfile-functions]
194    }
195    return $result
196  }
197
198  ###
199  # Generate code that provides implements Tcl API
200  # calls
201  ###
202  method generate-cfile-tclapi {} {
203    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
204    my variable code methods tclprocs
205    set result {}
206    if {[info exists code(method)]} {
207      ::practcl::cputs result $code(method)
208    }
209    foreach obj [my link list product] {
210      # Exclude products that will generate their own C files
211      if {[$obj define get output_c] ne {}} continue
212      ::practcl::cputs result [$obj generate-cfile-tclapi]
213    }
214    return $result
215  }
216
217
218  method generate-hfile-public-define {} {
219    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
220    my variable code
221    set result {}
222    if {[info exists code(public-define)]} {
223      ::practcl::cputs result $code(public-define)
224    }
225    set result [::practcl::_tagblock $result c [my define get filename]]
226    foreach mod [my link list product] {
227      ::practcl::cputs result [$mod generate-hfile-public-define]
228    }
229    return $result
230  }
231
232  method generate-hfile-public-macro {} {
233    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
234    my variable code
235    set result {}
236    if {[info exists code(public-macro)]} {
237      ::practcl::cputs result $code(public-macro)
238    }
239    set result [::practcl::_tagblock $result c [my define get filename]]
240    foreach mod [my link list product] {
241      ::practcl::cputs result [$mod generate-hfile-public-macro]
242    }
243    return $result
244  }
245
246  method generate-hfile-public-typedef {} {
247    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
248    my variable code cstruct
249    set result {}
250    if {[info exists code(public-typedef)]} {
251      ::practcl::cputs result $code(public-typedef)
252    }
253    if {[info exists cstruct]} {
254      # Add defintion for native c data structures
255      foreach {name info} $cstruct {
256        if {[dict get $info public]==0} continue
257        ::practcl::cputs result "typedef struct $name ${name}\;"
258        if {[dict exists $info aliases]} {
259          foreach n [dict get $info aliases] {
260            ::practcl::cputs result "typedef struct $name ${n}\;"
261          }
262        }
263      }
264    }
265    set result [::practcl::_tagblock $result c [my define get filename]]
266    foreach mod [my link list product] {
267      ::practcl::cputs result [$mod generate-hfile-public-typedef]
268    }
269    return $result
270  }
271
272  method generate-hfile-public-structure {} {
273    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
274    my variable code cstruct
275    set result {}
276    if {[info exists code(public-structure)]} {
277      ::practcl::cputs result $code(public-structure)
278    }
279    if {[info exists cstruct]} {
280      foreach {name info} $cstruct {
281        if {[dict get $info public]==0} continue
282        if {[dict exists $info comment]} {
283          ::practcl::cputs result [dict get $info comment]
284        }
285        ::practcl::cputs result "struct $name \{[dict get $info body]\}\;"
286      }
287    }
288    set result [::practcl::_tagblock $result c [my define get filename]]
289    foreach mod [my link list product] {
290      ::practcl::cputs result [$mod generate-hfile-public-structure]
291    }
292    return $result
293  }
294
295  method generate-hfile-public-headers {} {
296    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
297    my variable code tcltype
298    set result {}
299    if {[info exists code(public-header)]} {
300      ::practcl::cputs result $code(public-header)
301    }
302    if {[info exists tcltype]} {
303      foreach {type info} $tcltype {
304        if {![dict exists $info cname]} {
305          set cname [string tolower ${type}]_tclobjtype
306          dict set tcltype $type cname $cname
307        } else {
308          set cname [dict get $info cname]
309        }
310        ::practcl::cputs result "extern const Tcl_ObjType $cname\;"
311      }
312    }
313    if {[info exists code(public)]} {
314      ::practcl::cputs result $code(public)
315    }
316    set result [::practcl::_tagblock $result c [my define get filename]]
317    foreach mod [my link list product] {
318      ::practcl::cputs result [$mod generate-hfile-public-headers]
319    }
320    return $result
321  }
322
323  method generate-hfile-public-function {} {
324    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
325    my variable code cfunct tcltype
326    set result {}
327
328    if {[my define get initfunc] ne {}} {
329      ::practcl::cputs result "int [my define get initfunc](Tcl_Interp *interp);"
330    }
331    if {[info exists cfunct]} {
332      foreach {funcname info} $cfunct {
333        if {![dict get $info public]} continue
334        ::practcl::cputs result "[dict get $info header]\;"
335      }
336    }
337    set result [::practcl::_tagblock $result c [my define get filename]]
338    foreach mod [my link list product] {
339      ::practcl::cputs result [$mod generate-hfile-public-function]
340    }
341    return $result
342  }
343
344  method generate-hfile-public-includes {} {
345    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
346    set includes {}
347    foreach item [my define get public-include] {
348      if {$item ni $includes} {
349        lappend includes $item
350      }
351    }
352    foreach mod [my link list product] {
353      foreach item [$mod generate-hfile-public-includes] {
354        if {$item ni $includes} {
355          lappend includes $item
356        }
357      }
358    }
359    return $includes
360  }
361
362  method generate-hfile-public-verbatim {} {
363    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
364    set includes {}
365    foreach item [my define get public-verbatim] {
366      if {$item ni $includes} {
367        lappend includes $item
368      }
369    }
370    foreach mod [my link list subordinate] {
371      foreach item [$mod generate-hfile-public-verbatim] {
372        if {$item ni $includes} {
373          lappend includes $item
374        }
375      }
376    }
377    return $includes
378  }
379
380  method generate-loader-external {} {
381    if {[my define get initfunc] eq {}} {
382      return "/*  [my define get filename] declared not initfunc */"
383    }
384    return "  if([my define get initfunc](interp)) return TCL_ERROR\;"
385  }
386
387  method generate-loader-module {} {
388    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
389    my variable code
390    set result {}
391    if {[info exists code(cinit)]} {
392      ::practcl::cputs result $code(cinit)
393    }
394    if {[my define get initfunc] ne {}} {
395      ::practcl::cputs result "  if([my define get initfunc](interp)!=TCL_OK) return TCL_ERROR\;"
396    }
397    set result [::practcl::_tagblock $result c [my define get filename]]
398    foreach item [my link list product] {
399      if {[$item define get output_c] ne {}} {
400        ::practcl::cputs result [$item generate-loader-external]
401      } else {
402        ::practcl::cputs result [$item generate-loader-module]
403      }
404    }
405    return $result
406  }
407
408  method generate-stub-function {} {
409    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
410    my variable code cfunct tcltype
411    set result {}
412    foreach mod [my link list product] {
413      foreach {funct def} [$mod generate-stub-function] {
414        dict set result $funct $def
415      }
416    }
417    if {[info exists cfunct]} {
418      foreach {funcname info} $cfunct {
419        if {![dict get $info export]} continue
420        dict set result $funcname [dict get $info header]
421      }
422    }
423    return $result
424  }
425
426
427  method IncludeAdd {headervar args} {
428    upvar 1 $headervar headers
429    foreach inc $args {
430      if {[string index $inc 0] ni {< \"}} {
431        set inc "\"$inc\""
432      }
433      if {$inc ni $headers} {
434        lappend headers $inc
435      }
436    }
437  }
438
439  method generate-tcl-loader {} {
440    set result {}
441    set PKGINIT [my define get pkginit]
442    set PKG_NAME [my define get name [my define get pkg_name]]
443    set PKG_VERSION [my define get pkg_vers [my define get version]]
444    if {[string is true [my define get SHARED_BUILD 0]]} {
445      set LIBFILE [my define get libfile]
446      ::practcl::cputs result [string map \
447        [list @LIBFILE@ $LIBFILE @PKGINIT@ $PKGINIT @PKG_NAME@ $PKG_NAME @PKG_VERSION@ $PKG_VERSION] {
448# Shared Library Style
449load [file join [file dirname [file join [pwd] [info script]]] @LIBFILE@] @PKGINIT@
450package provide @PKG_NAME@ @PKG_VERSION@
451}]
452    } else {
453      ::practcl::cputs result [string map \
454      [list @PKGINIT@ $PKGINIT @PKG_NAME@ $PKG_NAME @PKG_VERSION@ $PKG_VERSION] {
455# Tclkit Style
456load {} @PKGINIT@
457package provide @PKG_NAME@ @PKG_VERSION@
458}]
459    }
460    return $result
461  }
462
463  ###
464  # This methods generates any Tcl script file
465  # which is required to pre-initialize the C library
466  ###
467  method generate-tcl-pre {} {
468    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
469    set result {}
470    my variable code
471    if {[info exists code(tcl)]} {
472      set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]]
473    }
474    if {[info exists code(tcl-pre)]} {
475      set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]]
476    }
477    foreach mod [my link list product] {
478      ::practcl::cputs result [$mod generate-tcl-pre]
479    }
480    return $result
481  }
482
483  method generate-tcl-post {} {
484    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
485    set result {}
486    my variable code
487    if {[info exists code(tcl-post)]} {
488      set result [::practcl::_tagblock $code(tcl-post) tcl [my define get filename]]
489    }
490    foreach mod [my link list product] {
491      ::practcl::cputs result [$mod generate-tcl-post]
492    }
493    return $result
494  }
495
496
497  method linktype {} {
498    return {subordinate product}
499  }
500
501  method Ofile filename {
502    set lpath [my <module> define get localpath]
503    if {$lpath eq {}} {
504      set lpath [my <module> define get name]
505    }
506    return ${lpath}_[file rootname [file tail $filename]]
507  }
508
509  ###
510  # Methods called by the master project
511  ###
512
513  method project-static-packages {} {
514    set result [my define get static_packages]
515    set initfunc [my define get initfunc]
516    if {$initfunc ne {}} {
517      set pkg_name [my define get pkg_name]
518      if {$pkg_name ne {}} {
519        dict set result $pkg_name initfunc $initfunc
520        dict set result $pkg_name version [my define get version [my define get pkg_vers]]
521        dict set result $pkg_name autoload [my define get autoload 0]
522      }
523    }
524    foreach item [my link list subordinate] {
525      foreach {pkg info} [$item project-static-packages] {
526        dict set result $pkg $info
527      }
528    }
529    return $result
530  }
531
532  ###
533  # Methods called by the toolset
534  ###
535
536  method toolset-include-directory {} {
537    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
538    set result [my define get include_dir]
539    foreach obj [my link list product] {
540      foreach path [$obj toolset-include-directory] {
541        lappend result $path
542      }
543    }
544    return $result
545  }
546
547  method target {method args} {
548    switch $method {
549      is_unix { return [expr {$::tcl_platform(platform) eq "unix"}] }
550    }
551  }
552}
553oo::objdefine ::practcl::product {
554
555  method select {object} {
556    set class [$object define get class]
557    set mixin [$object define get product]
558    if {$class eq {} && $mixin eq {}} {
559      set filename [$object define get filename]
560      if {$filename ne {} && [file exists $filename]} {
561        switch [file extension $filename] {
562          .tcl {
563            set mixin ::practcl::product.dynamic
564          }
565          .h {
566            set mixin ::practcl::product.cheader
567          }
568          .c {
569            set mixin ::practcl::product.csource
570          }
571          .ini {
572            switch [file tail $filename] {
573              module.ini {
574                set class ::practcl::module
575              }
576              library.ini {
577                set class ::practcl::subproject
578              }
579            }
580          }
581          .so -
582          .dll -
583          .dylib -
584          .a {
585            set mixin ::practcl::product.clibrary
586          }
587        }
588      }
589    }
590    if {$class ne {}} {
591      $object clay mixinmap core $class
592    }
593    if {$mixin ne {}} {
594      $object clay mixinmap product $mixin
595    }
596  }
597}
598
599###
600# A product which generated from a C header file. Which is to say, nothing.
601###
602::clay::define ::practcl::product.cheader {
603  superclass ::practcl::product
604
605  method project-compile-products {} {}
606  method generate-loader-module {} {}
607}
608
609###
610# A product which generated from a C source file. Normally an object (.o) file.
611###
612::clay::define ::practcl::product.csource {
613  superclass ::practcl::product
614
615  method project-compile-products {} {
616    set result {}
617    set filename [my define get filename]
618    if {$filename ne {}} {
619      ::practcl::debug [self] [self class] [self method] project-compile-products $filename
620      if {[my define exists ofile]} {
621        set ofile [my define get ofile]
622      } else {
623        set ofile [my Ofile $filename]
624        my define set ofile $ofile
625      }
626      lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]] object [self]]
627    }
628    foreach item [my link list subordinate] {
629      lappend result {*}[$item project-compile-products]
630    }
631    return $result
632  }
633}
634
635###
636# A product which is generated from a compiled C library.
637# Usually a .a or a .dylib file, but in complex cases may
638# actually just be a conduit for one project to integrate the
639# source code of another
640###
641::clay::define ::practcl::product.clibrary {
642  superclass ::practcl::product
643
644  method linker-products {configdict} {
645    return [my define get filename]
646  }
647
648}
649
650###
651# A product which is generated from C code that itself is generated
652# by practcl or some other means. This C file may or may not produce
653# its own .o file, depending on whether it is eligible to become part
654# of an amalgamation
655###
656::clay::define ::practcl::product.dynamic {
657  superclass ::practcl::dynamic ::practcl::product
658
659  method initialize {} {
660    set filename [my define get filename]
661    if {$filename eq {}} {
662      return
663    }
664    if {[my define get name] eq {}} {
665      my define set name [file tail [file rootname $filename]]
666    }
667    if {[my define get localpath] eq {}} {
668      my define set localpath [my <module> define get localpath]_[my define get name]
669    }
670    # Future Development:
671    # Scan source file to see if it is encoded in criticl or practcl notation
672    #set thisline {}
673    #foreach line [split [::practcl::cat $filename] \n] {
674    #
675    #}
676    ::source $filename
677    if {[my define get output_c] ne {}} {
678      # Turn into a module if we have an output_c file
679      my morph ::practcl::module
680    }
681  }
682}
683
684###
685# A binary product produced by critcl. Note: The implementation is not
686# written yet, this class does nothing.
687::clay::define ::practcl::product.critcl {
688  superclass ::practcl::dynamic ::practcl::product
689}
690
691