Hello Kashyap I can do MSL and Region, maybe I did the parser combinators but I can't find them at the moment. I tried to keep the code close to the original SML, so as Haskell code its not pretty. Not having quasiquote was a problem. Best wishes Stephen -------------------------------------------------------------------------------- -- MSL module MSL where type Expr = String type Predicate = Expr type Statement = String type Fieldname = String data Bitsource = Source Expr Expr deriving Show newbitsource a i = Source a i initbs (Source _ i) = i ++ " = 0;" getByte (Source a i) = a ++ "[" ++ i ++ "/8]" getNthByte :: Bitsource -> Int -> Expr getNthByte (Source a i) n | n == 0 = a ++ "[" ++ i ++ "/8]" | otherwise = a ++ "[" ++ i ++ "/8+" ++ show n ++ "]" advanceByte (Source a i) = i ++ " = " ++ i ++ "-(" ++ i ++ "%8)+8;" advanceNBytes (Source a i) n | n == 0 = "" | otherwise = i ++ " = " ++ i ++ "-(" ++ i ++ "%8)+(8*" ++ show n++");" data Recordfield = Field Expr [Fieldname] deriving Show recordptr :: Expr -> Recordfield recordptr e = Field e [] subfield :: Recordfield -> Fieldname -> Recordfield subfield (Field e fl) f = Field e (f:fl) deref :: Recordfield -> Expr deref (Field e fl) = "(*" ++e++ ")" ++ concat ( map cojoin (reverse fl) ) where cojoin :: Fieldname -> String cojoin s = "." ++ s type Message = Bitsource -> Recordfield -> Statement -> Statement infield :: Fieldname -> Message -> Message infield f m src tgt = m src (subfield tgt f) c_if :: Expr -> Statement -> Statement -> Statement c_if e s1 s2 = if e=="1" || e=="(1)" then s1 else "if("++e++"){" ++ s1 ++ "}" ++ if s2 /= "" then "else {" ++ s2 ++ "}" else "" seqmsg :: [Message] -> Message seqmsg (m:ml) src tgt s = (m src tgt "error_action();") ++ (seqmsg ml src tgt s) seqmsg [] _ _ _ = "" asc2Int :: Int -> (Int,Int) -> Message asc2Int w (lo,hi) src tgt s = c_if ("inrange(" ++ (getByte src) ++ ", " ++ (ms w) ++ ", " ++ (ms lo) ++ ", " ++ (ms hi)) "" s where ms n = show n alt :: [Message] -> Message alt (m:ml) src tgt s = m src tgt (alt ml src tgt s) delim :: Expr -> Message delim e src tgt s = "if (" ++ getByte src ++ " == " ++ e ++")" ++ advanceByte src rangex :: Int -> Int -> [Int] rangex i j | i > j = [] | otherwise = (i:(rangex (i+1) j)) c_and [] = "" c_and [pred] = "(" ++ pred ++ ")" c_and (pred1:pred2:preds) = "(" ++ pred1 ++ " && " ++ c_and (pred2:preds) ++ ")" asc :: String -> String -> Message asc chars value src tgt s = c_if "" (deref tgt ++ " == " ++ value ++ ";" ) s skip :: Int -> Message skip n src tgt s = (deref tgt) ++ "= 1;" ++ (advanceNBytes src n) -------------------------------------------------------------------------------- bs = newbitsource "A" "bit" f = recordptr "target" main = delim "6" bs f "abort();" to_confidence = alt [ asc "HH" "High" , asc "MM" "Medium" , asc "LL" "Low" , asc "NN" "None" ] -------------------------------------------------------------------------------- -- Region -- This one doesn't work properly - -- CPoints are difficult to manipulate as strings, hence the `hasVar` -- problems, it gives some idea of the method though. module Region where import Data.Char ( isAlpha ) import Data.List ( foldl' ) -- Prolog type CExpr = String type CPred = String type CFloat = Float infixr 6 ++& (++&) :: Show a => String -> a -> String s ++& a = s ++ show a sqrdist _ = "" add :: CPoint -> CPoint -> CPoint add a b = a ++ "+" ++ b sub :: CPoint -> CPoint -> CPoint sub a b = a ++ "-" ++ b hasVar :: CExpr -> Bool hasVar = any isAlpha cfst :: CPoint -> CExpr cfst a | hasVar a = a ++ ".x" | otherwise = "1.1" csnd :: CPoint -> CExpr csnd a | hasVar a = a ++".y" | otherwise = "2.2" pt :: (CFloat,CFloat) -> CPoint pt = show intersect :: [Region] -> Region intersect (r:rs) = foldl' (/\) r rs intersect [] = error $ "intersect on empty list" -- presentation type CPoint = CExpr type Region = CPoint -> CPred circle :: CFloat -> Region circle n = \p -> "(" ++ sqrdist p ++ "<" ++& n ++ "*" ++& n ++ ")" halfplane :: CPoint -> CPoint -> Region halfplane a b = \p -> "(" ++ zcross (a `sub` p) (b `sub` a) ++ " > 0.0)" where zcross e1 e2 = "(" ++ cfst e1 ++ "*" ++ csnd e2 ++ "-" ++ csnd e2 ++ "*" ++ cfst e1 ++ ")" (/\) :: Region -> Region -> Region r1 /\ r2 = \p -> "(" ++ r1 p ++ " && " ++ r2 p ++ ")" (\/) :: Region -> Region -> Region r1 \/ r2 = \p -> "(" ++ r1 p ++ " || " ++ r2 p ++ ")" at :: Region -> CPoint -> Region r `at` p0 = \p -> r (p `sub` p0) convexPoly :: [CPoint] -> Region convexPoly (p:ps) = intersect (zipWith halfplane ([p] ++ ps) (ps ++ [p])) tightZone :: CPoint -> CPred tightZone = (convexPoly [pt (0.0,5.0), pt (118.0,32.0), pt (118.0,62.0), pt (0.0,25.0) ]) \/ (convexPoly [pt (118.0,32.0), pt (259.0,5.0), pt (259.0, 25.0), pt (118.0,62.0)]) main = tightZone e1 where e1::CExpr e1 = "p"