Standard ML (smlnj): "constant" variables for pattern matching - sml

I'm new to SMLNJ. This works:
case (tts t2) of
(other, "<+") => parse_append t t2 ts pre c j
| (other, "<<-") => parse_sample t t2 ts pre c j
| (other, "<-") => parse_assign_or_sub t t2 ts pre c j
| (_, _) => error t2 "parse_stmt: Expected sample, append or assignment operator."
(other is of type "datatype tokentype", t and t2 are tokens and tts maps a token to a pair (tokentype, content). The rest is context-specific and not important here.)
But it's not very modular. Especially as I'm matching against the same operators in multiple places and I don't want them repeated all over the place. So I attempted this, which doesn't work:
(* this should go in a separate file of declarations *)
structure Ops = struct
val APPEND = "<+"
val SAMPLE = "<<-"
val ASSIGN = "<-"
end
(* this stays in the code *)
case (tts t2) of
(other, Op.APPEND) => parse_append t t2 ts pre c j
| (other, Op.SAMPLE) => parse_sample t t2 ts pre c j
| (other, Op.ASSIGN) => parse_assign_or_sub t t2 ts pre c j
| (_, _) => error t2 "parse_stmt: Expected sample, append or assignment operator."
Apparently you can't pattern-match against the value of a variable (which makes sense, in a way). Is there any kind of "constant" declaration I can apply to the operator definitions so that I can put their values in a separate module, or is there some other nice way to do this in SMLNJ?

You can make them constructors:
datatype Op = APPEND | ...
and then tokenize your stream
datatype Token = Op of Op | Id of string | ...
and then your pattern match can be
case (tts t2) of
(other, APPEND) => ...

Related

How to return a SOME list instead of a normal list?

I am trying to implement a program that takes a string and a list and returns NONE if it doesn't find any match and the list without the element if it does.
fun all_except_option ("string",["he","she","string"]) = SOME["he","she"]
I have managed to make it working, but without the options type and i have no idea how to make it return SOME list instead a normal list.
fun all_except_option(str,lst)=
case lst of
[] => []
| x::lst' => if same_string(x,str) = false
then let fun append (word, list) = word::list
in append(x,[]) :: all_except_option(str,lst')
end
else all_except_option(str,lst')
Thank you. I managed to make it working, but i still don't understand the "else case" and how is my programm handling it. Here is the working code. I would be glad if you can explain me the "else case all_except_option(str,list') of".
fun all_except_option(str,list)=
case list of
[] => NONE
| x::list' => if same_string(x,str) then
SOME( list')
else case all_except_option(str,list') of
NONE=>NONE
| SOME list'=>SOME(x::list')
implement a program that takes a string and a list and returns NONE if it doesn't find any match and the list without the element if it does.
all_except_option ("string",["he","she","string"]) = SOME ["he","she"]
How is SOME [] different from NONE? As in, if this function returned just a list, it would be possible to say that removing occurrences of "string" results in no other strings: Either the list was empty already, or it contained only occurrences of "string". I am not sure why NONE vs. SOME [] is warranted in one case over the other.
So the better function is one that simply returns a plain list:
fun except (x, ys) = List.filter (fn y => x <> y)
When is it useful to return 'a option?
For example when the return type does not have a way to indicate no result already:
fun lookup k1 [] = NONE
| lookup k1 ((k2,v)::pairs) =
if k1 = k2
then SOME v
else lookup k1 pairs
This function returns 0 or 1 thing. But it's also a simple function because it never aggregates results over its recursion. Recursive functions become complicated when they return composite data types like 'a option when it needs to unpack the result of the recursion.
A good example is an eval function that sometimes fails:
datatype expr
= Add of expr * expr
| Sub of expr * expr
| Mul of expr * expr
| Div of expr * expr
| Int of int
fun eval (Int n) = SOME n
| eval (Add (e1, e2)) = evalHelper ( op+ ) (e1, e2)
| eval (Sub (e1, e2)) = evalHelper ( op- ) (e1, e2)
| eval (Mul (e1, e2)) = evalHelper ( op* ) (e1, e2)
| eval (Div (e1, e2)) =
case eval e1 of
NONE => NONE
| SOME x => case eval e2 of
NONE => NONE
| SOME 0 => NONE
| SOME y => SOME (x div y)
and evalHelper binop (e1, e2) =
case eval e1 of
NONE => NONE
| SOME x => case eval e2 of
NONE => NONE
| SOME y => SOME (binop (x, y))
Here the return type is int option, which means that you most often return an int, but if you ever divide by zero, that results in "no value", so rather than raise an exception, we return NONE, which necessitates us to return SOME n when there is a result, so that the type fits in both cases.
A quick demonstration:
- eval (Div (Int 5, Int 2));
> val it = SOME 2 : int option
- eval (Div (Int 5, Int 0));
> val it = NONE : int option
- eval (Div (Int 2, Sub (Int 3, Int 3)));
> val it = NONE : int option
- eval (Div (Int 0, Int 1));
> val it = SOME 0 : int option
Here SOME 0 actually means "the result is 0", which is not the same as "cannot divide by zero."

how to represent a non-empty list type

I'm a big fan of creating data structures that make representing invalid states impossible, so I wanted to ask how I could represent a non empty list in reasonml?
Since it's possible to pattern match on lists like [] and [head, ...rest] I thought it would be easy to represent a non empty list, but I haven't found a way yet.
Update: Thanks to the enlightening answers below I was able to come up with something that really strikes my tune:
module List = {
include List;
type nonEmpty('a) = ::('a, list('a));
let foldNonEmpty = (type a, fn, l: nonEmpty(a)) => switch(l) {
| [head, ...tail] => fold_left(fn, head, tail)
};
}
module Number = {
let min = List.foldNonEmpty(Pervasives.min);
let max = List.foldNonEmpty(Pervasives.max);
}
Number.min([]); // illegal :D
Number.min([1]); // legal
Don't know how you guys feel about it, but I think it's awesome. Thanks!
You can also define a new list type without GADT as:
type nonempty('a) =
| First('a)
| ::('a,nonempty('a))
Compared to the GADT solution, you lose some syntactic sugar, because the syntax
let l = [1,2,3,4]
implicitly adds a terminal [] but the [x, ...y] syntax still works
let x = [1, 2, 3, 4, ...First(5)];
let head =
fun
| [a, ...q] => a
| First(a) => a;
let tail =
fun
| [a, ...q] => Some(q)
| First(a) => None;
Otherwise, the encoding
type nonempty_2('a) = { head:'a, more:list('a) };
let x = { head:1, more:[2,3,4,5 ] };
let head = (x) => x.head;
let tail = fun
| {more:[head,...more],_} => Some({head, more})
| {more:[],_} => None;
is even simpler and does not rely on potentially surprising syntactic constructions.
EDIT: ::, the infix variant constructor
If the part of the definition with :: seems strange, it is because it is a left-over of corner case of the OCaml syntax. In Ocaml,
[x, ... l ]
is written
x :: l
which is itself the infix form of
(::)(x,l)
(This the same prefix form of standard operator : 1 + 2 can also be written as
(+)(1,2) (in Reason)
)
And the last form is also the prefix form of [x,...l] in reason.
In brief, in Reason we have
[x, ... l ] ≡ (::)(x,l)
with the OCaml syntax as the missing link between the two notations.
In other words :: is an infix constructor (and the only one). With recent enough version of OCaml, it is possible to define your own version of this infix constructor with
type t = (::) of int * int list
The same construction carries over in Reason as
type t = ::(int, list(int))
Then if you write [a, ...b] it is translated to (::)(a,b) with :: as your newly defined operator. Similarly,
[1,2,3]
is in fact a shortcut for
[1,2,3, ...[]]
So if you define both [] and ::, for instance in this silly example
type alternating('a,'b) =
| []
| ::('a, alternating('b,'a) )
/* here the element of the list can alternate between `'a` and `'b`:*/
let l = [1,"one",2,"two"]
you end up with a syntax for exotic lists, that works exactly the same as
standard lists.
You can use GADT for this use case.
(we can also add phantom type https://blog.janestreet.com/howto-static-access-control-using-phantom-types/) but it isn't mandatory
type empty = Empty;
type nonEmpty = NonEmpty;
type t('a, 's) =
| []: t('a, empty)
| ::(('a, t('a, 's))): t('a, nonEmpty);
How to use it
let head: type a. t(a, nonEmpty) => a =
fun
| [x, ..._] => x;
type idea come form https://sketch.sh/s/yH0MJiujNSiofDWOU85loX/

OCaml checking if an element exists on the right-hand side of a tuple

I'm currently trying to implement a type inference algorithm (unification algorithm) using the OCaml language. I faced some implementation-wise difficulties and was hoping someone would be kind enough to give me some help.
Let me give some background information of what I'm trying to implement.
[(TypeVar "t1", TypeFunc (TypeVar "t2", TypeVar "t3"))]
This (type * type) list type is a way to express an equality, such that type t1 is mapped to a function of t2 -> t3.
What I'm trying to capture is the case where the type variable on the left-hand side of the equality also occurs on the right-hand side, which would lead to the algorithm failing. To elaborate, if we would have
[(TypeVar "t1", TypeFunc (TypeVar "t1", TypeVar "t3"))]
this would give us an error, since t1 = t1 -> t3 is a contradiction.
Here's the actual OCaml function that I tried to implement to catch this contradiction:
let contradiction_check (a, t) =
List.exists (fun (x, _) -> x = a) t;;
let t1 = TypeVar "t1";;
let t2 = TypeFunc (TypeVar "t2", TypeVar "t3");;
The problem with this code is that first of all t2 isn't a list, which would give us an error. However, this is intentional, since my objective is to take the tuple list [(TypeVar "t1", TypeFunc (TypeVar "t2", TypeVar "t3"))] and check if the left-hand side of the tuple occurs in the right-hand side.
I guess my specific question would be: Is it possible to implement the List.exists function as a version for tuples? I've tried manually writing functions but it seems to get more complicated than I initially thought.
It gets particularly complicated for examples such as:
[(TypeVar "t1", TypeFunc (TypeFunc (TypeVar "t2", TypeVar "t3"),
TypeFunc (TypeVar "t1", TypeVar "t4")))]
(** t1 = (t2 -> t3) -> (t1 -> t4) **)
Any feedback is appreciated. Thank you.
You should just write a recursive function to search:
(** [is_free ~varname t] is [true] iff [varname] appears as a free type variable in [t] *)
let is_free ~varname =
let rec r = function
| TypeVar n when String.( = ) n varname -> true
| TypeVar _ -> false
| TypeFunc s t -> r s || r t
| TypaApp c t -> r c || r t (* if c is just a name not a type you don’t want [r c] here *)
| TypeForall n t ->
if String.( = ) n varname
then false
else r t
in
r
I don’t know what all your cases look like but you will write a function something like the above.
Then to see if you can unify things:
let can_unify = function
| TypeVar t1, TypeVar t2 when String.( = ) t1 t2 -> (* decide what to do here *)
| TypeVar varname, t -> not (is_free ~varname t)
| _ -> (* throw an error or fix your types so this case can’t happen *)
You can now achieve what you want with familiar list functions.

Generalized fold for inductive datatypes in coq

I've found myself repeating a pattern over and over again, and I'd like to abstract it. I'm fairly confident that coq is sufficiently expressive to capture the pattern, but I'm having a bit of trouble figuring out how to do so. I'm defining a programming language, which has mutually recursive inductive datatypes representing the syntactic terms:
Inductive Expr : Set :=
| eLambda (x:TermVar) (e:Expr)
| eVar (x:TermVar)
| eAscribe (e:Expr) (t:IFType)
| ePlus (e1:Expr) (e2:Expr)
| ... many other forms ...
with DType : Set :=
| tArrow (x:TermVar) (t:DType) (c:Constraint) (t':DType)
| tInt
| ... many other forms ...
with Constraint : Set :=
| cEq (e1:Expr) (e2:Expr)
| ...
Now, there are a number of functions that I need to define over these types. For example, I'd like a function to find all of the free variables, a function to perform substitution, and a function to pull out the set of all constraints. These functions all have the following form:
Fixpoint doExpr (e:Expr) := match e with
(* one or two Interesting cases *)
| ...
(* lots and lots of boring cases,
** all of which just recurse on the subterms
** and then combine the results in the same way
*)
| ....
with doIFType (t:IFType) := match t with
(* same structure as above *)
with doConstraint (c:Constraint) := match c with
(* ditto *)
For example, to find free variables, I need to do something interesting in the variable cases and the cases that do binding, but for everything else I just recursively find all of the free variables of the subexpressions and then union those lists together. Similarly for the function that produces a list of all of the constraints. The substitution case is a little bit more tricky, because the result types of the three functions are different, and the constructors used to combine the subexpressions are also different:
Variable x:TermVar, v:Expr.
Fixpoint substInExpr (e:Expr) : **Expr** := match e with
(* interesting cases *)
| eLambda y e' =>
if x = y then eLambda y e' else eLambda y (substInExpr e')
| eVar y =>
if x = y then v else y
(* boring cases *)
| eAscribe e' t => **eAscribe** (substInExpr e') (substInType t)
| ePlus e1 e2 => **ePlus** (substInExpr e1) (substInExpr e2)
| ...
with substInType (t:Type) : **Type** := match t with ...
with substInConstraint (c:Constraint) : **Constraint** := ...
.
Writing these functions is tedious and error prone, because I have to write out all of the uninteresting cases for each function, and I need to make sure I recurse on all of the subterms. What I would like to write is something like the following:
Fixpoint freeVars X:syntax := match X with
| syntaxExpr eVar x => [x]
| syntaxExpr eLambda x e => remove x (freeVars e)
| syntaxType tArrow x t1 c t2 => remove x (freeVars t1)++(freeVars c)++(freeVars t2)
| _ _ args => fold (++) (map freeVars args)
end.
Variable x:TermVar, v:Expr.
Fixpoint subst X:syntax := match X with
| syntaxExpr eVar y => if y = x then v else eVar y
| syntaxExpr eLambda y e => eLambda y (if y = x then e else (subst e))
| syntaxType tArrow ...
| _ cons args => cons (map subst args)
end.
The key to this idea is the ability to generally apply a constructor to some number of arguments, and to have some kind of "map" that that preserves the type and number of arguments.
Clearly this pseudocode doesn't work, because the _ cases just aren't right. So my question is, is it possible to write code that is organized this way, or am I doomed to just manually listing out all of the boring cases?
Here's another way, though it's not everyone's cup of tea.
The idea is to move recursion out of the types and the evaluators, parameterizing it instead, and turning your expression values into folds. This offers convenience in some ways, but more effort in others -- it's really a question of where you end up spending the most time. The nice aspect is that evaluators can be easy to write, and you won't have to deal with mutually recursive definitions. However, some things that are simpler the other way can become brain-twisters in this style.
Require Import Ssreflect.ssreflect.
Require Import Ssreflect.ssrbool.
Require Import Ssreflect.eqtype.
Require Import Ssreflect.seq.
Require Import Ssreflect.ssrnat.
Inductive ExprF (d : (Type -> Type) -> Type -> Type)
(c : Type -> Type) (e : Type) : Type :=
| eLambda (x:nat) (e':e)
| eVar (x:nat)
| eAscribe (e':e) (t:d c e)
| ePlus (e1:e) (e2:e).
Inductive DTypeF (c : Type -> Type) (e : Type) : Type :=
| tArrow (x:nat) (t:e) (c':c e) (t':e)
| tInt.
Inductive ConstraintF (e : Type) : Type :=
| cEq (e1:e) (e2:e).
Definition Mu (f : Type -> Type) := forall a, (f a -> a) -> a.
Definition Constraint := Mu ConstraintF.
Definition DType := Mu (DTypeF ConstraintF).
Definition Expr := Mu (ExprF DTypeF ConstraintF).
Definition substInExpr (x:nat) (v:Expr) (e':Expr) : Expr := fun a phi =>
e' a (fun e => match e return a with
(* interesting cases *)
| eLambda y e' =>
if (x == y) then e' else phi e
| eVar y =>
if (x == y) then v _ phi else phi e
(* boring cases *)
| _ => phi e
end).
Definition varNum (x:ExprF DTypeF ConstraintF nat) : nat :=
match x with
| eLambda _ e => e
| eVar y => y
| _ => 0
end.
Compute (substInExpr 2 (fun a psi => psi (eVar _ _ _ 3))
(fun _ phi =>
phi (eLambda _ _ _ 1 (phi (eVar _ _ _ 2)))))
nat varNum.
Compute (substInExpr 1 (fun a psi => psi (eVar _ _ _ 3))
(fun _ phi =>
phi (eLambda _ _ _ 1 (phi (eVar _ _ _ 2)))))
nat varNum.
Here is a way to go, but it does not give very readable code: use tactics.
Let's say I have a language with many constructors of various arity, and I want to apply a specific goal only to the case given by constructor aaa, and I want to traverse all the other constructors, to get down to the aaa's that may appear under them. I can do the following:
Say you want to define a function A -> B (A is the type of the language), you will need to keep track of what case you are in,
so you should define a phantom type over A, reducing to B.
Definition phant (x : A) : Type := B.
I suppose that the union function has type B -> B -> B and that you have a default value in B, called empty_B
Ltac generic_process f acc :=
match goal with
|- context [phan (aaa _)] => (* assume aaa has arith 1 *)
intros val_of_aaa_component; exact process_this_value val_of_aaa_component
| |- _ =>
(* This should be used when the next argument of the current
constructor is in type A, you want to process recursively
down this argument, using the function f, and keep this result
in the accumulator. *)
let v := fresh "val_in_A" in
intros v; generic_process f (union acc (f v))
(* This clause will fail if val_in_A is not in type A *)
| |- _ => let v := fresh "val_not_in_A" in
(* This should be used when the next argument of the current
constructor is not in type A, you want to ignore it *)
intros v; generic_process f acc
| |- phant _ =>
(* this rule should be used at the end, when all
the arguments of the constructor have been used. *)
exact acc
end.
Now, you define the function by a proof. Let's say the function is called process_aaa.
Definition process_aaa (x : A) : phant x.
fix process_aaa 1.
(* This adds process_add : forall x:A, phant x. in the context. *)
intros x; case x; generic_process process_aaa empty_B.
Defined.
Note that the definition of generic_process only mention one constructor by name, aaa, all others
are treated in a systematic way. We use the type information to detect those sub-components in which we want to perform a recursive descent. If you have several mutually inductive types, you can add arguments to the generic_process function to indicate which function will be used for each type and have more clauses, one for each argument of each type.
Here is a test of this idea, where the language has 4 constructors, values to be processed are the ones that appear in the constructor var and the type nat is also used in another constructor (c2). We use the type of lists of natural numbers as the type B, with nil as the empty and singleton lists as result when encountering variables. The function collects all occurrences of var.
Require Import List.
Inductive expr : Type :=
var : nat -> expr
| c1 : expr -> expr -> expr -> expr
| c2 : expr -> nat -> expr
| c3 : expr -> expr -> expr
| c4 : expr -> expr -> expr
.
Definition phant (x : expr) : Type := list nat.
Definition union := (#List.app nat).
Ltac generic_process f acc :=
match goal with
|- context[phant (var _)] => exact (fun y => y::nil)
| |- _ => let v := fresh "val_in_expr" in
intros v; generic_process f (union acc (f v))
| |- _ => let v := fresh "val_not_in_expr" in
intros v; generic_process f acc
| |- phant _ => exact acc
end.
Definition collect_vars : forall x : expr, phant x.
fix collect_vars 1.
intros x; case x; generic_process collect_vars (#nil nat).
Defined.
Compute collect_vars (c1 (var 0) (c2 (var 4) 1)
(c3 (var 2) (var 3))).
The last computation returns a list containing values 0 4 2 and 3 as expected, but not 1, which did not occur inside a var constructor.

Haskell - parse error/ using multiple where clauses

when trying to define a function that would remove the largest subset of set m that is also a subset of set a from set a, I encountered the following error:
filename.hs:7:33:parse error (possibly incorrect indentation)
for the following code:
exclude :: Integral t => [t] -> [t] -> [t]
a `exclude` m
| m == [] = a
| a == (b ++ c) = b
| otherwise = []
where b /= []
where c = [z | z <- m]
how do I implement multiple conditions/definitions (using where or otherwise), or correct the function to properly work in a different way?
One part of your question is easily answerable. You can have multiple definitions in one where clause, as in
foo n
| even r = bar
| s < 12 = baz
| otherwise = quux
where
r = n `mod` 1357
h = a + b
where
(a,b) = r `divMod` 53 -- nested where-clause
s = r - 3*h
and you can have nested where-clauses. But in a where-clause, you can only have definitions. Conditions would go into the guards (or if then else expressions on the right hand side) and can be combined with the boolean operators, (&&), (||), not ...
As for your code, so far I haven't figured out what you intended it to do.
Saying "the largest subset of set m that is also a subset of set a"
is the same as saying "all elements of m that are also elements of a".
Then the solution to your problem is stated simply as:
exclude a = filter (`notElem` a)
which when applied to m will give you a subset of m modulo any elements
that are also members of a. That is, it will "remove the largest subset of
m that is also a subset of a".
In fact,there is a function in Data.List and Data.Set called '\'. I'll show '\' function of Data.List .
import Data.List
exclude :: Integral t => [t] -> [t] -> [t]
a `exclude` m = a\\m