13 import System.CommandLine
15 from Text import class Text(concat), instance Text String
19 from yard import :: Error, instance toString Error
29 derive gPrint TokenValue
31 Start :: *World -> *World
33 # (args, w) = parseArgs w
34 # (stdin, w) = stdio w
37 <<< "spl 0.1 (17 march 2016)\n"
38 <<< "Copyright Pim Jager and Mart Lubbers\n"
39 = snd $ fclose stdin w
42 <<< "Usage: " <<< args.program <<< " [OPTION] [FILE]\n"
43 <<< "<spl> ::= <spl> <parser> <lexer>\n"
44 <<< "Lex parse and either FILE or stdin\n"
47 <<< " --help Show this help\n"
48 <<< " --version Show the version\n"
49 <<< " --[no-]lex Lexer output(default: disabled)\n"
50 <<< " --[no-]parse Parser output(default: enabled)\n"
51 = snd $ fclose stdin w
52 # (contents, stdin, w) = readFileOrStdin stdin args.fp w
54 (Left cs) = snd $ fclose (stdin <<< cs) w
57 # stdin = if (not args.lex) stdin (case lexOut of
59 stdin <<< "---LEXER\n" <<< printTokens toks <<< "---LEXER\n"
61 # parseOut = parser lexOut
62 # stdin = if (not args.parse) stdin (case parser lexOut of
64 stdin <<< "---PARSER\n" <<< toString ast <<< "---PARSER\n"
65 (Left parse) = stdin <<< toString parse)
66 = snd $ fclose stdin w
68 printTokens :: [Token] -> String
69 printTokens ts = concat $ flatten $ map pt ts
71 pt {line,column,token} = [toString line, ":",
72 toString column, ": ", printToString token, "\n"]
74 parseArgs :: *World -> (Opts, *World)
76 # ([p:args], w) = getCommandLine w
85 pa :: [String] Opts -> Opts
87 pa ["--help":r] o = pa r {o & help=True}
88 pa ["--version":r] o = pa r {o & version=True}
89 pa ["--lex":r] o = pa r {o & lex=True}
90 pa ["--no-lex":r] o = pa r {o & lex=False}
91 pa ["--parse":r] o = pa r {o & parse=True}
92 pa ["--no-parse":r] o = pa r {o & parse=False}
93 pa [x:r] o = pa r {o & fp=Just x}
95 readFileOrStdin :: *File (Maybe String) *World -> *(Either String [Char], *File, *World)
96 readFileOrStdin stdin Nothing w
97 # (cs, stdin) = readEntireFile stdin
98 = (Right cs, stdin, w)
99 readFileOrStdin stdin (Just fp) w
100 # (b, fin, w) = fopen fp FReadText w
101 | not b = (Left "Unable to open file", stdin, w)
102 # (cs, fin) = readEntireFile fin
103 # (b, w) = fclose fin w
104 | not b = (Left "Unable to close file", stdin, w)
105 = (Right cs, stdin, w)
107 readEntireFile :: *File -> *([Char], *File)
109 # (b, c, f) = freadc f
111 # (cs, f) = readEntireFile f