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