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