structure PMBasic =struct type filename = string datatype body = SRC of filename * body | STRSRC of filename * body | LOCAL of body * body * body | NULL datatype pmfile = PM of {imports : filename list, body : body} fun eq x y = x=y local open Parsercomb infix 6 $-- --$ #-- --# infix 5 -- infix 3 >> >>* infix 2 >>= infix 0 || fun fileChar c = Char.isAlphaNum c orelse c = #"_" orelse c = #"/" orelse c = #"-" orelse c = #"." val ident = getChars1 fileChar datatype token = LOCAL_T | IN_T | END_T | IMPORT_T | STRUCTURE_T | TOPLEVEL_T | FILENAME_T of filename | EOF_T fun toList stream = case getItem stream of SOME(EOF_T, _) => [EOF_T] | SOME(x, stream) => x :: toList stream | NONE => [] infix 7 |> fun (pf |> res) = pf >> (fn _ => res) fun keyword "local" = LOCAL_T | keyword "in" = IN_T | keyword "end" = END_T | keyword "import" = IMPORT_T | keyword "structure" = STRUCTURE_T | keyword "toplevel" = TOPLEVEL_T | keyword file = FILENAME_T file fun token stream = ( ident >> keyword || $ "(*" #-- comment 1 || eof EOF_T ) (StringCvt.skipWS getItem stream) (* FIXME: write the third clause without recursion *) and comment depth stream = ( $"*)" #-- (if depth-1 = 0 then token else comment (depth-1)) || $"(*" #-- comment (depth+1) || getChar (fn _ => true) #-- comment depth || eof () >> (fn _ => raise Fail "Comment not closed") ) stream val lexer = stream token fun getIf pred stream = case getItem stream of res as SOME(x, src) => if pred x then res else NONE | _ => NONE infix 6 &-- --& fun (t &-- pf) = getLit t #-- pf fun (pf --& t) = pf --# getLit t(* val getFile = getIf (fn (FILENAME_T _) => true | _ => false) >> (fn (FILENAME_T s) => s) *) fun getOpt f = getItem >>* f val getFile = getOpt(fn (FILENAME_T s) => SOME s | _ => NONE) val imports = repeat0 getFile val optTOPLEVEL = optional(getLit TOPLEVEL_T) fun body stream = ( optTOPLEVEL #-- getFile -- body >> SRC || STRUCTURE_T &-- getFile -- body >> STRSRC || LOCAL_T &-- body -- IN_T &-- body -- END_T &-- body >> (fn((b1,b2),b3) => LOCAL(b1,b2,b3)) || success NULL ) stream val pm = IMPORT_T &-- imports -- IN_T &-- body --& END_T >> (fn (im,b) => PM{imports=im ,body=b}) || body >> (fn b => PM{imports=[], body=b}) val pmfile = pm --& EOF_T in fun parse get src = let val stream = stream get src val lexer = lexer stream in case pmfile lexer of SOME(res, _) => SOME(res, src) (*FIXME: src is wrong *) | NONE => NONE end fun parseFile filename = let open TextIO val dev = openIn filename val res = scanStream parse dev in closeIn dev ; Option.valOf res end fun tokList filename = let open TextIO val dev = openIn filename val ss = Substring.all(inputAll dev) before closeIn dev in toList (lexer(stream Substring.getc ss)) end fun parse get src = let val stream = stream get src val lexer = lexer stream in case pmfile lexer of SOME(res, _) => SOME res | NONE => NONE end fun parseFile filename = let open TextIO val dev = openIn filename val ss = Substring.all(inputAll dev) before closeIn dev val res = parse Substring.getc ss in Option.valOf res end endend
structure PMBasic =
struct
type filename = string
datatype body =
SRC of filename * body
| STRSRC of filename * body
| LOCAL of body * body * body
| NULL
datatype pmfile = PM of {imports : filename list,
body : body}
fun eq x y = x=y
local
open Parsercomb
infix 6 $-- --$ #-- --#
infix 5 --
infix 3 >> >>*
infix 2 >>=
infix 0 ||
fun fileChar c =
Char.isAlphaNum c
orelse c = #"_" orelse c = #"/" orelse c = #"-" orelse c = #"."
val ident = getChars1 fileChar
datatype token =
LOCAL_T | IN_T | END_T | IMPORT_T | STRUCTURE_T | TOPLEVEL_T
| FILENAME_T of filename
| EOF_T
fun toList stream =
case getItem stream of
SOME(EOF_T, _) => [EOF_T]
| SOME(x, stream) => x :: toList stream
| NONE => []
infix 7 |>
fun (pf |> res) = pf >> (fn _ => res)
fun keyword "local" = LOCAL_T
| keyword "in" = IN_T
| keyword "end" = END_T
| keyword "import" = IMPORT_T
| keyword "structure" = STRUCTURE_T
| keyword "toplevel" = TOPLEVEL_T
| keyword file = FILENAME_T file
fun token stream =
( ident >> keyword
|| $ "(*" #-- comment 1
|| eof EOF_T
) (StringCvt.skipWS getItem stream)
(* FIXME: write the third clause without recursion *)
and comment depth stream =
( $"*)" #-- (if depth-1 = 0 then token
else comment (depth-1))
|| $"(*" #-- comment (depth+1)
|| getChar (fn _ => true) #-- comment depth
|| eof () >> (fn _ => raise Fail "Comment not closed")
) stream
val lexer = stream token
fun getIf pred stream =
case getItem stream of
res as SOME(x, src) => if pred x then res
else NONE
| _ => NONE
infix 6 &-- --&
fun (t &-- pf) = getLit t #-- pf
fun (pf --& t) = pf --# getLit t
(*
val getFile = getIf (fn (FILENAME_T _) => true | _ => false) >>
(fn (FILENAME_T s) => s)
*)
fun getOpt f = getItem >>* f
val getFile = getOpt(fn (FILENAME_T s) => SOME s | _ => NONE)
val imports = repeat0 getFile
val optTOPLEVEL = optional(getLit TOPLEVEL_T)
fun body stream =
( optTOPLEVEL #-- getFile -- body >> SRC
|| STRUCTURE_T &-- getFile -- body >> STRSRC
|| LOCAL_T &-- body -- IN_T &-- body -- END_T &-- body
>> (fn((b1,b2),b3) => LOCAL(b1,b2,b3))
|| success NULL
) stream
val pm =
IMPORT_T &-- imports -- IN_T &-- body --& END_T
>> (fn (im,b) => PM{imports=im ,body=b})
|| body >> (fn b => PM{imports=[], body=b})
val pmfile = pm --& EOF_T
in
fun parse get src =
let val stream = stream get src
val lexer = lexer stream
in case pmfile lexer of
SOME(res, _) => SOME(res, src) (*FIXME: src is wrong *)
| NONE => NONE
end
fun parseFile filename =
let open TextIO
val dev = openIn filename
val res = scanStream parse dev
in closeIn dev
; Option.valOf res
end
fun tokList filename =
let open TextIO
val dev = openIn filename
val ss = Substring.all(inputAll dev) before closeIn dev
in toList (lexer(stream Substring.getc ss))
end
fun parse get src =
let val stream = stream get src
val lexer = lexer stream
in case pmfile lexer of
SOME(res, _) => SOME res
| NONE => NONE
end
fun parseFile filename =
let open TextIO
val dev = openIn filename
val ss = Substring.all(inputAll dev) before closeIn dev
val res = parse Substring.getc ss
in Option.valOf res
end
end
end