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 Start :: *World -> *World
39 # (args, w) = parseArgs w
40 # (stdin, w) = stdio w
43 <<< "spl 0.1 (17 march 2016)\n"
44 <<< "Copyright Pim Jager and Mart Lubbers\n"
45 = snd $ fclose stdin w
48 <<< "Usage: " <<< args.program <<< " [OPTION] [FILE]\n"
49 <<< "<spl> ::= <spl> <parser> <lexer>\n"
50 <<< "Lex parse and either FILE or stdin\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: enabled)\n"
58 = snd $ fclose stdin w
59 # (contents, stdin, w) = readFileOrStdin stdin args.fp w
61 (Left cs) = snd $ fclose (stdin <<< cs) w
62 (Right cs) = case lexer cs of
63 (Left e) = snd $ fclose (stdin <<< toString e <<< "\n") w
65 # stdin = if (not args.lex) stdin (
66 stdin <<< "//LEXER\n" <<< printTokens lexOut <<< "//LEXER\n")
67 = case parser lexOut of
68 (Left e) = snd $ fclose (stdin <<< toString e <<< "\n") w
70 # stdin = if (not args.parse) stdin (
71 stdin <<< "//PARSER\n" <<< toString parseOut <<< "//PARSER\n")
72 = case sem parseOut of
73 (Left e) = snd $ fclose (stdin <<< join "\n" (map toString e) <<< "\n") w
75 # stdin = if (not args.sem) stdin (stdin
76 <<< "//SEM G\n" <<< toString ast <<< "//SEMA\n")
77 # stdin = if (not args.gen) stdin (stdin
78 <<< "//CODE GEN\n" <<< gen ast <<< "\n//CODE GEN\n")
79 = snd $ fclose (stdin <<< "\n") w
81 printConstraints :: Constraints -> String
82 printConstraints [] = ""
83 printConstraints [(t1, t2):ts] = concat [
84 "(", toString t1, ",", toString t2, ")"] +++ printConstraints ts
86 printTokens :: [Token] -> String
87 printTokens ts = concat $ flatten $ map pt ts
89 pt ({line,col},token) = [toString line, ":",
90 toString col, ": ", printToString token, "\n"]
92 parseArgs :: *World -> (Opts, *World)
94 # ([p:args], w) = getCommandLine w
105 pa :: [String] Opts -> Opts
107 pa ["--help":r] o = pa r {o & help=True}
108 pa ["--version":r] o = pa r {o & version=True}
109 pa ["--lex":r] o = pa r {o & lex=True}
110 pa ["--no-lex":r] o = pa r {o & lex=False}
111 pa ["--parse":r] o = pa r {o & parse=True}
112 pa ["--no-parse":r] o = pa r {o & parse=False}
113 pa ["--sem":r] o = pa r {o & sem=True}
114 pa ["--no-sem":r] o = pa r {o & sem=False}
115 pa ["--gen":r] o = pa r {o & gen=True}
116 pa ["--no-gen":r] o = pa r {o & gen=False}
117 pa [x:r] o = pa r {o & fp=Just x}
119 readFileOrStdin :: *File (Maybe String) *World -> *(Either String [Char], *File, *World)
120 readFileOrStdin stdin Nothing w
121 # (cs, stdin) = readEntireFile stdin
122 = (Right cs, stdin, w)
123 readFileOrStdin stdin (Just fp) w
124 # (b, fin, w) = fopen fp FReadText w
125 | not b = (Left "Unable to open file", stdin, w)
126 # (cs, fin) = readEntireFile fin
127 # (b, w) = fclose fin w
128 | not b = (Left "Unable to close file", stdin, w)
129 = (Right cs, stdin, w)
131 readEntireFile :: *File -> *([Char], *File)
133 # (b, c, f) = freadc f
135 # (cs, f) = readEntireFile f