Lahenda constraint praktikumis

Author: sim642

src/constraint/abseval/constraint_abseval.ml

@@ -14,7 +14,15 @@ struct
       Vihje: Abseval.eval_expr.
       Vihje: Abseval.eval_guard. *)
   let eval_edge (env: ED.t) (edge: Cfg.Edge.t): ED.t =
-    failwith "TODO"
+    match edge with
+    | Nop -> env
+    | Assign (x, e) -> ED.add x (eval_expr env e) env
+    | Error ->
+      if ED.equal env ED.bot then
+        ED.bot
+      else
+        failwith "eval_edge: Error"
+    | Guard (c, b) -> eval_guard env c b
 
 
   (** Võrrandisüsteem juhtvoograafiga defineeritud programmi jaoks. *)
@@ -36,6 +44,16 @@ struct
         Vihje: Cfg.pred.
         Vihje: eval_edge. *)
     let f (node: V.t) (get: V.t -> D.t): D.t =
-      failwith "TODO"
+      let initial_env =
+        if V.equal node cfg.entry then
+          entry_env
+        else
+          D.bot
+      in
+      Cfg.pred cfg node
+      |> List.map (fun (edge, prev_node) ->
+          eval_edge (get prev_node) edge
+        )
+      |> List.fold_left D.join initial_env
   end
 end

src/constraint/grammar/constraint_grammar.ml

@@ -8,7 +8,8 @@ end
 
 (** Näited. *)
 
-(** T → R
+(**T' → T$
+    T → R
     T → aTc
     R →
     R → bR
@@ -35,7 +36,9 @@ struct
     (** Nullable võrrandite paremad pooled.
         Järgi täpselt grammatikat ja ära ise lihtsusta! *)
     let f (nt: V.t) (get: V.t -> D.t): D.t =
-      failwith "TODO"
+      match nt with
+      | T -> get R || (false && get T && false)
+      | R -> true || (false && get R)
   end
 
   (** FIRST võrrandisüsteem. *)
@@ -53,7 +56,9 @@ struct
         Vihje: D.singleton.
         Vihje: D.join. *)
     let f (nt: V.t) (get: V.t -> D.t): D.t =
-      failwith "TODO"
+      match nt with
+      | T -> D.join (get R) (D.singleton 'a')
+      | R -> D.join D.empty (D.singleton 'b')
   end
 
   (** FOLLOW võrrandisüsteem. *)
@@ -72,7 +77,15 @@ struct
         Järgi täpselt grammatikat ja ära ise lihtsusta!
         Vihje: join_list. *)
     let f (nt: V.t) (get: V.t -> D.t): D.t =
-      failwith "TODO"
+      match nt with
+      | T -> join_list [
+          D.singleton '$';
+          D.singleton 'c'
+        ]
+      | R -> join_list [
+          get T;
+          get R
+        ]
   end
 end