helm/ocaml/mathql_interpreter/select.ml

   1
   2 (*
   3  * implementazione del comando SELECT
   4  *)
   5
   6 open Mathql;;
   7 open Func;;
   8 open Utility;;
   9
  10 (*
  11  * valutazione di una stringa
  12  *)
  13 let stringeval s l =
  14  match s with
  15     MQCons s ->
  16      s
  17  |  MQFunc (f, rvar) ->
  18      (
  19       match f with
  20          MQName -> func_name (List.assoc rvar l)
  21      )
  22  |  MQRVar rvar ->
  23      List.assoc rvar l
  24  |  MQSVar svar ->
  25      List.assoc svar l
  26  |  MQMConclusion ->
  27      "MainConclusion"
  28  |  MQConclusion ->
  29      "InConclusion"
  30 ;;
  31
  32 (*
  33  *
  34  *)
  35 let rec is_good l abool =
  36  match abool with
  37     MQAnd (b1, b2) ->
  38      (is_good l b1) && (is_good l b2)
  39  |  MQOr (b1, b2) ->
  40      (is_good l b1) || (is_good l b2)
  41  |  MQNot b1 ->
  42      not (is_good l b1)
  43  |  MQTrue ->
  44      true
  45  |  MQFalse ->
  46      false
  47  |  MQIs (s1, s2) ->
  48      (stringeval s1 l) = (stringeval s2 l)
  49 ;;
  50
  51 (*
  52  *
  53  *)
  54 let rec replace avar newval l =
  55  match l with
  56     MQAnd (b1, b2) -> MQAnd (replace avar newval b1, replace avar newval b2)
  57  |  MQOr (b1, b2)  -> MQOr  (replace avar newval b1, replace avar newval b2)
  58  |  MQNot b1       -> MQNot (replace avar newval b1)
  59  |  MQIs (s1, s2)  ->
  60      let ns1 = (
  61       match s1 with
  62          MQRVar v when v = avar      -> MQRVar newval
  63       |  MQFunc (f, v) when v = avar -> MQFunc (f, newval)
  64       |  _                           -> s1
  65      )
  66      and ns2 = (
  67       match s2 with
  68          MQRVar v when v = avar      -> MQRVar newval
  69       |  MQFunc (f, v) when v = avar -> MQFunc (f, newval)
  70       |  _                           -> s2
  71      )
  72      in
  73       MQIs (ns1, ns2)
  74  |  _              -> l (* i casi non compresi sono MQTrue e MQFalse *)
  75 ;;
  76
  77 let rec print_booltree b =
  78  match b with
  79     MQAnd (b1, b2) ->
  80      let i = print_booltree b1 in
  81       let j = print_string " AND " in
  82        print_booltree b2
  83  |  MQOr (b1, b2) ->
  84      let i = print_booltree b1 in
  85       let j = print_string " OR " in
  86        print_booltree b2
  87  |  MQNot b1 ->
  88      let j = print_string " NOT " in
  89       print_booltree b1
  90  |  MQTrue ->
  91      print_string " TRUE "
  92  |  MQFalse ->
  93      print_string " FALSE "
  94  |  MQIs (s1, s2) ->
  95      let s1v = match s1 with
  96         MQCons s ->
  97          "'" ^ s ^ "'"
  98      |  MQFunc (f, rvar) ->
  99         (
 100           match f with
 101            MQName -> "NAME " ^ rvar
 102         )
 103      |  MQRVar rvar ->
 104          rvar
 105      |  MQSVar svar ->
 106          svar
 107      |  MQMConclusion ->
 108          "MainConclusion"
 109      |  MQConclusion ->
 110          "InConclusion"
 111      and s2v = match s2 with
 112         MQCons s ->
 113          s
 114      |  MQFunc (f, rvar) ->
 115         (
 116           match f with
 117            MQName -> "NAME " ^ rvar
 118         )
 119      |  MQRVar rvar ->
 120          rvar
 121      |  MQSVar svar ->
 122          svar
 123      |  MQMConclusion ->
 124          "MainConclusion"
 125      |  MQConclusion ->
 126          "InConclusion"
 127      in
 128       print_string (s1v ^ " = " ^ s2v)
 129 ;;
 130
 131 (*
 132  * implementazione del comando SELECT
 133  *)
 134 let select_ex avar alist abool =
 135  let wrt = replace avar "retVal" abool in
 136  (*let j = print_booltree wrt in*)
 137   [List.hd alist]
 138   @
 139   List.find_all
 140    (fun l -> is_good (List.combine (List.hd alist) l) wrt)
 141    (List.tl alist)
 142 ;;
 143