Strings

editor/rustscript.vim

@@ -56,6 +56,9 @@ syntax match rscIdentifier "\v[A-Za-z@!?][A-Za-z0-9@!?]*"
 syntax match rscIdentifier "\v_"
 highlight link rscIdentifier Identifier
 
+syntax match rscString "\v\".*\""
+highlight link rscString String
+
 " comments
 syntax match rscComment "#.*"
 highlight link rscComment Comment

examples/bst.rsc

@@ -20,8 +20,7 @@ let tree_to_ls_inorder = {
 	| %{val: v, left: l, right: r} -> {
 	    let acc = loop(l, acc)
 	    let acc = [v | acc]
-	    let acc = loop(r, acc)
-	    acc
+	    loop(r, acc)
 	}
 
     fn(bst) => reverse(loop(bst, []))
@@ -32,3 +31,4 @@ let construct_from_list = fn(ls) =>
 
 let ls = [50, 30, 20, 65, 42, 20, 40, 70, 60, 80]
 let bst = construct_from_list(ls)
+inspect(bst)

examples/strings.rsc

@@ -0,0 +1,7 @@
+let a = "abc"
+
+let b = "123!"
+
+let result = match (a, b, a + b)
+    | ("abc", "123!", "abc123!") -> T
+    | _ -> F

lib/eval.ml

@@ -14,6 +14,8 @@ let rec bind lhs rhs ss =
             Map.set state ~key:s ~data:rhs;
     | NumberPat lhs, Number rhs when Float.equal lhs rhs -> 
             fun state -> state
+    | StringPat lhs, StringVal rhs when String.equal lhs rhs ->
+            fun state -> state
     | OrPat (l, r), _ -> fun state ->
             if (pattern_matches l rhs state) then (bind l rhs) state else (bind r rhs) state
     | AsPat (pat, n), _ -> fun state ->
@@ -68,8 +70,8 @@ and pattern_matches pat value ss state =
         | SinglePat _, _ -> true
         | AsPat (pat, _), _ -> pattern_matches pat value state
         | OrPat (lhs, rhs), value -> (pattern_matches lhs value state) || (pattern_matches rhs value state)
-        | NumberPat lhs, Number rhs -> 
-                Float.equal lhs rhs
+        | NumberPat lhs, Number rhs -> Float.equal lhs rhs
+        | StringPat lhs, StringVal rhs -> String.equal lhs rhs
         | ((TuplePat lhs_ls), (Tuple rhs_ls))|(ListPat (FullPat lhs_ls), ValList rhs_ls) ->
             if list_equal_len lhs_ls rhs_ls then
                 let zipped = List.zip_exn lhs_ls rhs_ls in
@@ -127,6 +129,17 @@ and fold_builtin (args, state) ss =
             printf "Expected (init, fn, ls) as arguments to fold\n";
             assert false
 
+and to_charlist_builtin (args, state) _ss =
+    match args with
+        | Tuple [StringVal s] ->
+            let chars = String.to_list s in
+            let char_strs = List.map ~f:String.of_char chars in
+            let val_ls = List.map ~f:(fun c -> StringVal c) char_strs in
+            ValList val_ls, state
+        | _ ->
+            printf "Expected a single string argument to to_charlist";
+            assert false
+
 and eval_op op lhs rhs ss = fun s ->
     let (lhs, s) = (eval_expr lhs ss) s in
     let (rhs, s) = (eval_expr rhs ss) s in
@@ -182,6 +195,7 @@ and eval_lambda_call ?tc:(tail_call=false) call ss =
                 | "inspect" -> inspect_builtin ((eval_expr call.call_args ss) state) ss
                 | "range_step" -> range_builtin ((eval_expr call.call_args ss) state)
                 | "fold" -> fold_builtin ((eval_expr call.call_args ss) state) ss
+                | "to_charlist" -> to_charlist_builtin ((eval_expr call.call_args ss) state) ss
                 | "get" ->
                     let (args, state) = (eval_expr call.call_args ss) state in begin
                     match args with

lib/operators.ml

@@ -5,6 +5,7 @@ open Base
 let val_add lhs rhs ss = match lhs, rhs with
     | Number lhs, Number rhs -> Number (lhs +. rhs)
     | ValList lhs, ValList rhs ->  ValList (lhs @ rhs)
+    | StringVal lhs, StringVal rhs ->  StringVal (lhs ^ rhs)
     | _ -> 
             printf "Invalid Add: lhs = %s, rhs = %s\n" (string_of_val ss lhs) (string_of_val ss rhs);
             assert false

lib/parser.ml

@@ -18,35 +18,35 @@ let prefix_op_bp = 13
 let rec complete_expr lhs ls min_bp = match ls with
     | Percent::xs -> complete_expr lhs ((Operator Mod)::xs) min_bp
     | (Operator op)::xs ->
-            let (l_bp, r_bp) = binary_op_bp op
-            in
-            if l_bp < min_bp 
-                then (lhs, ls)
-                else let (rhs, rem) = parse xs r_bp in 
-                     let complete = Binary {op = op; lhs = lhs; rhs = rhs}
-                      in complete_expr complete rem min_bp
+            let (l_bp, r_bp) = binary_op_bp op in
+            if l_bp < min_bp then 
+                (lhs, ls)
+            else 
+                let (rhs, rem) = parse xs r_bp in 
+                let complete = Binary {op = op; lhs = lhs; rhs = rhs} in 
+                complete_expr complete rem min_bp
     | _ -> (lhs, ls)
 
 and parse_prefix_expr op xs min_bp =
     let (rhs, rem) = parse xs min_bp in 
     let complete = Prefix {op = op; rhs = rhs} in
     complete_expr complete rem min_bp
 
-and parse_expr_tuple xs min_bp =
+and parse_paren_expr xs min_bp =
     let rec aux toks saw_comma acc = match toks with
         | RParen::rest -> acc, rest, saw_comma
-        | _ -> let nx, rest = parse toks 0 in begin
+        | _ -> let nx, rest = parse toks 0 in
             match rest with
                 | Comma::rest -> aux rest true (nx::acc)
                 | RParen::rest -> (nx::acc), rest, saw_comma
                 | _ -> assert false
-        end
-    in let expr_list, rest, saw_comma = aux xs false [] in begin
+
+    in let expr_list, rest, saw_comma = aux xs false [] in
         match expr_list, saw_comma with
             | _, true -> complete_expr (TupleExpr (List.rev expr_list)) rest min_bp
             | [], false -> complete_expr (TupleExpr []) rest min_bp
-            | _, false -> complete_expr (List.hd_exn expr_list) rest min_bp
-    end
+            | [paren_expr], false -> complete_expr (paren_expr) rest min_bp
+            | _, false -> assert false
 
 
 and parse_list_expr xs min_bp =
@@ -61,10 +61,10 @@ and parse_list_expr xs min_bp =
     and parse_range ls expr_list =
         let (end_, rest) = parse ls 0 in
         match expr_list, rest with
-            | [a; b], RBracket::rest ->
-                let step = (Binary {lhs = a; rhs = b; op = Neg}) in
+            | [snd; fst], RBracket::rest ->
+                let step = (Binary {lhs = snd; rhs = fst; op = Neg}) in
                 let call =
-                    LambdaCall {callee = "range_step"; call_args = TupleExpr [b;end_;step]}
+                    LambdaCall {callee = "range_step"; call_args = TupleExpr [fst;end_;step]}
                 in
                 complete_expr call rest min_bp
             | [start], RBracket::rest ->
@@ -76,6 +76,19 @@ and parse_list_expr xs min_bp =
                 printf "Invalid range expression:\n";
                 assert false
 
+    and parse_filter_clause ls = match ls with
+        | RBracket::xs -> None, xs
+        | If::rest -> begin match parse rest 0 with
+            | e, RBracket::more ->
+                Some e, more
+            | _ ->
+                printf "Invalid filter clause in list comprehension\n";
+                assert false
+        end
+        | _ ->
+            printf "Invalid list comprehension";
+            assert false
+
     and parse_listcomp ls expr_list =
         let arg_pat, rest = parse_pat ls in
         let arg_pat = TuplePat [arg_pat] in
@@ -85,20 +98,7 @@ and parse_list_expr xs min_bp =
                 let map_fn = LambdaDef {lambda_def_expr = map_expr; lambda_def_args = arg_pat} in
                 let map_args = TupleExpr [map_fn; ls_expr] in
                 let mapped_ls = LambdaCall {callee = "map_rev"; call_args = map_args} in
-                let filter_expr, more = match rest with
-                    | RBracket::more -> 
-                        None, more
-                    | If::rest -> begin match parse rest 0 with
-                        | e, RBracket::more ->
-                            Some e, more
-                        | _ ->
-                            printf "Invalid filter clause in list comprehension\n";
-                            assert false
-                    end
-                    | _ ->
-                        printf "Invalid list comprehension\n";
-                        assert false
-                in
+                let filter_expr, more = parse_filter_clause rest in
                 begin match filter_expr with
                     | Some e ->
                         let filter_fn = LambdaDef {lambda_def_expr = e; lambda_def_args = arg_pat} in
@@ -134,10 +134,11 @@ and parse_list_expr xs min_bp =
     aux xs []
 
 and expr_bp ls min_bp = match ls with
-    | (LParen::xs) -> parse_expr_tuple xs min_bp
+    | (LParen::xs) -> parse_paren_expr xs min_bp
     | (LBracket::xs) -> parse_list_expr xs min_bp
     | (Number f)::xs -> complete_expr (Atomic (Number f)) xs min_bp
     | (Ident n)::xs -> complete_expr (Ident n) xs min_bp
+    | (StringTok s)::xs -> complete_expr (Atomic (StringVal s)) xs min_bp
     | (Operator op)::xs -> parse_prefix_expr op xs min_bp
     | True::xs -> complete_expr (Atomic (Boolean true)) xs min_bp
     | False::xs -> complete_expr (Atomic (Boolean false)) xs min_bp
@@ -227,6 +228,7 @@ and parse_pat ?in_list:(in_list=false) ls = match ls with
         assert false
     | (Ident s)::xs -> complete_pat (SinglePat s) xs in_list
     | (Number f)::xs -> complete_pat (NumberPat f) xs in_list
+    | (StringTok f)::xs -> complete_pat (StringPat f) xs in_list
     | Underscore::xs -> complete_pat WildcardPat xs in_list
     | _ ->
             printf "Expected pattern, got %s" (string_of_toks ls);
@@ -422,7 +424,7 @@ and parse: token list -> int -> expr * (token list) = fun s min_bp ->
         | LParen::_ -> expr_bp s 0
         | LBracket::_ -> expr_bp s 0
         | (Operator _)::_ -> expr_bp s 0
-        | (True|False|Number _| Ident _)::_ -> expr_bp s min_bp
+        | (True|False|Number _| Ident _| StringTok _)::_ -> expr_bp s min_bp
         | Let::xs -> parse_let xs
         | Fn::_ -> 
             let (lambda_parsed, xs) = parse_lambda s in

lib/preprocess.ml

@@ -2,7 +2,7 @@ open Base
 open Types
 
 let rec find_pat_atoms pat atoms = match pat with
-    | SinglePat _ | NumberPat _ | AtomPat _ | WildcardPat -> atoms
+    | SinglePat _ | NumberPat _ | AtomPat _ | StringPat _ | WildcardPat -> atoms
     | TuplePat ls -> List.fold_left ~init:atoms ~f:(fun atoms pat -> find_pat_atoms pat atoms) ls
     | ListPat (FullPat ls) -> List.fold_left ~init:atoms ~f:(fun atoms pat -> find_pat_atoms pat atoms) ls
     | ListPat (HeadTailPat (ls, tail)) -> atoms |> find_pat_atoms (ListPat (FullPat ls)) |> find_pat_atoms tail
@@ -39,7 +39,7 @@ let rec resolve_pat_atoms ss p =
     let resolve = resolve_pat_atoms ss in
     let resolve_expr = resolve_atoms ss in
     match p with
-    | SinglePat _ | NumberPat _ | AtomPat _ | WildcardPat -> p
+    | SinglePat _ | NumberPat _ | AtomPat _ | WildcardPat | StringPat _ -> p
     | TuplePat ls -> TuplePat (List.map ~f:resolve ls)
     | ListPat (FullPat ls) ->  ListPat (FullPat (List.map ~f:resolve ls))
     | ListPat (HeadTailPat (ls, p)) -> ListPat (HeadTailPat (List.map ~f:resolve ls, resolve p))

lib/run.ml

@@ -67,6 +67,10 @@ let enumerate_rev_rsc =
 
 let enumerate_rsc = "let enumerate = fn(ls) => reverse(enumerate_rev(ls))"
 
+let concat_rsc = "let concat = fn(ls) => fold(\"\", fn(a, b) => a + b, ls)"
+
+let concat_sep_rsc = "let concat_sep = fn(ls, sep) => fold(\"\", fn(a, b) => a + b + sep, ls)"
+
 let load_stdlib state =
     let ss = { static_atoms = [] } in
     let run_line_swap line state = run_line ss state line in
@@ -83,6 +87,8 @@ let load_stdlib state =
         |> run_line_swap length_rsc
         |> run_line_swap enumerate_rev_rsc
         |> run_line_swap enumerate_rsc
+        |> run_line_swap concat_rsc
+        |> run_line_swap concat_sep_rsc
 
 let default_state: state = Map.empty (module String) |> load_stdlib
 

lib/scanner.ml

@@ -1,11 +1,13 @@
 open Base
 open Stdio
+open Printf
 
 type token =
     | True
     | False
     | Number of float
     | Ident of string
+    | StringTok of string
     | Operator of Types.operator
     | Match
     | Let
@@ -72,6 +74,15 @@ and scan_ident ls =
                 tok::(scan_ls ls)
     in aux ls []
 
+and scan_string ls =
+    let rec aux ls acc = match ls with
+        | '"'::xs -> (StringTok (String.of_char_list (List.rev acc)))::(scan_ls xs)
+        | c::xs -> aux xs (c::acc)
+        | [] ->
+            printf "Unmatched quote";
+            assert false
+    in aux ls []
+
 and scan_ls = function
     | [] -> []
     | (' '|'\t')::xs -> scan_ls xs
@@ -109,6 +120,7 @@ and scan_ls = function
     | 'T'::xs -> True :: scan_ls xs
     | 'F'::xs -> False :: scan_ls xs
     | ':'::xs -> Colon :: scan_ls xs
+    | '"'::xs -> scan_string xs
     | d::_ as ls when Char.is_digit d -> scan_digit ls
     | i::_ as ls when Char.is_alpha i -> scan_ident ls
     | ls -> 
@@ -130,6 +142,7 @@ let scan s = s |> String.to_list |> scan_ls |> remove_comments
 let string_of_tok = function
     | Number f -> Float.to_string f
     | Ident s -> "(Ident " ^ s ^ ")"
+    | StringTok s -> sprintf "String (\"%s\")" s
     | Operator _ -> "Operator"
     | Let -> "Let"
     | Equal -> "Equal"

lib/types.ml

@@ -29,10 +29,12 @@ type value =
     | Thunk of {thunk_fn: lambda; thunk_args: value; thunk_fn_name: string}
     | Dictionary of (int, (value * value) list, Int.comparator_witness) Map.t
     | Atom of int
+    | StringVal of string
 
 and pattern =
     | SinglePat of string
     | NumberPat of float
+    | StringPat of string
     | UnresolvedAtomPat of string
     | AtomPat of int
     | TuplePat of pattern list
@@ -74,7 +76,8 @@ let rec string_of_val ss v =
     let string_of_val = string_of_val ss in
     match v with
     | Number n -> Float.to_string n
-    | Boolean b -> Bool.to_string b
+    | Boolean true -> "T"
+    | Boolean false -> "F"
     | Tuple ls -> "(" ^ String.concat ~sep:", " (List.map ~f:string_of_val ls) ^ ")"
     | ValList ls -> "[" ^ String.concat ~sep:", " (List.map ~f:string_of_val ls) ^ "]"
     | Lambda _ -> "Lambda"
@@ -87,6 +90,7 @@ let rec string_of_val ss v =
     | Atom n -> 
         let reverse_map = List.Assoc.inverse ss.static_atoms in
         sprintf ":%s" (List.Assoc.find_exn reverse_map ~equal:Int.equal n)
+    | StringVal s -> sprintf "\"%s\"" s
 
 let rec string_of_expr ss e = 
     let string_of_expr = string_of_expr ss in
@@ -117,6 +121,7 @@ and string_of_list_pat = function
 
 and string_of_pat = function
     | SinglePat s -> s
+    | StringPat s -> sprintf "StringPat (\"%s\")" s
     | ListPat lp -> (string_of_list_pat lp)
     | MapPat _ -> "MapPat"
     | NumberPat f -> Float.to_string f

test/dune

@@ -1,3 +1,3 @@
 (tests
- (names fib tuple block comments tailrec euler match_expr map run_len_encode two_sum sort)
+ (names fib tuple block comments tailrec euler match_expr map run_len_encode two_sum sort strings)
  (libraries base stdio rustscript))

test/strings.ml

@@ -0,0 +1,12 @@
+open Base
+open Stdio
+
+open Rustscript.Run
+open Util
+
+let () =
+    let ss, state = 
+        Map.empty (module String) |> run_file (test_file "strings.rsc") in
+    assert_equal_expressions "result" "T" ss state;
+
+    printf "Passed\n"