spl.icl

   1 module spl
   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         version :: Bool,
  23         program :: String,
  24         lex :: Bool,
  25         parse :: Bool,
  26         fp :: Maybe String,
  27         help :: Bool}
  28
  29 derive gPrint TokenValue
  30
  31 Start :: *World -> *World
  32 Start w
  33 # (args, w) = parseArgs w
  34 # (stdin, w) = stdio w
  35 | args.version
  36         # stdin = stdin
  37                 <<< "spl 0.1 (17 march 2016)\n"
  38                 <<< "Copyright Pim Jager and Mart Lubbers\n"
  39         = snd $ fclose stdin w
  40 | args.help
  41         # stdin = stdin
  42                 <<< "Usage: " <<< args.program <<< " [OPTION] [FILE]\n"
  43                 <<< "<spl> ::= <spl> <parser> <lexer>\n"
  44                 <<< "Lex parse and either FILE or stdin\n"
  45                 <<< "\n"
  46                 <<< "Options:\n"
  47                 <<< "  --help             Show this help\n"
  48                 <<< "  --version          Show the version\n"
  49                 <<< "  --[no-]lex         Lexer output(default: disabled)\n"
  50                 <<< "  --[no-]parse       Parser output(default: enabled)\n"
  51         = snd $ fclose stdin w
  52 # (contents, stdin, w) = readFileOrStdin stdin args.fp w
  53 = case contents of
  54         (Left cs) = snd $ fclose (stdin <<< cs) w
  55         (Right cs)
  56         # lexOut = lexer cs
  57         # stdin = if (not args.lex) stdin (case lexOut of
  58                 (Right toks) =
  59                         stdin <<< "---LEXER\n" <<< printTokens toks <<< "---LEXER\n"
  60                 _ = stdin)
  61         # parseOut = parser lexOut
  62         # stdin = if (not args.parse) stdin (case parser lexOut of
  63                 (Right ast) =
  64                         stdin <<<  "---PARSER\n" <<< toString ast <<< "---PARSER\n"
  65                 (Left parse) = stdin <<< toString parse)
  66         = snd $ fclose stdin w
  67                 where
  68                         printTokens :: [Token] -> String
  69                         printTokens ts = concat $ flatten $ map pt ts
  70                                 where
  71                                         pt {line,column,token} = [toString line, ":",
  72                                                 toString column, ": ", printToString token, "\n"]
  73
  74 parseArgs :: *World -> (Opts, *World)
  75 parseArgs w
  76 # ([p:args], w) = getCommandLine w
  77 = (pa args {
  78         program=p,
  79         version=False,
  80         lex=False,
  81         parse=True,
  82         fp=Nothing,
  83         help=False}, w)
  84 where
  85         pa :: [String] Opts -> Opts
  86         pa [] o = o
  87         pa ["--help":r] o = pa r {o & help=True}
  88         pa ["--version":r] o = pa r {o & version=True}
  89         pa ["--lex":r] o = pa r {o & lex=True}
  90         pa ["--no-lex":r] o = pa r {o & lex=False}
  91         pa ["--parse":r] o = pa r {o & parse=True}
  92         pa ["--no-parse":r] o = pa r {o & parse=False}
  93         pa [x:r] o = pa r {o & fp=Just x}
  94
  95 readFileOrStdin :: *File (Maybe String) *World -> *(Either String [Char], *File, *World)
  96 readFileOrStdin stdin Nothing w
  97 # (cs, stdin) = readEntireFile stdin
  98 = (Right cs, stdin, w)
  99 readFileOrStdin stdin (Just fp) w
 100 # (b, fin, w) = fopen fp FReadText w
 101 | not b = (Left "Unable to open file", stdin, w)
 102 # (cs,  fin) = readEntireFile fin
 103 # (b, w) = fclose fin w
 104 | not b = (Left "Unable to close file", stdin, w)
 105 = (Right cs, stdin, w)
 106
 107 readEntireFile :: *File -> *([Char], *File)
 108 readEntireFile f
 109 # (b, c, f) = freadc f
 110 | not b = ([], f)
 111 # (cs, f) = readEntireFile f
 112 = ([c:cs], f)