diff --git a/DDC/Interface/Input.hs b/DDC/Interface/Input.hs new file mode 100644 --- /dev/null +++ b/DDC/Interface/Input.hs @@ -0,0 +1,189 @@ + +module DDC.Interface.Input + ( InputInterface (..) + , InputState (..) + , Input (..) + , readInput + , inputLine) +where +import DDC.Interface.Source +import DDC.Data.ListUtils +import System.Directory +import Data.List +import Data.Char + + +-- InputState ----------------------------------------------------------------- +-- Interpreter input state +data InputState command + = InputState + { -- Function to parse commands. + inputParseCommand :: String -> Maybe (command, String) + + -- Input mode. + , inputMode :: Input + + -- Command that we're still receiving input for, + -- along with the line number it started on. + , inputCommand :: Maybe (Maybe command, Int) + + + -- The current line number in the command stream. + , inputLineNumber :: Int + + -- Accumulation of current input buffer. + , inputAcc :: String } + + +-- InputInterface ------------------------------------------------------------- +-- | What interface is being used. +data InputInterface + -- | Read commands from unix command-line args. + = InputInterfaceArgs + + -- | Read commands interactively from the console. + | InputInterfaceConsole + + -- | Read commands from the file with this name. + | InputInterfaceBatch FilePath + deriving (Eq, Show) + + +-- Input ---------------------------------------------------------------------- +-- | How we're reading the current expression. +data Input + -- | Read input line-by-line, using a backslash at the end of the + -- line to continue to the next. + = InputLine + + -- | Read input as a block terminated by a double semicolon (;;) + | InputBlock + + -- | Read input from a file specified on the prompt + | InputFile FilePath + deriving (Eq, Show) + + +-- | Read the input mode from the front of a string. +readInput :: String -> (Input, String) +readInput ss + | isPrefixOf ".." ss + = (InputBlock, drop 2 ss) + + | isPrefixOf "<" ss + , filePath <- dropWhile isSpace (drop 1 ss) + = (InputFile filePath, drop (length filePath) ss) + + | otherwise + = (InputLine, ss) + +------------------------------------------------------------------------------- +inputLine + :: InputInterface + -> InputState c + -> String + -> IO ( InputState c + , Maybe (Source, Maybe c, String)) + -- Just for complete command. + -- .. then Maybe for the default command. + +inputLine interface inputState chunk + | InputState readCmd mode mCommand lineNumber acc <- inputState + = do + -- If this is the first line then try to read the command and + -- input mode from the front so we know how to continue. + -- If we can't read an explicit command then assume this is + -- an expression to evaluate. + let (cmd, lineStart, (input, rest)) + = case mCommand of + -- We haven't started a command yet. + Nothing + -> case readCmd chunk of + Just (cmd', rest') -> (Just cmd', lineNumber, readInput rest') + Nothing -> (Nothing, lineNumber, (InputLine, chunk)) + + -- We've already started a command, and this is more input for it. + Just (cmd', lineStart') + -> (cmd', lineStart', (mode, chunk)) + + let source + -- We were instructed to read the program from a file. + -- Report this file as the source location, independent + -- of how we were instructed to read it. + | InputFile filePath <- input + = SourceFile filePath + + -- The program was embedded in the command stream. + | otherwise + = case interface of + InputInterfaceArgs -> SourceArgs + InputInterfaceConsole -> SourceConsole lineStart + InputInterfaceBatch file -> SourceBatch file lineStart + + + case input of + -- For line-by-line mode, if the line ends with backslash then keep + -- reading, otherwise run the command. + -- We also convert the backslash to a newline so the source + -- position comes out right in parser error messages. + InputLine + | not $ null rest + , last rest == '\\' + , Just initRest <- takeInit rest + -> return ( inputState + { inputCommand = (Just (cmd, lineStart)) + , inputLineNumber = lineNumber + 1 + , inputAcc = acc ++ initRest ++ "\n" } + , Nothing) + + | otherwise + -> return ( inputState + { inputMode = InputLine + , inputCommand = Nothing + , inputLineNumber = lineNumber + 1 + , inputAcc = [] } + , Just (source, cmd, acc ++ rest)) + + + -- For block mode, if the line ends with ';;' then run the command, + -- otherwise keep reading. + InputBlock + | isSuffixOf ";;" rest + -> do let rest' = take (length rest - 2) rest + return ( inputState + { inputMode = InputLine + , inputCommand = Nothing + , inputLineNumber = lineNumber + 1 + , inputAcc = [] } + , Just (source, cmd, acc ++ rest')) + + | otherwise + -> return ( inputState + { inputMode = input + , inputCommand = Just (cmd, lineStart) + , inputLineNumber = lineNumber + 1 + , inputAcc = acc ++ rest ++ "\n" } + , Nothing) + + -- Read input from a file + InputFile filePath + -> do exists <- doesFileExist filePath + if exists + then do + contents <- readFile filePath + return ( inputState + { inputMode = InputLine + , inputCommand = Nothing + , inputLineNumber = lineNumber + 1 + , inputAcc = [] } + , Just (source, cmd, contents)) + else do + putStrLn "No such file." + return ( inputState + { inputMode = InputLine + , inputCommand = Nothing + , inputLineNumber = lineNumber + 1 + , inputAcc = [] } + , Nothing) + + diff --git a/DDC/Interface/Source.hs b/DDC/Interface/Source.hs new file mode 100644 --- /dev/null +++ b/DDC/Interface/Source.hs @@ -0,0 +1,43 @@ + +module DDC.Interface.Source + ( Source(..) + , lineStartOfSource + , nameOfSource) +where + +-- | Where some source code was obtained from. +-- +-- This is used when generating error messages. +data Source + -- | Read directly from a file. + = SourceFile FilePath + + -- | Supplied on the command line. + | SourceArgs + + -- | Typed into the console. + | SourceConsole Int + + -- | Part of a @.dcx@ batch file. + | SourceBatch FilePath Int + deriving (Eq, Show) + + +-- | Get the starting source line number to report for this source. +lineStartOfSource :: Source -> Int +lineStartOfSource ss + = case ss of + SourceFile{} -> 1 + SourceArgs{} -> 1 + SourceConsole i -> i + SourceBatch _ i -> i + + +-- | Get the name of a source. +nameOfSource :: Source -> String +nameOfSource ss + = case ss of + SourceFile f -> f + SourceArgs -> "" + SourceConsole{} -> "" + SourceBatch{} -> "" diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +-------------------------------------------------------------------------------- +The Disciplined Disciple Compiler License (MIT style) + +Copyrite (K) 2007-2013 The Disciplined Disciple Compiler Strike Force +All rights reversed. + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +------------------------------------------------------------------------------- +Under Australian law copyright is free and automatic. +By contributing to DDC authors grant all rights they have regarding their +contributions to the other members of the Disciplined Disciple Compiler Strike +Force, past, present and future, as well as placing their contributions under +the above license. + +Use "darcs show authors" to get a list of Strike Force members. + +-------------------------------------------------------------------------------- +Redistributions of libraries in ./external are governed by their own licenses: + + - TinyPTC GNU Lesser General Public License + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/ddc-interface.cabal b/ddc-interface.cabal new file mode 100644 --- /dev/null +++ b/ddc-interface.cabal @@ -0,0 +1,38 @@ +Name: ddc-interface +Version: 0.3.2.1 +License: MIT +License-file: LICENSE +Author: The Disciplined Disciple Compiler Strike Force +Maintainer: Ben Lippmeier +Build-Type: Simple +Cabal-Version: >=1.6 +Stability: experimental +Category: Compilers/Interpreters +Homepage: http://disciple.ouroborus.net +Synopsis: Disciplined Disciple Compiler user interface support. +Description: Disciplined Disciple Compiler user interface support. + +Library + Build-Depends: + base == 4.6.*, + containers == 0.5.*, + directory == 1.2.*, + ddc-base == 0.3.2.* + + Exposed-modules: + DDC.Interface.Input + DDC.Interface.Source + + GHC-options: + -Wall + -fno-warn-orphans + -fno-warn-missing-signatures + -fno-warn-unused-do-bind + + Extensions: + NoMonomorphismRestriction + KindSignatures + ScopedTypeVariables + PatternGuards + ParallelListComp +