compiles
This commit is contained in:
parent
68a7cafd8e
commit
db2c757355
|
@ -1,6 +1,6 @@
|
||||||
(* number ; is-hole? *)
|
(* number ; is-hole? *)
|
||||||
type meta = Mv of int * bool
|
type meta
|
||||||
|
= Mv of int * bool
|
||||||
|
|
||||||
let cMV : int ref = ref 0
|
let cMV : int ref = ref 0
|
||||||
|
|
||||||
|
|
|
@ -1,15 +1,13 @@
|
||||||
module V = Value
|
module V = Value
|
||||||
module T = Term
|
module T = Term
|
||||||
|
module M = Metaenv
|
||||||
|
|
||||||
let rec index (env : V.env) (i : int) =
|
open List
|
||||||
match env with
|
|
||||||
| [] -> failwith "Can't happen"
|
|
||||||
| x :: xs -> if i < 1 then x else index xs (i-1)
|
|
||||||
|
|
||||||
let rec eval (env : V.env) (tr : T.term) =
|
let rec eval (env : V.env) (tr : T.term) =
|
||||||
match tr with
|
match tr with
|
||||||
| Var (Ix i) -> index env i
|
| Var (Ix i) -> nth env i
|
||||||
| Mv m -> V.Stuck (V.Meta m, ?)
|
| Meta (Mv (i, b)) -> V.Stuck (V.Meta (Mv (i, b)), M.getMetaType i)
|
||||||
| Type -> V.Type
|
| Type -> V.Type
|
||||||
| T0 -> V.T0
|
| T0 -> V.T0
|
||||||
| Ind0 (B b, t) -> begin
|
| Ind0 (B b, t) -> begin
|
||||||
|
|
13
lib/Core/Metaenv.ml
Normal file
13
lib/Core/Metaenv.ml
Normal file
|
@ -0,0 +1,13 @@
|
||||||
|
module C = Common
|
||||||
|
module V = Value
|
||||||
|
|
||||||
|
open List
|
||||||
|
|
||||||
|
type mentry = {m: C.meta; ty: V.value}
|
||||||
|
|
||||||
|
let metaEntries : mentry list ref = ref []
|
||||||
|
|
||||||
|
let getMetaEntry (i : int) =
|
||||||
|
nth (! metaEntries) i
|
||||||
|
|
||||||
|
let getMetaType (i : int) = (getMetaEntry i).ty
|
|
@ -1,6 +1,5 @@
|
||||||
module P = AbsImplicitt
|
module P = AbsImplicitt
|
||||||
module R = RawSyntax
|
module R = RawSyntax
|
||||||
module C = Common
|
|
||||||
|
|
||||||
open R
|
open R
|
||||||
|
|
||||||
|
@ -34,17 +33,18 @@ let rec proc (e : P.id list) (ex : P.exp) =
|
||||||
| ExpPair (e1, e2) -> Pair (proc e e1, proc e e2)
|
| ExpPair (e1, e2) -> Pair (proc e e1, proc e e2)
|
||||||
| ExpFst e1 -> Fst (proc e e1)
|
| ExpFst e1 -> Fst (proc e e1)
|
||||||
| ExpSnd e1 -> Snd (proc e e1)
|
| ExpSnd e1 -> Snd (proc e e1)
|
||||||
| ExpHole -> C.Mv (getCMV (), true)
|
| ExpHole -> Hole
|
||||||
| ExpInd0 (Id i1, e1, e2) -> Ind0 (B (proc (i1 :: e)) e1) e2
|
| ExpInd0 (i1, e1, e2) -> Ind0 (proc (i1 :: e) e1, proc e e2)
|
||||||
| ExpIndN (Id i1, e1, e2, Id i2, Id i3, e3, e4) ->
|
| ExpIndN (i1, e1, e2, i2, i3, e3, e4) ->
|
||||||
IndN (B (proc (i1 :: e) e1)) (proc e e2)
|
IndN (proc (i1 :: e) e1
|
||||||
(B (B (proc (i3 :: i2 :: e) e3)))
|
, proc e e2
|
||||||
(proc e e4)
|
, proc (i3 :: i2 :: e) e3
|
||||||
| ExpIndB (Id i1, e1, e2, e3, e4) ->
|
, proc e e4)
|
||||||
IndB (B (proc (i1 :: e) e1))
|
| ExpIndB (i1, e1, e2, e3, e4) ->
|
||||||
(proc e e2)
|
IndB (proc (i1 :: e) e1
|
||||||
(proc e e3)
|
, proc e e2
|
||||||
(proc e e4)
|
, proc e e3
|
||||||
|
, proc e e4)
|
||||||
|
|
||||||
and unwrapLambda (e : P.id list) (bs : P.bD list) (sc : P.exp) =
|
and unwrapLambda (e : P.id list) (bs : P.bD list) (sc : P.exp) =
|
||||||
match bs with
|
match bs with
|
||||||
|
|
|
@ -1,3 +1,5 @@
|
||||||
|
module C = Core.Common
|
||||||
|
|
||||||
type var = Ix of int
|
type var = Ix of int
|
||||||
type name = string
|
type name = string
|
||||||
|
|
||||||
|
@ -7,6 +9,7 @@ type icit
|
||||||
|
|
||||||
type ast
|
type ast
|
||||||
= Var of var
|
= Var of var
|
||||||
|
| Hole
|
||||||
|
|
||||||
| Type
|
| Type
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user