151 lines · 3.7 KB · Standard ML
RawDownload
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