diff options
| -rw-r--r-- | LaTeX.dcl | 15 | ||||
| -rw-r--r-- | LaTeX.icl | 41 | ||||
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | Smurf.dcl | 7 | ||||
| -rw-r--r-- | Smurf.icl | 105 | ||||
| -rw-r--r-- | tree.icl | 9 |
6 files changed, 173 insertions, 6 deletions
diff --git a/LaTeX.dcl b/LaTeX.dcl new file mode 100644 index 0000000..cbccf4c --- /dev/null +++ b/LaTeX.dcl @@ -0,0 +1,15 @@ +definition module LaTeX +// This module is more flexible than Text.LaTeX + +from StdOverloaded import class toString + +:: LaTeX = Command !String ![LaTeX] + | Environment !String ![LaTeX] + | Text !String + | Raw !String + | Math !Bool /* double $ */ ![LaTeX] + | List ![LaTeX] + +class toLaTeX a :: !a -> LaTeX + +instance toString LaTeX diff --git a/LaTeX.icl b/LaTeX.icl new file mode 100644 index 0000000..fba573e --- /dev/null +++ b/LaTeX.icl @@ -0,0 +1,41 @@ +implementation module LaTeX + +from StdFunc import seq +from StdList import ++, map +from StdOverloaded import class toString(..), class +++(..) +from StdString import instance +++ {#Char} + +from Text import class Text(replaceSubString,concat), instance Text String + +instance toString [a] | toString a +where toString xs = concat (map toString xs) + +instance toString LaTeX +where + toString (Command "justifies" []) = "\n\\justifies{}" + toString (Command cmd lts) = "\\" +++ cmd +++ + concat ["{" +++ toString lt +++ "}" \\ lt <- lts] + toString (Environment env lt) = toString + ([Command "begin" [Text env]] ++ lt ++ [Command "env" [Text env]]) + toString (Math True lt) = "$$" +++ toString lt +++ "$$" + toString (Math False lt) = "$" +++ toString lt +++ "$" + toString (List lts) = concat (map toString lts) + toString (Raw s) = s + toString (Text s) = escape s + where + escape :: !String -> String // From Text.LaTeX + escape s = seq (map (\(x,y) -> replaceSubString x y) escape`) s + where + escape` = [ ("\\", "\\textbackslash{}") + , ("^", "\\textasciicircum{}") + , ("~", "\\textasciitilde{}") + , ("*", "\\textasteriskcentered{}") + , ("|", "\\textbar{}") + , ("$", "\\textdollar{}") + , (">", "\\textgreater{}") + , ("<", "\\textless{}") + , ("\"", "\\textquotedblright{}") + , ("'", "\\textquoteright{}") + , ("_", "\\textunderscore{}") + , ("&", "\\&{}") + ] @@ -1,6 +1,6 @@ CPM=cpm OBJ=run tree -DEPS=Smurf.dcl Smurf.icl SmurfParse.dcl SmurfParse.icl +DEPS=Smurf.dcl Smurf.icl SmurfParse.dcl SmurfParse.icl LaTeX.dcl LaTeX.icl all: $(OBJ) @@ -10,6 +10,8 @@ from GenEq import generic gEq from Data.Maybe import ::Maybe +from LaTeX import class toLaTeX + :: Stm = Push String | Input | Output | Cat | Head | Tail | Quotify @@ -30,7 +32,7 @@ from Data.Maybe import ::Maybe , output :: [String] } -:: Transition = (-->) infix 1 (Program, [String], State) ([String], [String], State) +:: Transition = (-->) infix 1 (Program, Stack, State) (Stack, Stack, State) :: DerivationTree :== [Transition] derive gEq Stm @@ -48,6 +50,9 @@ instance zero ListIO instance toString Transition instance toString DerivationTree +instance toLaTeX Transition +instance toLaTeX DerivationTree + step :: !Program State u:io u:(IO u:io) -> u:(Maybe (!Program, State), u:io) run :: !Program State io (IO io) -> (Maybe State, io) @@ -18,6 +18,7 @@ import GenEq import GenPrint import SmurfParse +import LaTeX derive gEq Stm derive gPrint (,) @@ -81,8 +82,110 @@ where = simple i (take i pgm) +++ ":..." instance toString DerivationTree +where toString ts = concat $ intersperse "\n" $ map toString $ reverse ts + +instance toLaTeX Stm +where + toLaTeX (Push s) = List [Command "StmPush" [], Raw "~", sToLaTeX s] + toLaTeX Input = Command "StmInput" [] + toLaTeX Output = Command "StmOutput" [] + toLaTeX Cat = Command "StmCat" [] + toLaTeX Head = Command "StmHead" [] + toLaTeX Tail = Command "StmTail" [] + toLaTeX Quotify = Command "StmQuotify" [] + toLaTeX Put = Command "StmPut" [] + toLaTeX Get = Command "StmGet" [] + toLaTeX Exec = Command "StmExec" [] + +instance toLaTeX Program +where + toLaTeX [] = Command "lambda" [] + toLaTeX pgm = List $ intersperse (Text ":") (map toLaTeX pgm) + +instance toLaTeX String where toLaTeX s = Text s + +instance toLaTeX Store +where + toLaTeX [] = Command "emptyset" [] + toLaTeX ass + = List + ([Command "{" []] ++ + intersperse (Raw ",") (map assToLaTeX ass) ++ + [Command "}" []]) + where + assToLaTeX :: (String,String) -> LaTeX + assToLaTeX (var,val) + = List + [ sToLaTeX var + , Command "mapsto" [] + , sToLaTeX val + ] + +instance toLaTeX State +where + toLaTeX {stack,store} + = List + [ Command "left" [] + , Raw "(" + , stackToLaTeX stack + , Raw "," + , toLaTeX store + , Command "right" [] + , Raw ")" + ] + +instance toLaTeX Transition +where + toLaTeX ((p1,ip1,st1) --> (ip2,op,st2)) + = Command "trans" + [ toLaTeX p1 + , stackToLaTeX ip1 + , toLaTeX st1 + , stackToLaTeX ip2 + , stackToLaTeX op + , toLaTeX st2 + ] + +stackToLaTeX :: [String] -> LaTeX +stackToLaTeX ss + = List $ intersperse (Text ":") (map sToLaTeX ss ++ [Command "Nil" []]) + +sToLaTeX :: String -> LaTeX +sToLaTeX s = Command "texttt" [List [Raw "\"", Text s, Raw "\""]] + +instance toLaTeX DerivationTree where - toString ts = concat $ intersperse "\n" $ map toString $ reverse ts + toLaTeX ts = toL ts + where + toL :: DerivationTree -> LaTeX + toL [] = List [] + toL [t] + = List + [ Command "axjustifies" [] + , toLaTeX t + , Command "using" [Command "rlambdans" []] + ] + toL [t=:((p1,_,_)-->_):ts] + = List + [ Command "[" [] + , toL ts + , Command "]" [] + , Command "justifies" [] + , toLaTeX t + , Command "using" [Command rule []] + ] + where + rule = case p1 of + [Push _:_] = "rpushns" + [Input:_] = "rinputns" + [Output:_] = "routputns" + [Cat:_] = "rcatns" + [Head:_] = "rheadns" + [Tail:_] = "rtailns" + [Quotify:_] = "rquotifyns" + [Put:_] = "rputns" + [Get:_] = "rgetns" + [Exec:_] = "rexecns" run :: !Program State io (IO io) -> (Maybe State, io) run prog st io iofuncs @@ -1,6 +1,6 @@ module tree -import StdEnv +import StdEnv, StdDebug import Data.Maybe, Data.List from Data.Func import $ @@ -9,15 +9,18 @@ import System.CommandLine, System.GetOpt import Smurf import SmurfParse +import LaTeX Start w # (_,f,w) = fopen "reverse.smf" FReadText w # (pgm,f) = readFile f # (ok,w) = fclose f w # (Just pgm) = parse [c \\ c <-: pgm] -= toString (devtree pgm) +# tree = devtree pgm +# tree = trace (toString tree +++ "\n") tree += toString (toLaTeX tree) where - devtree pgm = fromJust (tree pgm zero {zero & input = ["reverse"]} listIO) + devtree pgm = fromJust (tree pgm zero { zero & input = [""] } listIO) readFile :: !*File -> *(!String, !*File) readFile f |