aboutsummaryrefslogtreecommitdiff
path: root/Sil/Util
diff options
context:
space:
mode:
Diffstat (limited to 'Sil/Util')
-rw-r--r--Sil/Util/Parser.dcl33
-rw-r--r--Sil/Util/Parser.icl93
-rw-r--r--Sil/Util/Printer.dcl23
-rw-r--r--Sil/Util/Printer.icl105
4 files changed, 254 insertions, 0 deletions
diff --git a/Sil/Util/Parser.dcl b/Sil/Util/Parser.dcl
new file mode 100644
index 0000000..361fa83
--- /dev/null
+++ b/Sil/Util/Parser.dcl
@@ -0,0 +1,33 @@
+definition module Sil.Util.Parser
+
+from StdOverloaded import class ==
+
+from Control.Applicative import class Applicative, class Alternative
+from Control.Monad import class Monad
+from Data.Error import :: MaybeError
+from Data.Functor import class Functor
+
+from Sil.Parse import :: ParseError
+
+:: Parser a b = Parser ([a] -> (MaybeError ParseError b, [a]))
+
+instance Functor (Parser a)
+instance Applicative (Parser a)
+instance Monad (Parser a)
+instance Alternative (Parser a)
+
+class name a :: a -> String
+instance name String
+
+runParser :: (Parser a b) [a] -> (MaybeError ParseError b, [a])
+(<?>) :: (Parser a b) ParseError -> Parser a b
+fail :: Parser a b
+top :: Parser a a
+peek :: Parser a a
+satisfy :: (a -> Bool) -> Parser a a
+check :: (a -> Bool) -> Parser a a
+(until) infix 2 :: (Parser a b) (Parser a c) -> Parser a [b]
+item :: a -> Parser a a | ==, name a
+list :: [a] -> Parser a [a] | ==, name a
+seplist :: a (Parser a b) -> Parser a [b] | ==, name a
+eof :: Parser a ()
diff --git a/Sil/Util/Parser.icl b/Sil/Util/Parser.icl
new file mode 100644
index 0000000..f0895fe
--- /dev/null
+++ b/Sil/Util/Parser.icl
@@ -0,0 +1,93 @@
+implementation module Sil.Util.Parser
+
+import StdList
+import StdOverloaded
+
+import Control.Applicative
+import Control.Monad
+import Data.Error
+from Data.Func import $
+import Data.Functor
+import Data.List
+
+import Sil.Parse
+
+instance Functor (Parser a) where
+ fmap f m = liftM f m
+
+instance Applicative (Parser a) where
+ pure a = Parser \i -> (Ok a, i)
+ (<*>) sf p = ap sf p
+
+instance Monad (Parser a) where
+ bind p f = Parser \i -> case runParser p i of
+ (Ok r, rest) -> runParser (f r) rest
+ (Error e, _) -> (Error e, i)
+
+instance Alternative (Parser a) where
+ empty = Parser \i -> (Error UnknownError, i)
+ (<|>) p1 p2 = Parser \i -> case runParser p1 i of
+ (Ok r, rest) -> (Ok r, rest)
+ (Error e1, rest) -> case runParser p2 i of
+ (Error e2, rest) -> (Error e2, i)
+ (Ok r, rest) -> (Ok r, rest)
+
+instance name String where name s = s
+
+runParser :: (Parser a b) [a] -> (MaybeError ParseError b, [a])
+runParser (Parser f) i = f i
+
+(<?>) :: (Parser a b) ParseError -> Parser a b
+(<?>) p e = Parser \i -> case runParser p i of
+ (Error _, rest) -> (Error e, rest)
+ o -> o
+
+fail :: Parser a b
+fail = empty
+
+top :: Parser a a
+top = Parser \i -> case i of
+ [] = (Error UnknownError, [])
+ [x:xs] = (Ok x, xs)
+
+peek :: Parser a a
+peek = Parser \i -> case i of
+ [] = (Error UnknownError, [])
+ [x:xs] = (Ok x, [x:xs])
+
+satisfy :: (a -> Bool) -> Parser a a
+satisfy f = top >>= \r -> if (f r) (pure r) fail
+
+check :: (a -> Bool) -> Parser a a
+check f = peek >>= \r -> if (f r) (pure r) fail
+
+(until) infix 2 :: (Parser a b) (Parser a c) -> Parser a [b]
+(until) p guard = try $ until` p guard []
+where
+ until` :: (Parser a b) (Parser a c) [b] -> Parser a [b]
+ until` p guard acc = Parser \i -> case runParser guard i of
+ (Ok _, rest) -> (Ok acc, rest)
+ (Error _, _) -> case runParser p i of
+ (Ok r, rest) -> runParser (until` p guard [r:acc]) rest
+ (Error e, _) -> (Error e, i)
+
+ try :: (Parser a b) -> Parser a b
+ try p = Parser \i -> case runParser p i of
+ (Error e, _) -> (Error e, i)
+ (Ok r, rest) -> (Ok r, rest)
+
+item :: a -> Parser a a | ==, name a
+item a = satisfy ((==) a) <?> Expected (name a)
+
+list :: [a] -> Parser a [a] | ==, name a
+list as = mapM item as
+
+seplist :: a (Parser a b) -> Parser a [b] | ==, name a
+seplist sep p = liftM2 (\es e-> es ++ [e]) (some (p <* item sep)) p
+ <|> liftM pure p
+ <|> pure empty
+
+eof :: Parser a ()
+eof = Parser \i -> case i of
+ [] = (Ok (), [])
+ _ = (Error $ Expected "eof", i)
diff --git a/Sil/Util/Printer.dcl b/Sil/Util/Printer.dcl
new file mode 100644
index 0000000..1d8fc5c
--- /dev/null
+++ b/Sil/Util/Printer.dcl
@@ -0,0 +1,23 @@
+definition module Sil.Util.Printer
+
+from StdOverloaded import class toString, class zero
+
+from Sil.Parse import :: Token
+from Sil.Syntax import :: Program, :: Function, :: CodeBlock,
+ :: Initialisation, :: Statement, :: Type, :: Application, :: Literal
+
+:: PrintState
+
+instance zero PrintState
+
+class PrettyPrinter t where
+ print :: PrintState t -> String
+
+instance PrettyPrinter [Token]
+instance PrettyPrinter Program
+instance PrettyPrinter Function
+instance PrettyPrinter CodeBlock
+instance PrettyPrinter Initialisation
+instance PrettyPrinter Statement
+
+printersperse :: a [b] -> String | toString a & toString b
diff --git a/Sil/Util/Printer.icl b/Sil/Util/Printer.icl
new file mode 100644
index 0000000..2252ee4
--- /dev/null
+++ b/Sil/Util/Printer.icl
@@ -0,0 +1,105 @@
+implementation module Sil.Util.Printer
+
+import _SystemArray
+import StdEnum
+from StdFunc import id
+import StdInt
+import StdList
+import StdOverloaded
+import StdString
+
+from Data.Func import $
+import Data.List
+import Data.Maybe
+import Text
+
+import Sil.Parse
+import Sil.Syntax
+
+:: PrintState =
+ { indent :: Int
+ }
+
+instance zero PrintState where zero = {indent=0}
+
+incIndent :: PrintState -> PrintState
+incIndent ps = {ps & indent=inc ps.indent}
+
+decIndent :: PrintState -> PrintState
+decIndent ps = {ps & indent=dec ps.indent}
+
+instance toString PrintState where toString st = {'\t' \\ _ <- [1..st.indent]}
+
+instance PrettyPrinter [Token]
+where
+ print st [] = ""
+ print st [t] = toString t
+ print st [t:ts=:[t`:_]] = toString t +++ spaceBetween t t` +++ print st` ts
+ where
+ st` = {st & indent=indent`}
+ indent` = newIndent t t` st.indent
+
+ spaceBetween :: Token Token -> String
+ spaceBetween _ TBraceClose = newline
+ spaceBetween TParenOpen _ = ""
+ spaceBetween TParenClose TBraceOpen = space
+ spaceBetween TParenClose _ = ""
+ spaceBetween TBraceOpen _ = newline
+ spaceBetween TBraceClose _ = newline
+ spaceBetween TComma _ = space
+ spaceBetween TSemicolon _ = newline
+ spaceBetween TAssign _ = space
+ spaceBetween (TLit _) _ = space
+ spaceBetween TIf _ = space
+ spaceBetween TWhile _ = space
+ spaceBetween TReturn _ = space
+ spaceBetween (TName _) TParenClose = ""
+ spaceBetween (TName _) TSemicolon = ""
+ spaceBetween (TName _) _ = space
+
+ newline = "\r\n" +++ {'\t' \\ _ <- [1..indent`]}
+ space = " "
+
+ newIndent :: Token Token -> Int -> Int
+ newIndent TBraceOpen _ = inc
+ newIndent _ TBraceClose = dec
+ newIndent _ _ = id
+
+instance PrettyPrinter Program
+where
+ print st prog = p st prog.p_funs
+ where
+ p :: PrintState [Function] -> String
+ p _ [] = ""
+ p st [f] = print st f
+ p st [f:fs] = print st f <+ "\r\n\r\n" <+ p st fs
+
+instance PrettyPrinter Function
+where
+ print st f = st <+ f.f_type <+ " " <+ f.f_name
+ <+ "(" <+ printersperse ", " f.f_args <+ ") {\r\n"
+ <+ print {st & indent=st.indent+1} f.f_code <+ "\r\n" <+ st <+ "}"
+
+instance PrettyPrinter CodeBlock
+where
+ print st cb = concat $ intersperse "\r\n" $
+ [print st x \\ x <- cb.cb_init] ++ [print st x \\ x <- cb.cb_content]
+
+instance PrettyPrinter Initialisation
+where
+ print st init = st <+ init.init_type <+ " " <+ init.init_name <+ ";"
+
+instance PrettyPrinter Statement
+where
+ print st (If c t Nothing) = st <+ "if (" <+ c <+ ") {\r\n" <+
+ print (incIndent st) t <+ "\r\n" <+ st <+ "}"
+ print st (If c t (Just e)) = st <+ "if (" <+ c <+ ") {\r\n" <+
+ print st` t <+ "\r\n" <+ st <+ "} else {\r\n" <+
+ print st` e <+ "\r\n" <+ st <+ "}"
+ where st` = incIndent st
+ print st stm = st <+ stm
+
+printersperse :: a [b] -> String | toString a & toString b
+printersperse _ [] = ""
+printersperse _ [x] = toString x
+printersperse g [x:xs] = x <+ g <+ printersperse g xs
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-12 20:04:20 +0000