Latex & Html output options

1 files changed, 92 insertions, 42 deletions

diff --git a/Logic.icl b/Logic.icl
index dabc71d..97d8df5 100644
--- a/Logic.icl
+++ b/Logic.icl
@@ -23,7 +23,7 @@
  */
 implementation module Logic
 
-import StdEnv, StringUtils
+import StdEnv, StdMaybe, StringUtils
 
 isBool  :: Expr -> Bool
 isBool (B _) = True
@@ -73,50 +73,51 @@ apply2 x Or y = x || y
 apply2 x Impl y = y || not x
 apply2 x Equiv y = x == y
 
-instance toString Op1
+instance == OutputOption
 where
-    toString Not = "~"
+    (==) Plain Plain = True
+    (==) Html Html = True
+    (==) LaTeX LaTeX = True
+    (==) _ _ = False
 
-instance toString Op2
+instance show Bool
 where
-    toString And = "&"
-    toString Or = "|"
-    toString Impl = "->"
-    toString Equiv = "<->"
+    show LaTeX True     = "\\top"
+    show LaTeX False    = "\\bot"
+    show _ b            = toString b
 
-instance toString Expr
+instance show Char
 where
-    toString (B b) = toString b
-    toString (Atom a) = toString a
-    toString (App1 op e)
-    | needs_parentheses (App1 op e) = toString op +++ "(" +++ toString e +++ ")"
-    | otherwise = toString op +++ toString e
-    toString (App2 e1 op e2) = e1` +++ " " +++ toString op +++ " " +++ e2`
-    where
-        e1`
-        | needs_parentheses_left (App2 e1 op e2) = "(" +++ toString e1 +++ ")"
-        | otherwise = toString e1
-        e2`
-        | needs_parentheses_right (App2 e1 op e2) = "(" +++ toString e2 +++ ")"
-        | otherwise = toString e2
-
-instance toString TruthTable
+    show LaTeX c        = " " +++ toString c
+    show _ c            = toString c
+
+instance show Op1
 where
-    toString t=:{exprs,options}
-        = row_b +++ join row_s [pad_right ' ' head len \\ head <- map toString exprs & len <- padlens] +++ row_e +++
-          line_b +++ join line_s [toString (repeatn len '-') \\ len <- padlens] +++ line_e +++
-          foldr (+++) "" [row_b +++ join row_s [pad_right ' ' (toStringOrEmpty val) len \\ val <- map (eval o substitute_all options`) exprs & len <- padlens] +++ row_e \\ options` <- options]
-    where
-        row_b = " "     // Row / Line begin, end, separator
-        row_e = " \n"
-        row_s = " | "
-        line_b = "-"
-        line_e = "-\n"
-        line_s = "-+-"
-        padlens = map ((max 5) o strlen o toString) exprs // 5 is the length of False
-        toStringOrEmpty :: [Bool] -> String
-        toStringOrEmpty [] = ""
-        toStringOrEmpty [b:bs] = toString b
+    show Plain Not      = "~"
+    show Html Not       = "&not;"
+    show LaTeX Not      = "\\neg"
+
+instance show Op2
+where
+    show Plain And      = "&"
+    show Plain Or       = "|"
+    show Plain Impl     = "->"
+    show Plain Equiv    = "<->"
+    show Html And       = "&and;"
+    show Html Or        = "&or;"
+    show Html Impl      = "&rarr;"
+    show Html Equiv     = "&harr;"
+    show LaTeX And      = "\\land"
+    show LaTeX Or       = "\\lor"
+    show LaTeX Impl     = "\\rightarrow"
+    show LaTeX Equiv    = "\\leftrightarrow"
+
+instance show Expr
+where
+    show opt (B b)              = show opt b
+    show opt (Atom a)           = show opt a
+    show opt (App1 op e)        = show opt op +++ show opt e
+    show opt (App2 e1 op e2)    = show opt e1 +++ " " +++ show opt op +++ " " +++ show opt e2
 
 instance == Op1
 where
@@ -175,7 +176,7 @@ where
         comp e1 e2 
         | isMember e1 (subexprs e2) = True
         | isMember e2 (subexprs e1) = False
-        | otherwise = strlen (toString e1) < strlen (toString e2)
+        | otherwise = strlen (show Plain e1) < strlen (show Plain e2)
 
 // Does a the argument of a unary operator need parentheses?
 needs_parentheses :: Expr -> Bool
@@ -256,6 +257,55 @@ simple_truthtable_n es = {exprs = removeDup ([Atom a \\ a <- flatten (map all_at
 truthtable :: Expr -> TruthTable
 truthtable e = {exprs = sorted_subexprs e ++ [e], options = all_atom_options e}
 
+truthtable_n :: [Expr] -> TruthTable
+truthtable_n es = {exprs = sort (removeDup (flatten ([[e:subexprs e] \\ e <- es]))), options = removeDup (flatten (map all_atom_options es))}
+
+compute :: TruthTable -> FilledTruthTable   // Fill in a truthtable
+compute table=:{exprs,options} = {table=table, values=values}
+where
+    values = [[toMaybeBool val \\ val <- map (eval o substitute_all options`) exprs] \\ options` <- options]
+    toMaybeBool [] = Nothing
+    toMaybeBool [b:bs] = Just b
+
+instance show FilledTruthTable
+where
+    show :: OutputOption FilledTruthTable -> String
+    show opt t=:{table=table=:{exprs,options},values} 
+        = begin +++
+          head_b +++ 
+            join head_s [pad_right (showOrNot head_i) header len \\ header <- map (show opt) exprs & len <- padlens] +++ 
+            head_e +++
+          line_b +++ 
+            join line_s [foldr (+++) "" (repeatn len (showOrNot line_i)) \\ len <- padlens] +++ 
+            line_e +++
+          foldr (+++) "" [row_b +++ join row_s [pad_right (showOrNot row_i) (showOrNot v) len \\ v <- r & len <- padlens] +++ row_e \\ r <- values] +++
+          end
+    where
+        padlens = map ((\l . maxList (map strlen [l,show opt True,show opt False])) o (show opt)) exprs
+        // Ideally, we would some kind of DOM writer for Html, but for this project this is sufficient (although not very readable)
+        (begin,end) = gen
+        gen
+        | opt == Plain = ("","")
+        | opt == Html  = ("<table>", "</tbody></table>")
+        | opt == LaTeX = ("\\begin{tabular}{" +++ join "|" (repeatn (length exprs) "c") +++ "}", "\\end{tabular}")
+        (head_b,head_e,head_s,head_i) = head
+        head
+        | opt == Html = ("<thead><tr><th>", "</th></tr></thead><tbody>", "</th><th>", Nothing)
+        | otherwise = row
+        (row_b,row_e,row_s,row_i) = row
+        row
+        | opt == Plain = (" ", " \n", " | ", Just ' ')
+        | opt == Html  = ("<tr><td>", "</td></tr>", "</td><td>", Nothing)
+        | opt == LaTeX = ("$", "$\\\\", "$&$", Nothing)
+        (line_b,line_e,line_s,line_i) = line
+        line
+        | opt == Plain = ("-", "-\n", "-+-", Just '-')
+        | opt == Html  = ("", "", "", Nothing)
+        | opt == LaTeX = ("\\hline", "", "", Nothing)
+        showOrNot :: (Maybe a) -> String | show a
+        showOrNot Nothing = ""
+        showOrNot (Just a) = show opt a
+
 NOT     :== '~'
 AND     :== '&'
 OR      :== '|'
@@ -313,7 +363,7 @@ where
         parse_stack` :: [Char] [Expr] -> Expr
         parse_stack` [] [e] = e
         parse_stack` [] [] = abort "Cannot parse: not enough expressoins on the stack"
-        parse_stack` [] es = abort ("Cannot parse: too many expressions on the stack:\n" +++ join "\n" (map toString es) +++ "\n")
+        parse_stack` [] es = abort ("Cannot parse: too many expressions on the stack:\n" +++ join "\n" (map (show Plain) es) +++ "\n")
         parse_stack` [AND:st] [e1:[e2:es]]   = parse_stack` st [App2 e2 And e1:es]
         parse_stack` [OR:st] [e1:[e2:es]]    = parse_stack` st [App2 e2 Or e1:es]
         parse_stack` [IMPL:st] [e1:[e2:es]]  = parse_stack` st [App2 e2 Impl e1:es]
@@ -322,7 +372,7 @@ where
         parse_stack` [c:st] es
         | cIsAtom [c] = parse_stack` st [Atom (cToAtom [c]) : es]
         | cIsBool [c] = parse_stack` st [B (cToBool [c]) : es]
-        parse_stack` [c:st] es = abort ("Cannot parse: tried to perform an operation (" +++ toString c +++ ") with too few expressions on the stack:\n" +++ join "," (map toString es) +++ "\n")
+        parse_stack` [c:st] es = abort ("Cannot parse: tried to perform an operation (" +++ show Plain c +++ ") with too few expressions on the stack:\n" +++ join "," (map (show Plain) es) +++ "\n")
 
     cIsOp :: [Char] -> Bool
     cIsOp ['~'] = True