Skip to content

Commit 84c8c79

Browse files
Merge pull request #223 from andrew-johnson-4/finish-match
Finish match
2 parents ac28e5f + b9d1d5c commit 84c8c79

File tree

11 files changed

+165408
-1360
lines changed

11 files changed

+165408
-1360
lines changed

BOOTSTRAP/production1.s

+165,290
Large diffs are not rendered by default.

Cargo.toml

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
[package]
22
name = "lambda_mountain"
3-
version = "1.11.86"
3+
version = "1.11.87"
44
authors = ["Andrew <andrew@subarctic.org>"]
55
license = "MIT"
66
description = "Lambda Mountain"

Makefile

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11

22
nostd: prod
3-
./production --nostd -o tmp.s tests/strict/match5.lm
3+
./production --nostd -o tmp.s tests/strict/match6.lm
44
as -o tmp.o tmp.s
55
ld -o tmp tmp.o
66
./tmp && echo $?

PRODUCTION/codegen-strict.lm

+9-3
Original file line numberDiff line numberDiff line change
@@ -105,7 +105,7 @@ compile-expr-strict := λctx e offset used . (tail(
105105
( (App( (App( (App( (Variable 'if) cond )) t )) f )) (tail(
106106
(set e1 (compile-expr-strict( ctx cond offset Used )))
107107
(set e2 (compile-expr-strict( (expr::get-context e1) t (expr::get-offset e1) Used )))
108-
(set e3 (compile-expr-strict( ctx f (expr::get-offset e1) Used )))
108+
(set e3 (compile-expr-strict( ctx f (expr::get-offset e2) Used )))
109109
(match (expr::get-type e1) (
110110
()
111111
(BranchConditional ())
@@ -132,11 +132,17 @@ compile-expr-strict := λctx e offset used . (tail(
132132
(expr::get-unframe e3)
133133
\t 'jmp \s label-end \n
134134
label-true-branch ': \n
135-
(expr::get-frame e2)
136135
(expr::get-prog e2)
137-
(expr::get-unframe e2)
138136
label-end ': \n
139137
))))
138+
(set e4 (expr::set-context( e4 (expr::get-context e2) )))
139+
(set e4 (expr::set-offset( e4 (expr::get-offset e1) )))
140+
(set e4 (expr::set-frame( e4 (
141+
(expr::get-frame e1) (expr::get-frame e2)
142+
))))
143+
(set e4 (expr::set-unframe( e4 (
144+
(expr::get-unframe e1) (expr::get-unframe e2)
145+
))))
140146
e4
141147
)))
142148
( (App( (Variable 'label) (Variable label-name) )) (

PRODUCTION/preprocess.lm

+26-11
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,15 @@ preprocess-index-types := ();
33

44
preprocess := λprogram . (tail(
55
(preprocess-index-typedefs program)
6-
(preprocess-apply-macros program)
6+
(set program (preprocess-apply-macros program))
7+
program
8+
));
9+
10+
preprocess-dump := λprogram . (tail(
11+
(while program (
12+
(print-s (tail program))(print-s \n)
13+
(set program (head program))
14+
))
715
));
816

917
preprocess-index-typedefs := λprogram . (tail(
@@ -108,23 +116,30 @@ try-destructure-macro := λlhs e . (match (lhs e) (
108116
(Accept (KV( pv e )))
109117
)
110118
))
111-
( ( (App( (Literal :Tag:) (Variable pv) )) (Literal el)) (
119+
( ( (App( (Literal :Variable:) (Variable pv) )) (Variable el)) (
120+
(Accept (KV( pv e )))
121+
))
122+
( ( (App( (App( (Literal :Tag:) (Variable pv) )) (Variable pt) )) (Literal el)) (
112123
(if (preprocess-index-of-tag el)
113-
(Accept (KV( pv
114-
(App(
124+
( Accept
125+
(KV(
126+
pv
115127
(App(
116-
(Literal :)
117-
(Literal (preprocess-index-of-tag el))
128+
(App(
129+
(Literal :)
130+
(Literal (preprocess-index-of-tag el))
131+
))
132+
(preprocess-restructure-type(parse-type( Constant+Literal+U64 )))
118133
))
119-
(preprocess-restructure-type(parse-type( Constant+Literal+U64 )))
120134
))
121-
)))
135+
(KV(
136+
pt
137+
(preprocess-restructure-type(parse-type( el )))
138+
))
139+
)
122140
()
123141
)
124142
))
125-
( ( (App( (Literal :Variable:) (Variable pv) )) (Variable el)) (
126-
(Accept (KV( pv e )))
127-
))
128143
( ((Variable pv) e) (
129144
(Accept (KV( pv e )))
130145
))

PRODUCTION/typecheck.lm

+2-4
Original file line numberDiff line numberDiff line change
@@ -782,9 +782,8 @@ typecheck-infer-expr := λctx e used . (tail(
782782
(typecheck-ascript( e (parse-type( U64+Literal+Constant )) ))
783783
)))
784784
( (App( (App( (App( (Variable 'if) cond )) t )) f )) (tail(
785-
(local iflet-ctx)
786-
(set iflet-ctx (typecheck-infer-expr( ctx cond Used )))
787-
(typecheck-infer-expr( iflet-ctx t Used ))
785+
(set ctx (typecheck-infer-expr( ctx cond Used )))
786+
(set ctx (typecheck-infer-expr( ctx t Used )))
788787
(typecheck-infer-expr( ctx f Used ))
789788
(typecheck-ascript( e (typecheck-lookup t) ))
790789
)))
@@ -808,7 +807,6 @@ typecheck-infer-expr := λctx e used . (tail(
808807
(set ctx ( ctx (lname ()) ))
809808
))
810809
(typecheck-ascript( e Nil ))
811-
ctx
812810
)))
813811
( (App( l r )) (tail(
814812
(set ctx (typecheck-infer-expr( ctx l used )))

STDLIB/default-rules.lm

+49-4
Original file line numberDiff line numberDiff line change
@@ -15,19 +15,64 @@ macro ('match-pats( term (ps (lhs rhs)) remainder )) (
1515
(match-pats(
1616
term
1717
ps
18-
(if (match-pats-condition term lhs) rhs remainder)
18+
(if (match-pats-condition( term lhs )) rhs remainder)
1919
))
2020
);
2121

22-
macro ('match-pats-condition term (:Variable: v)) (
22+
macro ('match-pats-condition( term (:Variable: v) )) (
2323
(tail( (let v term) (branchtrue()) ))
2424
);
2525

26-
macro ('match-pats-condition term (:Literal: l)) (
26+
macro ('match-pats-condition( term (:Literal: l) )) (
2727
(==( term l ))
2828
);
2929

30-
macro ('match-pats-condition term (:Tag: l)) (
30+
macro ('match-pats-condition( term (:Tag: l lt) )) (
3131
(==( (.0( term )) l ))
3232
);
3333

34+
macro ('match-pats-condition( term ((:Tag: l lt) ( x1 )) )) (tail(
35+
(let ok Trueu8)
36+
(if (==( (.0( term )) l )) () (set ok Falseu8))
37+
(if (match-pats-condition( (.1( (as term lt) )) x1 )) () (set ok Falseu8))
38+
(==( ok Trueu8 ))
39+
));
40+
41+
macro ('match-pats-condition( term ((:Tag: l lt) ( x2 x1 ) ))) (tail(
42+
(let ok Trueu8)
43+
(if (==( (.0( term )) l )) () (set ok Falseu8))
44+
(if (match-pats-condition( (.1( (as term lt) )) x1 )) () (set ok Falseu8))
45+
(if (match-pats-condition( (.2( (as term lt) )) x2 )) () (set ok Falseu8))
46+
(==( ok Trueu8 ))
47+
));
48+
49+
macro ('match-pats-condition( term ((:Tag: l lt) ( x3 x2 x1 ) ))) (tail(
50+
(let ok Trueu8)
51+
(if (==( (.0( term )) l )) () (set ok Falseu8))
52+
(if (match-pats-condition( (.1( (as term lt) )) x1 )) () (set ok Falseu8))
53+
(if (match-pats-condition( (.2( (as term lt) )) x2 )) () (set ok Falseu8))
54+
(if (match-pats-condition( (.3( (as term lt) )) x3 )) () (set ok Falseu8))
55+
(==( ok Trueu8 ))
56+
));
57+
58+
macro ('match-pats-condition( term ((:Tag: l lt) ( x4 x3 x2 x1 ) ))) (tail(
59+
(let ok Trueu8)
60+
(if (==( (.0( term )) l )) () (set ok Falseu8))
61+
(if (match-pats-condition( (.1( (as term lt) )) x1 )) () (set ok Falseu8))
62+
(if (match-pats-condition( (.2( (as term lt) )) x2 )) () (set ok Falseu8))
63+
(if (match-pats-condition( (.3( (as term lt) )) x3 )) () (set ok Falseu8))
64+
(if (match-pats-condition( (.4( (as term lt) )) x4 )) () (set ok Falseu8))
65+
(==( ok Trueu8 ))
66+
));
67+
68+
macro ('match-pats-condition( term ((:Tag: l lt) ( x5 x4 x3 x2 x1 ) ))) (tail(
69+
(let ok Trueu8)
70+
(if (==( (.0( term )) l )) () (set ok Falseu8))
71+
(if (match-pats-condition( (.1( (as term lt) )) x1 )) () (set ok Falseu8))
72+
(if (match-pats-condition( (.2( (as term lt) )) x2 )) () (set ok Falseu8))
73+
(if (match-pats-condition( (.3( (as term lt) )) x3 )) () (set ok Falseu8))
74+
(if (match-pats-condition( (.4( (as term lt) )) x4 )) () (set ok Falseu8))
75+
(if (match-pats-condition( (.5( (as term lt) )) x5 )) () (set ok Falseu8))
76+
(==( ok Trueu8 ))
77+
));
78+

preprocess.lm.bak

-206
This file was deleted.

0 commit comments

Comments
 (0)