I'm compiling a lexer using CM and ML-Lex. When I try to compile using CM.make "sources.cm", it throws errors.
errormsg.sml:7.24-7.39 Error: unbound structure: TextIO in path TextIO.instream
errormsg.sml:21.26-21.38 Error: unbound structure: TextIO in path TextIO.stdIn
errormsg.sml:27.18-27.30 Error: unbound structure: TextIO in path TextIO.stdIn
errormsg.sml:36.12-36.24 Error: unbound structure: Int in path Int.toString
and a couple more just like previous ones. If I try to do use "errormsg.sml", everything works perfectly fine. I tried moving errormsg.sml around in sources.cm.
sources.cm :
Group is
$/smlnj-lib.cm
driver.sml
tokens.sig
tokens.sml
errormsg.sml
tiger.lex
errormsg.sml:
signature ERRORMSG =
sig
val anyErrors : bool ref
val fileName : string ref
val lineNum : int ref
val linePos : int list ref
val sourceStream : TextIO.instream ref
val error : int -> string -> unit
exception Error
val impossible : string -> 'a (* raises Error *)
val reset : unit -> unit
end
structure ErrorMsg : ERRORMSG =
struct
val anyErrors = ref false
val fileName = ref ""
val lineNum = ref 1
val linePos = ref [1]
val sourceStream = ref TextIO.stdIn
fun reset() = (anyErrors:=false;
fileName:="";
lineNum:=1;
linePos:=[1];
sourceStream:=TextIO.stdIn)
exception Error
fun error pos (msg:string) =
let fun look(a::rest,n) =
if a<pos then app print [":",
Int.toString n,
".",
Int.toString (pos-a)]
else look(rest,n-1)
| look _ = print "0.0"
in anyErrors := true;
print (!fileName);
look(!linePos,!lineNum);
print ":";
print msg;
print "\n"
end
fun impossible msg =
(app print ["Error: Compiler bug: ",msg,"\n"];
TextIO.flushOut TextIO.stdOut;
raise Error)
end
You need to add $/basis.cm to your sources.cm. This will import the Standard ML basis library:
Group is
$/basis.cm
$/smlnj-lib.cm
driver.sml
tokens.sig
tokens.sml
errormsg.sml
tiger.lex
Related
I have a problem with functor in Ocaml. I have this situation:
module type EveryType =
sig
type t
val str : t -> string
end;;
module type StackInterface =
functor (El : EveryType) ->
sig
type el = El.t
type stack
exception EmptyStackException
val empty : stack
val pop : stack -> stack
val top : stack -> el
val push : stack -> el -> stack
val str : stack -> string
end;;
module StackImpl (El : EveryType) =
struct
type el = El.t
type stack = Empty | Node of el * stack
exception EmptyStackException
let empty = Empty
let pop s =
match s with
| Empty -> raise EmptyStackException
| Node(_, t) -> t
let top s =
match s with
| Empty -> raise EmptyStackException
| Node(h, _) -> h
let push s el = Node(el, s)
let str s =
let rec str s =
match s with
| Node(h, Empty) -> El.str h ^ ")"
| Node(h, t) -> El.str h ^ ", " ^ str t
| _ -> ""
in
if s == Empty then
"Stack()"
else
"Stack(" ^ str s
end;;
module Stack = (StackImpl : StackInterface);;
module TypeChar =
struct
type t = char
let str c = Printf.sprintf "%c" c
end;;
module StackChar = Stack(TypeChar);;
module CheckExp(St : module type of StackChar) =
struct
let checkExp str =
let rec checkExp str stk =
try
match str with
| [] -> true
| '(' :: t -> checkExp t (St.push stk '(')
| ')' :: t -> checkExp t (St.pop stk)
| _ :: t -> checkExp t stk
with St.EmptyStackException -> false
in checkExp (explode str) St.empty
end;;
I create a Stack with functor to have a stack of every type. Now I want to use this stack (with type char) in a function that check parantesis into an expression. But compiler gives me this error: Unbound module type StackChar refered to line module CheckExp(St : StackChar) =
What have I wrong???
StackChar is a module, but what you need for a functor is a module type. It wouldn't be much of a functor if you always pass it the same module. The simplest fix for this is to replace it with module type of StackChar:
module CheckExp(St : module type of StackChar) =
struct
...
end
But are you sure you actually need a functor here?
Background:
I am trying to use regexp to parse one language's comment, whihc starts with //:
structure Main =
struct
structure RE = RegExpFn(
structure P = AwkSyntax
structure E = ThompsonEngine
)
val regexes = [
("[a-zA-z#= ]* *//.*", fn match => ("comment", match)),
("[0-9]*", fn match => ("2nd", match)),
("1tom|2jerry", fn match => ("3rd", match))
]
fun main () =
let
val input = "#=abs //sdfasdfdfa sdf as"
val comment = "[a-zA-z#= ]* *//"
val compiledComment = RE.compileString comment
in
(* #1 StringCvt.scanString (RE.match regexes) input *)
(* #2 StringCvt.scanString (RE.find compiledComment) input *)
(* #3 case ... of ... *)
end
end
input is my testcase, I hope to trim //sdfasdfdfa sdf as and prserve #=abs only.
Here are some my trials:
let StringCvt.scanString (RE.find compiledComment) input be fun main's return value:
- Main.main();
[autoloading]
[autoloading done]
val it = SOME (Match ({len=8,pos=0},[])) : StringCvt.cs Main.RE.match option
let StringCvt.scanString (RE.match regexes) input be return value:
- Main.main();
[autoloading]
[autoloading done]
val it = SOME ("comment",Match ({len=#,pos=#},[]))
: (string * StringCvt.cs Main.RE.match) option
The two cases tell me StringCvt.scanString (RE.find compiledComment) input is what I want, because its value contains {len=8,pos=0},[]), which can be used to trim all comments. But I am a little confused about its value and type: val it = SOME (Match ({len=8,pos=0},[])) : StringCvt.cs Main.RE.match option. How can I access len and poshere? Why StringCvt.cs and Main.RE.match only split by space?
After googling sml's document, I include all information I got below:
#+BEGIN_SRC sml
StringCvt.scanString (RE.match regexes) input
val it = SOME (
"comment" , Match ({len=#,pos=#},[]))
: (string * StringCvt.cs Main.RE.match)
option
StringCvt.scanString (RE.find compiledComment) input
val it = SOME (
Match ({len=8,pos=0},[]))
: StringCvt.cs Main.RE.match
option
val find : regexp ->
(char,'a) StringCvt.reader -> ({pos : 'a, len : int} option MatchTree.match_tree,'a) StringCvt.reader
val scanString :
((char, cs) reader -> ('a, cs) reader) -> string -> 'a option
val match : (string * ({pos : 'a, len : int} option MatchTree.match_tree -> 'b)) list -> (char,'a) StringCvt.reader -> ('b,'a) StringCvt.reader
#+END_SRC
type cs
The abstract type of the character stream used by scanString. A value of this type represents the state of a character stream. The concrete type is left unspecified to allow implementations a choice of representations. Typically, cs will be an integer index into a string.
IIUC, the type of Match should be StringCvt.cs, the type of ({len=8,pos=0},[])) and ({len=#,pos=#},[])) should be Main.RE.match. Then I start to pattern match:
let
...
in
case StringCvt.scanString (RE.find compiledComment) input of
NONE => ""
| SOME (
StringCvt.cs ({len = b, pos = a}, _)) => String.substring (input a b)
Unfortunate,
main.sml:23.19-23.39 Error: non-constructor applied to argument in pattern
main.sml:23.92 Error: unbound variable or constructor: a
main.sml:23.94 Error: unbound variable or constructor: b
main.sml:23.86-23.95 Error: operator is not a function [tycon mismatch]
operator: string
in expression:
input <errorvar>
[autoloading failed: unable to load module(s)]
stdIn:1.2-1.11 Error: unbound structure: Main in path Main.main
It seems I cannot use StringCvt.cs for pattern because it is not constructor. Then I tried to use wildcard:
case StringCvt.scanString (RE.find compiledComment) input of
NONE => ""
| SOME (_ ({len = b, pos = a}, _)) => String.substring (input a b)
,
main.sml:23.19 Error: non-constructor applied to argument in pattern
So, constructor for Match is a must here? I cannot dig into deeper any more. Do you have any ideas? thanks in advance
Solved:
case StringCvt.scanString (RE.find compiledComment) input
of NONE => ""
| SOME match =>
let
val {pos, len} = MatchTree.root match
in
String.substring (input, 0, pos)
end
I'am writing this function for a MOOC. It's job is to remove a string from the list and return that list without the string as a SOME or return NONE is the string is not there.
I wrote the code below but whenever I try to run it I get the following error: Error: non-constructor applied to argument in pattern: -.
exception NotFound
fun all_except_option (str : string, strs : string list) =
let
fun remove_str (strs : string list) =
case strs of
[] => raise NotFound
| str'::strs' => if same_string(str, str') then strs' else str'::remove_str strs'
in
SOME (remove_str strs) handle NotFound => NONE
end
And where's one test to run it:
val test01-01 = all_except_option ("string", ["string"]) = SOME []
edit
forgot to include the same_string function that was provided to us to simplify types
fun same_string(s1 : string, s2 : string) =
s1 = s2
Figured out the problem. Seems like SML doesn't like hyphens, like the one I had in the test:
val test01-01 = all_except_option ("string", ["string"]) = SOME []
I changed to underscore instead and now it works.
val test01_01 = all_except_option ("string", ["string"]) = SOME []
Since you've already solved this task, here's a way to write it without using exceptions:
fun all_except_option (_, []) = NONE
| all_except_option (t, s :: ss) =
if s = t
then SOME ss (* don't include s in result, and don't recurse further *)
else case all_except_option (t, ss) of
SOME ss' => SOME (s :: ss')
| NONE => NONE
Having a recursive function return t option rather than t makes it more difficult to deal with, since upon every recursive call, you must inspect if it returned SOME ... or NONE. This can mean a lot of case ... of ... s!
They can be abstracted away using the library function Option.map. The definition is found in the standard library and translates into:
fun (*Option.*)map f opt =
case opt of
SOME v => SOME (f v)
| NONE => NONE
This bit resembles the case ... of ... in all_except_option; rewriting it would look like:
fun all_except_option (_, []) = NONE
| all_except_option (t, s :: ss) =
if s = t
then SOME ss (* don't include s in result, and don't recurse further *)
else Option.map (fn ss' => s :: ss') (all_except_option (t, ss))
I'm following Real World OCaml to get started with the language, and, at one point, I am to make use of s-expressions in a module signature. Here's my mli file:
open Core.Std
(** Configuration type for query handlers *)
type config with sexp
(** Name of the query handler *)
val name : string
(** Query handler abstract type *)
type t
(** Create a query handler from an existing [config] *)
val create : config -> t
(** Evaluate a query, where both input and output an s-expressions. *)
val eval : t -> Sexp.t -> Sexp.t Or_error.t
But, when compiling an implementation of that interface, I get the following error:
File "Query_Handler.mli", line 4, characters 12-16:
Error: Syntax error
Command exited with code 2.
So I opened utop to try with sexp on a simpler example:
module type Test = sig
type t with sexp
end;;
But I get the following error:
Error: Parse Error: "end" expected after [sig_items] (in [module type])
However, sexplib is installed and neither the book nor my searches on the Internet mention any "prerequisites" for using this syntax.
I feel like I'm missing something. Any idea? :(
This is because the sexp library had been rewritten to use Extension Point, instead of Camlp4.
open Core.Std
module type Query_handler = sig
(** Configuration for a query handler. Note that this can be
Converted to and from an s-expression *)
type config [##deriving sexp]
(** The name of the query-handling service *)
val name : string
(** The state of the query handler *)
type t
(** Create a new query handler from a config *)
val create : config -> t
(** Evaluate a given query, where both input and output are
s-expressions *)
val eval : t -> Sexp.t -> Sexp.t Or_error.t
end
module Unique = struct
type config = int [##deriving sexp]
type t = { mutable next_id: int }
let name = "unique"
let create start_at = { next_id = start_at }
let eval t sexp =
match Or_error.try_with (fun () -> unit_of_sexp sexp) with
| Error _ as err -> err
| Ok () ->
let response = Ok (Int.sexp_of_t t.next_id) in
t.next_id <- t.next_id + 1;
response
end
module List_dir = struct
type config = string [##deriving sexp]
type t = { cwd: string }
(** [is_abs p] Returns true if [p] is an absolute path *)
let is_abs p =
String.length p > 0 && p.[0] = '/'
let name = "ls"
let create cwd = { cwd }
let eval t sexp =
match Or_error.try_with (fun () -> string_of_sexp sexp) with
| Error _ as err -> err
| Ok dir ->
let dir =
if is_abs dir then dir
else Filename.concat t.cwd dir
in
Ok (Array.sexp_of_t String.sexp_of_t (Sys.readdir dir))
end
module type Query_handler_instance = sig
module Query_handler : Query_handler
val this : Query_handler.t
end
let build_instance (type a)
(module Q : Query_handler with type config = a)
config =
(module struct
module Query_handler = Q
let this = Q.create config
end : Query_handler_instance)
let build_dispatch_table handlers =
let table = String.Table.create () in
List.iter handlers
~f:(fun ((module I : Query_handler_instance) as instance) ->
Hashtbl.replace table ~key:I.Query_handler.name ~data:instance);
table
let dispatch dispatch_table name_and_query =
match name_and_query with
| Sexp.List [Sexp.Atom name; query] ->
begin match Hashtbl.find dispatch_table name with
| None ->
Or_error.error "Could not find matching handler"
name String.sexp_of_t
| Some (module I : Query_handler_instance) ->
I.Query_handler.eval I.this query
end
| _ ->
Or_error.error_string "malformed query"
let rec cli dispatch_table =
printf ">>> %!";
let result =
match In_channel.input_line stdin with
| None -> `Stop
| Some line ->
match Or_error.try_with (fun () -> Sexp.of_string line) with
| Error e -> `Continue (Error.to_string_hum e)
| Ok query ->
begin match dispatch dispatch_table query with
| Error e -> `Continue (Error.to_string_hum e)
| Ok s -> `Continue (Sexp.to_string_hum s)
end;
in
match result with
| `Stop -> ()
| `Continue msg ->
printf "%s\n%!" msg;
cli dispatch_table
let unique_instance = build_instance (module Unique) 0
let list_dir_instance = build_instance (module List_dir) "/var"
module Loader = struct
type config = (module Query_handler) list sexp_opaque [##deriving sexp]
type t = { known : (module Query_handler) String.Table.t
; active : (module Query_handler_instance) String.Table.t
}
let name ="loader"
let create known_list =
let active = String.Table.create () in
let known = String.Table.create () in
List.iter known_list
~f:(fun ((module Q : Query_handler) as q) ->
Hashtbl.replace known ~key:Q.name ~data:q);
{ known; active }
let load t handler_name config =
if Hashtbl.mem t.active handler_name then
Or_error.error "Can't re-register an active handler"
handler_name String.sexp_of_t
else
match Hashtbl.find t.known handler_name with
| None ->
Or_error.error "Unknown handler" handler_name String.sexp_of_t
| Some (module Q : Query_handler) ->
let instance =
(module struct
module Query_handler = Q
let this = Q.create (Q.config_of_sexp config)
end : Query_handler_instance)
in
Hashtbl.replace t.active ~key:handler_name ~data:instance;
Ok Sexp.unit
let unload t handler_name =
if not (Hashtbl.mem t.active handler_name) then
Or_error.error "Handler not active" handler_name String.sexp_of_t
else if handler_name = name then
Or_error.error_string "It's unwise to unload yourself"
else (
Hashtbl.remove t.active handler_name;
Ok Sexp.unit
)
type request =
| Load of string * Sexp.t
| Unload of string
| Known_services
| Active_services [##deriving sexp]
let eval t sexp =
match Or_error.try_with (fun () -> request_of_sexp sexp) with
| Error _ as err -> err
| Ok resp ->
match resp with
| Load (name,config) -> load t name config
| Unload name -> unload t name
| Known_services ->
Ok [%sexp ((Hashtbl.keys t.known ) : string list)]
| Active_services ->
Ok [%sexp ((Hashtbl.keys t.active) : string list)]
end
This is my ~/.ocamlinit; just comment out the camlp4. utop should work happy.
#use "topfind";;
#warnings "+9"
#thread;;
(*camlp4;;*)
#require "core.top";;
#require "core_extended";;
#require "core_bench";;
#require "ppx_jane";;
#require "ctypes";;
#require "ctypes.foreign";;
I have problems defining the type of a module that is returned by a functor. Could anyone solve this?
module type ANIMALTYPE = sig
val age : unit -> int
end
module type SHIPGENERATOR = sig
val age : unit -> int
(* Another possibility: include ANIMALTYPE *)
val hello : string
end
module RabbitModule : ANIMALTYPE = struct
let age () = 10
end
module Make_ShipGenerator (A : ANIMALTYPE) = struct
let age = A.age
let hello = "world"
end
let get_shipgenerator race = match race with
| Rabbit -> let module M = (Make_ShipGenerator (RabbitModule))
in (module M : SHIPGENERATOR)
Edit: Added hello to Make_ShipGenerator.
Edit 2: Added module type SHIPGENERATOR, which will include those parts needed from ANIMALTYPE.
Well, it is ANIMALTYPE, what else?
let module M = (Make_ShipGenerator (RabbitModule))
in (module M : ANIMALTYPE);;