successfully compiled converted to Ficus Ast.fx

vpisarev · Feb 27, 2021 · 8603ea9 · 8603ea9
1 parent 807e5f0
commit 8603ea9
Show file tree

Hide file tree

Showing 10 changed files with 320 additions and 196 deletions.
diff --git a/compiler/Ast.fx b/compiler/Ast.fx
diff --git a/lib/Builtins.fx b/lib/Builtins.fx
@@ -93,6 +93,10 @@ pure fun join_embrace(begin: string, end: string,
         strs->dim[0].size, fx_result);
 }
 
+fun join_embrace(begin: string, end: string,
+                 sep: string, strs: string list) =
+    join_embrace(begin, end, sep, [for s <- strs {s}])
+
 fun join(sep: string, strs: string list) =
     join(sep, [for s <- strs {s}])
 
@@ -206,6 +210,30 @@ pure fun string(a: char []): string = ccode {
     return fx_make_str((char_*)a->data, a->dim[0].size, fx_result);
 }
 
+pure operator * (c: char, n: int): string = ccode
+{
+    int fx_status = fx_make_str(0, n, fx_result);
+    if (fx_status >= 0) {
+        for( int_ i = 0; i < n; i++ )
+            fx_result->data[i] = c;
+    }
+    return fx_status;
+}
+
+pure operator * (s: string, n: int): string = ccode
+{
+    int_ sz = s->length;
+    int fx_status = fx_make_str(0, n*sz, fx_result);
+    if (fx_status >= 0 && (n*sz) > 0) {
+        for( int_ i = 0; i < n; i++ )
+            memcpy(fx_result->data + i*sz, s->data, sz*sizeof(s->data[0]));
+    }
+    return fx_status;
+}
+
+operator * (n: int, c: char) = c * n
+operator * (n: int, s: string) = s * n
+
 operator == (a: 't list, b: 't list): int =
     try {
         fold r=0 for xa <- a, xb <- b {

diff --git a/lib/Filename.fx b/lib/Filename.fx
@@ -5,17 +5,17 @@
 
 import Sys
 
-fun separator() = if Sys.win32 {"\\"} else {"/"}
+fun dir_sep() = if Sys.win32 {"\\"} else {"/"}
 
 fun is_absolute(path: string) =
-    path.startswith(separator()) ||
+    path.startswith(dir_sep()) ||
     path.startswith("/") ||
     path.find(":") >= 0
 
 fun is_relative(path: string) = !is_absolute(path)
 
 fun split(path: string) {
-    val sep = separator()
+    val sep = dir_sep()
     val sep0 = "/"
     assert(sep.length() == 1)
     if path.endswith(sep) || (sep != sep0 && path.endswith(sep0)) {
@@ -39,7 +39,7 @@ fun dirname(path: string) = split(path).0
 fun basename(path: string) = split(path).1
 
 fun concat(dir: string, fname: string) {
-    val sep = separator()
+    val sep = dir_sep()
     val sep0 = "/"
     if dir.endswith(sep) || dir.endswith(sep0) {
         dir + fname
@@ -50,7 +50,7 @@ fun concat(dir: string, fname: string) {
 
 fun normalize(dir: string, fname: string)
 {
-    val sep = separator()
+    val sep = dir_sep()
     val sep0 = "/"
     assert(sep.length() == 1)
     if is_absolute(fname) {
@@ -65,7 +65,7 @@ fun normalize(dir: string, fname: string)
 }
 
 fun remove_extension(path: string) {
-    val sep = separator()
+    val sep = dir_sep()
     val sep0 = "/"
     val dotpos = path.rfind(".")
     if dotpos < 0 {

diff --git a/lib/Set.fx b/lib/Set.fx
@@ -274,7 +274,7 @@ fun foldr(s: 't t, f: ('t, 'r) -> 'r, res0: 'r)
 
 fun app(s: 't t, f: 't -> void)
 {
-    fun app_(t: 't rbtree, f: 't -> void): void =
+    fun app_(t: 't tree_t, f: 't -> void): void =
     match t {
         | Node(_, l, x, r) => app_(l, f); f(x); app_(r, f)
         | _ => {}

diff --git a/lib/String.fx b/lib/String.fx
@@ -19,15 +19,15 @@ pure nothrow fun startswith(s: string, prefix: string): bool = ccode
 {
     int_ sz1 = s->length;
     int_ sz2 = prefix->length;
-    return sz2 <= sz1 && memcmp(s->data, prefix->data,
+    return sz2 == 0 ? true : sz2 <= sz1 && memcmp(s->data, prefix->data,
         (size_t)(sz2*sizeof(s->data[0]))) == 0;
 }
 
 pure nothrow fun endswith(s: string, suffix: string): bool = ccode
 {
     int_ sz1 = s->length;
     int_ sz2 = suffix->length;
-    return sz2 <= sz1 && memcmp(s->data + (sz1 - sz2), suffix->data,
+    return sz2 == 0 ? true : sz2 <= sz1 && memcmp(s->data + (sz1 - sz2), suffix->data,
         (size_t)(sz2*sizeof(s->data[0]))) == 0;
 }
 
@@ -49,13 +49,61 @@ pure nothrow fun find(s: string, part: string): int = ccode
 pure nothrow fun rfind(s: string, part: string): int = ccode
 {
     int_ sz1 = s->length, sz2 = part->length, pos = sz1 - sz2;
+    if (sz2 == 0)
+        return sz1 - 1;
     for ( ; pos >= 0; pos--) {
         if( memcmp(s->data + pos, part->data, sz2*sizeof(part->data[0])) == 0)
             break;
     }
     return pos;
 }
 
+pure nothrow fun has(s: string, c: char): bool = ccode
+{
+    int_ i, sz = s->length;
+    char_* data = s->data;
+
+    for ( i = 0; i < sz; pos--) {
+        if (data[i] == c) return true;
+    }
+    return false;
+}
+
+pure fun replace(s: string, substr: string, new_substr: string): string = ccode
+{
+    int_ i, j = 0, sz = s->length, sz1 = substr->length, sz2 = new_substr->length;
+    int_ newsz = 0;
+    if (sz == 0 || sz1 == 0) {
+        fx_copy_str(s, fx_result);
+        return FX_OK;
+    }
+    for( i = 0; i < sz; ) {
+        if( i <= sz - sz1 && s->data[i] == substr->data[0] &&
+            memcmp(s->data + i, substr->data, sz1*sizeof(s->data[0])) == 0 ) {
+            newsz += sz2;
+            i += sz1;
+        } else {
+            newsz++;
+            i++;
+        }
+    }
+    int fx_status = fx_make_str(0, newsz, fx_result);
+    if (fx_status >= 0) {
+        for( i = 0; i < sz; ) {
+            if( i <= sz - sz1 && s->data[i] == substr->data[0] &&
+                memcmp(s->data + i, substr->data, sz1*sizeof(s->data[0])) == 0 ) {
+                if (sz2 > 0)
+                    memcpy(fx_result->data + j, new_substr->data, sz2*sizeof(s->data[0]));
+                j += sz2;
+                i += sz1;
+            } else {
+                fx_result->data[j++] = s->data[i++];
+            }
+        }
+    }
+    return fx_status;
+}
+
 pure fun tolower(s: string): string = ccode
 {
     int_ i, sz = s->length;
@@ -71,7 +119,7 @@ pure fun tolower(s: string): string = ccode
     int fx_status = fx_make_str(0, sz, fx_result);
     if( fx_status >= 0 ) {
         char_* dst = fx_result->data;
-        for (size_t i = 0; i < sz; i++)
+        for (int_ i = 0; i < sz; i++)
             dst[i] = fx_tolower(src[i]);
     }
     return fx_status;
@@ -92,7 +140,7 @@ pure fun toupper(s: string): string = ccode
     int fx_status = fx_make_str(0, sz, fx_result);
     if( fx_status >= 0 ) {
         char_* dst = fx_result->data;
-        for (size_t i = 0; i < sz; i++)
+        for (int_ i = 0; i < sz; i++)
             dst[i] = fx_toupper(src[i]);
     }
     return fx_status;
@@ -110,7 +158,7 @@ pure fun capitalize(s: string): string = ccode
     if( fx_status >= 0 ) {
         char_* dst = fx_result->data;
         dst[0] = fx_toupper(src[0]);
-        for (size_t i = 1; i < sz; i++)
+        for (int_ i = 1; i < sz; i++)
             dst[i] = src[i];
     }
     return fx_status;
@@ -119,8 +167,7 @@ pure fun capitalize(s: string): string = ccode
 pure fun lstrip(s: string): string = ccode
 {
     const char_* ptr = s->data;
-    size_t sz = s->length;
-    size_t i = 0;
+    int_ i = 0, sz = s->length;
     for (; i < sz && fx_isspace(ptr[i]); i++)
         ;
     return fx_substr(s, i, sz, 1, 0, fx_result);
@@ -129,7 +176,7 @@ pure fun lstrip(s: string): string = ccode
 pure fun rstrip(s: string): string = ccode
 {
     const char_* ptr = s->data;
-    size_t sz = s->length;
+    int_ sz = s->length;
     for (; sz > 0 && fx_isspace(ptr[sz - 1]); sz--)
         ;
     return fx_substr(s, 0, sz, 1, 0, fx_result);

diff --git a/lib/Sys.fx b/lib/Sys.fx
@@ -9,6 +9,7 @@ import File
 ccode {
     #include <limits.h>
     #include <stdio.h>
+    #include <sys/stat.h>
     #include <unistd.h>
 
     #ifndef PATH_MAX
@@ -106,6 +107,18 @@ fun rename(name: string, new_name: string): bool = ccode
     return fx_status;
 }
 
+fun file_exists(name: string): bool = ccode
+{
+    fx_cstr_t name_;
+    int fx_status = fx_str2cstr(name, &name_, 0, 0);
+    if (fx_status >= 0) {
+        struct stat s;
+        *fx_result = stat(name_.data, &s) == 0;
+        fx_free_cstr(&name_);
+    }
+    return fx_status;
+}
+
 fun getcwd(): string = ccode {
     char buf[PATH_MAX+16];
     char* p = getcwd(buf, PATH_MAX);

diff --git a/runtime/ficus/impl/string.impl.h b/runtime/ficus/impl/string.impl.h
@@ -44,16 +44,25 @@ void fx_copy_str(const fx_str_t* src, fx_str_t* dst)
 
 int fx_make_str(const char_* strdata, int_ length, fx_str_t* str)
 {
-    size_t total = sizeof(*str->rc) + length*sizeof(strdata[0]);
-    str->rc = (int_*)fx_malloc(total);
-    if(!str->rc) FX_FAST_THROW_RET(FX_EXN_OutOfMemError);
-
-    *str->rc = 1;
-    str->data = (char_*)(str->rc + 1);
-    str->length = length;
-    if(strdata)
-        memcpy(str->data, strdata, length*sizeof(strdata[0]));
-    return FX_OK;
+    if (length <= 0) {
+        if (length == 0) {
+            fx_str_t temp = {0, 0, 0};
+            *str = temp;
+            return FX_OK;
+        }
+        FX_FAST_THROW_RET(FX_EXN_SizeError);
+    } else {
+        size_t total = sizeof(*str->rc) + length*sizeof(strdata[0]);
+        str->rc = (int_*)fx_malloc(total);
+        if(!str->rc) FX_FAST_THROW_RET(FX_EXN_OutOfMemError);
+
+        *str->rc = 1;
+        str->data = (char_*)(str->rc + 1);
+        str->length = length;
+        if(strdata)
+            memcpy(str->data, strdata, length*sizeof(strdata[0]));
+        return FX_OK;
+    }
 }
 
 int fx_make_cstr(const char* strdata, int_ length, fx_cstr_t* str)

diff --git a/src/ast_typecheck.ml b/src/ast_typecheck.ml
@@ -915,8 +915,8 @@ and check_exp e env sc =
         let (etyp1, eloc1) = get_exp_ctx new_e1 in
         let (etyp2, eloc2) = get_exp_ctx new_e2 in
 
-        if (maybe_unify etyp (TypList etyp1) false) &&
-           (maybe_unify etyp2 (TypList etyp1) false) then
+        if (maybe_unify etyp (TypList (make_new_typ())) false) ||
+           (maybe_unify etyp2 (TypList (make_new_typ())) false) then
             let _ = unify etyp (TypList etyp1) eloc1 "'::' operation should produce a list" in
             let _ = unify etyp2 (TypList etyp1) eloc2 "incorrect type of the second argument of '::' operation" in
             ExpBinOp(OpCons, new_e1, new_e2, ctx)
@@ -2096,7 +2096,7 @@ and check_pat pat typ env idset typ_vars sc proto_mode simple_pat_mode is_mutabl
     let rec process_id i t loc =
         let i0 = get_orig_id i in
         (if (IdSet.mem i0 !r_idset) then
-            raise_compile_err loc "duplicate identifier"
+            raise_compile_err loc (sprintf "duplicate identifier '%s' in the pattern" (id2str i0))
         else
             r_idset := IdSet.add i0 !r_idset;
         if proto_mode then i0 else
@@ -2113,6 +2113,7 @@ and check_pat pat typ env idset typ_vars sc proto_mode simple_pat_mode is_mutabl
             unify t (get_lit_typ l) loc "the literal of unexpected type";
             p
         | PatIdent(i, loc) ->
+            if (pp_id2str i) = "_" then raise_compile_err loc "'_' occured in PatIdent()" else ();
             PatIdent((process_id i t loc), loc)
         | PatTuple(pl, loc) ->
             let tl = List.map (fun p -> make_new_typ ()) pl in

diff --git a/src/parser.mly b/src/parser.mly
@@ -971,7 +971,15 @@ pat:
 | dot_ident LBRACE id_pat_list_ RBRACE { PatRecord(Some(get_id $1), (List.rev $3), curr_loc()) }
 | LBRACE id_pat_list_ RBRACE { PatRecord(None, (List.rev $2), curr_loc()) }
 | dot_ident LPAREN pat_list_ RPAREN { PatVariant((get_id $1), (List.rev $3), curr_loc()) }
-| dot_ident IDENT { PatVariant((get_id $1), [PatIdent((get_id $2), (curr_loc_n 2))], curr_loc()) }
+| dot_ident IDENT
+    {
+        let arg_loc = curr_loc_n 2 in
+        let arg = match $2 with
+            | "_" -> PatAny(arg_loc)
+            | _ -> PatIdent((get_id $2), arg_loc)
+            in
+        PatVariant((get_id $1), [arg], curr_loc())
+    }
 | dot_ident literal { PatVariant((get_id $1), [PatLit($2, (curr_loc_n 2))], curr_loc()) }
 | pat COLON typespec { PatTyped($1, $3, curr_loc()) }
 | REF pat { PatRef ($2, curr_loc()) }

diff --git a/test/test_filename.fx b/test/test_filename.fx
@@ -8,7 +8,7 @@ import Filename
 
 TEST("filename.regression", fun() {
     val cwd = "/home/joe/project"
-    val sep = Filename.separator()
+    val sep = Filename.dir_sep()
 
     val reg_data = [:
         ("note.txt", ".", "note.txt", "note", cwd+sep+"note.txt"),