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