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