main.icl

   1 module main
   2
   3 import StdEnv
   4 import Data.Either
   5 import Data.Functor
   6 import Data.Func
   7 import Control.Monad
   8 import System.GetOpt
   9 import System.CommandLine
  10
  11 import parse
  12 import ast
  13 import check
  14 import int
  15 import gen
  16
  17 chars :: *File -> ([Char], *File)
  18 chars f
  19         # (ok,c,f) = freadc f
  20         | not ok = ([], f)
  21         # (cs,f) = chars f
  22         = ([c:cs], f)
  23
  24 :: Mode = MHelp | MLex | MParse | MType | MInterpret | MGen
  25 :: Result
  26         = Lex [Token]
  27         | Parse AST
  28         | Type [([Char], Scheme)]
  29         | Interpret Value
  30         | Gen [String]
  31
  32 options :: [OptDescr (Mode->Mode)]
  33 options =
  34         [ Option ['?'] ["help"]      (NoArg (const MHelp))      "Display this message"
  35         , Option ['l'] ["lex"]       (NoArg (const MLex))       "Up to and including lexing"
  36         , Option ['p'] ["parse"]     (NoArg (const MParse))     "Up to and including parse"
  37         , Option ['t'] ["type"]      (NoArg (const MType))      "Up to and including typing"
  38         , Option ['i'] ["interpret"] (NoArg (const MInterpret)) "Up to and including interpretation"
  39         , Option ['g'] ["gen"]       (NoArg (const MGen))       "Up to and including generation"
  40         ]
  41
  42 Start :: *World -> Either [String] Result
  43 Start w
  44         # ([argv0:args], w) = getCommandLine w
  45         # (mode, positionals, errs) = getOpt Permute options args
  46         # mode = foldl (o) id mode MInterpret
  47         | not (errs =: []) = Left [e +++ "\n"\\e<-errs]
  48         | not (positionals =: []) = Left ["Positional arguments not allowed"]
  49         # (io, w) = stdio w
  50         # (cs, io) = chars io
  51         = case mode of
  52                 MHelp = Left [usageInfo ("Usage: " +++ argv0 +++ " [options]\n") options]
  53                 MLex = Lex <$> lex cs
  54                 MParse = Parse <$> (lex cs >>= parse)
  55                 MType = Type <$> snd <$> (lex cs >>= parse >>= check)
  56                 MInterpret = Interpret <$> (lex cs >>= parse >>= check >>= int o fst)
  57                 MGen = Gen <$> (lex cs >>= parse >>= check >>= gen o fst)