initial commit

Dochi/Main.hs

@@ -0,0 +1,67 @@
+module Main where
+
+import System.IO
+import System.Environment
+import System.Console.GetOpt
+
+import Parse
+
+
+
+-- filename utils
+
+basename = reverse . dropWhile (== '.') . dropWhile (/= '.') . reverse
+addslash dir = if ((head $ reverse dir) == '/') then dir else (dir ++ "/")
+
+
+
+-- options
+
+data Options = Options { make :: Bool
+                       , debug :: Bool
+                       , verbose :: Bool }
+
+
+defaultOptions = Options { make = False
+                         , debug = False
+                         , verbose = False }
+
+options :: [OptDescr (Options -> Options)]
+options = [ Option ['m'] ["make"] (NoArg (\o -> o {make=True})) "Compile input"
+          , Option [] ["debug"] (NoArg (\o -> o {debug=True})) "Debug info"
+          , Option ['v'] ["verbose"] (NoArg (\o -> o {verbose=True})) "Verbose mode" ]
+
+getopts :: [String] -> IO (Options, [String])
+getopts args = 
+    case getOpt Permute options args of
+      (o,n,[]) -> return (foldl (flip id) defaultOptions o, n)
+      (_,_,errs) -> error $ concat errs ++ usageInfo header options
+
+header = "Usage: dochi [OPTION...] input"
+
+
+-- main entry
+
+main = do
+  args <- getArgs
+  (opts, files) <- getopts args
+
+  case (length files) of
+    0 -> interactive
+    _ -> mapM_ runFile files
+
+
+-- interactive
+
+interactive :: IO ()
+interactive =  putStrLn "interactive"
+
+
+-- run file
+
+runFile :: String -> IO ()
+runFile name = do
+  content <- readFile name
+  case (dochiParse name content) of
+    Left err -> hPrint stderr err >> error "Parse Error"
+    Right p -> putStrLn $ show p

Dochi/Parse.hs

@@ -0,0 +1,62 @@
+module Parse (AST(..), Prog, dochiParse) where
+
+import Text.ParserCombinators.Parsec
+import qualified Data.Map as M
+
+
+data AST = Word String
+         | CodeBlock [AST]
+         | LArray [AST]
+         | LString String
+         | LInteger Integer
+         | Capture [String]
+           deriving (Show)
+
+type Prog = M.Map String AST
+
+type ChiParser a = GenParser Char () a
+
+
+
+idletter = (alphaNum <|> oneOf "_-+?!/\\*<>=.") <?> ""
+identifier = (many1 idletter) <?> "identifier"
+
+litInt :: ChiParser AST
+litInt = i1 <?> "integer"
+    where i1 = do i <- many1 digit
+                  notFollowedBy idletter
+                  return $ LInteger $ read i
+
+litStr :: ChiParser AST
+litStr = (s1 <?> "string")
+    where s1 = (char '"') >> (manyTill anyChar $ char '"') >>= (return . LString)
+
+lexCap :: ChiParser AST
+lexCap = do char '|'
+            spaces
+            v <- sepEndBy identifier spaces
+            char '|'
+            return $ Capture v
+
+word :: ChiParser AST
+word = (identifier <?> "word") >>= (return . Word)
+
+codeQuot :: ChiParser AST
+codeQuot = do char '['
+              spaces
+              v <- manyTill value $ char ']'
+              return $ CodeBlock v
+
+litArr :: ChiParser AST
+litArr = do char '{'
+            spaces
+            v <- manyTill value $ char '}'
+            return $ LArray v
+
+value :: ChiParser AST
+value = do v <- (try litInt <|> (litStr <|> word <|> codeQuot <|> litArr <|> lexCap))
+           spaces
+           return v
+
+dochiParse :: String -> String -> Either ParseError AST
+dochiParse name content = runParser (spaces >> value) () name content

Makefile

@@ -0,0 +1,6 @@
+
+dochi: Dochi/Main.hs Dochi/Parse.hs
+	ghc --make -iDochi Main -o dochi
+
+clean:
+	rm Dochi/*.hi Dochi/*.o dochi

test.chi

@@ -0,0 +1,9 @@
+
+def hello |i| i i *
+
+def goodbye |j| j j +
+
+def adding
+    1 + |addone|
+    2 + |addtwo|
+    addone addtwo +