src/main.icl

   1 module main
   2
   3 import StdFile
   4 import StdBool
   5 import StdMisc
   6 import StdFunc
   7 import StdTuple
   8 import StdList
   9 import StdString
  10 import Data.Either
  11 import Data.Maybe
  12 import Data.Func
  13 import System.CommandLine
  14 import GenPrint
  15 from Text import class Text(concat), instance Text String
  16
  17 import parse
  18 import lex
  19
  20 :: Opts = {
  21         program :: String,
  22         lex :: Bool,
  23         parse :: Bool,
  24         fp :: Maybe String,
  25         help :: Bool}
  26
  27 derive gPrint TokenValue
  28
  29 Start :: *World -> *World
  30 Start w
  31 # (args, w) = parseArgs w
  32 | args.help
  33         # (out, w) = stdio w
  34         # out = out <<< "Usage: " <<< args.program <<< " [opts] [FILENAME]\n"
  35                 <<< "\t--help  Show this help\n"
  36                 <<< "\t--[no-]lex   Lexer output(default: disabled)\n"
  37                 <<< "\t--[no-]parse Parser output(default: enabled)\n\n"
  38                 <<< "\tFILENAME   File to parse, when unspecified stdin is parsed\n"
  39         = snd $ fclose out w
  40 # (stdin, w) = stdio w
  41 # (contents, stdin, w) = readFileOrStdin stdin args.fp w
  42 = case contents of
  43         (Left cs) = snd $ fclose (stdin <<< cs) w
  44         (Right cs)
  45         # lexOut = lexer cs
  46         # stdin = if (not args.lex) stdin (case lexOut of
  47                 (Left lex) = stdin <<< toString lex
  48                 (Right toks) = stdin <<<
  49                         concat (map (\(_, _, t)->printToString t +++ "\n") toks))
  50         # parseOut = parser lexOut
  51         # stdin = if (not args.parse) stdin (case parser lexOut of
  52                 (Left parse) = stdin <<< toString parse
  53                 (Right ast) = stdin <<< toString ast)
  54         = snd $ fclose stdin w
  55
  56 parseArgs :: *World -> (Opts, *World)
  57 parseArgs w
  58 # ([p:args], w) = getCommandLine w
  59 = (pa args {program=p, lex=False, parse=True, fp=Nothing, help=False}, w)
  60 where
  61         pa :: [String] Opts -> Opts
  62         pa [] o = o
  63         pa ["--help":r] o = pa r {o & help=True}
  64         pa ["--lex":r] o = pa r {o & lex=True}
  65         pa ["--no-lex":r] o = pa r {o & lex=False}
  66         pa ["--parse":r] o = pa r {o & parse=True}
  67         pa ["--no-parse":r] o = pa r {o & parse=False}
  68         pa [x:r] o = pa r {o & fp=Just x}
  69
  70 readFileOrStdin :: *File (Maybe String) *World -> *(Either String [Char], *File, *World)
  71 readFileOrStdin stdin Nothing w
  72 # (cs, stdin) = readEntireFile stdin
  73 = (Right cs, stdin, w)
  74 readFileOrStdin stdin (Just fp) w
  75 # (b, fin, w) = fopen fp FReadText w
  76 | not b = (Left "Unable to open file", stdin, w)
  77 # (cs,  fin) = readEntireFile fin
  78 # (b, w) = fclose fin w
  79 | not b = (Left "Unable to close file", stdin, w)
  80 = (Right cs, stdin, w)
  81
  82 readEntireFile :: *File -> *([Char], *File)
  83 readEntireFile f
  84 # (b, c, f) = freadc f
  85 | not b = ([], f)
  86 # (cs, f) = readEntireFile f
  87 = ([c:cs], f)