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