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 from yard import :: Error, instance toString Error
  20
  21 :: Opts = {
  22         program :: String,
  23         lex :: Bool,
  24         parse :: Bool,
  25         fp :: Maybe String,
  26         help :: Bool}
  27
  28 derive gPrint TokenValue
  29
  30 Start :: *World -> *World
  31 Start w
  32 # (args, w) = parseArgs w
  33 | args.help
  34         # (out, w) = stdio w
  35         # out = out <<< "Usage: " <<< args.program <<< " [opts] [FILENAME]\n"
  36                 <<< "\t--help  Show this help\n"
  37                 <<< "\t--[no-]lex   Lexer output(default: disabled)\n"
  38                 <<< "\t--[no-]parse Parser output(default: enabled)\n\n"
  39                 <<< "\tFILENAME   File to parse, when unspecified stdin is parsed\n"
  40         = snd $ fclose out w
  41 # (stdin, w) = stdio w
  42 # (contents, stdin, w) = readFileOrStdin stdin args.fp w
  43 = case contents of
  44         (Left cs) = snd $ fclose (stdin <<< cs) w
  45         (Right cs)
  46         # lexOut = lexer cs
  47         # stdin = if (not args.lex) stdin (case lexOut of
  48                 (Right toks) =
  49                         stdin <<< "---LEXER\n" <<< printTokens toks <<< "---LEXER\n"
  50                 _ = stdin)
  51         # parseOut = parser lexOut
  52         # stdin = if (not args.parse) stdin (case parser lexOut of
  53                 (Right ast) =
  54                         stdin <<<  "---PARSER\n" <<< toString ast <<< "---PARSER\n"
  55                 (Left parse) = stdin <<< toString parse)
  56         = snd $ fclose stdin w
  57                 where
  58                         printTokens :: [Token] -> String
  59                         printTokens ts = concat $ flatten $ map pt ts
  60                                 where
  61                                         pt {line,column,token} = [toString line, ":",
  62                                                 toString column, ": ", printToString token, "\n"]
  63
  64 parseArgs :: *World -> (Opts, *World)
  65 parseArgs w
  66 # ([p:args], w) = getCommandLine w
  67 = (pa args {program=p, lex=False, parse=True, fp=Nothing, help=False}, w)
  68 where
  69         pa :: [String] Opts -> Opts
  70         pa [] o = o
  71         pa ["--help":r] o = pa r {o & help=True}
  72         pa ["--lex":r] o = pa r {o & lex=True}
  73         pa ["--no-lex":r] o = pa r {o & lex=False}
  74         pa ["--parse":r] o = pa r {o & parse=True}
  75         pa ["--no-parse":r] o = pa r {o & parse=False}
  76         pa [x:r] o = pa r {o & fp=Just x}
  77
  78 readFileOrStdin :: *File (Maybe String) *World -> *(Either String [Char], *File, *World)
  79 readFileOrStdin stdin Nothing w
  80 # (cs, stdin) = readEntireFile stdin
  81 = (Right cs, stdin, w)
  82 readFileOrStdin stdin (Just fp) w
  83 # (b, fin, w) = fopen fp FReadText w
  84 | not b = (Left "Unable to open file", stdin, w)
  85 # (cs,  fin) = readEntireFile fin
  86 # (b, w) = fclose fin w
  87 | not b = (Left "Unable to close file", stdin, w)
  88 = (Right cs, stdin, w)
  89
  90 readEntireFile :: *File -> *([Char], *File)
  91 readEntireFile f
  92 # (b, c, f) = freadc f
  93 | not b = ([], f)
  94 # (cs, f) = readEntireFile f
  95 = ([c:cs], f)