extra/yaml/dbg/dbg.factor

   1 ! Copyright (C) 2014 Jon Harper.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types alien.data assocs classes.struct
   4 combinators continuations destructors io io.backend
   5 io.encodings.ascii io.encodings.string io.encodings.utf8
   6 io.launcher kernel libc math.parser prettyprint sequences
   7 yaml.ffi yaml.private ;
   8 IN: yaml.dbg
   9
  10 : event. ( event -- )
  11     dup [ data>> ] [ type>> ] bi* {
  12         { YAML_STREAM_START_EVENT [ stream_start>>  ] }
  13         { YAML_DOCUMENT_START_EVENT [ document_start>> ] }
  14         { YAML_DOCUMENT_END_EVENT [ document_end>> ] }
  15         { YAML_ALIAS_EVENT [ alias>> ] }
  16         { YAML_SCALAR_EVENT [ scalar>> ] }
  17         { YAML_SEQUENCE_START_EVENT [ sequence_start>> ] }
  18         { YAML_MAPPING_START_EVENT [ mapping_start>> ] }
  19         [ nip ]
  20     } case . ;
  21
  22 :: yaml-events ( string -- )
  23     [
  24         yaml_parser_t (malloc-struct) &free &yaml_parser_delete :> parser
  25         parser yaml_parser_initialize .
  26
  27         string utf8 encode [ malloc-byte-array &free ] [ length ] bi :> ( input length )
  28         parser input length yaml_parser_set_input_string
  29
  30         yaml_event_t (malloc-struct) &free :> event
  31
  32         f :> done!
  33         [
  34             [ done ] [
  35                 parser event yaml_parser_parse [ [
  36                     event &yaml_event_delete event.
  37                     event type>> YAML_STREAM_END_EVENT = done!
  38                 ] with-destructors ] [
  39                     parser (libyaml-parser-error)
  40                 ] if
  41             ] until
  42         ] [ . ] recover
  43     ] with-destructors ;
  44
  45 : factor-struct-sizes ( -- arr )
  46     {
  47         yaml_version_directive_t
  48         yaml_tag_directive_t
  49         yaml_mark_t
  50         stream_start_token_data
  51         alias_token_data
  52         anchor_token_data
  53         tag_token_data
  54         scalar_token_data
  55         version_directive_token_data
  56         yaml_token_t
  57         stream_start_event_data
  58         tag_directives_document_start_event_data
  59         document_start_event_data
  60         document_end_event_data
  61         alias_event_data
  62         scalar_event_data
  63         sequence_start_event_data
  64         mapping_start_event_data
  65         yaml_event_t
  66         yaml_node_pair_t
  67         scalar_node_data
  68         sequence_node_data_items
  69         sequence_node_data
  70         mapping_node_data_pairs
  71         mapping_node_data
  72         yaml_node_t
  73         yaml_document_nodes
  74         yaml_document_tag_directives
  75         yaml_document_t
  76         yaml_simple_key_t
  77         yaml_alias_data_t
  78         string_yaml_parser_input
  79         yaml_parser_buffer
  80         yaml_parser_raw_buffer
  81         yaml_parser_tokens
  82         yaml_parser_indents
  83         yaml_parser_simple_keys
  84         yaml_parser_states
  85         yaml_parser_marks
  86         yaml_parser_tag_directives
  87         yaml_parser_aliases
  88         yaml_parser_t
  89         yaml_emitter_output_string
  90         yaml_emitter_buffer
  91         yaml_emitter_raw_buffer
  92         yaml_emitter_states
  93         yaml_emitter_events
  94         yaml_emitter_indents
  95         yaml_emitter_tag_directives
  96         yaml_emitter_anchor_data
  97         yaml_emitter_tag_data
  98         yaml_emitter_scalar_data
  99         yaml_emitter_anchors
 100         yaml_emitter_t
 101     } [ heap-size ] map ;
 102
 103 : c-struct-sizes ( -- sizes )
 104     "vocab:yaml/dbg/structs" normalize-path
 105     ascii <process-reader> stream-lines
 106     [ string>number ] map ;
 107
 108 : struct-sizes-dbg ( -- )
 109     c-struct-sizes factor-struct-sizes
 110     zip [ first2 = not ] find . . ;