/* $OpenXM: OpenXM/src/k097/lib/minimal/cohom.k,v 1.1 2000/05/03 06:42:07 takayama Exp $ */


def Boundp(a) {
   local b;
   sm1("[(parse) [(/) ",a," ( load tag 0 eq 
                          { /FunctionValue 0 def }
                          { /FunctionValue 1 def } ifelse )] cat ] extension");
}

def load_cohom() {
  if (Boundp("cohom.sm1.loaded")) {
  }else{
    sm1(" [(parse) (k0-cohom.sm1) pushfile ] extension ");
  }
}

load_cohom();

def sm1_deRham(a,b) {
  local aa,bb;
  aa = ToString(a); 
  if (IsArray(b)) {
     bb = Map(b,"ToString");
  }else{
     bb = ToString(b);
  }
  sm1("[", aa,bb, " ]  deRham /FunctionValue set ");
}


def Weyl(v,w,p) {
  local a,L;
  L=Length(Arglist);
  if (L == 1) {
    a=RingD(v);
  } else if (L == 2) {
    a=RingD(v,w);
  }else if (L == 3) {
    a=RingD(v,w,p);
  }else{
    Println("Error: argument mismatch");
    return(null);
  }
  sm1(" define_ring_variables ");
  return(a);
}

def sm1_pmat(a) {
  sm1(a," pmat ");
}

Weyl("x,y");
/*  See page 8, (2.2).  */
cech=[ 
  [ [x*Dx], 
    [y*Dy]
  ],
  [[ y*Dy, -x*Dx]]
];

def sm1_v_string(V) {
  if (IsArray(V)) {
    V = Map(V,"ToString");
  }else {
    V = ToString(V);
  }
  return(V);
}

def sm1_syz(A,V,W) {
  local L,P;
  L=Length(Arglist);
  if (L == 1) {
    P = [A];
  }else if (L==2) {
    V = sm1_v_string(V);
    P = [A,V];
  }else if (L==3) {
    P = [A,V,W];
  }else {
    Println("sm1_syz: Argument mismatch");
    return(null);
  }
  sm1(P," syz /FunctionValue set");
}
/*  
  sm1_syz([x*Dx,y*Dy],[x,y]):
  We want to syz_h, too.
  Step 1: Control by global variable ?  syz ==> syz_generic
  Step 2: syz and syz_h
*/

def sm1_resol1(I,V,W) {
  local P,L;
  L=Length(Arglist);
  if (L == 1) {
    P = [I];
  }else if (L==2) {
    V = sm1_v_string(V);
    P = [I,V];
  }else if (L==3) {
    P = [I,V,W];
  }else {
    Println("sm1_syz: Argument mismatch");
    return(null);
  }
  sm1(P," resol1 /FunctionValue set ");
}
/*  sm1_resol1([x^2,x*y],[x,y]):  */

def sm1_res_solv(A,B,C) {
  local P,L;
  L=Length(Arglist);
  if (L == 2) {
    P = [A,B];
    sm1(P," res-solv /FunctionValue set");
  }else if (L==3) {
    C = sm1_v_string(C);
    P = [[A,B], C];
    sm1(P," res*solv /FunctionValue set ");
  }else{
    Println("Error: argument mismatch");
    return(null);
  }
}
/*
 sm1_res_solv(
  [[x*Dx + 2, 0], 
   [Dx+3,    x^3],
   [3,      x],
   [Dx*(x*Dx + 3) - (x*Dx + 2)*(x*Dx -4), 0]],
   [1, 0], [x,y]):

 sm1_res_solv([x,1],1,"x"):
 sm1_res_solv([x,y],y,"x,y"):
*/

def sm1_res_solv_h(A,B,C) {
  local P;
  P = [[A,B], C];
  sm1(P," res*solv*h /FunctionValue set ");
}

def Reparse(A) {
  if (IsArray(A)) {
    return(Map(A,"Reparse"));
  }else if (IsPolynomial(A) || IsInteger(A)) {
    return(Poly(ToString(A)));
  }else{
    return(A);
  }
}

def sm1_res_sub2Q(I,V) {
  local L,P;
  L = Length(Arglist);
  if (L == 1) {
    P = I;
  }else if ( L == 2) {
    V = sm1_v_string(V);
    if (IsArray(V)) {
      sm1(V," from_records /V set ");
    }
    Weyl(V);
    P = Reparse(I);
  }
  sm1(P," res-sub2Q /FunctionValue set ");
}

/*
   sm1_res_sub2Q([x*Dx,Dy]):
   M res-sub2Q =: J,   M \simeq D^p/J
*/

def ex2_9() {
  Weyl("x,y,z");
  I = [ x*Dx+y*Dy+z*Dz+6,
        z^2*Dy-y^2*Dz,
        z^2*Dx-x^2*Dz,
        y^2*Dx-x^2*Dy,
        x^3*Dz+y^3*Dz+z^3*Dz+6*z^2,
        x^3*Dy+y^3*Dy+y^2*z*Dz+6*y^2];
  a = sm1_resol1(I,"x,y,z");
  return(a);
}