prop-src/logicgen.pcc

   1 ///////////////////////////////////////////////////////////////////////////////
   2 //
   3 //  This file implements the constraint compiler.
   4 //
   5 ///////////////////////////////////////////////////////////////////////////////
   6 #include <iostream>
   7 #include <AD/strings/quark.h>
   8 #include "ir.ph"
   9 #include "ast.ph"
  10 #include "constraint.ph"
  11 #include "wam.ph"
  12 #include "type.h"
  13 #include "hashtab.h"
  14 #include "datagen.h"
  15 #include "logicgen.ph"
  16 #include "pat.ph"
  17 #include "datatype.ph"
  18 #include "list.h"
  19
  20 ///////////////////////////////////////////////////////////////////////////////
  21 //
  22 //  Method for generating the interface methods for a logic
  23 //
  24 ///////////////////////////////////////////////////////////////////////////////
  25 void DatatypeClass::generate_logic_interface(CodeGen&) {}
  26 void DatatypeClass::generate_logic_implementation(CodeGen&, Tys, DefKind) {}
  27
  28 ///////////////////////////////////////////////////////////////////////////////
  29 //
  30 //  Constructor for the constraint compiler implementation
  31 //
  32 ///////////////////////////////////////////////////////////////////////////////
  33 ConstraintCompilerInternal::ConstraintCompilerInternal (Id id)
  34    : class_name(id),
  35      rule_map     (string_hash,string_equal),
  36      typing_map   (string_hash,string_equal),
  37      instness_map (string_hash,string_equal),
  38      det_map      (string_hash,string_equal)
  39 {
  40 }
  41
  42 ///////////////////////////////////////////////////////////////////////////////
  43 //
  44 //  Destructor for the constraint compiler implementation
  45 //
  46 ///////////////////////////////////////////////////////////////////////////////
  47 ConstraintCompilerInternal::~ConstraintCompilerInternal() {}
  48
  49 ///////////////////////////////////////////////////////////////////////////////
  50 //
  51 //  Method to compile a set of constraint rules
  52 //
  53 ///////////////////////////////////////////////////////////////////////////////
  54 void ConstraintCompiler::compile_ruleset (Id id, ConstraintSet rule_set)
  55 {
  56    ConstraintCompilerInternal G(id);
  57    internal = &G;
  58
  59    ////////////////////////////////////////////////////////////////////////////
  60    //
  61    //  Rules by kind.
  62    //
  63    ////////////////////////////////////////////////////////////////////////////
  64    ConstraintRules                rules          = #[];
  65    List<.[Id, Ty]>                typing_rules   = #[];
  66    List<.[Id, Pat]>               instness_rules = #[];
  67    List<.[Id, Pats, Determinism]> det_rules      = #[];
  68
  69    ////////////////////////////////////////////////////////////////////////////
  70    //
  71    //  Partition the rules by kind.
  72    //
  73    ////////////////////////////////////////////////////////////////////////////
  74    match (rule_set) of
  75       CONSTRAINTset defs:
  76       {  ConstraintDefs ds = defs;
  77          match while (ds) of
  78             #[ one ... rest ]:
  79             {  match (one) of
  80                   CONSTRAINTruledef r:    { rules = #[r ... rules];  }
  81                |  CONSTRAINTtype(id,ty):
  82                     { typing_rules = #[.(id,ty) ... typing_rules]; }
  83                |  CONSTRAINTinstness(id,pat):
  84                     { instness_rules = #[.(id,pat) ... instness_rules]; }
  85                |  CONSTRAINTdet(id,pats,det):
  86                     { det_rules = #[.(id,pats,det) ... det_rules]; }
  87                end match;
  88                ds = rest;
  89             }
  90          end match;
  91       }
  92    end match;
  93
  94    rules          = rev(rules);
  95    typing_rules   = rev(typing_rules);
  96    instness_rules = rev(instness_rules);
  97    det_rules      = rev(det_rules);
  98
  99    ////////////////////////////////////////////////////////////////////////////
 100    //
 101    //  Process each kind of rules.
 102    //
 103    ////////////////////////////////////////////////////////////////////////////
 104    process_typing_rules(id, typing_rules);
 105    process_ruleset(id, rules);
 106
 107    ////////////////////////////////////////////////////////////////////////////
 108    //
 109    //  Translate the rules into constraint abstract machine instructions.
 110    //
 111    ////////////////////////////////////////////////////////////////////////////
 112 }
 113
 114 ///////////////////////////////////////////////////////////////////////////////
 115 //
 116 //  Method to add a predicate : type judgement into the typing map.
 117 //
 118 ///////////////////////////////////////////////////////////////////////////////
 119 void ConstraintCompiler::add_predicate_type(Id id, Ty ty)
 120 {  HashTable::Entry * e = internal->typing_map.lookup(id);
 121    if (e)
 122    {  Ty old_ty = Ty(internal->typing_map.value(e));
 123       if (! unify(ty,old_ty))
 124       {  error("%Lpredicate %s: expecting type %T but found %T\n",
 125                id, old_ty, ty);
 126       }
 127    } else
 128    {  internal->typing_map.insert(id,ty);
 129    }
 130 }
 131
 132 ///////////////////////////////////////////////////////////////////////////////
 133 //
 134 //  Method to process the typing rules.
 135 //
 136 ///////////////////////////////////////////////////////////////////////////////
 137 void ConstraintCompiler::process_typing_rules(Id id, List<.[Id,Ty]> typing_rules)
 138 {  match while (typing_rules)
 139    {  #[.(id,ty) ... rest]:
 140       {  add_predicate_type(id,ty); typing_rules = rest; }
 141    }
 142 }
 143
 144 ///////////////////////////////////////////////////////////////////////////////
 145 //
 146 //  Method to partition a set of constraint rules by functor name and type.
 147 //
 148 ///////////////////////////////////////////////////////////////////////////////
 149 void ConstraintCompiler::process_ruleset(Id id, ConstraintRules rules)
 150 {
 151    ////////////////////////////////////////////////////////////////////////////
 152    //
 153    //   Perform type checking on each of the rule.
 154    //
 155    ////////////////////////////////////////////////////////////////////////////
 156    for_each (ConstraintRule, r, rules)
 157    {  match (r)
 158       {  CONSTRAINTrule { id, pat, body, ty }:
 159          {  r->set_loc();
 160
 161             // Lookup entry
 162             HashTable::Entry * e = internal->rule_map.lookup(id);
 163
 164             // Infer the type of pattern.
 165             ty = mkfunty(type_of(pat),mktypety());
 166             add_predicate_type(id,ty);
 167
 168             // Insert into the type
 169             if (e) // append rule
 170             {  ConstraintRules old_rules = ConstraintRules(e->v);
 171                match (old_rules) of
 172                   #[ CONSTRAINTrule { ty = old_ty ... } ... _ ]:
 173                   {  if (! unify(ty,old_ty))
 174                      {  error("%Ltype mismatch in rule %s%p\n"
 175                               "%Lexpecting %T but found %T\n",
 176                               id, pat, old_ty, ty);
 177                      }
 178                   }
 179                |  _: // skip
 180                end match;
 181                internal->rule_map.insert(id,#[r ... old_rules]);
 182             } else // insert new rule
 183             {  internal->rule_map.insert(id,#[r]);
 184             }
 185          }
 186       }
 187    }
 188
 189    ////////////////////////////////////////////////////////////////////////////
 190    //
 191    //  Makes sure all the rules have all the type information annotated.
 192    //
 193    ////////////////////////////////////////////////////////////////////////////
 194    for_each (ConstraintRule, R, rules)
 195    {  match (R)
 196       {  CONSTRAINTrule { id, pat, body, ty }:
 197          {  R->set_loc();
 198             // Check to make sure it has all the type information.
 199             if (! is_ground(ty))
 200             { error("%Lmissing type info in rule: %s%p : %T\n", id, pat, ty); }
 201             pat = unifier_of(pat);
 202             debug_msg("%s %p :- ...\n", id, pat);
 203          }
 204       }
 205    }
 206 }