13 import System.CommandLine
16 from Text import class Text(concat,join), instance Text String
23 from yard import :: Error, instance toString Error
35 derive gPrint TokenValue
37 preamble :: AST -> AST
38 preamble (AST fd) = AST (pre ++ fd)
41 FunDecl zero "1printstr" ["x"] Nothing [] [
42 IfStmt (FunExpr zero "isEmpty" [VarExpr zero (VarDef "x" [])] [])
44 [FunStmt "1printchar" [VarExpr zero (VarDef "x" [FieldHd])] []
45 ,FunStmt "1printstr" [VarExpr zero (VarDef "x" [FieldTl])] []]]
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"] []]]
53 Start :: *World -> *World
55 # (args, w) = parseArgs w
56 # (stdin, w) = stdio w
59 <<< "spl 1.0 (9 June 2016)\n"
60 <<< "Copyright Pim Jager and Mart Lubbers\n"
61 = snd $ fclose stdin w
64 <<< "Usage: " <<< args.program <<< " [OPTION] [FILE]\n"
67 <<< " --help Show this help\n"
68 <<< " --version Show the version\n"
69 <<< " --[no-]lex Lexer output(default: disabled)\n"
70 <<< " --[no-]parse Parser output(default: disabled)\n"
71 <<< " --[no-]sem Semantic analysis output(default: disabled)\n"
72 <<< " --[no-]code Code generation output(default: enabled)\n"
73 = snd $ fclose stdin w
74 # (contents, stdin, w) = readFileOrStdin stdin args.fp w
76 (Left cs) = snd $ fclose (stdin <<< cs) w
77 (Right cs) = case lexer cs of
78 (Left e) = snd $ fclose (stdin <<< toString e <<< "\n") w
80 # stdin = if (not args.lex) stdin (
81 stdin <<< "//LEXER\n" <<< printTokens lexOut <<< "//LEXER\n")
82 = case parser lexOut of
83 (Left e) = snd $ fclose (stdin <<< toString e <<< "\n") w
85 # stdin = if (not args.parse) stdin (
86 stdin <<< "//PARSER\n" <<< toString parseOut <<< "//PARSER\n")
87 = case sem (preamble parseOut) of
88 (Left e) = snd $ fclose (stdin <<< join "\n" (map toString e) <<< "\n") w
90 # stdin = if (not args.sem) stdin (stdin
91 <<< "//SEM AST\n" <<< toString ast <<< "//SEM AST\n"
92 <<< "//SEM GAMMA\n" <<< toString gam <<< "//SEM GAMMA\n")
94 (Left e) = snd $ fclose (stdin <<< e) w
96 # stdin = if (not args.gen) stdin (stdin
97 <<< ";CODE GEN\n" <<< asm <<< "\n;CODE GEN\n")
98 = snd $ fclose (stdin <<< "\n") w
100 printConstraints :: Constraints -> String
101 printConstraints [] = ""
102 printConstraints [(t1, t2):ts] = concat [
103 "(", toString t1, ",", toString t2, ")"] +++ printConstraints ts
105 printTokens :: [Token] -> String
106 printTokens ts = concat $ flatten $ map pt ts
108 pt ({line,col},token) = [toString line, ":",
109 toString col, ": ", printToString token, "\n"]
111 parseArgs :: *World -> (Opts, *World)
113 # ([p:args], w) = getCommandLine w
124 pa :: [String] Opts -> Opts
126 pa ["--help":r] o = pa r {o & help=True}
127 pa ["--version":r] o = pa r {o & version=True}
128 pa ["--lex":r] o = pa r {o & lex=True}
129 pa ["--no-lex":r] o = pa r {o & lex=False}
130 pa ["--parse":r] o = pa r {o & parse=True}
131 pa ["--no-parse":r] o = pa r {o & parse=False}
132 pa ["--sem":r] o = pa r {o & sem=True}
133 pa ["--no-sem":r] o = pa r {o & sem=False}
134 pa ["--code":r] o = pa r {o & gen=True}
135 pa ["--no-code":r] o = pa r {o & gen=False}
136 pa [x:r] o = pa r {o & fp=Just x}
138 readFileOrStdin :: *File (Maybe String) *World -> *(Either String [Char], *File, *World)
139 readFileOrStdin stdin Nothing w
140 # (cs, stdin) = readEntireFile stdin
141 = (Right cs, stdin, w)
142 readFileOrStdin stdin (Just fp) w
143 # (b, fin, w) = fopen fp FReadText w
144 | not b = (Left "Unable to open file", stdin, w)
145 # (cs, fin) = readEntireFile fin
146 # (b, w) = fclose fin w
147 | not b = (Left "Unable to close file", stdin, w)
148 = (Right cs, stdin, w)
150 readEntireFile :: *File -> *([Char], *File)
152 # (b, c, f) = freadc f
154 # (cs, f) = readEntireFile f