mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-06 06:48:48 +00:00
Opam/install
This commit is contained in:
Dmitry Boulytchev
parent
166c6663c2
commit
cf78cd20e3
9 changed files with 96 additions and 47 deletions
15
Makefile
15
Makefile
|
|
@ -1,3 +1,6 @@
|
|||
EXECUTABLE = src/rc.opt
|
||||
INSTALL ?= install -v
|
||||
MKDIR ?= mkdir
|
||||
SHELL := /bin/bash
|
||||
|
||||
.PHONY: all regression
|
||||
|
|
@ -7,7 +10,17 @@ all:
|
|||
pushd runtime && make && popd
|
||||
pushd stdlib && make && popd
|
||||
|
||||
#install: ;
|
||||
STD_FILES=$(shell ls stdlib/*.[oi] stdlib/*.expr runtime/runtime.a runtime/Std.i)
|
||||
#$(info $(STD_FILES))
|
||||
|
||||
install: all
|
||||
$(INSTALL) $(EXECUTABLE) `opam var bin`
|
||||
$(MKDIR) -p `opam var share`/Lama
|
||||
$(INSTALL) $(STD_FILES) `opam var share`/Lama/
|
||||
|
||||
uninstall:
|
||||
$(RM) -r `opam var share`/Lama
|
||||
$(RM) `opam var bin`/$(EXECUTABLE)
|
||||
|
||||
regression:
|
||||
pushd regression && make clean check && popd
|
||||
|
|
|
|||
1
opam
1
opam
|
|
@ -20,6 +20,7 @@ build: [
|
|||
[make "-f" "Makefile"]
|
||||
[make "-f" "Makefile" "regression"] {with-test}
|
||||
]
|
||||
install: [make "install"]
|
||||
|
||||
#remove: ["ocamlfind" "remove" "compiler-workout"]
|
||||
#flags: light-uninstall
|
||||
|
|
|
|||
3
regression/orig/test103.log
Normal file
3
regression/orig/test103.log
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
> > > 0
|
||||
0
|
||||
5
|
||||
4
regression/test103.expr
Normal file
4
regression/test103.expr
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
repeat
|
||||
local n = read ();
|
||||
write (n)
|
||||
until n > 0
|
||||
3
regression/test103.input
Normal file
3
regression/test103.input
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
0
|
||||
0
|
||||
5
|
||||
|
|
@ -178,7 +178,7 @@ void* Ls__Infix_58 (void *p, void *q) {
|
|||
|
||||
push_extra_root(&p);
|
||||
push_extra_root(&q);
|
||||
res = Bsexp (3, p, q, 848787);
|
||||
res = Bsexp (BOX(3), p, q, 848787);
|
||||
pop_extra_root(&q);
|
||||
pop_extra_root(&p);
|
||||
|
||||
|
|
@ -779,6 +779,8 @@ extern void* LmakeArray (int length) {
|
|||
|
||||
r->tag = ARRAY_TAG | (n << 3);
|
||||
|
||||
memset (r->contents, 0, n * sizeof(int));
|
||||
|
||||
__post_gc ();
|
||||
|
||||
return r->contents;
|
||||
|
|
@ -869,13 +871,13 @@ extern void* Bstringval (void *p) {
|
|||
return s;
|
||||
}
|
||||
|
||||
extern void* Bclosure (int n, void *entry, ...) {
|
||||
va_list args = (va_list) BOX (NULL);
|
||||
int i = BOX(0),
|
||||
ai = BOX(0);
|
||||
extern void* Bclosure (int bn, void *entry, ...) {
|
||||
va_list args;
|
||||
int i, ai;
|
||||
register int * ebp asm ("ebp");
|
||||
size_t * argss = NULL;
|
||||
data *r = (data*) BOX (NULL);
|
||||
size_t *argss;
|
||||
data *r;
|
||||
int n = UNBOX(bn);
|
||||
|
||||
__pre_gc ();
|
||||
#ifdef DEBUG_PRINT
|
||||
|
|
@ -917,11 +919,11 @@ extern void* Bclosure (int n, void *entry, ...) {
|
|||
return r->contents;
|
||||
}
|
||||
|
||||
extern void* Barray (int n, ...) {
|
||||
va_list args = (va_list) BOX (NULL);
|
||||
int i = BOX(0),
|
||||
ai = BOX(0);
|
||||
data *r = (data*) BOX (NULL);
|
||||
extern void* Barray (int bn, ...) {
|
||||
va_list args;
|
||||
int i, ai;
|
||||
data *r;
|
||||
int n = UNBOX(bn);
|
||||
|
||||
__pre_gc ();
|
||||
|
||||
|
|
@ -949,13 +951,14 @@ extern void* Barray (int n, ...) {
|
|||
return r->contents;
|
||||
}
|
||||
|
||||
extern void* Bsexp (int n, ...) {
|
||||
va_list args = (va_list) BOX (NULL);
|
||||
int i = BOX(0);
|
||||
int ai = BOX(0);
|
||||
size_t * p = NULL;
|
||||
sexp *r = (sexp*) BOX (NULL);
|
||||
data *d = (data *) BOX (NULL);
|
||||
extern void* Bsexp (int bn, ...) {
|
||||
va_list args;
|
||||
int i;
|
||||
int ai;
|
||||
size_t *p;
|
||||
sexp *r;
|
||||
data *d;
|
||||
int n = UNBOX(bn);
|
||||
|
||||
__pre_gc () ;
|
||||
|
||||
|
|
@ -995,27 +998,27 @@ extern void* Bsexp (int n, ...) {
|
|||
}
|
||||
|
||||
extern int Btag (void *d, int t, int n) {
|
||||
data *r = (data *) BOX (NULL);
|
||||
data *r;
|
||||
|
||||
if (UNBOXED(d)) return BOX(0);
|
||||
else {
|
||||
r = TO_DATA(d);
|
||||
#ifndef DEBUG_PRINT
|
||||
return BOX(TAG(r->tag) == SEXP_TAG && TO_SEXP(d)->tag == t && LEN(r->tag) == n);
|
||||
return BOX(TAG(r->tag) == SEXP_TAG && TO_SEXP(d)->tag == UNBOX(t) && LEN(r->tag) == UNBOX(n));
|
||||
#else
|
||||
return BOX(TAG(r->tag) == SEXP_TAG &&
|
||||
GET_SEXP_TAG(TO_SEXP(d)->tag) == t && LEN(r->tag) == n);
|
||||
GET_SEXP_TAG(TO_SEXP(d)->tag) == UNBOX(t) && LEN(r->tag) == UNBOX(n));
|
||||
#endif
|
||||
}
|
||||
}
|
||||
|
||||
extern int Barray_patt (void *d, int n) {
|
||||
data *r = BOX(NULL);
|
||||
data *r;
|
||||
|
||||
if (UNBOXED(d)) return BOX(0);
|
||||
else {
|
||||
r = TO_DATA(d);
|
||||
return BOX(TAG(r->tag) == ARRAY_TAG && LEN(r->tag) == n);
|
||||
return BOX(TAG(r->tag) == ARRAY_TAG && LEN(r->tag) == UNBOX(n));
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -44,7 +44,7 @@ class options args =
|
|||
object (self)
|
||||
val i = ref 1
|
||||
val infile = ref (None : string option)
|
||||
val paths = ref [try Sys.getenv "RC_RUNTIME" with _ -> "../runtime"]
|
||||
val paths = ref [X86.get_std_path ()]
|
||||
val mode = ref (`Default : [`Default | `Eval | `SM | `Compile ])
|
||||
(* Workaround until Ostap starts to memoize properly *)
|
||||
val const = ref false
|
||||
|
|
|
|||
|
|
@ -83,7 +83,7 @@ module Value =
|
|||
|
||||
let to_int = function
|
||||
| Int n -> n
|
||||
| _ -> failwith "int value expected"
|
||||
| x -> failwith (Printf.sprintf "int value expected (%s)\n" (show(t) (fun _ -> "<not supported>") (fun _ -> "<not supported>") x))
|
||||
|
||||
let to_string = function
|
||||
| String s -> s
|
||||
|
|
@ -636,23 +636,24 @@ module Expr =
|
|||
ostap (
|
||||
parse[def][infix][atr]: h:basic[def][infix][Void] -";" t:parse[def][infix][atr] {Seq (h, t)}
|
||||
| basic[def][infix][atr];
|
||||
scope[def][infix][atr][e]: <(d, infix')> : def[infix] expr:e[infix'][atr] {Scope (d, expr)};
|
||||
scope[def][infix][atr][e]: <(d, infix')> : def[infix] expr:e[infix'][atr] {Scope (d, expr)} |
|
||||
<(d, infix')> : def[infix] => {d <> []} => {Scope (d, materialize atr Skip)};
|
||||
|
||||
basic[def][infix][atr]: !(expr (fun x -> x) (Array.map (fun (a, (atr, l)) -> a, (atr, List.map (fun (s, _, f) -> ostap (- $(s)), f) l)) infix) (primary def infix) atr);
|
||||
|
||||
primary[def][infix][atr]:
|
||||
s:(s:"-"? {match s with None -> fun x -> x | _ -> fun x -> Binop ("-", Const 0, x)})
|
||||
s:(s:"-"? {match s with None -> fun x -> x | _ -> fun x -> Binop ("-", Const 0, x)})
|
||||
b:base[def][infix][Val] is:( "." f:LIDENT args:(-"(" !(Util.list)[parse def infix Val] -")")? {`Post (f, args)}
|
||||
| "." %"length" {`Len}
|
||||
| "." %"string" {`Str}
|
||||
| "[" i:parse[def][infix][Val] "]" {`Elem i}
|
||||
| "(" args:!(Util.list0)[parse def infix Val] ")" {`Call args}
|
||||
)+
|
||||
)+
|
||||
=> {match (List.hd (List.rev is)), atr with
|
||||
| `Elem i, Reff -> true
|
||||
| _, Reff -> false
|
||||
| _, _ -> true} =>
|
||||
{
|
||||
{
|
||||
let is =
|
||||
let rec fix_is = function
|
||||
| [ ] -> []
|
||||
|
|
@ -687,7 +688,7 @@ module Expr =
|
|||
in
|
||||
ignore atr (s res)
|
||||
}
|
||||
| base[def][infix][atr];
|
||||
| base[def][infix][atr];
|
||||
base[def][infix][atr]:
|
||||
l:$ n:DECIMAL => {notRef atr} :: (not_a_reference l) => {ignore atr (Const n)}
|
||||
| l:$ s:STRING => {notRef atr} :: (not_a_reference l) => {ignore atr (String s)}
|
||||
|
|
@ -733,7 +734,22 @@ module Expr =
|
|||
| %"for" i:parse[def][infix][Void] "," c:parse[def][infix][Val] "," s:parse[def][infix][Void] %"do" b:scope[def][infix][Void][parse def] => {isVoid atr} => %"od"
|
||||
{materialize atr (Seq (i, While (c, Seq (b, s))))}
|
||||
|
||||
| %"repeat" s:scope[def][infix][Void][parse def] %"until" e:basic[def][infix][Val] => {isVoid atr} => {materialize atr (Repeat (s, e))}
|
||||
| %"repeat" s:scope[def][infix][Void][parse def] %"until" e:basic[def][infix][Val] => {isVoid atr} => {
|
||||
materialize atr @@
|
||||
match s with
|
||||
| Scope (defs, s) ->
|
||||
let defs, s =
|
||||
List.fold_right (fun (name, def) (defs, s) ->
|
||||
match def with
|
||||
| (`Local, `Variable (Some expr)) ->
|
||||
(name, (`Local, `Variable None)) :: defs, Seq (Ignore (Assign (Ref name, expr)), s)
|
||||
| def -> (name, def) :: defs, s)
|
||||
defs
|
||||
([], s)
|
||||
in
|
||||
Scope (defs, Repeat (s, e))
|
||||
| _ -> Repeat (s, e)
|
||||
}
|
||||
| %"return" e:basic[def][infix][Val]? => {isVoid atr} => {Return e}
|
||||
|
||||
| %"case" l:$ e:parse[def][infix][Val] %"of" bs:!(Util.listBy)[ostap ("|")][ostap (!(Pattern.parse) -"->" scope[def][infix][atr][parse def])] %"esac"
|
||||
|
|
@ -941,7 +957,7 @@ module Definition =
|
|||
};
|
||||
parse[infix][expr][expr'][def]:
|
||||
m:(%"local" {`Local} | %"public" e:(%"external")? {match e with None -> `Public | Some _ -> `PublicExtern} | %"external" {`Extern})
|
||||
locs:!(Util.list (local_var m infix expr' def)) ";" {locs, infix}
|
||||
locs:!(Util.list (local_var m infix expr' def)) next:";" {locs, infix}
|
||||
| - <(m, orig_name, name, infix', flag)> : head[infix] -"(" -args:!(Util.list0 arg) -")"
|
||||
(l:$ "{" body:expr[def][infix'][Expr.Weak] "}" {
|
||||
if flag && List.length args != 2 then report_error ~loc:(Some l#coord) "infix operator should accept two arguments";
|
||||
|
|
@ -1084,7 +1100,7 @@ ostap (
|
|||
definitions[infix]:
|
||||
<(def, infix')> : !(Definition.parse infix (fun def infix atr -> Expr.scope def infix atr (Expr.parse def))
|
||||
(fun def infix atr -> Expr.basic def infix atr)
|
||||
definitions) <(defs, infix'')> : definitions[infix'] {
|
||||
definitions) <(defs, infix'')> : definitions[infix'] {
|
||||
def @ defs, infix''
|
||||
}
|
||||
| empty {[], infix}
|
||||
|
|
|
|||
22
src/X86.ml
22
src/X86.ml
|
|
@ -129,6 +129,7 @@ let compile cmd env imports code =
|
|||
| ">" -> "g"
|
||||
| _ -> failwith "unknown operator"
|
||||
in
|
||||
let box n = (n lsl 1) lor 1 in
|
||||
let rec compile' env scode =
|
||||
let on_stack = function S _ -> true | _ -> false in
|
||||
let mov x s = if on_stack x && on_stack s then [Mov (x, eax); Mov (eax, s)] else [Mov (x, s)] in
|
||||
|
|
@ -172,8 +173,8 @@ let compile cmd env imports code =
|
|||
let env, pushs = push_args env [] n in
|
||||
let pushs =
|
||||
match f with
|
||||
| "Barray" -> List.rev @@ (Push (L n)) :: pushs
|
||||
| "Bsexp" -> List.rev @@ (Push (L n)) :: pushs
|
||||
| "Barray" -> List.rev @@ (Push (L (box n))) :: pushs
|
||||
| "Bsexp" -> List.rev @@ (Push (L (box n))) :: pushs
|
||||
| "Bsta" -> pushs
|
||||
| _ -> List.rev pushs
|
||||
in
|
||||
|
|
@ -203,7 +204,7 @@ let compile cmd env imports code =
|
|||
pushr @
|
||||
push_closure @
|
||||
[Push (M ("$" ^ name));
|
||||
Push (L closure_len);
|
||||
Push (L (box closure_len));
|
||||
Call "Bclosure";
|
||||
Binop ("+", L (word_size * (closure_len + 2)), esp);
|
||||
Mov (eax, s)] @
|
||||
|
|
@ -211,7 +212,7 @@ let compile cmd env imports code =
|
|||
|
||||
| CONST n ->
|
||||
let s, env' = env#allocate in
|
||||
(env', [Mov (L ((n lsl 1) lor 1), s)])
|
||||
(env', [Mov (L (box n), s)])
|
||||
|
||||
| STRING s ->
|
||||
let s, env = env#string s in
|
||||
|
|
@ -431,12 +432,12 @@ let compile cmd env imports code =
|
|||
let s1, env = env#allocate in
|
||||
let s2, env = env#allocate in
|
||||
let env, code = call env ".tag" 3 in
|
||||
env, [Mov (L env#hash t, s1); Mov (L n, s2)] @ code
|
||||
env, [Mov (L (box (env#hash t)), s1); Mov (L (box n), s2)] @ code
|
||||
|
||||
| ARRAY n ->
|
||||
let s, env = env#allocate in
|
||||
let env, code = call env ".array_patt" 2 in
|
||||
env, [Mov (L n, s)] @ code
|
||||
env, [Mov (L (box n), s)] @ code
|
||||
|
||||
| PATT StrCmp -> call env ".string_patt" 2
|
||||
|
||||
|
|
@ -454,7 +455,7 @@ let compile cmd env imports code =
|
|||
| FAIL ((line, col), value) ->
|
||||
let v, env = if value then env#peek, env else env#pop in
|
||||
let s, env = env#string cmd#get_infile in
|
||||
env, [Push (L col); Push (L line); Push (M ("$" ^ s)); Push v; Call "Bmatch_failure"; Binop ("+", L (3 * word_size), esp)]
|
||||
env, [Push (L (box col)); Push (L (box line)); Push (M ("$" ^ s)); Push v; Call "Bmatch_failure"; Binop ("+", L (3 * word_size), esp)]
|
||||
|
||||
| i ->
|
||||
invalid_arg (Printf.sprintf "invalid SM insn: %s\n" (GT.show(insn) i))
|
||||
|
|
@ -688,6 +689,11 @@ let genasm cmd prog =
|
|||
(globals @ data @ [Meta "\t.text"] @ code);
|
||||
Buffer.contents asm
|
||||
|
||||
let get_std_path () =
|
||||
match Sys.getenv_opt "RC_RUNTIME" with
|
||||
| Some s -> s
|
||||
| None -> "../runtime"
|
||||
|
||||
(* Builds a program: generates the assembler file and compiles it with the gcc toolchain *)
|
||||
let build cmd prog =
|
||||
let find_objects imports paths =
|
||||
|
|
@ -710,7 +716,7 @@ let build cmd prog =
|
|||
in
|
||||
cmd#dump_file "s" (genasm cmd prog);
|
||||
cmd#dump_file "i" (Interface.gen prog);
|
||||
let inc = try Sys.getenv "RC_RUNTIME" with _ -> "../runtime" in
|
||||
let inc = get_std_path () in
|
||||
match cmd#get_mode with
|
||||
| `Default ->
|
||||
let objs = find_objects (fst @@ fst prog) cmd#get_include_paths in
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue