main.icl

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