begin implementing lisp structures attributes.

see DFHack#404 for ref-size.
BenLubar · May 14, 2020 · 61ba30f · 61ba30f
1 parent cbeed8b
commit 61ba30f
Show file tree

Hide file tree

Showing 7 changed files with 132 additions and 17 deletions.
diff --git a/Common.pm b/Common.pm
@@ -19,7 +19,8 @@ BEGIN {
 
         &is_primitive_type &primitive_type_name &get_primitive_base
 
-        *weak_refs *strong_refs *header_refs &header_ref &register_ref &decode_type_name_ref
+        *weak_refs *strong_refs *header_refs &header_ref &register_ref
+        &decode_type_name_ref &translate_lookup
 
         &with_capture_traits &with_emit_traits
         *cur_header_name %header_data &with_header_file
@@ -265,6 +266,113 @@ sub decode_type_name_ref($;%) {
     }
 }
 
+sub translate_lookup {
+    my ($str) = @_;
+    return undef unless defined $str;
+    if ($str eq "0") {
+        return "&zero";
+    }
+    if ($str eq "-1") {
+        return "&negone";
+    }
+    if ($str =~ /^\$global\.([a-zA-Z][_a-zA-Z0-9]*)$/) {
+        return "df::global::$1";
+    }
+    if ($str eq "\$\$") {
+        return "aux";
+    }
+    if ($str eq "\$") {
+        return "val";
+    }
+    if ($str =~ /^(.+)\.([a-zA-Z][_a-zA-Z0-9]*)$/) {
+        my $field = $2;
+        my $base = translate_lookup($1);
+        return "_fieldptr($base, $field)";
+    }
+    if ($str =~ /^(.+)\.ref-target$/) {
+        my $base = translate_lookup($1);
+        return "_reftarget($base)";
+    }
+    if ($str =~ /^(.+)\.refers-to$/) {
+        my $base = translate_lookup($1);
+        return "_refersto($base)";
+    }
+    if ($str =~ /^(.+)\.index-refers-to$/) {
+        my $base = translate_lookup($1);
+        return "_indexrefersto($base)";
+    }
+    if ($str =~ /^(.+)\._parent$/) {
+        my $base = translate_lookup($1);
+        return "_TODOparent($base)";
+    }
+    if ($str =~ /^(.+)\._global$/) {
+        my $base = translate_lookup($1);
+        return "_TODOglobal($base)";
+    }
+    if ($str =~ /^(.+)\._upglobal$/) {
+        my $base = translate_lookup($1);
+        return "_TODOglobal(_TODOparent($base))";
+    }
+    if ($str =~ /^(.+)\._key$/) {
+        my $base = translate_lookup($1);
+        return "_TODOkey($base)";
+    }
+    if ($str =~ /^(.+)\[([^\[\]]+)\]$/) {
+        my $idx = $2;
+        my $base = translate_lookup($1);
+        $idx = translate_lookup($idx);
+        return "_index($base, $idx)";
+    }
+    if ($str =~ /^\(find-plant-raw ([^ ]+)\)$/) {
+        my $idx = translate_lookup($1);
+        return "df::plant_raw::find($idx)";
+    }
+    if ($str =~ /^\(food-mat-by-idx \$([a-zA-Z][_a-zA-Z0-9]*) ([^ ]+)\)$/) {
+        my $cat = $1; 
+        my $idx = translate_lookup($2);
+        return "_foodmat($cat, $idx)";
+    }
+    if ($str =~ /^\(find-creature ([^ ]+)\)$/) {
+        my $idx = translate_lookup($1);
+        return "df::creature_raw::find($idx)";
+    }
+    if ($str =~ /^\(find-entity ([^ ]+)\)$/) {
+        my $idx = translate_lookup($1);
+        return "df::historical_entity::find($idx)";
+    }
+    if ($str =~ /^\(find-instance \$([a-zA-Z][_a-zA-Z0-9]*) ([^ ]+)\)$/) {
+        my $type = $1;
+        my $idx = translate_lookup($2);
+        return "df::${type}::find($idx)";
+    }
+    if ($str =~ /^\(find-by-id ([^ ]+) \$([a-zA-Z][_a-zA-Z0-9]*) ([^ ]+)\)$/) {
+        my $idx = $3;
+        my $fld = $2;
+        my $vec = translate_lookup($1);
+        $idx = translate_lookup($idx);
+        return "_TODOfind($vec, $fld, $idx)";
+    }
+    if ($str =~ /^\(\* ([^ ]+) ([^ ]+)\)$/) {
+        my $b = $2;
+        my $a = translate_lookup($1);
+        $b = translate_lookup($b);
+        return "_TODOmultiply($a, $b)";
+    }
+    if ($str =~ /^\(material-by-id ([^ ]+) ([^ ]+)\)$/) {
+        my $idx = $2;
+        my $type = translate_lookup($1);
+        $idx = translate_lookup($idx);
+        return "_material($type, $idx)";
+    }
+    if ($str =~ /^\(item-subtype-target ([^ ]+) ([^ ]+)\)$/) {
+        my $st = $2;
+        my $type = translate_lookup($1);
+        $st = translate_lookup($st);
+        return "_itemsubtype($type, $st)";
+    }
+    die "unhandled lookup expression ${str}";
+}
+
 # Trait generation
 
 our @trait_lines;

diff --git a/StructFields.pm b/StructFields.pm
@@ -460,6 +460,22 @@ sub render_field_metadata_rec($$) {
         $field_defs_extra{$name}{union_tag_attr} = "\"$uta\"";
         $extra = "&EXTRA($name)";
     }
+    if (my $rt = $field->getAttribute('refers-to')) {
+        # TODO
+        translate_lookup $rt;
+    }
+    if (my $irt = $field->getAttribute('index-refers-to')) {
+        # TODO
+        translate_lookup $irt;
+    }
+    if (my $av = $field->getAttribute('aux-value')) {
+        # TODO
+        translate_lookup $av;
+    }
+    if (my $rs = $field->getAttribute('ref-size')) {
+        # TODO
+        translate_lookup $rs;
+    }
 
     if ($meta eq 'number') {
         my $tname = primitive_type_name($subtype);

diff --git a/StructType.pm b/StructType.pm
@@ -24,17 +24,6 @@ use StructFields;
 
 # MISC
 
-sub translate_lookup($) {
-    my ($str) = @_;
-    return undef unless $str && $str =~ /^\$global((\.[_a-zA-Z0-9]+)+)$/;
-    my @fields = split /\./, substr($1,1);
-    my $expr = "df::global::".shift(@fields);
-    for my $fn (@fields) {
-        $expr = "_fieldptr($expr, $fn)";
-    }
-    return $expr;
-}
-
 sub emit_find_instance(\%$) {
     my ($rinfo, $tag) = @_;
 

diff --git a/data-definition.xsd b/data-definition.xsd
@@ -458,6 +458,8 @@
     <xs:complexType name="PointerField">
         <xs:complexContent>
             <xs:extension base="ContainerFieldType">
+                <xs:attribute name="ref-size">
+                </xs:attribute>
                 <xs:attribute name="is-array" type="xs:boolean">
                 </xs:attribute>
             </xs:extension>

diff --git a/df.entities.xml b/df.entities.xml
@@ -1191,7 +1191,7 @@
                 <int32_t name='histfig_id' ref-target='historical_figure'/>
                 <int32_t name='former_histfig_id' ref-target='historical_figure'/>
                 <int32_t name='entity_id' ref-target='historical_entity'/>
-                <int32_t name='position_assignment_id' refers-to='$(find-entity $$._parent.entity_id).positions.assignments[$]'/>
+                <int32_t name='position_assignment_id' refers-to='$$._parent.entity_id.ref-target.positions.assignments[$]'/>
             </compound>
             <compound name='claim'>
                 <int32_t name='entity_id' ref-target='historical_entity'/>

diff --git a/df.units.xml b/df.units.xml
@@ -1636,7 +1636,7 @@
 
                 <compound name='info' is-union='true' union-tag-field='job_type' union-tag-attr='tag_op_history'>
                     <compound name='crutch'>
-                        <int32_t name='item_type' refers-to='(enum-to-key $item_type $)'/>
+                        <enum name='item_type' base-type='int32_t' type-name='item_type'/>
                         <int32_t name='item_subtype' init-value='-1'/>
                         <int32_t name="mat_type" ref-target='material' aux-value='$$.mat_index'/>
                         <int32_t name="mat_index" init-value='-1'/>

diff --git a/df.world-data.xml b/df.world-data.xml
@@ -821,10 +821,10 @@
         </stl-vector>
         <stl-vector name="rivers" pointer-type='world_river'/>
 
-        <pointer name="region_map" is-array='true'>
-            <pointer is-array='true' type-name='region_map_entry'/>
+        <pointer name="region_map" is-array='true' ref-size='$$._parent.world_width'>
+            <pointer is-array='true' type-name='region_map_entry' ref-size='$$._parent._parent.world_height'/>
         </pointer>
-        <pointer name="unk_1c4" type-name='int8_t' is-array='true'/> 2d byte array with size based on map size
+        <pointer name="unk_1c4" type-name='int8_t' is-array='true' ref-size='(* $$._parent.world_width $$._parent.world_height)'/> 2d byte array with size based on map size
         <padding name="unk_1c8" size="4"/>
 
         <stl-vector name="embark_notes" pointer-type='embark_note'/>