Skip to content

Commit

Permalink
Merge pull request #807 from andrew-johnson-4/as-branch-conditional-blob
Browse files Browse the repository at this point in the history 
As branch conditional blob
  • Loading branch information
@andrew-johnson-4
andrew-johnson-4 authored Oct 12, 2024
2 parents 73b8b62 + 2222d09 commit 25ec1fd
Show file tree
Hide file tree
Showing 9 changed files with 31,738 additions and 40,772 deletions.
72,347 changes: 31,654 additions & 40,693 deletions BOOTSTRAP/cli.s
View file

Large diffs are not rendered by default.

2 changes: 1 addition & 1 deletion Cargo.toml
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
[package]
name = "lambda_mountain"
version = "1.17.0"
version = "1.17.1"
authors = ["Andrew <andrew@subarctic.org>"]
license = "MIT"
description = "Typed Macro Assembler (backed by Coq proofs-of-correctness)"
Expand Down
70 changes: 35 additions & 35 deletions LIB/default-primitives.lm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -194,56 +194,56 @@ fragment branchfalse := λ(: _ Nil). (: (
(.expression( 'jne ))
) BranchConditional);

into-branch-conditional := λ: Blob+ImpureCtx(: into-branch-conditional::l BranchConditional). (: (
(:program (:program into-branch-conditional::l))
(:text (:text into-branch-conditional::l))
(:data (:data into-branch-conditional::l))
(:frame (:frame into-branch-conditional::l))
(:unframe (:unframe into-branch-conditional::l))
(:expression( 'jne_l ))
into-branch-conditional := λ: Blob(: l BranchConditional). (: (
(:program (:program l))
(:text (:text l))
(:data (:data l))
(:frame (:frame l))
(:unframe (:unframe l))
(:expression( (:expression l) ))
) BranchConditional);
into-branch-conditional := λ: Blob+ImpureCtx(: into-branch-conditional::l Reg64). (: (
into-branch-conditional := λ: Blob(: l Reg64). (: (
(:program (
(:program into-branch-conditional::l)
'\tcmp\s$0,\s%_l (:expression into-branch-conditional::l) '\n_l
(:program l)
'\tcmp\s$0,\s%_l (:expression l) '\n_l
))
(:text (:text into-branch-conditional::l))
(:data (:data into-branch-conditional::l))
(:frame (:frame into-branch-conditional::l))
(:unframe (:unframe into-branch-conditional::l))
(:text (:text l))
(:data (:data l))
(:frame (:frame l))
(:unframe (:unframe l))
(:expression( 'jne_l ))
) BranchConditional);
into-branch-conditional := λ: Blob+ImpureCtx(: into-branch-conditional::l Reg32). (: (
into-branch-conditional := λ: Blob(: l Reg32). (: (
(:program (
(:program into-branch-conditional::l)
'\tcmp\s$0,\s%_l (:expression into-branch-conditional::l) '\n_l
(:program l)
'\tcmp\s$0,\s%_l (:expression l) '\n_l
))
(:text (:text into-branch-conditional::l))
(:data (:data into-branch-conditional::l))
(:frame (:frame into-branch-conditional::l))
(:unframe (:unframe into-branch-conditional::l))
(:text (:text l))
(:data (:data l))
(:frame (:frame l))
(:unframe (:unframe l))
(:expression( 'jne_l ))
) BranchConditional);
into-branch-conditional := λ: Blob+ImpureCtx(: into-branch-conditional::l Reg16). (: (
into-branch-conditional := λ: Blob(: l Reg16). (: (
(:program (
(:program into-branch-conditional::l)
'\tcmp\s$0,\s%_l (:expression into-branch-conditional::l) '\n_l
(:program l)
'\tcmp\s$0,\s%_l (:expression l) '\n_l
))
(:text (:text into-branch-conditional::l))
(:data (:data into-branch-conditional::l))
(:frame (:frame into-branch-conditional::l))
(:unframe (:unframe into-branch-conditional::l))
(:text (:text l))
(:data (:data l))
(:frame (:frame l))
(:unframe (:unframe l))
(:expression( 'jne_l ))
) BranchConditional);
into-branch-conditional := λ: Blob+ImpureCtx(: into-branch-conditional::l Reg8). (: (
into-branch-conditional := λ: Blob(: l Reg8). (: (
(:program (
(:program into-branch-conditional::l)
'\tcmp\s$0,\s%_l (:expression into-branch-conditional::l) '\n_l
(:program l)
'\tcmp\s$0,\s%_l (:expression l) '\n_l
))
(:text (:text into-branch-conditional::l))
(:data (:data into-branch-conditional::l))
(:frame (:frame into-branch-conditional::l))
(:unframe (:unframe into-branch-conditional::l))
(:text (:text l))
(:data (:data l))
(:frame (:frame l))
(:unframe (:unframe l))
(:expression( 'jne_l ))
) BranchConditional);

Expand Down
11 changes: 0 additions & 11 deletions SRC/as-branch-conditional.lm
View file

This file was deleted.

66 changes: 43 additions & 23 deletions SRC/cc-args.lm
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@

cc-args := λ(: callee-ctx FContext)(: caller-ctx FContext)(: lhs AST)(: rhs AST)(: offset I64)(: is-impure U64). (: (
cc-args := λ(: callee-ctx FContext)(: caller-ctx FContext)(: lhs AST)(: rhs AST)(: offset I64). (: (
# for varargs, even if there is nothing to bind, the binding still needs to exist as an empty vararg list
(match lhs (
()
Expand All @@ -14,22 +14,27 @@ cc-args := λ(: callee-ctx FContext)(: caller-ctx FContext)(: lhs AST)(: rhs AST
(if (is-open kt) (
(set callee-ctx (union( callee-ctx (unify( kt (typeof re) )) )))
) ())
(set callee-ctx (bind-vararg( callee-ctx k kt (compile-expr( caller-ctx re offset Used )) )))
(let e1 (cc-args( callee-ctx caller-ctx lhs le offset is-impure )))
(set callee-ctx (.1 e1))
(let c1 (compile-expr( caller-ctx re offset Used )))
(set offset (.offset c1))
(set caller-ctx (open(.context c1)))
(set callee-ctx (bind-vararg( callee-ctx k kt c1 )))
(let e1 (cc-args( callee-ctx caller-ctx lhs le offset )))
(let tmp-cc-e1 (.1 e1)) (set callee-ctx (.2 tmp-cc-e1)) (set caller-ctx (.1 tmp-cc-e1))
(set offset (.2 e1))
)) (
(let e1 (cc-args( callee-ctx caller-ctx lhs-rst rhs offset is-impure )))
(set callee-ctx (.1 e1))
(let e1 (cc-args( callee-ctx caller-ctx lhs-rst rhs offset )))
(let tmp-cc-e1 (.1 e1)) (set callee-ctx (.2 tmp-cc-e1)) (set caller-ctx (.1 tmp-cc-e1))
(set offset (.2 e1))
))
) (scope(
(if (is-open kt) (
(set callee-ctx (union( callee-ctx (unify( kt (typeof re) )) )))
) ())
(set callee-ctx (FCtxBind( (close callee-ctx) k kt (compile-expr( caller-ctx re offset Used )) )))
(let e1 (cc-args( callee-ctx caller-ctx lhs-rst le offset is-impure )))
(set callee-ctx (.1 e1))
(let c1 (compile-expr( caller-ctx re offset Used )))
(set caller-ctx (open(.context c1)))
(set callee-ctx (FCtxBind( (close callee-ctx) k kt c1 )))
(let e1 (cc-args( callee-ctx caller-ctx lhs-rst le offset )))
(let tmp-cc-e1 (.1 e1)) (set callee-ctx (.2 tmp-cc-e1)) (set caller-ctx (.1 tmp-cc-e1))
(set offset (.2 e1))
)))
))
Expand All @@ -41,17 +46,23 @@ cc-args := λ(: callee-ctx FContext)(: caller-ctx FContext)(: lhs AST)(: rhs AST
(if (is-open kt) (
(set callee-ctx (union( callee-ctx (unify( kt (typeof rhs) )) )))
) ())
(set callee-ctx (bind-vararg( callee-ctx k kt (compile-expr( caller-ctx rhs offset Used )) )))
(let c1 (compile-expr( caller-ctx rhs offset Used )))
(set offset (.offset c1))
(set caller-ctx (open(.context c1)))
(set callee-ctx (bind-vararg( callee-ctx k kt c1 )))
)) (
(let e1 (cc-args( callee-ctx caller-ctx lhs-rst rhs offset is-impure )))
(set callee-ctx (.1 e1))
(let e1 (cc-args( callee-ctx caller-ctx lhs-rst rhs offset )))
(let tmp-cc-e1 (.1 e1)) (set callee-ctx (.2 tmp-cc-e1)) (set caller-ctx (.1 tmp-cc-e1))
(set offset (.2 e1))
))
) (
(if (is-open kt) (
(set callee-ctx (union( callee-ctx (unify( kt (typeof rhs) )) )))
) ())
(set callee-ctx (FCtxBind( (close callee-ctx) k kt (compile-expr( caller-ctx rhs offset Used )) )))
(let c1 (compile-expr( caller-ctx rhs offset Used )))
(set offset (.offset c1))
(set caller-ctx (open(.context c1)))
(set callee-ctx (FCtxBind( (close callee-ctx) k kt c1 )))
))
))
))
Expand All @@ -65,9 +76,12 @@ cc-args := λ(: callee-ctx FContext)(: caller-ctx FContext)(: lhs AST)(: rhs AST
(if (is-open kt) (
(set callee-ctx (union( callee-ctx (unify( kt (typeof re) )) )))
) ())
(set callee-ctx (bind-vararg( callee-ctx k kt (compile-expr( caller-ctx re offset Used )) )))
(let e1 (cc-args( callee-ctx caller-ctx lhs le offset is-impure )))
(set callee-ctx (.1 e1))
(let c1 (compile-expr( caller-ctx re offset Used )))
(set offset (.offset c1))
(set caller-ctx (open(.context c1)))
(set callee-ctx (bind-vararg( callee-ctx k kt c1 )))
(let e1 (cc-args( callee-ctx caller-ctx lhs le offset )))
(let tmp-cc-e1 (.1 e1)) (set callee-ctx (.2 tmp-cc-e1)) (set caller-ctx (.1 tmp-cc-e1))
(set offset (.2 e1))
)) (
(print (typeof rhs))
Expand All @@ -76,21 +90,27 @@ cc-args := λ(: callee-ctx FContext)(: caller-ctx FContext)(: lhs AST)(: rhs AST
))
))
) (
(if (is-vararg kt) (
(if (is-vararg kt) (scope(
(set kt (get-vararg-inner kt))
(if (is-open kt) (
(set callee-ctx (union( callee-ctx (unify( kt (typeof rhs) )) )))
) ())
(set callee-ctx (bind-vararg( callee-ctx k kt (compile-expr( caller-ctx rhs offset Used )) )))
) (
(let c1 (compile-expr( caller-ctx rhs offset Used )))
(set offset (.offset c1))
(set caller-ctx (open(.context c1)))
(set callee-ctx (bind-vararg( callee-ctx k kt c1 )))
)) (scope(
(if (is-open kt) (
(set callee-ctx (union( callee-ctx (unify( kt (typeof rhs) )) )))
) ())
(set callee-ctx (FCtxBind( (close callee-ctx) k kt (compile-expr( caller-ctx rhs offset Used )) )))
))
(let c1 (compile-expr( caller-ctx rhs offset Used )))
(set offset (.offset c1))
(set caller-ctx (open(.context c1)))
(set callee-ctx (FCtxBind( (close callee-ctx) k kt c1 )))
)))
))
))
( ASTNil () )
))
(Tuple( offset callee-ctx ))
) Tuple<I64,FContext>);
(Tuple( offset callee-ctx caller-ctx ))
) Tuple<I64,Tuple<FContext,FContext>>);
6 changes: 3 additions & 3 deletions SRC/cc-blob.lm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,8 +7,9 @@ cc-blob := λ(: caller-ctx FContext)(: function-name String)(: args AST)(: offse
(match (.term f) (
()
( (Abs( lhs rhs tlt )) (
(let e1 (cc-args( global-ctx caller-ctx lhs args offset (is-impure-ctx tlt) )))
(let callee-ctx (.1 e1))
(let e1 (cc-args( global-ctx caller-ctx lhs args offset )))
(set offset (.2 e1))
(let tmp-cc-e1 (.1 e1)) (let callee-ctx (.2 tmp-cc-e1)) (set caller-ctx (.1 tmp-cc-e1))
(if (==( function-name 'cdecl::return_s )) (
(let args-size (fragment-context::lookup( caller-ctx 'cdecl::args-size_s TAny args )))
(set callee-ctx (fragment-context::bind( callee-ctx 'cdecl::args-size_s (t1 'L_s) args-size )))
Expand All @@ -17,7 +18,6 @@ cc-blob := λ(: caller-ctx FContext)(: function-name String)(: args AST)(: offse
(let t (.term f))
(set r (fragment::set-type( r (range(typeof t)) )))
(set r (fragment::set-offset( r offset )))
(if (is-impure-ctx tlt) (set caller-ctx callee-ctx) ())
(set r (fragment::set-context( r caller-ctx )))
))
))
Expand Down
7 changes: 2 additions & 5 deletions SRC/compile-expr-direct.lm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -141,8 +141,7 @@ compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used
(set e (fragment::set-offset( e stack-offset )))
))
( (App( (App( (Var( 'while_s _ )) cond )) body )) (
(let e1 (compile-expr( ctx cond stack-offset Used )))
(set e1 (as-branch-conditional( e1 cond )))
(let e1 (cc-blob( ctx 'into-branch-conditional_s cond stack-offset )))
(let e2 (compile-expr( (open(.context e1)) body (.offset e1) Unused )))

(let ectx (fragment::new()))
Expand All @@ -158,9 +157,7 @@ compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used
))
( (App( (App( (App( (Var( 'if_s _ )) cond )) t )) f )) (
(let rsp-offset (+( stack-offset -8_i64 )))
(let e1 (as-branch-conditional(
(compile-expr( ctx cond rsp-offset Used )) cond
)))
(let e1 (cc-blob( ctx 'into-branch-conditional_s cond rsp-offset )))
(let e2 (compile-expr( (open(.context e1)) t (.offset e1) Tail )))
(let end-offset (.offset e2))
(set e2 (compile-maybe-push-stack( (open(.context e2)) (.offset e2) e2 (typeof term) term )))
Expand Down
1 change: 0 additions & 1 deletion SRC/index-codegen.lm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,4 +15,3 @@ import SRC/translate-local-variables.lm;
import SRC/cc-blob.lm;
import SRC/cc-args.lm;
import SRC/blob-render.lm;
import SRC/as-branch-conditional.lm;
Empty file added tests/regress/rc.lm.skip
View file
Empty file.

0 comments on commit 25ec1fd

Please sign in to comment.