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