st/lama_byterun
1
0
Fork 0
mirror of https://github.com/ProgramSnail/Lama.git synced 2025-12-06 06:48:48 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Length, string -> std functions

Browse source
This commit is contained in:
Dmitry Boulytchev 2021-01-31 22:57:12 +03:00
parent 216e716251
commit f1430a1cdf
10 changed files with 21 additions and 39 deletions
Download patch file Download diff file Expand all files Collapse all files

4
regression/test082.lama
View file

@ -3,8 +3,8 @@ var n;
fun collect_ints_acc (v, tail) {
var i;
case v of
a@#val -> Cons (a, tail)
| #string -> tail
a@#val -> Cons (a, tail)
| #str -> tail
| _ ->
for i := 0, i < v.length, i := i + 1 do
tail := collect_ints_acc (v[i], tail)

2
runtime/Std.i
View file

@ -4,6 +4,8 @@ F,system;
V,sysargs;
F,stringInt;
F,makeArray;
F,string;
F,length;
F,clone;
F,hash;
F,fst;

4
runtime/runtime.c
View file

@ -335,7 +335,7 @@ int Ls__Infix_37 (void *p, void *q) {
return BOX(UNBOX(p) % UNBOX(q));
}
extern int Blength (void *p) {
extern int Llength (void *p) {
data *a = (data*) BOX (NULL);
ASSERT_BOXED(".length", p);
@ -974,7 +974,7 @@ extern void* Lstringcat (void *p) {
return s;
}
extern void* Bstringval (void *p) {
extern void* Lstring (void *p) {
void *s = (void *) BOX (NULL);
__pre_gc () ;

28
src/Language.ml
View file

@ -149,11 +149,11 @@ module Value =
module Builtin =
struct
let list = ["read"; "write"; ".elem"; ".length"; ".array"; ".stringval"]
let list = ["read"; "write"; ".elem"; "length"; ".array"; "string"]
let bindings () = List.map (fun name -> name, Value.Builtin name) list
let names = List.map (fun name -> name, FVal) list
let eval (st, i, o, vs) args = function
let eval (st, i, o, vs) args = function
| "read" -> (match i with z::i' -> (st, i', o, (Value.of_int z)::vs) | _ -> failwith "Unexpected end of input")
| "write" -> (st, i, o @ [Value.to_int @@ List.hd args], Value.Empty :: vs)
| ".elem" -> let [b; j] = args in
@ -164,9 +164,9 @@ let eval (st, i, o, vs) args = function
| Value.Sexp (_, a) -> a.(i)
) :: vs
)
| ".length" -> (st, i, o, (Value.of_int (match List.hd args with Value.Sexp (_, a) | Value.Array a -> Array.length a | Value.String s -> Bytes.length s))::vs)
| ".array" -> (st, i, o, (Value.of_array @@ Array.of_list args)::vs)
| ".stringval" -> let [a] = args in (st, i, o, (Value.of_string @@ Value.string_val a)::vs)
| "length" -> (st, i, o, (Value.of_int (match List.hd args with Value.Sexp (_, a) | Value.Array a -> Array.length a | Value.String s -> Bytes.length s))::vs)
| ".array" -> (st, i, o, (Value.of_array @@ Array.of_list args)::vs)
| "string" -> let [a] = args in (st, i, o, (Value.of_string @@ Value.string_val a)::vs)
end
@ -328,7 +328,7 @@ module Pattern =
| %"false" {Const 0}
| "#" %"box" {Boxed}
| "#" %"val" {UnBoxed}
| "#" %"string" {StringTag}
| "#" %"str" {StringTag}
| "#" %"sexp" {SexpTag}
| "#" %"array" {ArrayTag}
| "#" %"fun" {ClosureTag}
@ -369,8 +369,6 @@ module Expr =
(* binary operator *) | Binop of string * t * t
(* element extraction *) | Elem of t * t
(* reference to an element *) | ElemRef of t * t
(* length *) | Length of t
(* string conversion *) | StringVal of t
(* function call *) | Call of t * t list
(* assignment *) | Assign of t * t
(* composition *) | Seq of t * t
@ -487,8 +485,6 @@ module Expr =
eval (st, i, o, (Value.of_int n) :: vs) Skip k
| String s ->
eval (st, i, o, (Value.of_string @@ Bytes.of_string s) :: vs) Skip k
| StringVal s ->
eval conf k (schedule_list [s; Intrinsic (fun (st, i, o, s::vs) -> (st, i, o, (Value.of_string @@ Value.string_val s)::vs))])
| Var x ->
let v =
match State.eval st x with
@ -509,8 +505,6 @@ module Expr =
eval conf k (schedule_list [b; i; Intrinsic (fun (st, i, o, j::b::vs) -> Builtin.eval (st, i, o, vs) [b; j] ".elem")])
| ElemRef (b, i) ->
eval conf k (schedule_list [b; i; Intrinsic (fun (st, i, o, j::b::vs) -> (st, i, o, (Value.Elem (b, Value.to_int j))::vs))])
| Length e ->
eval conf k (schedule_list [e; Intrinsic (fun (st, i, o, v::vs) -> Builtin.eval (st, i, o, vs) [v] ".length")])
| Call (f, args) ->
eval conf k (schedule_list (f :: args @ [Intrinsic (fun (st, i, o, vs) ->
let es, vs' = take (List.length args + 1) vs in
@ -656,8 +650,6 @@ module Expr =
primary[infix][atr]:
s:(s:"-"? {match s with None -> fun x -> x | _ -> fun x -> Binop ("-", Const 0, x)})
b:base[infix][Val] is:( "." f:LIDENT args:(-"(" !(Util.list)[parse infix Val] -")")? {`Post (f, args)}
| "." %"length" {`Len}
| "." %"string" {`Str}
| "[" i:parse[infix][Val] "]" {`Elem i}
| "(" args:!(Util.list0)[parse infix Val] ")" {`Call args}
)+
@ -682,8 +674,6 @@ module Expr =
(fun b ->
function
| `Elem i -> Elem (b, i)
| `Len -> Length b
| `Str -> StringVal b
| `Post (f, args) -> Call (Var f, b :: match args with None -> [] | Some args -> args)
| `Call args -> (match b with Sexp _ -> invalid_arg "retry!" | _ -> Call (b, args))
)
@ -693,8 +683,6 @@ module Expr =
let res = match lastElem, atr with
| `Elem i , Reff -> ElemRef (b, i)
| `Elem i , _ -> Elem (b, i)
| `Len , _ -> Length b
| `Str , _ -> StringVal b
| `Post (f, args), _ -> Call (Var f, b :: match args with None -> [] | Some args -> args)
| `Call args , _ -> (match b with Sexp _ -> invalid_arg "retry!" | _ -> Call (b, args))
in
@ -1266,10 +1254,8 @@ let run_parser cmd =
"while"; "do"; "od";
"for";
"fun"; "var"; "public"; "external"; "import";
"length";
"string";
"case"; "of"; "esac"; "when";
"box"; "val"; "string"; "sexp"; "array";
"box"; "val"; "str"; "sexp"; "array";
"infix"; "infixl"; "infixr"; "at"; "before"; "after";
"true"; "false"; "lazy"; "eta"; "syntax"]
in

6
src/SM.ml
View file

@ -830,12 +830,6 @@ let compile cmd ((imports, infixes), p) =
| Expr.Elem (a, i) -> let lelem, env = env#get_label in
add_code (compile_list false lelem env [a; i]) lelem false [CALL (".elem", 2, tail)]
| Expr.Length e -> let llen, env = env#get_label in
add_code (compile_expr false llen env e) llen false [CALL (".length", 1, tail)]
| Expr.StringVal e -> let lsv, env = env#get_label in
add_code (compile_expr false lsv env e) lsv false [CALL (".stringval", 1, tail)]
| Expr.Assign (Expr.Ref x, e) -> let lassn, env = env#get_label in
let env , line = env#gen_line x in
let env , acc = env#lookup x in

2
src/version.ml
View file

@ -1 +1 @@
let version = "Version 1.10, 5ae88f820, Sun Jan 31 21:07:17 2021 +0300"
let version = "Version 1.10, 216e71625, Sun Jan 31 22:25:31 2021 +0300"

2
stdlib/Collection.lama
View file

@ -317,7 +317,7 @@ public fun lookupMemo (mm@[p, m], v) {
Some (w) -> w
| None ->
case v of
#string -> mm[1] := addMap (m, v, v); v
#str -> mm[1] := addMap (m, v, v); v
| _ ->
var vc = clone (v), i = case vc of #fun -> 1 | _ -> 0 esac;
for skip, i < v.length, i := i + 1 do

6
stdlib/Ostap.lama
View file

@ -18,7 +18,7 @@ public fun logOn () {
public fun initOstap () {
tab := ref (emptyHashTab (1024, hash, compare));
restab := emptyCustomMemo (fun (x) {case x of #string -> true | _ -> false esac}, compare);
restab := emptyCustomMemo (fun (x) {case x of #str -> true | _ -> false esac}, compare);
hct := emptyMemo ()
}
@ -74,8 +74,8 @@ public fun memo (f) {
public fun token (x) {
case x of
#string -> memo $ fun (k) {fun (s) {k $ matchString (s, x)}}
| _ -> memo $ fun (k) {fun (s) {k $ matchRegexp (s, x)}}
#str -> memo $ fun (k) {fun (s) {k $ matchString (s, x)}}
| _ -> memo $ fun (k) {fun (s) {k $ matchRegexp (s, x)}}
esac
}

2
stdlib/regression/test02.lama
View file

@ -6,7 +6,7 @@ var
lident = createRegexp ("[a-z][a-zA-Z_]*", "lowercase identifier"),
uident = createRegexp ("[A-Z][a-zA-Z_]*", "uppercase identifier"),
ws = createRegexp ("\\([ \t\n]\\|--[^\n]*\n\\)*", "whitespace"),
str = createRegexp ("""\([^""]\|""""\)*""", "string literal"),
strlit = createRegexp ("""\([^""]\|""""\)*""", "string literal"),
decimal = createRegexp ("[0-9]+", "decimal literal"),
chr = createRegexp ("'[^']'", "character literal");

4
stdlib/regression/test21.lama
View file

@ -2,8 +2,8 @@ fun collect_ints_acc (v, tail) {
var i;
case v of
a@#val -> Cons (a, tail)
| #string -> tail
a@#val -> Cons (a, tail)
| #str -> tail
| _ ->
for i := 0, i < v.length, i := i + 1 do
tail := collect_ints_acc (v[i], tail)